From 396b49871aa5432e2ff00230868013a22b180656 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Jan 2024 07:43:25 +0200 Subject: [PATCH 001/385] ; Fix last change in package.texi * doc/lispref/package.texi (Multi-file Packages): Fix wording and markup. (Bug#65027) (cherry picked from commit 6d76e3991241905b0841effc6f8cd42394d9aa64) --- doc/lispref/package.texi | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index ebe578932bf..f75023d4039 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -284,12 +284,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: (expand-file-name file superfrobnicator-base)) @end smallexample - If your project contains files that you don't wish to distribute to +@cindex @file{.elpaignore} file + If your package contains files that you don't wish to distribute to users (e.g.@: regression tests), you can add them to an -@file{.elpaignore} file. In this file, each line lists a file or -wildcard matching files to ignore when producing your package's tar -file on ELPA. (ELPA will pass this file to @command{tar} with the -@code{-X} option.) +@file{.elpaignore} file. In this file, each line lists a file or a +wildcard matching files; those files should be ignored when producing +your package's tarball on ELPA (@pxref{Package Archives}). (ELPA +will pass this file to the @command{tar} command via the @option{-X} +command-line option, when it prepares the package for download.) @node Package Archives @section Creating and Maintaining Package Archives From c22d0ae2dd899ebc1f74e4e67f098216899ea202 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 28 Jan 2024 10:19:48 +0200 Subject: [PATCH 002/385] Fix "emacs -nw" on MS-Windows * src/w32term.c (w32_flip_buffers_if_dirty): Do nothing if F is not a GUI frame. This avoids rare crashes in "emacs -nw". * src/w32console.c (initialize_w32_display): Set the ENABLE_EXTENDED_FLAGS bit in 'prev_console_mode'. (cherry picked from commit e1970c99f097715fc5bb3b88154799bfe13de90f) --- src/w32console.c | 4 ++++ src/w32term.c | 5 +++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/w32console.c b/src/w32console.c index c2b87928cc1..0936b5f37e6 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -705,6 +705,10 @@ initialize_w32_display (struct terminal *term, int *width, int *height) /* Remember original console settings. */ keyboard_handle = GetStdHandle (STD_INPUT_HANDLE); GetConsoleMode (keyboard_handle, &prev_console_mode); + /* Make sure ENABLE_EXTENDED_FLAGS is set in console settings, + otherwise restoring the original setting of ENABLE_MOUSE_INPUT + will not work. */ + prev_console_mode |= ENABLE_EXTENDED_FLAGS; prev_screen = GetStdHandle (STD_OUTPUT_HANDLE); diff --git a/src/w32term.c b/src/w32term.c index 6dae118108e..281ce3c663a 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -776,12 +776,13 @@ w32_buffer_flipping_unblocked_hook (struct frame *f) /* Flip buffers on F if drawing has happened. This function is not called to flush the display connection of a frame (which doesn't - exist on MS Windows), but also called in some situations in + exist on MS Windows), but is called in some situations in minibuf.c to make the contents of the back buffer visible. */ void w32_flip_buffers_if_dirty (struct frame *f) { - if (FRAME_OUTPUT_DATA (f)->paint_buffer + if (FRAME_W32_P (f) /* do nothing in TTY frames */ + && FRAME_OUTPUT_DATA (f)->paint_buffer && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty && !f->garbaged && !buffer_flipping_blocked_p ()) w32_show_back_buffer (f); From 77f5d4d523a406650036b7cd0d872d39a114a9ac Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sun, 12 Nov 2023 13:21:50 -0800 Subject: [PATCH 003/385] Fix completing-read functional REQUIRE-MATCH behavior * lisp/minibuffer.el (completion--complete-and-exit): If minibuffer-completion-confirm is a function which returns nil, immediately fail to complete. See bug#66187. --- lisp/minibuffer.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3c4315b87fc..faa7f543ece 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1847,10 +1847,13 @@ appear to be a match." ;; Allow user to specify null string ((= beg end) (funcall exit-function)) ;; The CONFIRM argument is a predicate. - ((and (functionp minibuffer-completion-confirm) - (funcall minibuffer-completion-confirm - (buffer-substring beg end))) - (funcall exit-function)) + ((functionp minibuffer-completion-confirm) + (if (funcall minibuffer-completion-confirm + (buffer-substring beg end)) + (funcall exit-function) + (unless completion-fail-discreetly + (ding) + (completion--message "No match")))) ;; See if we have a completion from the table. ((test-completion (buffer-substring beg end) minibuffer-completion-table From 2f98b13ed0522ef37c7bb2ca37f24b1be2f9fde5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 29 Jan 2024 14:56:40 +0200 Subject: [PATCH 004/385] ; Fix doc strings of splash-screen data structures * lisp/startup.el (fancy-startup-text, fancy-about-text): Doc fixes. (Bug#68788) --- lisp/startup.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index dcc99fd3dea..eb1e027d2cb 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1749,7 +1749,7 @@ If this is nil, no message will be displayed." "\n")) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs -`:face FACE', like `fancy-splash-insert' accepts them.") +`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") (defconst fancy-about-text `((:face (variable-pitch font-lock-comment-face) @@ -1842,7 +1842,7 @@ Each element in the list should be a list of strings or pairs "\tDisplay the Emacs manual in Info mode")) "A list of texts to show in the middle part of the About screen. Each element in the list should be a list of strings or pairs -`:face FACE', like `fancy-splash-insert' accepts them.") +`:KEYWORD VALUE', like what `fancy-splash-insert' accepts.") (defgroup fancy-splash-screen () From cfc1779f4676b1be3ff34abc913e97a1b2a7de37 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 29 Jan 2024 21:18:12 +0100 Subject: [PATCH 005/385] * Better type comparison in comp tests * test/src/comp-tests.el (comp-tests--type-lists-equal): New function. (comp-tests--types-equal): Handle function types. --- test/src/comp-tests.el | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 54a9a6c11cc..fbcb6ca9560 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -904,16 +904,23 @@ Return a list of results." (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) (should (= (comp-tests-fw-prop-1-f) 6)))) +(defun comp-tests--type-lists-equal (l1 l2) + (and (= (length l1) (length l2)) + (cl-every #'comp-tests--types-equal l1 l2))) + (defun comp-tests--types-equal (t1 t2) - "Whether the types T1 and T2 are equal." - (or (equal t1 t2) ; optimization for the common case - (and (consp t1) (consp t2) - (eq (car t1) (car t2)) - (if (memq (car t1) '(and or member)) - (null (cl-set-exclusive-or (cdr t1) (cdr t2) - :test #'comp-tests--types-equal)) - (and (= (length t1) (length t2)) - (cl-every #'comp-tests--types-equal (cdr t1) (cdr t2))))))) + "Whether the types T1 and T2 are equal." + (or (equal t1 t2) ; for atoms, and optimization for the common case + (and (consp t1) (consp t2) + (eq (car t1) (car t2)) + (cond ((memq (car t1) '(and or member)) + ;; Order or duplicates don't matter. + (null (cl-set-exclusive-or (cdr t1) (cdr t2) + :test #'comp-tests--types-equal))) + ((eq (car t1) 'function) + (and (comp-tests--type-lists-equal (nth 1 t1) (nth 1 t2)) + (comp-tests--types-equal (nth 2 t1) (nth 2 t2)))) + (t (comp-tests--type-lists-equal (cdr t1) (cdr t2))))))) (defun comp-tests-check-ret-type-spec (func-form ret-type) (let ((lexical-binding t) From e625f2044a37f638e8c76b18e0b2d030031d6eda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 18:56:19 -0500 Subject: [PATCH 006/385] (byte-compile): Try and make it a bit more readable * lisp/emacs-lisp/bytecomp.el (byte-compile--reify-function): Use `macroexp-parse-body` and only handle closures. (byte-compile): Clarify the control and data flow a bit. --- lisp/emacs-lisp/bytecomp.el | 82 ++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 46 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ea9298c6646..e87595b3e77 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3018,18 +3018,10 @@ otherwise, print without quoting." (defun byte-compile--reify-function (fun) "Return an expression which will evaluate to a function value FUN. -FUN should be either a `lambda' value or a `closure' value." - (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) - `(closure ,env ,args . ,body)) - fun) - (preamble nil) +FUN should be an interpreted closure." + (pcase-let* ((`(closure ,env ,args . ,body) fun) + (`(,preamble . ,body) (macroexp-parse-body body)) (renv ())) - ;; Split docstring and `interactive' form from body. - (when (stringp (car body)) - (push (pop body) preamble)) - (when (eq (car-safe (car body)) 'interactive) - (push (pop body) preamble)) - (setq preamble (nreverse preamble)) ;; Turn the function's closed vars (if any) into local let bindings. (dolist (binding env) (cond @@ -3051,41 +3043,39 @@ If FORM is a lambda or a macro, byte-compile it as a function." (fun (if (symbolp form) (symbol-function form) form)) - (macro (eq (car-safe fun) 'macro))) - (if macro - (setq fun (cdr fun))) - (prog1 - (cond - ;; Up until Emacs-24.1, byte-compile silently did nothing - ;; when asked to compile something invalid. So let's tone - ;; down the complaint from an error to a simple message for - ;; the known case where signaling an error causes problems. - ((compiled-function-p fun) - (message "Function %s is already compiled" - (if (symbolp form) form "provided")) - fun) - (t - (let (final-eval) - (when (or (symbolp form) (eq (car-safe fun) 'closure)) - ;; `fun' is a function *value*, so try to recover its corresponding - ;; source code. - (setq lexical-binding (eq (car fun) 'closure)) - (setq fun (byte-compile--reify-function fun)) - (setq final-eval t)) - ;; Expand macros. - (setq fun (byte-compile-preprocess fun)) - (setq fun (byte-compile-top-level fun nil 'eval)) - (if (symbolp form) - ;; byte-compile-top-level returns an *expression* equivalent to the - ;; `fun' expression, so we need to evaluate it, tho normally - ;; this is not needed because the expression is just a constant - ;; byte-code object, which is self-evaluating. - (setq fun (eval fun t))) - (if final-eval - (setq fun (eval fun t))) - (if macro (push 'macro fun)) - (if (symbolp form) (fset form fun)) - fun)))))))) + (macro (eq (car-safe fun) 'macro)) + (need-a-value nil)) + (when macro + (setq need-a-value t) + (setq fun (cdr fun))) + (cond + ;; Up until Emacs-24.1, byte-compile silently did nothing + ;; when asked to compile something invalid. So let's tone + ;; down the complaint from an error to a simple message for + ;; the known case where signaling an error causes problems. + ((compiled-function-p fun) + (message "Function %s is already compiled" + (if (symbolp form) form "provided")) + fun) + (t + (when (or (symbolp form) (eq (car-safe fun) 'closure)) + ;; `fun' is a function *value*, so try to recover its + ;; corresponding source code. + (when (setq lexical-binding (eq (car-safe fun) 'closure)) + (setq fun (byte-compile--reify-function fun))) + (setq need-a-value t)) + ;; Expand macros. + (setq fun (byte-compile-preprocess fun)) + (setq fun (byte-compile-top-level fun nil 'eval)) + (when need-a-value + ;; `byte-compile-top-level' returns an *expression* equivalent to + ;; the `fun' expression, so we need to evaluate it, tho normally + ;; this is not needed because the expression is just a constant + ;; byte-code object, which is self-evaluating. + (setq fun (eval fun lexical-binding))) + (if macro (push 'macro fun)) + (if (symbolp form) (fset form fun)) + fun)))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." From c385e966e18bebd52b1a692f13e2a7495891966d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 19:04:59 -0500 Subject: [PATCH 007/385] derived.el: Delete old code (bug#68625) * lisp/emacs-lisp/derived.el (derived-mode-setup-function-name) (derived-mode-init-mode-variables, derived-mode-set-keymap) (derived-mode-set-syntax-table, derived-mode-set-abbrev-table) (derived-mode-run-hooks, derived-mode-merge-keymaps) (derived-mode-merge-syntax-tables, derived-mode-merge-abbrev-tables): Delete functions. --- etc/NEWS | 10 +++ lisp/emacs-lisp/derived.el | 131 ------------------------------------- 2 files changed, 10 insertions(+), 131 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a21f45481fd..a9d6eb6789d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1370,6 +1370,16 @@ files and save the changes. * Incompatible Lisp Changes in Emacs 30.1 +--- +** Old 'derived.el' functions removed. +The following functions have been deleted because they were only used +by code compiled with Emacs<21: +'derived-mode-setup-function-name', 'derived-mode-init-mode-variables', +'derived-mode-set-keymap', 'derived-mode-set-syntax-table', +'derived-mode-set-abbrev-table', 'derived-mode-run-hooks', +'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables', +'derived-mode-merge-abbrev-tables'. + +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. By default, Text mode no longer binds 'M-TAB' to diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 726f96a25f7..2423426dca0 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -365,137 +365,6 @@ which more-or-less shadow%s %s's corresponding table%s." docstring)) -;;; OBSOLETE -;; The functions below are only provided for backward compatibility with -;; code byte-compiled with versions of derived.el prior to Emacs-21. - -(defsubst derived-mode-setup-function-name (mode) - "Construct a setup-function name based on a MODE name." - (declare (obsolete nil "28.1")) - (intern (concat (symbol-name mode) "-setup"))) - - -;; Utility functions for defining a derived mode. - -;;;###autoload -(defun derived-mode-init-mode-variables (mode) - "Initialize variables for a new MODE. -Right now, if they don't already exist, set up a blank keymap, an -empty syntax table, and an empty abbrev table -- these will be merged -the first time the mode is used." - - (if (boundp (derived-mode-map-name mode)) - t - (eval `(defvar ,(derived-mode-map-name mode) - (make-sparse-keymap) - ,(format "Keymap for %s." mode))) - (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-syntax-table-name mode)) - t - (eval `(defvar ,(derived-mode-syntax-table-name mode) - ;; Make a syntax table which doesn't specify anything - ;; for any char. Valid data will be merged in by - ;; derived-mode-merge-syntax-tables. - (make-char-table 'syntax-table nil) - ,(format "Syntax table for %s." mode))) - (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-abbrev-table-name mode)) - t - (eval `(defvar ,(derived-mode-abbrev-table-name mode) - (progn - (define-abbrev-table (derived-mode-abbrev-table-name ',mode) nil) - (make-abbrev-table)) - ,(format "Abbrev table for %s." mode))))) - -;; Utility functions for running a derived mode. - -(defun derived-mode-set-keymap (mode) - "Set the keymap of the new MODE, maybe merging with the parent." - (let* ((map-name (derived-mode-map-name mode)) - (new-map (eval map-name)) - (old-map (current-local-map))) - (and old-map - (get map-name 'derived-mode-unmerged) - (derived-mode-merge-keymaps old-map new-map)) - (put map-name 'derived-mode-unmerged nil) - (use-local-map new-map))) - -(defun derived-mode-set-syntax-table (mode) - "Set the syntax table of the new MODE, maybe merging with the parent." - (let* ((table-name (derived-mode-syntax-table-name mode)) - (old-table (syntax-table)) - (new-table (eval table-name))) - (if (get table-name 'derived-mode-unmerged) - (derived-mode-merge-syntax-tables old-table new-table)) - (put table-name 'derived-mode-unmerged nil) - (set-syntax-table new-table))) - -(defun derived-mode-set-abbrev-table (mode) - "Set the abbrev table for MODE if it exists. -Always merge its parent into it, since the merge is non-destructive." - (let* ((table-name (derived-mode-abbrev-table-name mode)) - (old-table local-abbrev-table) - (new-table (eval table-name))) - (derived-mode-merge-abbrev-tables old-table new-table) - (setq local-abbrev-table new-table))) - -(defun derived-mode-run-hooks (mode) - "Run the mode hook for MODE." - (let ((hooks-name (derived-mode-hook-name mode))) - (if (boundp hooks-name) - (run-hooks hooks-name)))) - -;; Functions to merge maps and tables. - -(defun derived-mode-merge-keymaps (old new) - "Merge an OLD keymap into a NEW one. -The old keymap is set to be the last cdr of the new one, so that there will -be automatic inheritance." - ;; ?? Can this just use `set-keymap-parent'? - (let ((tail new)) - ;; Scan the NEW map for prefix keys. - (while (consp tail) - (and (consp (car tail)) - (let* ((key (vector (car (car tail)))) - (subnew (lookup-key new key)) - (subold (lookup-key old key))) - ;; If KEY is a prefix key in both OLD and NEW, merge them. - (and (keymapp subnew) (keymapp subold) - (derived-mode-merge-keymaps subold subnew)))) - (and (vectorp (car tail)) - ;; Search a vector of ASCII char bindings for prefix keys. - (let ((i (1- (length (car tail))))) - (while (>= i 0) - (let* ((key (vector i)) - (subnew (lookup-key new key)) - (subold (lookup-key old key))) - ;; If KEY is a prefix key in both OLD and NEW, merge them. - (and (keymapp subnew) (keymapp subold) - (derived-mode-merge-keymaps subold subnew))) - (setq i (1- i))))) - (setq tail (cdr tail)))) - (setcdr (nthcdr (1- (length new)) new) old)) - -(defun derived-mode-merge-syntax-tables (old new) - "Merge an OLD syntax table into a NEW one. -Where the new table already has an entry, nothing is copied from the old one." - (set-char-table-parent new old)) - -;; Merge an old abbrev table into a new one. -;; This function requires internal knowledge of how abbrev tables work, -;; presuming that they are obarrays with the abbrev as the symbol, the expansion -;; as the value of the symbol, and the hook as the function definition. -(defun derived-mode-merge-abbrev-tables (old new) - (if old - (mapatoms - (lambda (symbol) - (or (intern-soft (symbol-name symbol) new) - (define-abbrev new (symbol-name symbol) - (symbol-value symbol) (symbol-function symbol)))) - old))) - (provide 'derived) ;;; derived.el ends here From a470dfb7f8a0f6d561b1f7c9665408d73b578e18 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 29 Jan 2024 17:33:35 -0800 Subject: [PATCH 008/385] Fix typo in Eshell's "du" command This option is supposed to be "--si", for "International System of Units", not "--is". * lisp/eshell/em-unix.el (eshell/du): Change "is" to "si". --- lisp/eshell/em-unix.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index c3c3fea691a..a88c7e09946 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -940,7 +940,7 @@ external command." "display data only this many levels of data") (?h "human-readable" 1024 human-readable "print sizes in human readable format") - (?H "is" 1000 human-readable + (?H "si" 1000 human-readable "likewise, but use powers of 1000 not 1024") (?k "kilobytes" 1024 block-size "like --block-size 1024") From c8b9ec923f2838321aafd6c0912c7e6371145ce0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 30 Jan 2024 16:15:59 +0200 Subject: [PATCH 009/385] ; Rename a lexical variable in vhdl-mode.el * lisp/progmodes/vhdl-mode.el (vhdl-speedbar-insert-hierarchy): Rename a variable to avoid shadowing a global. (Bug#68810) --- lisp/progmodes/vhdl-mode.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index afdf52629c4..f52baf049aa 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -14978,9 +14978,9 @@ otherwise use cached data." (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg - package-alist ent-inst-list depth) - "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST." - (if (not (or ent-alist-arg conf-alist-arg package-alist)) + pkg-alist ent-inst-list depth) + "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST." + (if (not (or ent-alist-arg conf-alist-arg pkg-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -15010,15 +15010,15 @@ otherwise use cached data." 'vhdl-speedbar-configuration-face depth) (setq conf-alist (cdr conf-alist))) ;; insert packages - (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while package-alist - (setq pack-entry (car package-alist)) + (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth)) + (while pkg-alist + (setq pack-entry (car pkg-alist)) (vhdl-speedbar-make-pack-line (nth 0 pack-entry) (nth 1 pack-entry) (cons (nth 2 pack-entry) (nth 3 pack-entry)) (cons (nth 7 pack-entry) (nth 8 pack-entry)) depth) - (setq package-alist (cdr package-alist)))))) + (setq pkg-alist (cdr pkg-alist)))))) (declare-function speedbar-line-directory "speedbar" (&optional depth)) From 3afbab2f1d6ce7d75cadf12af096314123b6d56f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 30 Jan 2024 13:14:32 -0500 Subject: [PATCH 010/385] * lisp/emacs-lisp/inline.el (inline-const-val): Improve docstring --- lisp/emacs-lisp/inline.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index c774296084e..ddbd6fdc017 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -80,7 +80,9 @@ (error "inline-const-p can only be used within define-inline")) (defmacro inline-const-val (_exp) - "Return the value of EXP." + "Return the value of EXP. +During inlining, if the value of EXP is not yet known, this aborts the +inlining and makes us revert to a non-inlined function call." (declare (debug t)) (error "inline-const-val can only be used within define-inline")) From 17771b2a425e776c81e7454d942ec238264ce12b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Jan 2024 17:09:37 -0800 Subject: [PATCH 011/385] ; Spelling fixes --- lisp/emacs-lisp/comp.el | 7 +++---- lisp/progmodes/gud.el | 2 +- src/sfnt.h | 2 +- test/lisp/net/tramp-tests.el | 4 ++-- 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 8441b228898..2a516246ed4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -569,10 +569,9 @@ In use by the back-end." finally return t) t)) -(defsubst comp--symbol-func-to-fun (symbol-funcion) - "Given a function called SYMBOL-FUNCION return its `comp-func'." - (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h - comp-ctxt)) +(defsubst comp--symbol-func-to-fun (symbol-func) + "Given a function called SYMBOL-FUNC return its `comp-func'." + (gethash (gethash symbol-func (comp-ctxt-sym-to-c-name-h comp-ctxt)) (comp-ctxt-funcs-h comp-ctxt))) (defun comp--function-pure-p (f) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be6357f4139..b7c85fe7f43 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -243,7 +243,7 @@ Check it when `gud-running' is t") :visible (eq gud-minor-mode 'gdbmi)] ["Print Expression" gud-print :enable (not gud-running)] - ["Dump object-Derefenrece" gud-pstar + ["Dump object-Dereference" gud-pstar :label (if (eq gud-minor-mode 'jdb) "Dump object" "Print Dereference") diff --git a/src/sfnt.h b/src/sfnt.h index 5b01270e8ce..444b1dfe427 100644 --- a/src/sfnt.h +++ b/src/sfnt.h @@ -248,7 +248,7 @@ enum sfnt_macintosh_platform_specific_id SFNT_MACINTOSH_GREEK = 6, SFNT_MACINTOSH_RUSSIAN = 7, SFNT_MACINTOSH_RSYMBOL = 8, - SFNT_MACINTOSH_DEVANGARI = 9, + SFNT_MACINTOSH_DEVANAGARI = 9, SFNT_MACINTOSH_GURMUKHI = 10, SFNT_MACINTOSH_GUJARATI = 11, SFNT_MACINTOSH_ORIYA = 12, diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 2a3b3e16891..489b682d0c3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5155,8 +5155,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (get-buffer-window (current-buffer) t)) (delete-file tmp-name))) - ;; Check remote and local DESTNATION file. This isn't - ;; implemented yet ina all file name handler backends. + ;; Check remote and local DESTINATION file. This isn't + ;; implemented yet in all file name handler backends. ;; (dolist (local '(nil t)) ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) ;; (should From dd177b7b88c81ab71e1d5a97b872d85d524fee9b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Jan 2024 17:22:50 -0800 Subject: [PATCH 012/385] Update from Gnulib by running admin/merge-gnulib --- lib/cdefs.h | 4 ++-- lib/gnulib.mk.in | 4 ++++ lib/string.in.h | 14 ++++++++++++-- lib/time.in.h | 14 ++++++++++++-- m4/copy-file-range.m4 | 41 ++++++++++++++++++++++++++--------------- m4/gettime.m4 | 4 ++-- m4/gnulib-common.m4 | 4 ++-- m4/gnulib-comp.m4 | 3 ++- m4/memset_explicit.m4 | 6 +++++- m4/string_h.m4 | 3 ++- m4/time_h.m4 | 3 ++- 11 files changed, 71 insertions(+), 29 deletions(-) diff --git a/lib/cdefs.h b/lib/cdefs.h index 87ddce319dc..d38382ad9d8 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -42,8 +42,8 @@ #if (defined __has_attribute \ && (!defined __clang_minor__ \ || (defined __apple_build_version__ \ - ? 6000000 <= __apple_build_version__ \ - : 3 < __clang_major__ + (5 <= __clang_minor__)))) + ? 7000000 <= __apple_build_version__ \ + : 5 <= __clang_major__))) # define __glibc_has_attribute(attr) __has_attribute (attr) #else # define __glibc_has_attribute(attr) 0 diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fcf2b186038..e10aab5fc8d 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -1185,6 +1185,7 @@ REPLACE_MB_CUR_MAX = @REPLACE_MB_CUR_MAX@ REPLACE_MEMCHR = @REPLACE_MEMCHR@ REPLACE_MEMMEM = @REPLACE_MEMMEM@ REPLACE_MEMPCPY = @REPLACE_MEMPCPY@ +REPLACE_MEMSET_EXPLICIT = @REPLACE_MEMSET_EXPLICIT@ REPLACE_MKDIR = @REPLACE_MKDIR@ REPLACE_MKFIFO = @REPLACE_MKFIFO@ REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@ @@ -1271,6 +1272,7 @@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ REPLACE_TIME = @REPLACE_TIME@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@ +REPLACE_TIMESPEC_GETRES = @REPLACE_TIMESPEC_GETRES@ REPLACE_TMPFILE = @REPLACE_TMPFILE@ REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ @@ -3560,6 +3562,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ -e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \ + -e 's|@''REPLACE_MEMSET_EXPLICIT''@|$(REPLACE_MEMSET_EXPLICIT)|g' \ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ -e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \ -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ @@ -3892,6 +3895,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( -e 's|@''REPLACE_TIME''@|$(REPLACE_TIME)|g' \ -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ -e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \ + -e 's|@''REPLACE_TIMESPEC_GETRES''@|$(REPLACE_TIMESPEC_GETRES)|g' \ -e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \ -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ diff --git a/lib/string.in.h b/lib/string.in.h index 01ea3e3913b..44ec2e7ecdb 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -414,11 +414,21 @@ _GL_WARN_ON_USE (memrchr, "memrchr is unportable - " /* Overwrite a block of memory. The compiler will not optimize effects away, even if the block is dead after the call. */ #if @GNULIB_MEMSET_EXPLICIT@ -# if ! @HAVE_MEMSET_EXPLICIT@ +# if @REPLACE_MEMSET_EXPLICIT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef memset_explicit +# define memset_explicit rpl_memset_explicit +# endif +_GL_FUNCDECL_RPL (memset_explicit, void *, + (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (memset_explicit, void *, (void *__dest, int __c, size_t __n)); +# else +# if !@HAVE_MEMSET_EXPLICIT@ _GL_FUNCDECL_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (memset_explicit, void *, (void *__dest, int __c, size_t __n)); +# endif _GL_CXXALIASWARN (memset_explicit); #elif defined GNULIB_POSIXCHECK # undef memset_explicit diff --git a/lib/time.in.h b/lib/time.in.h index 58e103af07c..ce28f1af25d 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -154,11 +154,21 @@ _GL_WARN_ON_USE (timespec_get, "timespec_get is unportable - " /* Set *TS to the current time resolution, and return BASE. Upon failure, return 0. */ # if @GNULIB_TIMESPEC_GETRES@ -# if ! @HAVE_TIMESPEC_GETRES@ +# if @REPLACE_TIMESPEC_GETRES@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef timespec_getres +# define timespec_getres rpl_timespec_getres +# endif +_GL_FUNCDECL_RPL (timespec_getres, int, (struct timespec *ts, int base) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (timespec_getres, int, (struct timespec *ts, int base)); +# else +# if !@HAVE_TIMESPEC_GETRES@ _GL_FUNCDECL_SYS (timespec_getres, int, (struct timespec *ts, int base) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (timespec_getres, int, (struct timespec *ts, int base)); +# endif _GL_CXXALIASWARN (timespec_getres); # elif defined GNULIB_POSIXCHECK # undef timespec_getres diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4 index e9198549510..443e598ba55 100644 --- a/m4/copy-file-range.m4 +++ b/m4/copy-file-range.m4 @@ -1,4 +1,4 @@ -# copy-file-range.m4 +# copy-file-range.m4 serial 5 dnl Copyright 2019-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -17,22 +17,33 @@ AC_DEFUN([gl_FUNC_COPY_FILE_RANGE], dnl Programs that use copy_file_range must fall back on read+write dnl anyway, and there's little point to substituting the Gnulib stub dnl for a glibc stub. - AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include - ]], - [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) - = copy_file_range; - return func (0, 0, 0, 0, 0, 0) & 127; - ]]) - ], - [gl_cv_func_copy_file_range=yes], - [gl_cv_func_copy_file_range=no]) - ]) - + case "$host_os" in + *-gnu* | gnu*) + AC_CACHE_CHECK([for copy_file_range], [gl_cv_func_copy_file_range], + [AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + ]], + [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) + = copy_file_range; + return func (0, 0, 0, 0, 0, 0) & 127; + ]]) + ], + [gl_cv_func_copy_file_range=yes], + [gl_cv_func_copy_file_range=no]) + ]) + gl_cv_onwards_func_copy_file_range="$gl_cv_func_copy_file_range" + ;; + *) + gl_CHECK_FUNCS_ANDROID([copy_file_range], [[#include ]]) + gl_cv_func_copy_file_range="$ac_cv_func_copy_file_range" + ;; + esac if test "$gl_cv_func_copy_file_range" != yes; then HAVE_COPY_FILE_RANGE=0 + case "$gl_cv_onwards_func_copy_file_range" in + future*) REPLACE_COPY_FILE_RANGE=1 ;; + esac else AC_DEFINE([HAVE_COPY_FILE_RANGE], 1, [Define to 1 if the function copy_file_range exists.]) diff --git a/m4/gettime.m4 b/m4/gettime.m4 index e450e6b9d05..1ec018d5154 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,4 +1,4 @@ -# gettime.m4 serial 14 +# gettime.m4 serial 15 dnl Copyright (C) 2002, 2004-2006, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -64,5 +64,5 @@ AC_DEFUN([gl_GETTIME_RES], dnl Prerequisites of lib/gettime-res.c. AC_REQUIRE([gl_CLOCK_TIME]) AC_REQUIRE([gl_TIMESPEC]) - AC_CHECK_FUNCS_ONCE([timespec_getres]) + gl_CHECK_FUNCS_ANDROID([timespec_getres], [[#include ]]) ]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 03d10fa51ea..00691c0d6c3 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 90 +# gnulib-common.m4 serial 91 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -79,7 +79,7 @@ AC_DEFUN([gl_COMMON_BODY], [ #if (defined __has_attribute \ && (!defined __clang_minor__ \ || (defined __apple_build_version__ \ - ? 6000000 <= __apple_build_version__ \ + ? 7000000 <= __apple_build_version__ \ : 5 <= __clang_major__))) # define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) #else diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 2e5b328e3d8..7a7ebb0f34e 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -432,7 +432,8 @@ AC_DEFUN([gl_INIT], ]) gl_STRING_MODULE_INDICATOR([memrchr]) gl_FUNC_MEMSET_EXPLICIT - gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], [test $HAVE_MEMSET_EXPLICIT = 0]) + gl_CONDITIONAL([GL_COND_OBJ_MEMSET_EXPLICIT], + [test $HAVE_MEMSET_EXPLICIT = 0 || test $REPLACE_MEMSET_EXPLICIT = 1]) AM_COND_IF([GL_COND_OBJ_MEMSET_EXPLICIT], [ gl_PREREQ_MEMSET_EXPLICIT ]) diff --git a/m4/memset_explicit.m4 b/m4/memset_explicit.m4 index 6ac798d4557..19514ff917e 100644 --- a/m4/memset_explicit.m4 +++ b/m4/memset_explicit.m4 @@ -1,3 +1,4 @@ +# memset_explicit.m4 serial 2 dnl Copyright 2022-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -7,9 +8,12 @@ AC_DEFUN([gl_FUNC_MEMSET_EXPLICIT], [ AC_REQUIRE([gl_STRING_H_DEFAULTS]) - AC_CHECK_FUNCS_ONCE([memset_explicit]) + gl_CHECK_FUNCS_ANDROID([memset_explicit], [[#include ]]) if test $ac_cv_func_memset_explicit = no; then HAVE_MEMSET_EXPLICIT=0 + case "$gl_cv_onwards_func_memset_explicit" in + future*) REPLACE_MEMSET_EXPLICIT=1 ;; + esac fi ]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 8b12101447f..9ea748cc774 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -5,7 +5,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -# serial 38 +# serial 39 # Written by Paul Eggert. @@ -132,6 +132,7 @@ AC_DEFUN([gl_STRING_H_DEFAULTS], REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM]) REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY]) + REPLACE_MEMSET_EXPLICIT=0; AC_SUBST([REPLACE_MEMSET_EXPLICIT]) REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY]) REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY]) REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 index 367f69efae6..32fade0f401 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -2,7 +2,7 @@ # Copyright (C) 2000-2001, 2003-2007, 2009-2024 Free Software Foundation, Inc. -# serial 24 +# serial 25 # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -175,5 +175,6 @@ AC_DEFUN([gl_TIME_H_DEFAULTS], REPLACE_TIME=0; AC_SUBST([REPLACE_TIME]) REPLACE_TIMEGM=0; AC_SUBST([REPLACE_TIMEGM]) REPLACE_TIMESPEC_GET=0; AC_SUBST([REPLACE_TIMESPEC_GET]) + REPLACE_TIMESPEC_GETRES=0; AC_SUBST([REPLACE_TIMESPEC_GETRES]) REPLACE_TZSET=0; AC_SUBST([REPLACE_TZSET]) ]) From f63bcf2dfeb26de511f468adc237e6ea8a3cb6cc Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 30 Jan 2024 22:18:33 -0800 Subject: [PATCH 013/385] Fix treesit--indent-1 regarding local parsers Take this code as an example: 1 class Foo 2 { 3 /** 4 * Block comment 5 */ 6 function foo($c) { 7 } 8 } Suppose the block comment is covered by a local parser. When we indent line 3, treesit--indent-1 will try to get the local parser at the BOL, and it'll get the local parser. But it shouldn't use the local parser to indent this line, it should use the host parser of that local parser instead. So now, if treesit--indent-1 gets a local parser, but the local parser's root node's start coincides with BOL, treesit--indent-1 will use the host parser to indent this line. We also need to make treesit--update-ranges-local to save the host parser along with the local parser, and make treesit-local-parsers-at/on extract and return the host parser. I also switch the two cases in the cond form in treesit--indent-1: (null (treesit-parser-list)) and (car local-parsers), (car local-parsers) now takes precedence. * lisp/treesit.el (treesit-local-parsers-at): (treesit-local-parsers-on): Add WITH-HOST parameter. (treesit--update-ranges-local): Save the host parser to the local overlay. (treesit--indent-1): If the root node of the local parser is at BOL, use the host parser instead. --- lisp/treesit.el | 44 +++++++++++++++++++++++++++++++------------- 1 file changed, 31 insertions(+), 13 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index 96222ed81cb..fab2ddd88e6 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -655,37 +655,47 @@ those inside are kept." if (<= start (car range) (cdr range) end) collect range)) -(defun treesit-local-parsers-at (&optional pos language) +(defun treesit-local-parsers-at (&optional pos language with-host) "Return all the local parsers at POS. POS defaults to point. Local parsers are those which only parse a limited region marked by an overlay with non-nil `treesit-parser' property. -If LANGUAGE is non-nil, only return parsers for LANGUAGE." +If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." (let ((res nil)) (dolist (ov (overlays-at (or pos (point)))) - (when-let ((parser (overlay-get ov 'treesit-parser))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) (when (or (null language) (eq (treesit-parser-language parser) language)) - (push parser res)))) + (push (if with-host (cons parser host-parser) parser) res)))) (nreverse res))) -(defun treesit-local-parsers-on (&optional beg end language) +(defun treesit-local-parsers-on (&optional beg end language with-host) "Return all the local parsers between BEG END. BEG and END default to the beginning and end of the buffer's accessible portion. Local parsers are those which have an `embedded' tag, and only parse a limited region marked by an overlay with a non-nil `treesit-parser' -property. If LANGUAGE is non-nil, only return parsers for LANGUAGE." +property. If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." (let ((res nil)) (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) - (when-let ((parser (overlay-get ov 'treesit-parser))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) (when (or (null language) (eq (treesit-parser-language parser) language)) - (push parser res)))) + (push (if with-host (cons parser host-parser) parser) res)))) (nreverse res))) (defun treesit--update-ranges-local @@ -701,7 +711,8 @@ parser for EMBEDDED-LANG." (treesit-parser-delete parser)))) ;; Update range. (let* ((host-lang (treesit-query-language query)) - (ranges (treesit-query-range host-lang query beg end))) + (host-parser (treesit-parser-create host-lang)) + (ranges (treesit-query-range host-parser query beg end))) (pcase-dolist (`(,beg . ,end) ranges) (let ((has-parser nil)) (dolist (ov (overlays-in beg end)) @@ -719,6 +730,7 @@ parser for EMBEDDED-LANG." embedded-lang nil t 'embedded)) (ov (make-overlay beg end nil nil t))) (overlay-put ov 'treesit-parser embedded-parser) + (overlay-put ov 'treesit-host-parser host-parser) (treesit-parser-set-included-ranges embedded-parser `((,beg . ,end))))))))) @@ -1800,11 +1812,17 @@ Return (ANCHOR . OFFSET). This function is used by (forward-line 0) (skip-chars-forward " \t") (point))) - (local-parsers (treesit-local-parsers-at bol)) + (local-parsers (treesit-local-parsers-at bol nil t)) (smallest-node - (cond ((null (treesit-parser-list)) nil) - (local-parsers (treesit-node-at - bol (car local-parsers))) + (cond ((car local-parsers) + (let ((local-parser (caar local-parsers)) + (host-parser (cdar local-parsers))) + (if (eq (treesit-node-start + (treesit-parser-root-node local-parser)) + bol) + (treesit-node-at bol host-parser) + (treesit-node-at bol local-parser)))) + ((null (treesit-parser-list)) nil) ((eq 1 (length (treesit-parser-list nil nil t))) (treesit-node-at bol)) ((treesit-language-at bol) From 5f24c9a4c82f7106e22cac8a5201db8307239837 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 31 Jan 2024 14:34:19 +0800 Subject: [PATCH 014/385] Don't hang when display objects are displaced by line or wrap-prefixes This fixes a hang that would frequently rear its ugly head while displaying messages in the `telega.el' instant messenger client, which inserts images approaching the width of the window with line and wrap prefixes. * src/xdisp.c (move_it_in_display_line_to): If a line or wrap prefix is set in place, do not generate continuation lines until a minimum of one glyph has been produced outside that prefix. (move_it_to): Remove the previous workaround that could not recover from errors caused by display strings. (display_line): Synchronize with move_it_in_display_line_to; remove old workaround that only provided for oversized wrap prefixes comprising `space' display objects. --- src/xdisp.c | 200 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 135 insertions(+), 65 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 19f176459c7..066217a2f0f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9733,6 +9733,13 @@ move_it_in_display_line_to (struct it *it, ptrdiff_t prev_pos = IT_CHARPOS (*it); bool saw_smaller_pos = prev_pos < to_charpos; bool line_number_pending = false; + int this_line_subject_to_line_prefix = 0; + +#ifdef GLYPH_DEBUG + /* atx_flag, atpos_flag and wrap_flag are assigned but never used; + these hold information useful while debugging. */ + int atx_flag, atpos_flag, wrap_flag; +#endif /* GLYPH_DEBUG */ /* Don't produce glyphs in produce_glyphs. */ saved_glyph_row = it->glyph_row; @@ -9798,6 +9805,11 @@ move_it_in_display_line_to (struct it *it, /* If there's a line-/wrap-prefix, handle it, if we didn't already. */ if (it->area == TEXT_AREA && !it->string_from_prefix_prop_p) handle_line_prefix (it); + + /* Save whether this line has received a wrap prefix, as this + affects whether Emacs attempts to move glyphs into + continuation lines. */ + this_line_subject_to_line_prefix = it->string_from_prefix_prop_p; } if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) @@ -9841,10 +9853,15 @@ move_it_in_display_line_to (struct it *it, break; } else if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) - /* If wrap_it is valid, the current position might be in a - word that is wrapped. So, save the iterator in - atpos_it and continue to see if wrapping happens. */ - SAVE_IT (atpos_it, *it, atpos_data); + { + /* If wrap_it is valid, the current position might be in + a word that is wrapped. So, save the iterator in + atpos_it and continue to see if wrapping happens. */ + SAVE_IT (atpos_it, *it, atpos_data); +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ + } } /* Stop when ZV reached. @@ -9906,6 +9923,9 @@ move_it_in_display_line_to (struct it *it, } /* Otherwise, we can wrap here. */ SAVE_IT (wrap_it, *it, wrap_data); +#ifdef GLYPH_DEBUG + wrap_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } /* Update may_wrap for the next iteration. */ may_wrap = next_may_wrap; @@ -9984,6 +10004,9 @@ move_it_in_display_line_to (struct it *it, { SAVE_IT (atpos_it, *it, atpos_data); IT_RESET_X_ASCENT_DESCENT (&atpos_it); +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } } else @@ -9998,6 +10021,9 @@ move_it_in_display_line_to (struct it *it, { SAVE_IT (atx_it, *it, atx_data); IT_RESET_X_ASCENT_DESCENT (&atx_it); +#ifdef GLYPH_DEBUG + atx_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } } } @@ -10012,12 +10038,27 @@ move_it_in_display_line_to (struct it *it, && FRAME_WINDOW_P (it->f) && ((it->bidi_p && it->bidi_it.paragraph_dir == R2L) ? WINDOW_LEFT_FRINGE_WIDTH (it->w) - : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))) + /* There is no line prefix, next to which the + iterator _must_ produce a minimum of one actual + glyph. */ + && (!this_line_subject_to_line_prefix + /* Or this is the second glyph to be produced + beyond the confines of the line. */ + || (i != 0 + && (x > it->last_visible_x + || (x == it->last_visible_x + && FRAME_WINDOW_P (it->f) + && ((it->bidi_p + && it->bidi_it.paragraph_dir == R2L) + ? WINDOW_LEFT_FRINGE_WIDTH (it->w) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))))) { bool moved_forward = false; if (/* IT->hpos == 0 means the very first glyph - doesn't fit on the line, e.g. a wide image. */ + doesn't fit on the line, e.g. a wide + image. */ it->hpos == 0 || (new_x == it->last_visible_x && FRAME_WINDOW_P (it->f))) @@ -10078,6 +10119,9 @@ move_it_in_display_line_to (struct it *it, SAVE_IT (atpos_it, *it, atpos_data); atpos_it.current_x = x_before_this_char; atpos_it.hpos = hpos_before_this_char; +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ } } @@ -10175,6 +10219,9 @@ move_it_in_display_line_to (struct it *it, if (it->line_wrap == WORD_WRAP && atpos_it.sp < 0) { SAVE_IT (atpos_it, *it, atpos_data); +#ifdef GLYPH_DEBUG + atpos_flag = this_line_subject_to_line_prefix; +#endif /* GLYPH_DEBUG */ IT_RESET_X_ASCENT_DESCENT (&atpos_it); } } @@ -10273,24 +10320,24 @@ move_it_in_display_line_to (struct it *it, if (it->method == GET_FROM_BUFFER) prev_pos = IT_CHARPOS (*it); - /* Detect overly-wide wrap-prefixes made of (space ...) display - properties. When such a wrap prefix reaches past the right - margin of the window, we need to avoid the call to - set_iterator_to_next below, so that it->line_wrap is left at - its TRUNCATE value wisely set by handle_line_prefix. - Otherwise, set_iterator_to_next will pop the iterator stack, - restore it->line_wrap, and we might miss the opportunity to - exit the loop and return. */ - bool overwide_wrap_prefix = - CONSP (it->object) && EQ (XCAR (it->object), Qspace) - && it->sp > 0 && it->method == GET_FROM_STRETCH - && it->current_x >= it->last_visible_x - && it->continuation_lines_width > 0 - && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE; - /* The current display element has been consumed. Advance - to the next. */ - if (!overwide_wrap_prefix) - set_iterator_to_next (it, true); + /* The current display element has been consumed. Advance to + the next. */ + set_iterator_to_next (it, true); + + /* If IT has just finished producing glyphs for the wrap prefix + and is proceeding to the next method, there might not be + sufficient space remaining in this line to accommodate its + glyphs, and one real glyph must be produced to prevent an + infinite loop. Next, clear this flag if such a glyph has + already been produced. */ + + if (this_line_subject_to_line_prefix == 1 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 2; + else if (this_line_subject_to_line_prefix == 2 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 0; + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); if (IT_CHARPOS (*it) < to_charpos) @@ -10374,11 +10421,26 @@ move_it_in_display_line_to (struct it *it, && wrap_it.sp >= 0 && ((atpos_it.sp >= 0 && wrap_it.current_x < atpos_it.current_x) || (atx_it.sp >= 0 && wrap_it.current_x < atx_it.current_x))) - RESTORE_IT (it, &wrap_it, wrap_data); + { +#ifdef GLYPH_DEBUG + this_line_subject_to_line_prefix = wrap_flag; +#endif /* GLYPH_DEBUG */ + RESTORE_IT (it, &wrap_it, wrap_data); + } else if (atpos_it.sp >= 0) - RESTORE_IT (it, &atpos_it, atpos_data); + { +#ifdef GLYPH_DEBUG + this_line_subject_to_line_prefix = atpos_flag; +#endif /* GLYPH_DEBUG */ + RESTORE_IT (it, &atpos_it, atpos_data); + } else if (atx_it.sp >= 0) - RESTORE_IT (it, &atx_it, atx_data); + { +#ifdef GLYPH_DEBUG + this_line_subject_to_line_prefix = atx_flag; +#endif /* GLYPH_DEBUG */ + RESTORE_IT (it, &atx_it, atx_data); + } done: @@ -10452,13 +10514,9 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos int line_height, line_start_x = 0, reached = 0; int max_current_x = 0; void *backup_data = NULL; - ptrdiff_t orig_charpos = -1; - enum it_method orig_method = NUM_IT_METHODS; for (;;) { - orig_charpos = IT_CHARPOS (*it); - orig_method = it->method; if (op & MOVE_TO_VPOS) { /* If no TO_CHARPOS and no TO_X specified, stop at the @@ -10730,21 +10788,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos } } else - { - /* Make sure we do advance, otherwise we might infloop. - This could happen when the first display element is - wider than the window, or if we have a wrap-prefix - that doesn't leave enough space after it to display - even a single character. We only do this for moving - through buffer text, as with display/overlay strings - we'd need to also compare it->object's, and this is - unlikely to happen in that case anyway. */ - if (IT_CHARPOS (*it) == orig_charpos - && it->method == orig_method - && orig_method == GET_FROM_BUFFER) - set_iterator_to_next (it, false); - it->continuation_lines_width += it->current_x; - } + it->continuation_lines_width += it->current_x; break; default: @@ -24943,6 +24987,7 @@ display_line (struct it *it, int cursor_vpos) int first_visible_x = it->first_visible_x; int last_visible_x = it->last_visible_x; int x_incr = 0; + int this_line_subject_to_line_prefix = 0; /* We always start displaying at hpos zero even if hscrolled. */ eassert (it->hpos == 0 && it->current_x == 0); @@ -25048,6 +25093,7 @@ display_line (struct it *it, int cursor_vpos) /* We only do this when not calling move_it_in_display_line_to above, because that function calls itself handle_line_prefix. */ handle_line_prefix (it); + this_line_subject_to_line_prefix = it->string_from_prefix_prop_p; } else { @@ -25214,12 +25260,15 @@ display_line (struct it *it, int cursor_vpos) process the prefix now. */ if (it->area == TEXT_AREA && pending_handle_line_prefix) { - /* Line numbers should precede the line-prefix or wrap-prefix. */ + /* Line numbers should precede the line-prefix or + wrap-prefix. */ if (line_number_needed) maybe_produce_line_number (it); pending_handle_line_prefix = false; handle_line_prefix (it); + this_line_subject_to_line_prefix + = it->string_from_prefix_prop_p; } continue; } @@ -25240,7 +25289,16 @@ display_line (struct it *it, int cursor_vpos) if (/* Not a newline. */ nglyphs > 0 /* Glyphs produced fit entirely in the line. */ - && it->current_x < it->last_visible_x) + && (it->current_x < it->last_visible_x + /* Or a line or wrap prefix is in effect, and not + truncating the glyph produced immediately after it + would cause an infinite cycle. */ + || (it->line_wrap != TRUNCATE + /* This code is not valid if multiple glyphs were + produced, as some of these glyphs might remain + within this line. */ + && nglyphs == 1 + && this_line_subject_to_line_prefix))) { it->hpos += nglyphs; row->ascent = max (row->ascent, it->max_ascent); @@ -25291,7 +25349,20 @@ display_line (struct it *it, int cursor_vpos) && FRAME_WINDOW_P (it->f) && (row->reversed_p ? WINDOW_LEFT_FRINGE_WIDTH (it->w) - : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w)))) + /* There is no line prefix, next to which the + iterator _must_ produce a minimum of one actual + glyph. */ + && (!this_line_subject_to_line_prefix + /* Or this is the second glyph to be produced + beyond the confines of the line. */ + || (i != 0 + && (x > it->last_visible_x + || (x == it->last_visible_x + && FRAME_WINDOW_P (it->f) + && (row->reversed_p + ? WINDOW_LEFT_FRINGE_WIDTH (it->w) + : WINDOW_RIGHT_FRINGE_WIDTH (it->w))))))) { /* End of a continued line. */ @@ -25588,24 +25659,23 @@ display_line (struct it *it, int cursor_vpos) break; } - /* Detect overly-wide wrap-prefixes made of (space ...) display - properties. When such a wrap prefix reaches past the right - margin of the window, we need to avoid the call to - set_iterator_to_next below, so that it->line_wrap is left at - its TRUNCATE value wisely set by handle_line_prefix. - Otherwise, set_iterator_to_next will pop the iterator stack, - restore it->line_wrap, and redisplay might infloop. */ - bool overwide_wrap_prefix = - CONSP (it->object) && EQ (XCAR (it->object), Qspace) - && it->sp > 0 && it->method == GET_FROM_STRETCH - && it->current_x >= it->last_visible_x - && it->continuation_lines_width > 0 - && it->line_wrap == TRUNCATE && it->stack[0].line_wrap != TRUNCATE; - /* Proceed with next display element. Note that this skips over lines invisible because of selective display. */ - if (!overwide_wrap_prefix) - set_iterator_to_next (it, true); + set_iterator_to_next (it, true); + + /* If IT has just finished producing glyphs for the wrap prefix + and is proceeding to the next method, there might not be + sufficient space remaining in this line to accommodate its + glyphs, and one real glyph must be produced to prevent an + infinite loop. Next, clear this flag if such a glyph has + already been produced. */ + + if (this_line_subject_to_line_prefix == 1 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 2; + else if (this_line_subject_to_line_prefix == 2 + && !it->string_from_prefix_prop_p) + this_line_subject_to_line_prefix = 0; /* If we truncate lines, we are done when the last displayed glyphs reach past the right margin of the window. */ From 7e85311a9113a4720ec9d7b06188646fc7bdae0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 31 Jan 2024 12:21:12 +0100 Subject: [PATCH 015/385] Allow equal user-defined hash table tests with different names Hash tables using different user-defined tests defined identically sometimes ended up using the wrong test (bug#68668). * src/fns.c (get_hash_table_user_test): Take test name into account when matching the test object. * test/src/fns-tests.el (fns--define-hash-table-test): New. --- src/fns.c | 5 ++++- test/src/fns-tests.el | 10 ++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index e4fa8157000..1262e3e749e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5374,6 +5374,8 @@ mark_fns (void) } } +/* Find the hash_table_test object correponding to the (bare) symbol TEST, + creating one if none existed. */ static struct hash_table_test * get_hash_table_user_test (Lisp_Object test) { @@ -5384,7 +5386,8 @@ get_hash_table_user_test (Lisp_Object test) Lisp_Object equal_fn = XCAR (prop); Lisp_Object hash_fn = XCAR (XCDR (prop)); struct hash_table_user_test *ut = hash_table_user_tests; - while (ut && !(EQ (equal_fn, ut->test.user_cmp_function) + while (ut && !(BASE_EQ (test, ut->test.name) + && EQ (equal_fn, ut->test.user_cmp_function) && EQ (hash_fn, ut->test.user_hash_function))) ut = ut->next; if (!ut) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3893b8b0320..7437c07f156 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1097,6 +1097,16 @@ (should (= (sxhash-equal (record 'a (make-string 10 ?a))) (sxhash-equal (record 'a (make-string 10 ?a)))))) +(ert-deftest fns--define-hash-table-test () + ;; Check that we can have two differently-named tests using the + ;; same functions (bug#68668). + (define-hash-table-test 'fns-tests--1 'my-cmp 'my-hash) + (define-hash-table-test 'fns-tests--2 'my-cmp 'my-hash) + (let ((h1 (make-hash-table :test 'fns-tests--1)) + (h2 (make-hash-table :test 'fns-tests--2))) + (should (eq (hash-table-test h1) 'fns-tests--1)) + (should (eq (hash-table-test h2) 'fns-tests--2)))) + (ert-deftest test-secure-hash () (should (equal (secure-hash 'md5 "foobar") "3858f62230ac3c915f300c664312c63f")) From 9bcc9690a8076a22398c27a7ccf836ee95eb16a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 30 Jan 2024 17:55:19 +0100 Subject: [PATCH 016/385] Eliminate lazy bytecode loading The obsolete lazy-loaded bytecode feature, enabled by `byte-compile-dynamic`, slows down Lisp execution even when not in use because every call to a bytecode function has to check that function for laziness. This change forces up-front loading of all lazy bytecode so that we can remove all those checks. (Dynamically loaded doc strings are not affected.) There is no point in generating lazy bytecode any more so we stop doing that; this simplifies the compiler. `byte-compile-dynamic` now has no effect. This is a fully compatible change; the few remaining users of `byte-compile-dynamic` should not notice any difference. * src/lread.c (bytecode_from_rev_list): Force eager loading of lazy bytecode. * src/bytecode.c (exec_byte_code): Remove lazy bytecode checks. * src/eval.c (fetch_and_exec_byte_code, Ffetch_bytecode): Remove. (funcall_lambda): Call exec_byte_code directly, avoiding checks. * lisp/subr.el (fetch-bytecode): New definition, obsolete no-op. * lisp/emacs-lisp/disass.el (disassemble-1): * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Remove calls to fetch-bytecode. (byte-compile-dynamic): Update doc string. (byte-compile-close-variables, byte-compile-from-buffer) (byte-compile-insert-header, byte-compile-output-file-form) (byte-compile--output-docform-recurse, byte-compile-output-docform) (byte-compile-file-form-defmumble): Remove effects of byte-compile-dynamic. * doc/lispref/compile.texi (Dynamic Loading): Remove node now that the entire `byte-compile-dynamic` facility has been rendered inert. * etc/NEWS: Announce changes. --- doc/lispref/compile.texi | 66 ------------------------------------- doc/lispref/elisp.texi | 1 - etc/NEWS | 7 ++++ lisp/emacs-lisp/bytecomp.el | 66 ++++++------------------------------- lisp/emacs-lisp/disass.el | 2 -- lisp/subr.el | 2 ++ src/bytecode.c | 27 +++++++-------- src/eval.c | 59 ++------------------------------- src/lread.c | 49 +++++++++++++-------------- 9 files changed, 58 insertions(+), 221 deletions(-) diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 98a01fb67f9..00602198da5 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -35,7 +35,6 @@ variable binding for @code{no-byte-compile} into it, like this: * Speed of Byte-Code:: An example of speedup from byte compilation. * Compilation Functions:: Byte compilation functions. * Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. * Byte-Code Objects:: The data type used for byte-compiled functions. @@ -289,71 +288,6 @@ stands for the name of this file, as a string. Do not use these constructs in Lisp source files; they are not designed to be clear to humans reading the file. -@node Dynamic Loading -@section Dynamic Loading of Individual Functions - -@cindex dynamic loading of functions -@cindex lazy loading - When you compile a file, you can optionally enable the @dfn{dynamic -function loading} feature (also known as @dfn{lazy loading}). With -dynamic function loading, loading the file doesn't fully read the -function definitions in the file. Instead, each function definition -contains a place-holder which refers to the file. The first time each -function is called, it reads the full definition from the file, to -replace the place-holder. - - The advantage of dynamic function loading is that loading the file -should become faster. This is a good thing for a file which contains -many separate user-callable functions, if using one of them does not -imply you will probably also use the rest. A specialized mode which -provides many keyboard commands often has that usage pattern: a user may -invoke the mode, but use only a few of the commands it provides. - - The dynamic loading feature has certain disadvantages: - -@itemize @bullet -@item -If you delete or move the compiled file after loading it, Emacs can no -longer load the remaining function definitions not already loaded. - -@item -If you alter the compiled file (such as by compiling a new version), -then trying to load any function not already loaded will usually yield -nonsense results. -@end itemize - - These problems will never happen in normal circumstances with -installed Emacs files. But they are quite likely to happen with Lisp -files that you are changing. The easiest way to prevent these problems -is to reload the new compiled file immediately after each recompilation. - - @emph{Experience shows that using dynamic function loading provides -benefits that are hardly measurable, so this feature is deprecated -since Emacs 27.1.} - - The byte compiler uses the dynamic function loading feature if the -variable @code{byte-compile-dynamic} is non-@code{nil} at compilation -time. Do not set this variable globally, since dynamic loading is -desirable only for certain files. Instead, enable the feature for -specific source files with file-local variable bindings. For example, -you could do it by writing this text in the source file's first line: - -@example --*-byte-compile-dynamic: t;-*- -@end example - -@defvar byte-compile-dynamic -If this is non-@code{nil}, the byte compiler generates compiled files -that are set up for dynamic function loading. -@end defvar - -@defun fetch-bytecode function -If @var{function} is a byte-code function object, this immediately -finishes loading the byte code of @var{function} from its -byte-compiled file, if it is not fully loaded already. Otherwise, -it does nothing. It always returns @var{function}. -@end defun - @node Eval During Compile @section Evaluation During Compilation @cindex eval during compilation diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a3ef8313f8e..cab1622337e 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -653,7 +653,6 @@ Byte Compilation * Speed of Byte-Code:: An example of speedup from byte compilation. * Compilation Functions:: Byte compilation functions. * Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. * Eval During Compile:: Code to be evaluated when you compile. * Compiler Errors:: Handling compiler error messages. * Byte-Code Objects:: The data type used for byte-compiled functions. diff --git a/etc/NEWS b/etc/NEWS index a9d6eb6789d..8fccc299c6b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1846,6 +1846,13 @@ The declaration '(important-return-value t)' sets the 'important-return-value' property which indicates that the function return value should probably not be thrown away implicitly. +** Bytecode is now always loaded eagerly. +Bytecode compiled with older Emacs versions for lazy loading using +'byte-compile-dynamic' is now loaded all at once. +As a consequence, 'fetch-bytecode' has no use, does nothing, and is +now obsolete. The variable 'byte-compile-dynamic' has no effect any +more; compilation will always yield bytecode for eager loading. + +++ ** New functions 'file-user-uid' and 'file-group-gid'. These functions are like 'user-uid' and 'group-gid', respectively, but diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e87595b3e77..becc77f504a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -231,17 +231,8 @@ This includes variable references and calls to functions such as `car'." :type 'boolean) (defvar byte-compile-dynamic nil - "If non-nil, compile function bodies so they load lazily. -They are hidden in comments in the compiled file, -and each one is brought into core when the -function is called. - -To enable this option, make it a file-local variable -in the source file you want it to apply to. -For example, add -*-byte-compile-dynamic: t;-*- on the first line. - -When this option is true, if you load the compiled file and then move it, -the functions you loaded will not be able to run.") + "Formerly used to compile function bodies so they load lazily. +This variable no longer has any effect.") (make-obsolete-variable 'byte-compile-dynamic "not worthwhile any more." "27.1") ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp) @@ -1858,7 +1849,6 @@ It is too wide if it has any lines longer than the largest of ;; (byte-compile-verbose byte-compile-verbose) (byte-optimize byte-optimize) - (byte-compile-dynamic byte-compile-dynamic) (byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings) (byte-compile-warnings byte-compile-warnings) @@ -2428,8 +2418,7 @@ With argument ARG, insert value in current buffer after the form." (defun byte-compile-insert-header (_filename outbuffer) "Insert a header at the start of OUTBUFFER. Call from the source buffer." - (let ((dynamic byte-compile-dynamic) - (optimize byte-optimize)) + (let ((optimize byte-optimize)) (with-current-buffer outbuffer (goto-char (point-min)) ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After @@ -2463,10 +2452,7 @@ Call from the source buffer." ((eq optimize 'byte) " byte-level optimization only") (optimize " all optimizations") (t "out optimization")) - ".\n" - (if dynamic ";;; Function definitions are lazy-loaded.\n" - "") - "\n\n")))) + ".\n\n\n")))) (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings @@ -2487,7 +2473,7 @@ Call from the source buffer." (print-circle t)) ; Handle circular data structures. (if (memq (car-safe form) '(defvar defvaralias defconst autoload custom-declare-variable)) - (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil + (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 (memq (car form) '(defvaralias autoload custom-declare-variable))) @@ -2498,15 +2484,11 @@ Call from the source buffer." (defvar byte-compile--for-effect) (defun byte-compile--output-docform-recurse - (info position form cvecindex docindex specindex quoted) + (info position form cvecindex docindex quoted) "Print a form with a doc string. INFO is (prefix postfix). POSITION is where the next doc string is to be inserted. CVECINDEX is the index in the FORM of the constant vector, or nil. DOCINDEX is the index of the doc string (or nil) in the FORM. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument -\(the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that. @@ -2529,29 +2511,7 @@ Return the position after any inserted docstrings as comments." (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") - (cond ((and (numberp specindex) (= index specindex) - ;; Don't handle the definition dynamically - ;; if it refers (or might refer) - ;; to objects already output - ;; (for instance, gensyms in the arg list). - (let (non-nil) - (when (hash-table-p print-number-table) - (maphash (lambda (_k v) (if v (setq non-nil t))) - print-number-table)) - (not non-nil))) - ;; Output the byte code and constants specially - ;; for lazy dynamic loading. - (goto-char position) - (let ((lazy-position (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (setq position (point)) - (goto-char (point-max)) - (princ (format "(#$ . %d) nil" lazy-position) - byte-compile--outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((eq index cvecindex) + (cond ((eq index cvecindex) (let* ((cvec (car form)) (len (length cvec)) (index2 0) @@ -2564,7 +2524,7 @@ Return the position after any inserted docstrings as comments." (byte-compile--output-docform-recurse '("#[" "]") position (append elt nil) ; Convert the vector to a list. - 2 4 specindex nil)) + 2 4 nil)) (prin1 elt byte-compile--outbuffer)) (setq index2 (1+ index2)) (unless (eq index2 len) @@ -2590,16 +2550,12 @@ Return the position after any inserted docstrings as comments." (defun byte-compile-output-docform (preface tailpiece name info form cvecindex docindex - specindex quoted) + quoted) "Print a form with a doc string. INFO is (prefix postfix). If PREFACE, NAME, and TAILPIECE are non-nil, print them too, before/after INFO and the FORM but after the doc string itself. CVECINDEX is the index in the FORM of the constant vector, or nil. DOCINDEX is the index of the doc string (or nil) in the FORM. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument -\(the constants vector) together, for lazy loading. QUOTED says that we have to put a quote before the list that represents a doc string reference. `defvaralias', `autoload' and `custom-declare-variable' need that." @@ -2627,7 +2583,7 @@ list that represents a doc string reference. (insert preface) (prin1 name byte-compile--outbuffer)) (byte-compile--output-docform-recurse - info position form cvecindex docindex specindex quoted) + info position form cvecindex docindex quoted) (when tailpiece (insert tailpiece)))))) @@ -2971,7 +2927,6 @@ not to take responsibility for the actual compilation of the code." (if macro '(" '(macro . #[" "])") '(" #[" "]")) (append code nil) ; Turn byte-code-function-p into list. 2 4 - (and (atom code) byte-compile-dynamic 1) nil) t))))) @@ -3810,7 +3765,6 @@ lambda-expression." (alen (length (cdr form))) (dynbinds ()) lap) - (fetch-bytecode fun) (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) ;; optimized switch bytecode makes it impossible to guess the correct ;; `byte-compile-depth', which can result in incorrect inlined code. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index a876e6b5744..b7db2adde59 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -191,8 +191,6 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (if (consp obj) (setq bytes (car (cdr obj)) ;the byte code constvec (car (cdr (cdr obj)))) ;constant vector - ;; If it is lazy-loaded, load it now - (fetch-bytecode obj) (setq bytes (aref obj 1) constvec (aref obj 2))) (cl-assert (not (multibyte-string-p bytes))) diff --git a/lisp/subr.el b/lisp/subr.el index 33de100870e..a97824965b5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2023,6 +2023,8 @@ instead; it will indirectly limit the specpdl stack size as well.") (defvaralias 'native-comp-deferred-compilation 'native-comp-jit-compilation) +(define-obsolete-function-alias 'fetch-bytecode #'ignore "30.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/bytecode.c b/src/bytecode.c index ed6e2b34e77..def20b232c6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -792,22 +792,19 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object original_fun = call_fun; if (SYMBOLP (call_fun)) call_fun = XSYMBOL (call_fun)->u.s.function; - Lisp_Object template; - Lisp_Object bytecode; - if (COMPILEDP (call_fun) - /* Lexical binding only. */ - && (template = AREF (call_fun, COMPILED_ARGLIST), - FIXNUMP (template)) - /* No autoloads. */ - && (bytecode = AREF (call_fun, COMPILED_BYTECODE), - !CONSP (bytecode))) + if (COMPILEDP (call_fun)) { - fun = call_fun; - bytestr = bytecode; - args_template = XFIXNUM (template); - nargs = call_nargs; - args = call_args; - goto setup_frame; + Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); + if (FIXNUMP (template)) + { + /* Fast path for lexbound functions. */ + fun = call_fun; + bytestr = AREF (call_fun, COMPILED_BYTECODE), + args_template = XFIXNUM (template); + nargs = call_nargs; + args = call_args; + goto setup_frame; + } } Lisp_Object val; diff --git a/src/eval.c b/src/eval.c index 6f1c39ffb0e..95eb21909d2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3122,19 +3122,6 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } -/* Call the compiled Lisp function FUN. If we have not yet read FUN's - bytecode string and constants vector, fetch them from the file first. */ - -static Lisp_Object -fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, - ptrdiff_t nargs, Lisp_Object *args) -{ - if (CONSP (AREF (fun, COMPILED_BYTECODE))) - Ffetch_bytecode (fun); - - return exec_byte_code (fun, args_template, nargs, args); -} - static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { @@ -3204,8 +3191,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, ARGLIST slot value: pass the arguments to the byte-code engine directly. */ if (FIXNUMP (syms_left)) - return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), - nargs, arg_vector); + return exec_byte_code (fun, XFIXNUM (syms_left), nargs, arg_vector); /* Otherwise the bytecode object uses dynamic binding and the ARGLIST slot contains a standard formal argument list whose variables are bound dynamically below. */ @@ -3293,7 +3279,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, val = XSUBR (fun)->function.a0 (); } else - val = fetch_and_exec_byte_code (fun, 0, 0, NULL); + val = exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } @@ -3411,46 +3397,6 @@ lambda_arity (Lisp_Object fun) return Fcons (make_fixnum (minargs), make_fixnum (maxargs)); } -DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, - 1, 1, 0, - doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */) - (Lisp_Object object) -{ - Lisp_Object tem; - - if (COMPILEDP (object)) - { - if (CONSP (AREF (object, COMPILED_BYTECODE))) - { - tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); - if (! (CONSP (tem) && STRINGP (XCAR (tem)) - && VECTORP (XCDR (tem)))) - { - tem = AREF (object, COMPILED_BYTECODE); - if (CONSP (tem) && STRINGP (XCAR (tem))) - error ("Invalid byte code in %s", SDATA (XCAR (tem))); - else - error ("Invalid byte code"); - } - - Lisp_Object bytecode = XCAR (tem); - if (STRING_MULTIBYTE (bytecode)) - { - /* BYTECODE must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and now - such a byte-code string is loaded as multibyte with raw 8-bit - characters converted to multibyte form. Convert them back to - the original unibyte form. */ - bytecode = Fstring_as_unibyte (bytecode); - } - - pin_string (bytecode); - ASET (object, COMPILED_BYTECODE, bytecode); - ASET (object, COMPILED_CONSTANTS, XCDR (tem)); - } - } - return object; -} /* Return true if SYMBOL's default currently has a let-binding which was made in the buffer that is now current. */ @@ -4512,7 +4458,6 @@ alist of active lexical bindings. */); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); defsubr (&Srun_hook_wrapped); - defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); DEFSYM (QCdebug_on_exit, ":debug-on-exit"); defsubr (&Smapbacktrace); diff --git a/src/lread.c b/src/lread.c index 929f86ef283..e77bfb8021d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3481,6 +3481,8 @@ vector_from_rev_list (Lisp_Object elems) return obj; } +static Lisp_Object get_lazy_string (Lisp_Object val); + static Lisp_Object bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) { @@ -3495,14 +3497,18 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) && FIXNATP (vec[COMPILED_STACK_DEPTH]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (load_force_doc_strings - && NILP (vec[COMPILED_CONSTANTS]) - && STRINGP (vec[COMPILED_BYTECODE])) + /* Always read 'lazily-loaded' bytecode (generated by the + `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to + avoid code in the fast path during execution. */ + if (CONSP (vec[COMPILED_BYTECODE])) + vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); + + /* Lazily-loaded bytecode is represented by the constant slot being nil + and the bytecode slot a (lazily loaded) string containing the + print representation of (BYTECODE . CONSTANTS). Unpack the + pieces by coerceing the string to unibyte and reading the result. */ + if (NILP (vec[COMPILED_CONSTANTS])) { - /* Lazily-loaded bytecode is represented by the constant slot being nil - and the bytecode slot a (lazily loaded) string containing the - print representation of (BYTECODE . CONSTANTS). Unpack the - pieces by coerceing the string to unibyte and reading the result. */ Lisp_Object enc = vec[COMPILED_BYTECODE]; Lisp_Object pair = Fread (Fcons (enc, readcharfun)); if (!CONSP (pair)) @@ -3512,25 +3518,20 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) vec[COMPILED_CONSTANTS] = XCDR (pair); } - if (!((STRINGP (vec[COMPILED_BYTECODE]) - && VECTORP (vec[COMPILED_CONSTANTS])) - || CONSP (vec[COMPILED_BYTECODE]))) + if (!(STRINGP (vec[COMPILED_BYTECODE]) + && VECTORP (vec[COMPILED_CONSTANTS]))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRINGP (vec[COMPILED_BYTECODE])) - { - if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) - { - /* BYTESTR must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and - now such a byte-code string is loaded as multibyte with - raw 8-bit characters converted to multibyte form. - Convert them back to the original unibyte form. */ - vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); - } - /* Bytecode must be immovable. */ - pin_string (vec[COMPILED_BYTECODE]); - } + if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and + now such a byte-code string is loaded as multibyte with + raw 8-bit characters converted to multibyte form. + Convert them back to the original unibyte form. */ + vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]); + + /* Bytecode must be immovable. */ + pin_string (vec[COMPILED_BYTECODE]); XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED); return obj; From 344a846b07dfcc9ad38e510da9115fadae94a477 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 31 Jan 2024 17:35:59 +0100 Subject: [PATCH 017/385] Bytecode engine fast-path streamlining of plain symbols * src/bytecode.c (exec_byte_code): Only use fast-path optimisations for calls and dynamic variable reference and setting where the symbol is plain, which is much faster. --- src/bytecode.c | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index def20b232c6..dd805cbd97a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -625,9 +625,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, varref: { Lisp_Object v1 = vectorp[op], v2; - if (!SYMBOLP (v1) - || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL - || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound))) + if (!BARE_SYMBOL_P (v1) + || XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL + || (v2 = XBARE_SYMBOL (v1)->u.s.val.value, + BASE_EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); PUSH (v2); NEXT; @@ -699,11 +700,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object val = POP; /* Inline the most common case. */ - if (SYMBOLP (sym) + if (BARE_SYMBOL_P (sym) && !BASE_EQ (val, Qunbound) - && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL - && !SYMBOL_TRAPPED_WRITE_P (sym)) - SET_SYMBOL_VAL (XSYMBOL (sym), val); + && XBARE_SYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL + && !XBARE_SYMBOL (sym)->u.s.trapped_write) + SET_SYMBOL_VAL (XBARE_SYMBOL (sym), val); else set_internal (sym, val, Qnil, SET_INTERNAL_SET); } @@ -790,8 +791,9 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, do_debug_on_call (Qlambda, count1); Lisp_Object original_fun = call_fun; - if (SYMBOLP (call_fun)) - call_fun = XSYMBOL (call_fun)->u.s.function; + /* Calls to symbols-with-pos don't need to be on the fast path. */ + if (BARE_SYMBOL_P (call_fun)) + call_fun = XBARE_SYMBOL (call_fun)->u.s.function; if (COMPILEDP (call_fun)) { Lisp_Object template = AREF (call_fun, COMPILED_ARGLIST); From cd2c45a3890601e1bc498c81e64791fead6efc86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 31 Jan 2024 17:50:30 +0100 Subject: [PATCH 018/385] ; hierarchy-tests.el: keep doc string within 80 columns --- test/lisp/emacs-lisp/hierarchy-tests.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 49c812edb05..3333f4014e6 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -570,8 +570,9 @@ should fail as this function will crash." (defun hierarchy-examples-delayed--childrenfn (hier-elem) "Return the children of HIER-ELEM. -Basically, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' -and then create a list of the number plus 0.0–0.9." +Basically, feed the number, minus 1, to +`hierarchy-examples-delayed--find-number' and then create a list of the +number plus 0.0–0.9." (when (> hier-elem 1) (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem)))) From b86bc02096c65517b9a29c20635ece100864fc62 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:08:47 +0800 Subject: [PATCH 019/385] Introduce a global variant of visual-wrap-prefix-mode * doc/emacs/basic.texi (Continuation Lines): * etc/NEWS: * lisp/visual-wrap.el (visual-wrap-prefix-mode): Document this new global minor mode. (global-visual-wrap-prefix-mode): New global minor mode. --- doc/emacs/basic.texi | 17 ++++++++++------- etc/NEWS | 4 +++- lisp/visual-wrap.el | 10 +++++++++- 3 files changed, 22 insertions(+), 9 deletions(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index cdc183c2a40..c00cd6e20cf 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -632,15 +632,18 @@ long, by using Auto Fill mode. @xref{Filling}. @cindex continuation lines, visual wrap prefix @findex visual-wrap-prefix-mode +@findex global-visual-wrap-prefix-mode Normally, the first character of each continuation line is positioned at the beginning of the screen line where it is displayed. -The minor mode @code{visual-wrap-prefix-mode} arranges that -continuation lines be prefixed by slightly adjusted versions of the -fill prefixes (@pxref{Fill Prefix}) of their respective logical lines, -so that indentation characters or the prefixes of source code comments -are replicated across every continuation line, and the appearance of -such comments or indentation is not broken. These prefixes are only -shown on display, and does not change the buffer text in any way. +The minor mode @code{visual-wrap-prefix-mode} and its global +counterpart @code{global-visual-wrap-prefix-mode} (@pxref{Minor +Modes}) arranges that continuation lines be prefixed by slightly +adjusted versions of the fill prefixes (@pxref{Fill Prefix}) of their +respective logical lines, so that indentation characters or the +prefixes of source code comments are replicated across every +continuation line, and the appearance of such comments or indentation +is not broken. These prefixes are only shown on display, and does not +change the buffer text in any way. Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding diff --git a/etc/NEWS b/etc/NEWS index 8fccc299c6b..9bd4d0f631b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -318,7 +318,9 @@ will receive a 'wrap-prefix' automatically computed from the line's surrounding context, such that continuation lines are indented on display as if they were filled with 'M-q' or similar. Unlike 'M-q', the indentation only happens on display, and doesn't change the buffer -text in any way. +text in any way. The global minor mode +'global-visual-wrap-prefix-mode' enables this minor mode in all +buffers. (This minor mode is the 'adaptive-wrap' ELPA package renamed and lightly edited for inclusion in Emacs.) diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 20e55444082..d95cf4bb569 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -173,7 +173,9 @@ by `visual-wrap-extra-indent'." ;;;###autoload (define-minor-mode visual-wrap-prefix-mode - "Display continuation lines with prefixes from surrounding context." + "Display continuation lines with prefixes from surrounding context. +To enable this minor mode across all buffers, enable +`global-visual-wrap-prefix-mode'." :lighter "" :group 'visual-line (if visual-wrap-prefix-mode @@ -192,5 +194,11 @@ by `visual-wrap-extra-indent'." (widen) (remove-text-properties (point-min) (point-max) '(wrap-prefix nil)))))) +;;;###autoload +(define-globalized-minor-mode global-visual-wrap-prefix-mode + visual-wrap-prefix-mode visual-wrap-prefix-mode + :init-value nil + :group 'visual-line) + (provide 'visual-wrap) ;;; visual-wrap.el ends here From 5ce02c91bc128f390bcf0beb82e37a3fa7f251ba Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 1 Feb 2024 09:08:19 +0100 Subject: [PATCH 020/385] Improve `desktop-save-mode` docstring * lisp/desktop.el (desktop-save-mode): Improve docstring. --- lisp/desktop.el | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/lisp/desktop.el b/lisp/desktop.el index 56841b49595..9100d825547 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -163,13 +163,22 @@ Used at desktop read to provide backward compatibility.") (define-minor-mode desktop-save-mode "Toggle desktop saving (Desktop Save mode). -When Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. In particular, Emacs will save the desktop when -it exits (this may prompt you; see the option `desktop-save'). The next -time Emacs starts, if this mode is active it will restore the desktop. +When Desktop Save mode is enabled, the state of Emacs is saved from one +session to another. The saved Emacs \"desktop configuration\" includes the +buffers, their file names, major modes, buffer positions, window and frame +configuration, and some important global variables. -To manually save the desktop at any time, use the command `\\[desktop-save]'. -To load it, use `\\[desktop-read]'. +To enable this feature for future sessions, customize `desktop-save-mode' +to t, or add this line in your init file: + + (desktop-save-mode 1) + +When this mode is enabled, Emacs will save the desktop when it exits +(this may prompt you, see the option `desktop-save'). The next time +Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command \\[desktop-save]. +To load it, use \\[desktop-read]. Once a desktop file exists, Emacs will auto-save it according to the option `desktop-auto-save-timeout'. From 881a1ade30d2efacf9fcbd136b8fea722760f36e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:16:09 +0800 Subject: [PATCH 021/385] Prevent continuation from affecting tab width in/after line prefix * src/dispextern.h (struct it) : New field, synchronized with current_x when producing glyphs for wrap prefixes, and subtracted from it->current_x when computing tab widths. * src/term.c (produce_glyphs): Set wrap_prefix_width. * src/xdisp.c (start_display, display_min_width, move_it_to) (move_it_vertically_backward, move_it_by_lines) (window_text_pixel_size, display_tab_bar_line) (display_tool_bar_line, redisplay_internal, redisplay_window) (try_window_id, insert_left_trunc_glyphs) (extend_face_to_end_of_line, display_line) (Fmove_point_visually): Set or clear wrap_prefix_width as appropriate. (gui_produce_glyphs): Set or clear it->wrap_prefix_width. When computing the base position of a tab character, do not subtract the continuation line width if a line prefix is the current iterator method. Subtract the wrap_prefix_width otherwise, in order that the width of the tab is computed free of influence from the wrap prefix. --- src/dispextern.h | 10 +++++++ src/term.c | 8 +++++- src/xdisp.c | 74 +++++++++++++++++++++++++++++++++++++----------- 3 files changed, 74 insertions(+), 18 deletions(-) diff --git a/src/dispextern.h b/src/dispextern.h index 84b9dadc184..5387cb45603 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2752,6 +2752,16 @@ struct it pixel_width with each call to produce_glyphs. */ int current_x; + /* Pixel position within a display line with a wrap prefix. Updated + to reflect current_x in produce_glyphs when producing glyphs from + a prefix string and continuation_lines_width > 0, which is to + say, from a wrap prefix. + + Such updates are unnecessary where it is impossible for a wrap + prefix to be active, e.g. when continuation lines are being + produced. */ + int wrap_prefix_width; + /* Accumulated width of continuation lines. If > 0, this means we are currently in a continuation line. This is initially zero and incremented/reset by display_line, move_it_to etc. */ diff --git a/src/term.c b/src/term.c index 447876d288a..b3793088fac 100644 --- a/src/term.c +++ b/src/term.c @@ -1704,7 +1704,13 @@ produce_glyphs (struct it *it) /* Advance current_x by the pixel width as a convenience for the caller. */ if (it->area == TEXT_AREA) - it->current_x += it->pixel_width; + { + it->current_x += it->pixel_width; + + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } it->ascent = it->max_ascent = it->phys_ascent = it->max_phys_ascent = 0; it->descent = it->max_descent = it->phys_descent = it->max_phys_descent = 1; #endif diff --git a/src/xdisp.c b/src/xdisp.c index 066217a2f0f..4ff689b2df7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3821,7 +3821,7 @@ start_display (struct it *it, struct window *w, struct text_pos pos) it->current_y = first_y; it->vpos = 0; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; } } } @@ -5532,7 +5532,13 @@ display_min_width (struct it *it, ptrdiff_t bufpos, it->object = list3 (Qspace, QCwidth, w); produce_stretch_glyph (it); if (it->area == TEXT_AREA) - it->current_x += it->pixel_width; + { + it->current_x += it->pixel_width; + + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } it->min_width_property = Qnil; } } @@ -10797,6 +10803,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos /* Reset/increment for the next run. */ it->current_x = line_start_x; + it->wrap_prefix_width = 0; line_start_x = 0; it->hpos = 0; it->line_number_produced_p = false; @@ -10827,6 +10834,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos { it->continuation_lines_width += it->current_x; it->current_x = it->hpos = it->max_ascent = it->max_descent = 0; + it->wrap_prefix_width = 0; it->current_y += it->max_ascent + it->max_descent; ++it->vpos; last_height = it->max_ascent + it->max_descent; @@ -10886,6 +10894,7 @@ move_it_vertically_backward (struct it *it, int dy) reseat_1 (it, it->current.pos, true); /* We are now surely at a line start. */ + it->wrap_prefix_width = 0; it->current_x = it->hpos = 0; /* FIXME: this is incorrect when bidi reordering is in effect. */ it->continuation_lines_width = 0; @@ -11164,7 +11173,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) dvpos--; } - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; /* Above call may have moved too far if continuation lines are involved. Scan forward and see if it did. */ @@ -11173,7 +11182,7 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) move_it_to (&it2, start_charpos, -1, -1, -1, MOVE_TO_POS); it->vpos -= it2.vpos; it->current_y -= it2.current_y; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; /* If we moved too far back, move IT some lines forward. */ if (it2.vpos > -dvpos) @@ -11452,7 +11461,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, IT.current_x will be incorrectly set to zero at some arbitrary non-zero X coordinate. */ move_it_by_lines (&it, 0); - it.current_x = it.hpos = 0; + it.current_x = it.hpos = it.wrap_prefix_width = 0; if (IT_CHARPOS (it) != start) { void *it1data = NULL; @@ -11505,7 +11514,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, /* If FROM is on a newline, pretend that we start at the beginning of the next line, because the newline takes no place on display. */ if (FETCH_BYTE (start) == '\n') - it.current_x = 0; + it.current_x = 0, it.wrap_prefix_width = 0; if (!NILP (x_limit)) { it.last_visible_x = max_x; @@ -14417,7 +14426,7 @@ display_tab_bar_line (struct it *it, int height) row->truncated_on_left_p = false; row->truncated_on_right_p = false; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; it->current_y += row->height; ++it->vpos; ++it->glyph_row; @@ -15441,7 +15450,7 @@ display_tool_bar_line (struct it *it, int height) row->truncated_on_left_p = false; row->truncated_on_right_p = false; - it->current_x = it->hpos = 0; + it->current_x = it->hpos = it->wrap_prefix_width = 0; it->current_y += row->height; ++it->vpos; ++it->glyph_row; @@ -17141,6 +17150,7 @@ redisplay_internal (void) NULL, DEFAULT_FACE_ID); it.current_x = this_line_start_x; it.current_y = this_line_y; + it.wrap_prefix_width = 0; it.vpos = this_line_vpos; if (current_buffer->long_line_optimizations_p @@ -20587,7 +20597,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) it.current_y = 0; } - it.current_x = it.hpos = 0; + it.current_x = it.wrap_prefix_width = it.hpos = 0; /* Set the window start position here explicitly, to avoid an infinite loop in case the functions in window-scroll-functions @@ -22555,7 +22565,7 @@ try_window_id (struct window *w) /* We may start in a continuation line. If so, we have to get the right continuation_lines_width and current_x. */ it.continuation_lines_width = last_row->continuation_lines_width; - it.hpos = it.current_x = 0; + it.hpos = it.current_x = it.wrap_prefix_width = 0; /* Display the rest of the lines at the window end. */ it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos); @@ -23160,6 +23170,7 @@ insert_left_trunc_glyphs (struct it *it) /* Get the truncation glyphs. */ truncate_it = *it; truncate_it.current_x = 0; + truncate_it.wrap_prefix_width = 0; truncate_it.face_id = DEFAULT_FACE_ID; truncate_it.glyph_row = &scratch_glyph_row; truncate_it.area = TEXT_AREA; @@ -23922,6 +23933,10 @@ extend_face_to_end_of_line (struct it *it) for (it->current_x = 0; g < e; g++) it->current_x += g->pixel_width; + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + it->area = LEFT_MARGIN_AREA; it->face_id = default_face->id; while (it->glyph_row->used[LEFT_MARGIN_AREA] @@ -25064,7 +25079,10 @@ display_line (struct it *it, int cursor_vpos) if (it->current_x < it->first_visible_x && (move_result == MOVE_NEWLINE_OR_CR || move_result == MOVE_POS_MATCH_OR_ZV)) - it->current_x = it->first_visible_x; + { + it->current_x = it->first_visible_x; + it->wrap_prefix_width = 0; + } /* In case move_it_in_display_line_to above "produced" the line number. */ @@ -25921,7 +25939,7 @@ display_line (struct it *it, int cursor_vpos) HPOS) = (0 0). Vertical positions are incremented. As a convenience for the caller, IT->glyph_row is set to the next row to be used. */ - it->current_x = it->hpos = 0; + it->wrap_prefix_width = it->current_x = it->hpos = 0; it->current_y += row->height; /* Restore the first and last visible X if we adjusted them for current-line hscrolling. */ @@ -26400,7 +26418,7 @@ Value is the new character position of point. */) { struct text_pos pt; struct it it; - int pt_x, target_x, pixel_width, pt_vpos; + int pt_x, pt_wrap_prefix_x, target_x, pixel_width, pt_vpos; bool at_eol_p; bool overshoot_expected = false; bool target_is_eol_p = false; @@ -26432,6 +26450,7 @@ Value is the new character position of point. */) reseat: reseat_at_previous_visible_line_start (&it); it.current_x = it.hpos = it.current_y = it.vpos = 0; + it.wrap_prefix_width = 0; if (IT_CHARPOS (it) != PT) { move_it_to (&it, overshoot_expected ? PT - 1 : PT, @@ -26450,6 +26469,7 @@ Value is the new character position of point. */) move_it_in_display_line (&it, PT, -1, MOVE_TO_POS); } pt_x = it.current_x; + pt_wrap_prefix_x = it.wrap_prefix_width; pt_vpos = it.vpos; if (dir > 0 || overshoot_expected) { @@ -26464,10 +26484,11 @@ Value is the new character position of point. */) it.glyph_row = NULL; PRODUCE_GLYPHS (&it); /* compute it.pixel_width */ it.glyph_row = row; - /* PRODUCE_GLYPHS advances it.current_x, so we must restore - it, lest it will become out of sync with it's buffer + /* PRODUCE_GLYPHS advances it.current_x, so it must be + restored, lest it become out of sync with its buffer position. */ it.current_x = pt_x; + it.wrap_prefix_width = pt_wrap_prefix_x; } else at_eol_p = ITERATOR_AT_END_OF_LINE_P (&it); @@ -26512,6 +26533,7 @@ Value is the new character position of point. */) it.last_visible_x = DISP_INFINITY; reseat_at_previous_visible_line_start (&it); it.current_x = it.current_y = it.hpos = 0; + it.wrap_prefix_width = 0; if (pt_vpos != 0) move_it_by_lines (&it, pt_vpos); } @@ -32659,7 +32681,19 @@ gui_produce_glyphs (struct it *it) if (font->space_width > 0) { int tab_width = it->tab_width * font->space_width; - int x = it->current_x + it->continuation_lines_width; + /* wrap-prefix strings are prepended to continuation + lines, so the width of tab characters inside should + be computed from the start of this screen line rather + than as a product of the total width of the physical + line being wrapped. */ + int x = it->current_x + (it->string_from_prefix_prop_p + /* Subtract the width of the + prefix from it->current_x if + it exists. */ + ? 0 : (it->continuation_lines_width + ? (it->continuation_lines_width + - it->wrap_prefix_width) + : 0)); int x0 = x; /* Adjust for line numbers, if needed. */ if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) @@ -33130,7 +33164,13 @@ gui_produce_glyphs (struct it *it) because this isn't true for images with `:ascent 100'. */ eassert (it->ascent >= 0 && it->descent >= 0); if (it->area == TEXT_AREA) - it->current_x += it->pixel_width; + { + it->current_x += it->pixel_width; + + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } if (extra_line_spacing > 0) { From 4e1661e96c4412e8bf04cd1ec8948df4a782a10c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:18:53 +0800 Subject: [PATCH 022/385] * src/term.c (produce_glyphs): Synchronize with gui_produce_glyphs. --- src/term.c | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/term.c b/src/term.c index b3793088fac..3fa244be824 100644 --- a/src/term.c +++ b/src/term.c @@ -1631,8 +1631,19 @@ produce_glyphs (struct it *it) it->pixel_width = it->nglyphs = 0; else if (it->char_to_display == '\t') { + /* wrap-prefix strings are prepended to continuation lines, so + the width of tab characters inside should be computed from + the start of this screen line rather than as a product of the + total width of the physical line being wrapped. */ int absolute_x = (it->current_x - + it->continuation_lines_width); + + (it->string_from_prefix_prop_p + /* Subtract the width of the + prefix from it->current_x if + it exists. */ + ? 0 : (it->continuation_lines_width + ? (it->continuation_lines_width + - it->wrap_prefix_width) + : 0))); int x0 = absolute_x; /* Adjust for line numbers. */ if (!NILP (Vdisplay_line_numbers) && it->line_number_produced_p) From 849f8c1d49edc93cd8133d2f0dee5ceeb8f659e5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 1 Feb 2024 16:25:09 +0800 Subject: [PATCH 023/385] ; * doc/emacs/basic.texi (Continuation Lines): Rearrange pxref. --- doc/emacs/basic.texi | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index c00cd6e20cf..b1b1573729a 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -636,14 +636,14 @@ long, by using Auto Fill mode. @xref{Filling}. Normally, the first character of each continuation line is positioned at the beginning of the screen line where it is displayed. The minor mode @code{visual-wrap-prefix-mode} and its global -counterpart @code{global-visual-wrap-prefix-mode} (@pxref{Minor -Modes}) arranges that continuation lines be prefixed by slightly -adjusted versions of the fill prefixes (@pxref{Fill Prefix}) of their -respective logical lines, so that indentation characters or the -prefixes of source code comments are replicated across every -continuation line, and the appearance of such comments or indentation -is not broken. These prefixes are only shown on display, and does not -change the buffer text in any way. +(@pxref{Minor Modes}) counterpart +@code{global-visual-wrap-prefix-mode} arranges that continuation lines +be prefixed by slightly adjusted versions of the fill prefixes +(@pxref{Fill Prefix}) of their respective logical lines, so that +indentation characters or the prefixes of source code comments are +replicated across every continuation line, and the appearance of such +comments or indentation is not broken. These prefixes are only shown +on display, and does not change the buffer text in any way. Sometimes, you may need to edit files containing many long logical lines, and it may not be practical to break them all up by adding From 169c704d74747d411a545eff9c497ddafb9c886c Mon Sep 17 00:00:00 2001 From: Sacha Chua Date: Fri, 26 Jan 2024 08:54:03 -0500 Subject: [PATCH 024/385] shr: Correct SVG attribute case * lisp/net/shr.el (shr-correct-attribute-case): New constant. (shr-correct-dom-case): New function to correct SVG attribute case. (shr-tag-svg): Correct SVG attribute cases before using them. --- lisp/net/shr.el | 76 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 74 insertions(+), 2 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 17fdffd619d..e23fc6104d2 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1437,13 +1437,85 @@ ones, in case fg and bg are nil." (shr-dom-print elem))))) (insert (format "" (dom-tag dom)))) +(defconst shr-correct-attribute-case + '((attributename . attributeName) + (attributetype . attributeType) + (basefrequency . baseFrequency) + (baseprofile . baseProfile) + (calcmode . calcMode) + (clippathunits . clipPathUnits) + (diffuseconstant . diffuseConstant) + (edgemode . edgeMode) + (filterunits . filterUnits) + (glyphref . glyphRef) + (gradienttransform . gradientTransform) + (gradientunits . gradientUnits) + (kernelmatrix . kernelMatrix) + (kernelunitlength . kernelUnitLength) + (keypoints . keyPoints) + (keysplines . keySplines) + (keytimes . keyTimes) + (lengthadjust . lengthAdjust) + (limitingconeangle . limitingConeAngle) + (markerheight . markerHeight) + (markerunits . markerUnits) + (markerwidth . markerWidth) + (maskcontentunits . maskContentUnits) + (maskunits . maskUnits) + (numoctaves . numOctaves) + (pathlength . pathLength) + (patterncontentunits . patternContentUnits) + (patterntransform . patternTransform) + (patternunits . patternUnits) + (pointsatx . pointsAtX) + (pointsaty . pointsAtY) + (pointsatz . pointsAtZ) + (preservealpha . preserveAlpha) + (preserveaspectratio . preserveAspectRatio) + (primitiveunits . primitiveUnits) + (refx . refX) + (refy . refY) + (repeatcount . repeatCount) + (repeatdur . repeatDur) + (requiredextensions . requiredExtensions) + (requiredfeatures . requiredFeatures) + (specularconstant . specularConstant) + (specularexponent . specularExponent) + (spreadmethod . spreadMethod) + (startoffset . startOffset) + (stddeviation . stdDeviation) + (stitchtiles . stitchTiles) + (surfacescale . surfaceScale) + (systemlanguage . systemLanguage) + (tablevalues . tableValues) + (targetx . targetX) + (targety . targetY) + (textlength . textLength) + (viewbox . viewBox) + (viewtarget . viewTarget) + (xchannelselector . xChannelSelector) + (ychannelselector . yChannelSelector) + (zoomandpan . zoomAndPan)) + "Attributes for correcting the case in SVG and MathML. +Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .") + +(defun shr-correct-dom-case (dom) + "Correct the case for SVG segments." + (dolist (attr (dom-attributes dom)) + (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case))) + (setcar attr rep))) + (dolist (child (dom-children dom)) + (shr-correct-dom-case child)) + dom) + (defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) (not shr-inhibit-images) (dom-attr dom 'width) (dom-attr dom 'height)) - (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8) - 'image/svg+xml) + (funcall shr-put-image-function + (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8) + 'image/svg+xml) "SVG Image"))) (defun shr-tag-sup (dom) From ff63da26b6b00fd0e2ba04239b56b385bd83b53a Mon Sep 17 00:00:00 2001 From: Stanislav Yaglo Date: Mon, 12 Jun 2023 11:56:37 +0100 Subject: [PATCH 025/385] macfont.m: Fix values for font widths and weights on macOS * src/macfont.m (mac_font_get_glyphs_for_variants) (macfont_variation_glyphs): Fix width values. (Bug#64013) --- src/macfont.m | 96 ++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 68 insertions(+), 28 deletions(-) diff --git a/src/macfont.m b/src/macfont.m index 6f192b00f1b..e3b3d40df43 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -855,21 +855,42 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, struct { enum font_property_index index; CFStringRef trait; - CGPoint points[6]; - CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat); - } numeric_traits[] = - {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, - {{-0.4, 50}, /* light */ - {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 80}, /* normal */ - {0.24, 140}, /* (semi-bold + normal) / 2 */ - {0.4, 200}, /* bold */ - {CGFLOAT_MAX, CGFLOAT_MAX}}, - mac_font_descriptor_get_adjusted_weight}, - {FONT_SLANT_INDEX, kCTFontSlantTrait, - {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}, - {FONT_WIDTH_INDEX, kCTFontWidthTrait, - {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}, NULL}}; + CGPoint points[12]; + CGFloat (*adjust_func) (CTFontDescriptorRef, CGFloat); + } numeric_traits[] = { + { FONT_WEIGHT_INDEX, + kCTFontWeightTrait, + { { -0.6, 0 }, /* thin */ + { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */ + { -0.23, 50 }, /* light */ + { -0.115, 55 }, /* semi-light, semilight, demilight */ + { 0, 80 }, /* regular, normal, unspecified, book */ + { 0.2, 100 }, /* medium */ + { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */ + { 0.4, 200 }, /* bold */ + { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */ + { 0.8, 210 }, /* black, heavy */ + { 1, 250 }, /* ultra-heavy, ultraheavy */ + { CGFLOAT_MAX, CGFLOAT_MAX } }, + mac_font_descriptor_get_adjusted_weight }, + { FONT_SLANT_INDEX, + kCTFontSlantTrait, + { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } }, + NULL }, + { FONT_WIDTH_INDEX, + kCTFontWidthTrait, + { { -0.4, 50 }, /* ultra-condensed, ultracondensed */ + { -0.3, 63 }, /* extra-condensed, extracondensed */ + { -0.2, 75 }, /* condensed, compressed, narrow */ + { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */ + { 0, 100 }, /* normal, medium, regular, unspecified */ + { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */ + { 0.2, 125 }, /* expanded */ + { 0.3, 150 }, /* extra-expanded, extraexpanded */ + { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */ + { CGFLOAT_MAX, CGFLOAT_MAX } }, + NULL } + }; int i; for (i = 0; i < ARRAYELTS (numeric_traits); i++) @@ -1941,19 +1962,38 @@ static int macfont_variation_glyphs (struct font *, int c, struct { enum font_property_index index; CFStringRef trait; - CGPoint points[6]; - } numeric_traits[] = - {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, - {{-0.4, 50}, /* light */ - {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 100}, /* normal */ - {0.24, 140}, /* (semi-bold + normal) / 2 */ - {0.4, 200}, /* bold */ - {CGFLOAT_MAX, CGFLOAT_MAX}}}, - {FONT_SLANT_INDEX, kCTFontSlantTrait, - {{0, 100}, {0.1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}, - {FONT_WIDTH_INDEX, kCTFontWidthTrait, - {{0, 100}, {1, 200}, {CGFLOAT_MAX, CGFLOAT_MAX}}}}; + CGPoint points[12]; + } numeric_traits[] = { + { FONT_WEIGHT_INDEX, + kCTFontWeightTrait, + { { -0.6, 0 }, /* thin */ + { -0.4, 40 }, /* ultra-light, ultralight, extra-light, extralight */ + { -0.23, 50 }, /* light */ + { -0.115, 55 }, /* semi-light, semilight, demilight */ + { 0, 80 }, /* regular, normal, unspecified, book */ + { 0.2, 100 }, /* medium */ + { 0.3, 180 }, /* semi-bold, semibold, demibold, demi-bold, demi */ + { 0.4, 200 }, /* bold */ + { 0.6, 205 }, /* extra-bold, extrabold, ultra-bold, ultrabold */ + { 0.8, 210 }, /* black, heavy */ + { 1, 250 }, /* ultra-heavy, ultraheavy */ + { CGFLOAT_MAX, CGFLOAT_MAX } } }, + { FONT_SLANT_INDEX, + kCTFontSlantTrait, + { { 0, 100 }, { 0.1, 200 }, { CGFLOAT_MAX, CGFLOAT_MAX } } }, + { FONT_WIDTH_INDEX, + kCTFontWidthTrait, + { { -0.4, 50 }, /* ultra-condensed, ultracondensed */ + { -0.3, 63 }, /* extra-condensed, extracondensed */ + { -0.2, 75 }, /* condensed, compressed, narrow */ + { -0.1, 87 }, /* semi-condensed, semicondensed, demicondensed */ + { 0, 100 }, /* normal, medium, regular, unspecified */ + { 0.1, 113 }, /* semi-expanded, semiexpanded, demiexpanded */ + { 0.2, 125 }, /* expanded */ + { 0.3, 150 }, /* extra-expanded, extraexpanded */ + { 0.4, 200 }, /* ultra-expanded, ultraexpanded, wide */ + { CGFLOAT_MAX, CGFLOAT_MAX } } } + }; registry = AREF (spec, FONT_REGISTRY_INDEX); if (NILP (registry) From 4adb4b2ac507636a82373ed1323dabcb7ee9258d Mon Sep 17 00:00:00 2001 From: Graham Marlow Date: Mon, 29 Jan 2024 17:16:04 -0800 Subject: [PATCH 026/385] Fix 'fill-paragraph' in 'yaml-ts-mode' * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode--fill-paragraph): Avoid 'fill-paragraph' when outside of block_scalar or comment nodes. (Bug#68781) --- lisp/textmodes/yaml-ts-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index c0185457bc2..a8cb504ef03 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -128,7 +128,7 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (save-restriction (widen) (let ((node (treesit-node-at (point)))) - (when (string= "block_scalar" (treesit-node-type node)) + (if (member (treesit-node-type node) '("block_scalar" "comment")) (let* ((start (treesit-node-start node)) (end (treesit-node-end node)) (start-marker (point-marker)) @@ -138,7 +138,8 @@ boundaries. JUSTIFY is passed to `fill-paragraph'." (forward-line) (move-marker start-marker (point)) (narrow-to-region (point) end)) - (fill-region start-marker end justify)))))) + (fill-region start-marker end justify)) + t)))) ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" From d0766c0999e1e78b2f63e1d97881e926e5e6f905 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Wed, 31 Jan 2024 13:54:16 +0000 Subject: [PATCH 027/385] Fix search error in woman.el * lisp/woman.el (woman-if-body): Avoid signaling an error if "el }" is not found. (Bug#68852) --- lisp/woman.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/woman.el b/lisp/woman.el index a9af46fa387..2357ba6b132 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2566,7 +2566,8 @@ If DELETE is non-nil then delete from point." ;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" ;; Interpret bogus `el \}' as `el \{', ;; especially for Tcl/Tk man pages: - "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*") + "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" + nil t) (match-beginning 1)) (re-search-forward "\\\\}")) (delete-region (if delete from (match-beginning 0)) (point)) From 5f3b46c61e23786295e8e532f7eadeee8cd4340b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulrich=20M=C3=BCller?= Date: Wed, 31 Jan 2024 08:49:36 +0100 Subject: [PATCH 028/385] * configure.ac: Include X11/Xlib.h for XOpenDisplay. (Bug#68842) Do not merge to master. --- configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index 78d5475f75a..34a5a89bea9 100644 --- a/configure.ac +++ b/configure.ac @@ -2697,7 +2697,7 @@ if test "${HAVE_X11}" = "yes"; then if test "${opsys}" = "gnu-linux"; then AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link], [emacs_cv_b_link], - [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], + [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[XOpenDisplay ("foo");]])], [xgnu_linux_first_failure=no], [xgnu_linux_first_failure=yes]) @@ -2706,7 +2706,7 @@ if test "${HAVE_X11}" = "yes"; then OLD_LIBS="$LIBS" CPPFLAGS="$CPPFLAGS -b i486-linuxaout" LIBS="$LIBS -b i486-linuxaout" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], + AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[XOpenDisplay ("foo");]])], [xgnu_linux_second_failure=no], [xgnu_linux_second_failure=yes]) From 886f4207ab71b2a3367566d013cbcb27eec25639 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 1 Feb 2024 11:06:51 -0500 Subject: [PATCH 029/385] * src/lread.c (bytecode_from_rev_list): Re-group checks Bring together all the conditions for well-formedness of the resulting bytecode object. --- src/lread.c | 52 +++++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/src/lread.c b/src/lread.c index e77bfb8021d..a6bfdfcf626 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3490,38 +3490,40 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) Lisp_Object *vec = XVECTOR (obj)->contents; ptrdiff_t size = ASIZE (obj); + if (!(size >= COMPILED_CONSTANTS)) + { + /* Always read 'lazily-loaded' bytecode (generated by the + `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to + avoid code in the fast path during execution. */ + if (CONSP (vec[COMPILED_BYTECODE]) + && FIXNUMP (XCDR (vec[COMPILED_BYTECODE]))) + vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); + + /* Lazily-loaded bytecode is represented by the constant slot being nil + and the bytecode slot a (lazily loaded) string containing the + print representation of (BYTECODE . CONSTANTS). Unpack the + pieces by coerceing the string to unibyte and reading the result. */ + if (NILP (vec[COMPILED_CONSTANTS]) && STRINGP (vec[COMPILED_BYTECODE])) + { + Lisp_Object enc = vec[COMPILED_BYTECODE]; + Lisp_Object pair = Fread (Fcons (enc, readcharfun)); + if (!CONSP (pair)) + invalid_syntax ("Invalid byte-code object", readcharfun); + + vec[COMPILED_BYTECODE] = XCAR (pair); + vec[COMPILED_CONSTANTS] = XCDR (pair); + } + } + if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1 && (FIXNUMP (vec[COMPILED_ARGLIST]) || CONSP (vec[COMPILED_ARGLIST]) || NILP (vec[COMPILED_ARGLIST])) + && STRINGP (vec[COMPILED_BYTECODE]) + && VECTORP (vec[COMPILED_CONSTANTS]) && FIXNATP (vec[COMPILED_STACK_DEPTH]))) invalid_syntax ("Invalid byte-code object", readcharfun); - /* Always read 'lazily-loaded' bytecode (generated by the - `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to - avoid code in the fast path during execution. */ - if (CONSP (vec[COMPILED_BYTECODE])) - vec[COMPILED_BYTECODE] = get_lazy_string (vec[COMPILED_BYTECODE]); - - /* Lazily-loaded bytecode is represented by the constant slot being nil - and the bytecode slot a (lazily loaded) string containing the - print representation of (BYTECODE . CONSTANTS). Unpack the - pieces by coerceing the string to unibyte and reading the result. */ - if (NILP (vec[COMPILED_CONSTANTS])) - { - Lisp_Object enc = vec[COMPILED_BYTECODE]; - Lisp_Object pair = Fread (Fcons (enc, readcharfun)); - if (!CONSP (pair)) - invalid_syntax ("Invalid byte-code object", readcharfun); - - vec[COMPILED_BYTECODE] = XCAR (pair); - vec[COMPILED_CONSTANTS] = XCDR (pair); - } - - if (!(STRINGP (vec[COMPILED_BYTECODE]) - && VECTORP (vec[COMPILED_CONSTANTS]))) - invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE])) /* BYTESTR must have been produced by Emacs 20.2 or earlier because it produced a raw 8-bit string for byte-code and From 8b92449b706e33da256142e190008bb1ead2e539 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 1 Feb 2024 11:08:56 -0500 Subject: [PATCH 030/385] * src/lread.c (bytecode_from_rev_list): Fix thinko --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index a6bfdfcf626..cc55b009ab9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3490,7 +3490,7 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) Lisp_Object *vec = XVECTOR (obj)->contents; ptrdiff_t size = ASIZE (obj); - if (!(size >= COMPILED_CONSTANTS)) + if (size >= COMPILED_CONSTANTS) { /* Always read 'lazily-loaded' bytecode (generated by the `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to From caecbf3e8db57d93715b8d20587b2ed54064cadb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 1 Feb 2024 17:17:36 +0100 Subject: [PATCH 031/385] Fix stale cache in Tramp (do not merge with master) * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Flush file properties when needed. (Bug#68805) --- lisp/net/tramp-sh.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1301cd633da..44c0bdc7aea 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2521,6 +2521,12 @@ The method used must be an out-of-band method." ;; cached password). (tramp-cleanup-connection v 'keep-debug 'keep-password)))) + ;; The cached file properties might be wrong if NEWNAME didn't + ;; exist. Flush them. + (when v2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname))) + ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) (tramp-compat-set-file-times From d89e427852a63dbeed3d5e03d9deb2ae9a8e3e1b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 1 Feb 2024 19:16:37 +0200 Subject: [PATCH 032/385] * lisp/simple.el (read-from-kill-ring): Ignore `read-only' text property. Add `read-only' to the list of text properties removed from history items (bug#68847). --- lisp/simple.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/simple.el b/lisp/simple.el index 8246b9cab81..9a33049f4ca 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6419,7 +6419,7 @@ PROMPT is a string to prompt with." 0 (length s) '( keymap local-map action mouse-action - button category help-args) + read-only button category help-args) s) s) kill-ring)) From c14c978e3b1be9802a5c1fdf1b29e0ee48e16364 Mon Sep 17 00:00:00 2001 From: dalu Date: Thu, 1 Feb 2024 11:45:13 +0800 Subject: [PATCH 033/385] Support kotlin-ts-mode in Eglot * lisp/progmodes/eglot.el (eglot-server-programs): Support kotlin-ts-mode. (Bug#68865) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 1e90e26a537..cbc77b331f0 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -216,7 +216,7 @@ chosen (interactively or automatically)." . ("haskell-language-server-wrapper" "--lsp")) (elm-mode . ("elm-language-server")) (mint-mode . ("mint" "ls")) - (kotlin-mode . ("kotlin-language-server")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) . ("gopls")) ((R-mode ess-r-mode) . ("R" "--slave" "-e" From 5f56bc1cdfcd474dd9cfad07240df6c252abd35c Mon Sep 17 00:00:00 2001 From: Piotr Kwiecinski Date: Thu, 1 Feb 2024 14:02:20 +0100 Subject: [PATCH 034/385] eglot: Add php-ts-mode to eglot-server-programs * lisp/progmodes/eglot.el (eglot-server-programs): Add php-ts-mode. (Bug#68870) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index cbc77b331f0..55b54ed6dc6 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -200,7 +200,7 @@ chosen (interactively or automatically)." (typescript-mode :language-id "typescript")) . ("typescript-language-server" "--stdio")) ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode) + ((php-mode phps-mode php-ts-mode) . ,(eglot-alternatives '(("phpactor" "language-server") ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) From a3987127618b9fe49b88807f0268ec9abcc7396f Mon Sep 17 00:00:00 2001 From: nibon7 Date: Thu, 18 Jan 2024 00:01:48 +0800 Subject: [PATCH 035/385] eglot: Add nushell language server * lisp/progmodes/eglot.el (eglot-server-programs): Add nushell language server. (Bug#68823) --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 55b54ed6dc6..9eaa92da03e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -235,6 +235,7 @@ chosen (interactively or automatically)." (erlang-mode . ("erlang_ls" "--transport" "stdio")) ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) (gdscript-mode . ("localhost" 6008)) ((fortran-mode f90-mode) . ("fortls")) (futhark-mode . ("futhark" "lsp")) From 72b1379f0795a5e2e9c57615c0b1d78c0b97cd1f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 2 Feb 2024 12:28:54 +0100 Subject: [PATCH 036/385] Increase `emacs-lisp-docstring-fill-column` to 72 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Monitors are wider now than when these defaults were first set, and it is useful to take better advantage of that, to fit text on fewer lines. Yet, it has repeatedly been shown that overly long lines reduce readability: "A reasonable guideline would be 55 to 75 characters per line."[1] We also don't want to disfavor narrow displays, like mobile phones; a more promising direction here might be to automatically word wrap docstrings and make their maximum width customizable. That might require a new docstring format, however. Bumping it by 7 characters, from 65 to 72, seems a reasonable compromise for now. Consideration was given to increasing it to 70 or 75, but 72 happens to be a commonly recommended maximum line width elsewhere (see Fortran 66, Python docstrings, commit message recommendations, etc.), and we might as well do the same. This change was discussed in: https://lists.gnu.org/r/emacs-devel/2022-07/msg00217.html [1] "Optimal Line Length in Reading — A Literature Review", Nanavati and Bias, Visible Language, Vol. 39 No. 2 (2005). https://journals.uc.edu/index.php/vl/article/view/5765 * lisp/emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): * .dir-locals.el (fill-column, emacs-lisp-docstring-fill-column): Bump default to 72. --- .dir-locals.el | 4 ++-- etc/NEWS | 5 +++++ lisp/emacs-lisp/lisp-mode.el | 5 +++-- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index ce7febca851..1f08c882e0b 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -3,8 +3,8 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 70) - (emacs-lisp-docstring-fill-column . 65) + (fill-column . 72) + (emacs-lisp-docstring-fill-column . 72) (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t) diff --git a/etc/NEWS b/etc/NEWS index 9bd4d0f631b..5b3d7dec8a6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1170,6 +1170,11 @@ Previously, the '@' character, which normally has 'symbol' syntax, would combine with a following Lisp symbol and interfere with symbol searching. +--- +*** 'emacs-lisp-docstring-fill-column' now defaults to 72. +It was previously 65. The new default formats documentation strings to +fit on fewer lines without negatively impacting readability. + ** CPerl mode --- diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ca207ff548d..ad0525e24be 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1420,14 +1420,15 @@ A prefix argument specifies pretty-printing." ;;;; Lisp paragraph filling commands. -(defcustom emacs-lisp-docstring-fill-column 65 +(defcustom emacs-lisp-docstring-fill-column 72 "Value of `fill-column' to use when filling a docstring. Any non-integer value means do not use a different value of `fill-column' when filling docstrings." :type '(choice (integer) (const :tag "Use the current `fill-column'" t)) :safe (lambda (x) (or (eq x t) (integerp x))) - :group 'lisp) + :group 'lisp + :version "30.1") (defun lisp-fill-paragraph (&optional justify) "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings. From 4b79c80c999fe95654b7db196b12e0844473f6da Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 15:24:55 +0200 Subject: [PATCH 037/385] New function 'sort-on' * lisp/sort.el (sort-on): New function. Patch by John Wiegley . * etc/NEWS: * doc/lispref/sequences.texi (Sequence Functions): Document 'sort-on'. --- doc/lispref/sequences.texi | 37 +++++++++++++++++++++++++++++++++---- etc/NEWS | 5 +++++ lisp/sort.el | 20 ++++++++++++++++++++ 3 files changed, 58 insertions(+), 4 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index f1f23f007a4..654019dfc31 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -434,12 +434,41 @@ but their relative order is also preserved: (9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")] @end group @end example - -@xref{Sorting}, for more functions that perform sorting. -See @code{documentation} in @ref{Accessing Documentation}, for a -useful example of @code{sort}. @end defun +Sometimes, computation of sort keys of list elements is expensive, and +therefore it is important to perform it the minimum number of times. +By contrast, computing the sort keys of elements inside the +@var{predicate} function passed to @code{sort} will generally perform +this computation each time @var{predicate} is called with some +element. If you can separate the computation of the sort key of an +element into a function of its own, you can use the following sorting +function, which guarantees that the key will be computed for each list +element exactly once. + +@defun sort-on sequence predicate accessor +This function stably sorts the list @var{sequence}, comparing the sort +keys of the elements using @var{predicate}. The comparison function +@var{predicate} accepts two arguments, the sort keys to compare, and +should return non-@code{nil} if the element corresponding to the first +key should sort before the element corresponding to the second key. +The function computes a sort key of each element by calling the +@var{accessor} function on that element; it does so exactly once for +each element of @var{sequence}. The @var{accessor} function is called +with a single argument, an element of @var{sequence}. + +This function implements what is known as +@dfn{decorate-sort-undecorate} paradigm, of the Schwartzian transform. +It basically trades CPU for memory, creating a temporary list with the +computed sport keys, then mapping @code{car} over the result of +sorting that temporary list. Unlike with @code{sort}, the return list +is a copy; the original list is left intact. +@end defun + +@xref{Sorting}, for more functions that perform sorting. See +@code{documentation} in @ref{Accessing Documentation}, for a useful +example of @code{sort}. + @cindex sequence functions in seq @cindex seq library @cindex sequences, generalized diff --git a/etc/NEWS b/etc/NEWS index 5b3d7dec8a6..816613de4ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1530,6 +1530,11 @@ precedence over the variable when present. Mostly used internally to do a kind of topological sort of inheritance hierarchies. +** New function 'sort-on'. +This function implements the Schwartzian transform, and is appropriate +for sorting lists when the computation of the sort key of a list +element can be expensive. + ** New API for 'derived-mode-p' and control of the graph of major modes. *** 'derived-mode-p' now takes the list of modes as a single argument. diff --git a/lisp/sort.el b/lisp/sort.el index 2ee76b6e1e3..97b40a2aef4 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -478,6 +478,26 @@ sRegexp specifying key within record: \nr") ;; if there was no such register (error (throw 'key nil)))))))))) +;;;###autoload +(defun sort-on (sequence predicate accessor) + "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. +SEQUENCE should be the input list to sort. +Elements of SEQUENCE are sorted by keys which are obtained by +calling ACCESSOR on each element. ACCESSOR should be a function of +one argument, an element of SEQUENCE, and should return the key +value to be compared by PREDICATE for sorting the element. +PREDICATE is the function for comparing keys; it is called with two +arguments, the keys to compare, and should return non-nil if the +first key should sort before the second key. +This function has the performance advantage of evaluating +ACCESSOR only once for each element in the input SEQUENCE, and is +therefore appropriate when computing the key by ACCESSOR is an +expensive operation. This is known as the \"decorate-sort-undecorate\" +paradigm, or the Schwartzian transform." + (mapcar #'car + (sort (mapcar #'(lambda (x) (cons x (funcall accessor x))) sequence) + #'(lambda (x y) (funcall predicate (cdr x) (cdr y)))))) + (defvar sort-columns-subprocess t) From dcce1e07fe750df060ab3a7c6782dc5145710fa3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 15:27:25 +0200 Subject: [PATCH 038/385] ; Fix last change * doc/lispref/sequences.texi (Sequence Functions): Improve indexing of last change --- doc/lispref/sequences.texi | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 654019dfc31..896dac35c8e 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -446,6 +446,8 @@ element into a function of its own, you can use the following sorting function, which guarantees that the key will be computed for each list element exactly once. +@cindex decorate-sort-undecorate +@cindex Schwartzian transform @defun sort-on sequence predicate accessor This function stably sorts the list @var{sequence}, comparing the sort keys of the elements using @var{predicate}. The comparison function From f9a15b8a1559999b8dd9895a5f5bb922c4e6730f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:39:23 +0200 Subject: [PATCH 039/385] ; Fix last change * lisp/sort.el (sort-on): Doc fix. * doc/lispref/sequences.texi (Sequence Functions): Fix description of 'sort-on'. --- doc/lispref/sequences.texi | 38 +++++++++++++++++++------------------- lisp/sort.el | 3 ++- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 896dac35c8e..9407b5f6342 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -436,35 +436,35 @@ but their relative order is also preserved: @end example @end defun -Sometimes, computation of sort keys of list elements is expensive, and -therefore it is important to perform it the minimum number of times. -By contrast, computing the sort keys of elements inside the -@var{predicate} function passed to @code{sort} will generally perform -this computation each time @var{predicate} is called with some +Sometimes, computation of sort keys of list or vector elements is +expensive, and therefore it is important to perform it the minimum +number of times. By contrast, computing the sort keys of elements +inside the @var{predicate} function passed to @code{sort} will generally +perform this computation each time @var{predicate} is called with some element. If you can separate the computation of the sort key of an element into a function of its own, you can use the following sorting function, which guarantees that the key will be computed for each list -element exactly once. +or vector element exactly once. @cindex decorate-sort-undecorate @cindex Schwartzian transform @defun sort-on sequence predicate accessor -This function stably sorts the list @var{sequence}, comparing the sort -keys of the elements using @var{predicate}. The comparison function -@var{predicate} accepts two arguments, the sort keys to compare, and -should return non-@code{nil} if the element corresponding to the first -key should sort before the element corresponding to the second key. -The function computes a sort key of each element by calling the -@var{accessor} function on that element; it does so exactly once for +This function stably sorts the list or vector @var{sequence}, comparing +the sort keys of the elements using @var{predicate}. The comparison +function @var{predicate} accepts two arguments, the sort keys to +compare, and should return non-@code{nil} if the element corresponding +to the first key should sort before the element corresponding to the +second key. The function computes a sort key of each element by calling +the @var{accessor} function on that element; it does so exactly once for each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. -This function implements what is known as -@dfn{decorate-sort-undecorate} paradigm, of the Schwartzian transform. -It basically trades CPU for memory, creating a temporary list with the -computed sport keys, then mapping @code{car} over the result of -sorting that temporary list. Unlike with @code{sort}, the return list -is a copy; the original list is left intact. +This function implements what is known as @dfn{decorate-sort-undecorate} +paradigm, of the Schwartzian transform. It basically trades CPU for +memory, creating a temporary list with the computed sort keys, then +mapping @code{car} over the result of sorting that temporary list. +Unlike with @code{sort}, the return value is always a new list; the +original @var{sequence} is left intact. @end defun @xref{Sorting}, for more functions that perform sorting. See diff --git a/lisp/sort.el b/lisp/sort.el index 97b40a2aef4..7047a714661 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -481,7 +481,7 @@ sRegexp specifying key within record: \nr") ;;;###autoload (defun sort-on (sequence predicate accessor) "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input list to sort. +SEQUENCE should be the input list or vector to sort. Elements of SEQUENCE are sorted by keys which are obtained by calling ACCESSOR on each element. ACCESSOR should be a function of one argument, an element of SEQUENCE, and should return the key @@ -489,6 +489,7 @@ value to be compared by PREDICATE for sorting the element. PREDICATE is the function for comparing keys; it is called with two arguments, the keys to compare, and should return non-nil if the first key should sort before the second key. +The return value is always a new list. This function has the performance advantage of evaluating ACCESSOR only once for each element in the input SEQUENCE, and is therefore appropriate when computing the key by ACCESSOR is an From 02bdb1e4c50153a1754b251538d705d7d81668f8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:46:19 +0200 Subject: [PATCH 040/385] ; Another fix of last change. --- doc/lispref/sequences.texi | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 9407b5f6342..068b69e9ef8 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -449,13 +449,14 @@ or vector element exactly once. @cindex decorate-sort-undecorate @cindex Schwartzian transform @defun sort-on sequence predicate accessor -This function stably sorts the list or vector @var{sequence}, comparing -the sort keys of the elements using @var{predicate}. The comparison -function @var{predicate} accepts two arguments, the sort keys to -compare, and should return non-@code{nil} if the element corresponding -to the first key should sort before the element corresponding to the -second key. The function computes a sort key of each element by calling -the @var{accessor} function on that element; it does so exactly once for +This function stably sorts @var{sequence}, which can be a list, a +vector, a bool-vector, or a string. It sorts by comparing the sort +keys of the elements using @var{predicate}. The comparison function +@var{predicate} accepts two arguments, the sort keys to compare, and +should return non-@code{nil} if the element corresponding to the first +key should sort before the element corresponding to the second key. The +function computes a sort key of each element by calling the +@var{accessor} function on that element; it does so exactly once for each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. From eb9bdb8948683e9870a3e52d085bf0c57d049130 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 17:48:28 +0200 Subject: [PATCH 041/385] ; And another fix... --- lisp/sort.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/sort.el b/lisp/sort.el index 7047a714661..4f0d759ef8a 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -481,7 +481,7 @@ sRegexp specifying key within record: \nr") ;;;###autoload (defun sort-on (sequence predicate accessor) "Sort SEQUENCE by calling PREDICATE on sort keys produced by ACCESSOR. -SEQUENCE should be the input list or vector to sort. +SEQUENCE should be the input sequence to sort. Elements of SEQUENCE are sorted by keys which are obtained by calling ACCESSOR on each element. ACCESSOR should be a function of one argument, an element of SEQUENCE, and should return the key From e2d1ac2f258a069f950d4df80c8096bfa34081fc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 2 Feb 2024 18:33:54 +0200 Subject: [PATCH 042/385] ; * doc/lispref/sequences.texi (Sequence Functions): Fix typo. --- doc/lispref/sequences.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 068b69e9ef8..74719d4779f 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -461,7 +461,7 @@ each element of @var{sequence}. The @var{accessor} function is called with a single argument, an element of @var{sequence}. This function implements what is known as @dfn{decorate-sort-undecorate} -paradigm, of the Schwartzian transform. It basically trades CPU for +paradigm, or the Schwartzian transform. It basically trades CPU for memory, creating a temporary list with the computed sort keys, then mapping @code{car} over the result of sorting that temporary list. Unlike with @code{sort}, the return value is always a new list; the From e9a668274e441645aed28e8c353187dfed35fcae Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 31 Jan 2024 18:56:43 -0500 Subject: [PATCH 043/385] bytecomp.el: Rewrite the way we print dynamic docstrings We used to print dynamic docstrings "manually" for two reasons: - References should look like `(#$ . POS)` but `prin1` was unable to print just `#$` for an sexp. - `make-docfile` needed to find those docstrings and the object to which they belonged. The second point is moot now that we don't use `make-docfile` on `.elc` files. So this patch lifts the first restriction, using `print-number-table`. The rest of the patch then simplifies and regularises the bytecompiler's generation of dynamic docstrings, which can now also easily be done for "inner" defvars and other places. * src/print.c (print_preprocess, print_object): Handle strings in `print-number-table`. (Vprint_number_table): Improve docstring. * lisp/emacs-lisp/bytecomp.el: (byte-compile--list-with-n): New function. (byte-compile--docstring-style-warn): Rename from `byte-compile-docstring-style-warn` and change calling convention. (byte-compile--\#$, byte-compile--docstrings): New vars. (byte-compile-close-variables): Bind them. (byte-compile--docstring): New function. (byte-compile-from-buffer): Set `byte-compile--\#$`. (byte-compile-output-file-form): Use `byte-compile--\#$` instead of special casing specific forms. (byte-compile--output-docform-recurse, byte-compile-output-docform): Delete functions. (byte-compile-file-form-autoload, byte-compile-file-form-defalias) (byte-compile-file-form-defvar-function, byte-compile-lambda): Use `byte-compile--docstring` and `byte-compile--list-with-n`. (byte-compile--declare-var): Add optional `not-toplevel` arg. (byte-compile-defvar): Add `toplevel` arg. Use `byte-compile--docstring`. (byte-compile-file-form-defvar): Delegate to `byte-compile-defvar`. (byte-compile--custom-declare-face): New function. Use it for `custom-declare-face`. (byte-compile-file-form-defmumble): Use `byte-compile-output-file-form` * src/doc.c (Fdocumentation_stringp): New function. (syms_of_doc): Defsubr it. (store_function_docstring): Remove left-over code from when we used DOC for the docstring of some Lisp files. * lisp/cus-face.el (custom-declare-face): Accept dynamic docstrings. * lisp/faces.el (face-documentation): Handle dynamic docstrings. * lisp/help-fns.el (describe-face): Simplify accordingly. --- lisp/cus-face.el | 2 +- lisp/emacs-lisp/bytecomp.el | 464 ++++++++++++++---------------------- lisp/faces.el | 4 +- lisp/help-fns.el | 5 +- src/doc.c | 58 ++--- src/print.c | 19 +- 6 files changed, 217 insertions(+), 335 deletions(-) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 0c8b6b0b97c..47afa841f5e 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -32,7 +32,7 @@ (defun custom-declare-face (face spec doc &rest args) "Like `defface', but with FACE evaluated as a normal argument." (when (and doc - (not (stringp doc))) + (not (documentation-stringp doc))) (error "Invalid (or missing) doc string %S" doc)) (unless (get face 'face-defface-spec) (face-spec-set face (purecopy spec) 'face-defface-spec) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index becc77f504a..6e66771658e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -345,7 +345,7 @@ A value of `all' really means all." '(docstrings-non-ascii-quotes) "List of warning types that are only enabled during Emacs builds. This is typically either warning types that are being phased in -(but shouldn't be enabled for packages yet), or that are only relevant +\(but shouldn't be enabled for packages yet), or that are only relevant for the Emacs build itself.") (defvar byte-compile--suppressed-warnings nil @@ -1740,68 +1740,82 @@ Also ignore URLs." The byte-compiler will emit a warning for documentation strings containing lines wider than this. If `fill-column' has a larger value, it will override this variable." - :group 'bytecomp :type 'natnum :safe #'natnump :version "28.1") -(define-obsolete-function-alias 'byte-compile-docstring-length-warn - 'byte-compile-docstring-style-warn "29.1") +(defun byte-compile--list-with-n (list n elem) + "Return LIST with its Nth element replaced by ELEM." + (if (eq elem (nth n list)) + list + (nconc (take n list) + (list elem) + (nthcdr (1+ n) list)))) -(defun byte-compile-docstring-style-warn (form) - "Warn if there are stylistic problems with the docstring in FORM. -Warn if documentation string of FORM is too wide. +(defun byte-compile--docstring-style-warn (docs kind name) + "Warn if there are stylistic problems in the docstring DOCS. +Warn if documentation string is too wide. It is too wide if it has any lines longer than the largest of `fill-column' and `byte-compile-docstring-max-column'." (when (byte-compile-warning-enabled-p 'docstrings) - (let* ((kind nil) (name nil) (docs nil) + (let* ((name (if (eq (car-safe name) 'quote) (cadr name) name)) (prefix (lambda () (format "%s%s" kind - (if name (format-message " `%s' " name) ""))))) - (pcase (car form) - ((or 'autoload 'custom-declare-variable 'defalias - 'defconst 'define-abbrev-table - 'defvar 'defvaralias - 'custom-declare-face) - (setq kind (nth 0 form)) - (setq name (nth 1 form)) - (when (and (consp name) (eq (car name) 'quote)) - (setq name (cadr name))) - (setq docs (nth 3 form))) - ('lambda - (setq kind "") ; can't be "function", unfortunately - (setq docs (nth 2 form)))) - (when (and kind docs (stringp docs)) - (let ((col (max byte-compile-docstring-max-column fill-column))) - (when (and (byte-compile-warning-enabled-p 'docstrings-wide) - (byte-compile--wide-docstring-p docs col)) - (byte-compile-warn-x - name - "%sdocstring wider than %s characters" (funcall prefix) col))) - ;; There's a "naked" ' character before a symbol/list, so it - ;; should probably be quoted with \=. - (when (string-match-p (rx (| (in " \t") bol) - (? (in "\"#")) - "'" - (in "A-Za-z" "(")) + (if name (format-message " `%S' " name) ""))))) + (let ((col (max byte-compile-docstring-max-column fill-column))) + (when (and (byte-compile-warning-enabled-p 'docstrings-wide) + (byte-compile--wide-docstring-p docs col)) + (byte-compile-warn-x + name + "%sdocstring wider than %s characters" (funcall prefix) col))) + ;; There's a "naked" ' character before a symbol/list, so it + ;; should probably be quoted with \=. + (when (string-match-p (rx (| (in " \t") bol) + (? (in "\"#")) + "'" + (in "A-Za-z" "(")) + docs) + (byte-compile-warn-x + name + (concat "%sdocstring has wrong usage of unescaped single quotes" + " (use \\=%c or different quoting such as %c...%c)") + (funcall prefix) ?' ?` ?')) + ;; There's a "Unicode quote" in the string -- it should probably + ;; be an ASCII one instead. + (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) + (when (string-match-p (rx (| " \"" (in " \t") bol) + (in "‘’")) docs) (byte-compile-warn-x name - (concat "%sdocstring has wrong usage of unescaped single quotes" - " (use \\=%c or different quoting such as %c...%c)") - (funcall prefix) ?' ?` ?')) - ;; There's a "Unicode quote" in the string -- it should probably - ;; be an ASCII one instead. - (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) - (when (string-match-p (rx (| " \"" (in " \t") bol) - (in "‘’")) - docs) - (byte-compile-warn-x - name - "%sdocstring uses curved single quotes; use %s instead of ‘...’" - (funcall prefix) "`...'")))))) - form) + "%sdocstring uses curved single quotes; use %s instead of ‘...’" + (funcall prefix) "`...'")))))) + +(defvar byte-compile--\#$) ; Special value that will print as `#$'. +(defvar byte-compile--docstrings nil "Table of already compiled docstrings.") + +(defun byte-compile--docstring (doc kind name &optional is-a-value) + (byte-compile--docstring-style-warn doc kind name) + ;; Make docstrings dynamic, when applicable. + (cond + ((and byte-compile-dynamic-docstrings + ;; The native compiler doesn't use those dynamic docstrings. + (not byte-native-compiling) + ;; Docstrings can only be dynamic when compiling a file. + byte-compile--\#$) + (let* ((byte-pos (with-memoization + ;; Reuse a previously written identical docstring. + ;; This is not done out of thriftiness but to try and + ;; make sure that "equal" functions remain `equal'. + ;; (Often those identical docstrings come from + ;; `help-add-fundoc-usage'). + ;; Needed e.g. for `advice-tests-nadvice'. + (gethash doc byte-compile--docstrings) + (byte-compile-output-as-comment doc nil))) + (newdoc (cons byte-compile--\#$ byte-pos))) + (if is-a-value newdoc (macroexp-quote newdoc)))) + (t doc))) ;; If we have compiled any calls to functions which are not known to be ;; defined, issue a warning enumerating them. @@ -1836,6 +1850,8 @@ It is too wide if it has any lines longer than the largest of ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (byte-compile--\#$ nil) + (byte-compile--docstrings (make-hash-table :test 'equal)) (overriding-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) @@ -2363,7 +2379,12 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer inbuffer - (when byte-compile-current-file + (when byte-compile-dest-file + (setq byte-compile--\#$ + (copy-sequence ;It needs to be a fresh new object. + ;; Also it stands for the `load-file-name' when the `.elc' will + ;; be loaded, so make it look like it. + byte-compile-dest-file)) (byte-compile-insert-header byte-compile-current-file byte-compile--outbuffer) ;; Instruct native-comp to ignore this file. @@ -2456,11 +2477,7 @@ Call from the source buffer." (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings - ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias, - ;; defconst, autoload, and custom-declare-variable. - ;; defalias calls are output directly by byte-compile-file-form-defmumble; - ;; it does not pay to first build the defalias in defmumble and then parse - ;; it here. + ;; (for `byte-compile-dynamic-docstrings'). (when byte-native-compiling ;; Spill output for the native compiler here (push (make-byte-to-native-top-level :form form :lexical lexical-binding) @@ -2470,123 +2487,17 @@ Call from the source buffer." (print-level nil) (print-quoted t) (print-gensym t) - (print-circle t)) ; Handle circular data structures. - (if (memq (car-safe form) '(defvar defvaralias defconst - autoload custom-declare-variable)) - (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 - (memq (car form) - '(defvaralias autoload - custom-declare-variable))) - (princ "\n" byte-compile--outbuffer) - (prin1 form byte-compile--outbuffer) - nil))) + (print-circle t) + (print-continuous-numbering t) + (print-number-table (make-hash-table :test #'eq))) + (when byte-compile--\#$ + (puthash byte-compile--\#$ "#$" print-number-table)) + (princ "\n" byte-compile--outbuffer) + (prin1 form byte-compile--outbuffer) + nil)) (defvar byte-compile--for-effect) -(defun byte-compile--output-docform-recurse - (info position form cvecindex docindex quoted) - "Print a form with a doc string. INFO is (prefix postfix). -POSITION is where the next doc string is to be inserted. -CVECINDEX is the index in the FORM of the constant vector, or nil. -DOCINDEX is the index of the doc string (or nil) in the FORM. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`defvaralias', `autoload' and `custom-declare-variable' need that. - -Return the position after any inserted docstrings as comments." - (let ((index 0) - doc-string-position) - ;; Insert the doc string, and make it a comment with #@LENGTH. - (when (and byte-compile-dynamic-docstrings - (stringp (nth docindex form))) - (goto-char position) - (setq doc-string-position - (byte-compile-output-as-comment - (nth docindex form) nil) - position (point)) - (goto-char (point-max))) - - (insert (car info)) - (prin1 (car form) byte-compile--outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((eq index cvecindex) - (let* ((cvec (car form)) - (len (length cvec)) - (index2 0) - elt) - (insert "[") - (while (< index2 len) - (setq elt (aref cvec index2)) - (if (byte-code-function-p elt) - (setq position - (byte-compile--output-docform-recurse - '("#[" "]") position - (append elt nil) ; Convert the vector to a list. - 2 4 nil)) - (prin1 elt byte-compile--outbuffer)) - (setq index2 (1+ index2)) - (unless (eq index2 len) - (insert " "))) - (insert "]"))) - ((= index docindex) - (cond - (doc-string-position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - doc-string-position) - byte-compile--outbuffer)) - ((stringp (car form)) - (let ((print-escape-newlines nil)) - (goto-char (prog1 (1+ (point)) - (prin1 (car form) - byte-compile--outbuffer))) - (insert "\\\n") - (goto-char (point-max)))) - (t (prin1 (car form) byte-compile--outbuffer)))) - (t (prin1 (car form) byte-compile--outbuffer)))) - (insert (cadr info)) - position)) - -(defun byte-compile-output-docform (preface tailpiece name info form - cvecindex docindex - quoted) - "Print a form with a doc string. INFO is (prefix postfix). -If PREFACE, NAME, and TAILPIECE are non-nil, print them too, -before/after INFO and the FORM but after the doc string itself. -CVECINDEX is the index in the FORM of the constant vector, or nil. -DOCINDEX is the index of the doc string (or nil) in the FORM. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`defvaralias', `autoload' and `custom-declare-variable' need that." - ;; We need to examine byte-compile-dynamic-docstrings - ;; in the input buffer (now current), not in the output buffer. - (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (with-current-buffer byte-compile--outbuffer - (let ((byte-compile-dynamic-docstrings dynamic-docstrings) - (position (point)) - (print-continuous-numbering t) - print-number-table - ;; FIXME: The bindings below are only needed for when we're - ;; called from ...-defmumble. - (print-escape-newlines t) - (print-length nil) - (print-level nil) - (print-quoted t) - (print-gensym t) - (print-circle t)) ; Handle circular data structures. - (when preface - ;; FIXME: We don't handle uninterned names correctly. - ;; E.g. if cl-define-compiler-macro uses uninterned name we get: - ;; (defalias '#1=#:foo--cmacro #[514 ...]) - ;; (put 'foo 'compiler-macro '#:foo--cmacro) - (insert preface) - (prin1 name byte-compile--outbuffer)) - (byte-compile--output-docform-recurse - info position form cvecindex docindex quoted) - (when tailpiece - (insert tailpiece)))))) - (defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-one-form form t))) @@ -2606,7 +2517,7 @@ list that represents a doc string reference. (if byte-compile-output (let ((form (byte-compile-out-toplevel t 'file))) (cond ((eq (car-safe form) 'progn) - (mapc 'byte-compile-output-file-form (cdr form))) + (mapc #'byte-compile-output-file-form (cdr form))) (form (byte-compile-output-file-form form))) (setq byte-compile-constants nil @@ -2681,12 +2592,12 @@ list that represents a doc string reference. (setq byte-compile-unresolved-functions (delq (assq funsym byte-compile-unresolved-functions) byte-compile-unresolved-functions))))) - (if (stringp (nth 3 form)) - (prog1 - form - (byte-compile-docstring-style-warn form)) - ;; No doc string, so we can compile this as a normal form. - (byte-compile-keep-pending form 'byte-compile-normal-call))) + (let* ((doc (nth 3 form)) + (newdoc (if (not (stringp doc)) doc + (byte-compile--docstring + doc 'autoload (nth 1 form))))) + (byte-compile-keep-pending (byte-compile--list-with-n form 3 newdoc) + #'byte-compile-normal-call))) (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) @@ -2698,9 +2609,10 @@ list that represents a doc string reference. (byte-compile-warn-x sym "global/dynamic var `%s' lacks a prefix" sym))) -(defun byte-compile--declare-var (sym) +(defun byte-compile--declare-var (sym &optional not-toplevel) (byte-compile--check-prefixed-var sym) - (when (memq sym byte-compile-lexical-variables) + (when (and (not not-toplevel) + (memq sym byte-compile-lexical-variables)) (setq byte-compile-lexical-variables (delq sym byte-compile-lexical-variables)) (when (byte-compile-warning-enabled-p 'lexical sym) @@ -2709,19 +2621,7 @@ list that represents a doc string reference. (push sym byte-compile--seen-defvars)) (defun byte-compile-file-form-defvar (form) - (let ((sym (nth 1 form))) - (byte-compile--declare-var sym) - (if (eq (car form) 'defconst) - (push sym byte-compile-const-variables))) - (if (and (null (cddr form)) ;No `value' provided. - (eq (car form) 'defvar)) ;Just a declaration. - nil - (byte-compile-docstring-style-warn form) - (setq form (copy-sequence form)) - (when (consp (nth 2 form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file))) - form)) + (byte-compile-defvar form 'toplevel)) (put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-defvar-function) @@ -2729,26 +2629,37 @@ list that represents a doc string reference. (defun byte-compile-file-form-defvar-function (form) (pcase-let (((or `',name (let name nil)) (nth 1 form))) - (if name (byte-compile--declare-var name))) - ;; Variable aliases are better declared before the corresponding variable, - ;; since it makes it more likely that only one of the two vars has a value - ;; before the `defvaralias' gets executed, which avoids the need to - ;; merge values. - (pcase form - (`(defvaralias ,_ ',newname . ,_) - (when (memq newname byte-compile-bound-variables) - (if (byte-compile-warning-enabled-p 'suspicious) - (byte-compile-warn-x - newname - "Alias for `%S' should be declared before its referent" newname))))) - (byte-compile-docstring-style-warn form) - (byte-compile-keep-pending form)) + (if name (byte-compile--declare-var name)) + ;; Variable aliases are better declared before the corresponding variable, + ;; since it makes it more likely that only one of the two vars has a value + ;; before the `defvaralias' gets executed, which avoids the need to + ;; merge values. + (pcase form + (`(defvaralias ,_ ',newname . ,_) + (when (memq newname byte-compile-bound-variables) + (if (byte-compile-warning-enabled-p 'suspicious) + (byte-compile-warn-x + newname + "Alias for `%S' should be declared before its referent" + newname))))) + (let ((doc (nth 3 form))) + (when (stringp doc) + (setcar (nthcdr 3 form) + (byte-compile--docstring doc (nth 0 form) name)))) + (byte-compile-keep-pending form))) (put 'custom-declare-variable 'byte-hunk-handler 'byte-compile-file-form-defvar-function) (put 'custom-declare-face 'byte-hunk-handler - 'byte-compile-docstring-style-warn) + #'byte-compile--custom-declare-face) +(defun byte-compile--custom-declare-face (form) + (let ((kind (nth 0 form)) (name (nth 1 form)) (docs (nth 3 form))) + (when (stringp docs) + (let ((newdocs (byte-compile--docstring docs kind name))) + (unless (eq docs newdocs) + (setq form (byte-compile--list-with-n form 3 newdocs))))) + form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) @@ -2902,33 +2813,24 @@ not to take responsibility for the actual compilation of the code." (cons (cons bare-name code) (symbol-value this-kind)))) - (if rest - ;; There are additional args to `defalias' (like maybe a docstring) - ;; that the code below can't handle: punt! - nil - ;; Otherwise, we have a bona-fide defun/defmacro definition, and use - ;; special code to allow dynamic docstrings and byte-code. - (byte-compile-flush-pending) + (byte-compile-flush-pending) + (let ((newform `(defalias ',bare-name + ,(if macro `'(macro . ,code) code) ,@rest))) (when byte-native-compiling - ;; Spill output for the native compiler here. + ;; Don't let `byte-compile-output-file-form' push the form to + ;; `byte-to-native-top-level-forms' because we want to use + ;; `make-byte-to-native-func-def' when possible. (push - (if macro + (if (or macro rest) (make-byte-to-native-top-level - :form `(defalias ',name '(macro . ,code) nil) + :form newform :lexical lexical-binding) (make-byte-to-native-func-def :name name :byte-func code)) byte-to-native-top-level-forms)) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" ")" - bare-name - (if macro '(" '(macro . #[" "])") '(" #[" "]")) - (append code nil) ; Turn byte-code-function-p into list. - 2 4 - nil) - t))))) + (let ((byte-native-compiling nil)) + (byte-compile-output-file-form newform))) + t)))) (defun byte-compile-output-as-comment (exp quoted) "Print Lisp object EXP in the output file at point, inside a comment. @@ -3129,9 +3031,9 @@ lambda-expression." (setq fun (cons 'lambda fun)) (unless (eq 'lambda (car-safe fun)) (error "Not a lambda list: %S" fun))) - (byte-compile-docstring-style-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) + (bare-arglist (byte-run-strip-symbol-positions arglist)) ; for compile-defun. (arglistvars (byte-run-strip-symbol-positions (byte-compile-arglist-vars arglist))) (byte-compile-bound-variables @@ -3140,16 +3042,22 @@ lambda-expression." (body (cdr (cdr fun))) (doc (if (stringp (car body)) (prog1 (car body) - ;; Discard the doc string + ;; Discard the doc string from the body ;; unless it is the last element of the body. (if (cdr body) (setq body (cdr body)))))) (int (assq 'interactive body)) command-modes) (when lexical-binding + (when arglist + ;; byte-compile-make-args-desc lost the args's names, + ;; so preserve them in the docstring. + (setq doc (help-add-fundoc-usage doc bare-arglist))) (dolist (var arglistvars) (when (assq var byte-compile--known-dynamic-vars) (byte-compile--warn-lexical-dynamic var 'lambda)))) + (when (stringp doc) + (setq doc (byte-compile--docstring doc "" nil 'is-a-value))) ;; Process the interactive spec. (when int ;; Skip (interactive) if it is in front (the most usual location). @@ -3193,8 +3101,7 @@ lambda-expression." (and lexical-binding (byte-compile-make-lambda-lexenv arglistvars)) - reserved-csts)) - (bare-arglist (byte-run-strip-symbol-positions arglist))) ; for compile-defun. + reserved-csts))) ;; Build the actual byte-coded function. (cl-assert (eq 'byte-code (car-safe compiled))) (let ((out @@ -3206,12 +3113,7 @@ lambda-expression." ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. - (cond ((and lexical-binding arglist) - ;; byte-compile-make-args-desc lost the args's names, - ;; so preserve them in the docstring. - (list (help-add-fundoc-usage doc bare-arglist))) - ((or doc int) - (list doc))) + (when (or doc int) (list doc)) ;; optionally, the interactive spec (and the modes the ;; command applies to). (cond @@ -5091,49 +4993,49 @@ binding slots have been popped." (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) (byte-compile-normal-call form)) -(defun byte-compile-defvar (form) - ;; This is not used for file-level defvar/consts. - (when (and (symbolp (nth 1 form)) - (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) - (byte-compile-warning-enabled-p 'lexical (nth 1 form))) - (byte-compile-warn-x - (nth 1 form) - "global/dynamic var `%s' lacks a prefix" - (nth 1 form))) - (byte-compile-docstring-style-warn form) - (let ((fun (nth 0 form)) - (var (nth 1 form)) - (value (nth 2 form)) - (string (nth 3 form))) - (when (or (> (length form) 4) - (and (eq fun 'defconst) (null (cddr form)))) - (let ((ncall (length (cdr form)))) - (byte-compile-warn-x - fun - "`%s' called with %d argument%s, but %s %s" - fun ncall - (if (= 1 ncall) "" "s") - (if (< ncall 2) "requires" "accepts only") - "2-3"))) - (push var byte-compile-bound-variables) +(defun byte-compile-defvar (form &optional toplevel) + (let* ((fun (nth 0 form)) + (var (nth 1 form)) + (value (nth 2 form)) + (string (nth 3 form))) + (byte-compile--declare-var var (not toplevel)) (if (eq fun 'defconst) (push var byte-compile-const-variables)) - (when (and string (not (stringp string))) + (cond + ((stringp string) + (setq string (byte-compile--docstring string fun var 'is-a-value))) + (string (byte-compile-warn-x string "third arg to `%s %s' is not a string: %s" - fun var string)) - ;; Delegate the actual work to the function version of the - ;; special form, named with a "-1" suffix. - (byte-compile-form-do-effect - (cond - ((eq fun 'defconst) `(defconst-1 ',var ,@(nthcdr 2 form))) - ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. - (t `(defvar-1 ',var - ;; Don't eval `value' if `defvar' wouldn't eval it either. - ,(if (macroexp-const-p value) value - `(if (boundp ',var) nil ,value)) - ,@(nthcdr 3 form))))))) + fun var string))) + (if toplevel + ;; At top-level we emit calls to defvar/defconst. + (if (and (null (cddr form)) ;No `value' provided. + (eq (car form) 'defvar)) ;Just a declaration. + nil + (let ((tail (nthcdr 4 form))) + (when (or tail string) (push string tail)) + (when (cddr form) + (push (if (not (consp value)) value + (byte-compile-top-level value nil 'file)) + tail)) + `(,fun ,var ,@tail))) + ;; At non-top-level, since there is no byte code for + ;; defvar/defconst, we delegate the actual work to the function + ;; version of the special form, named with a "-1" suffix. + (byte-compile-form-do-effect + (cond + ((eq fun 'defconst) + `(defconst-1 ',var ,@(byte-compile--list-with-n + (nthcdr 2 form) 1 (macroexp-quote string)))) + ((not (cddr form)) `',var) ; A simple (defvar foo) just returns foo. + (t `(defvar-1 ',var + ;; Don't eval `value' if `defvar' wouldn't eval it either. + ,(if (macroexp-const-p value) value + `(if (boundp ',var) nil ,value)) + ,@(byte-compile--list-with-n + (nthcdr 3 form) 0 (macroexp-quote string))))))))) (defun byte-compile-autoload (form) (and (macroexp-const-p (nth 1 form)) @@ -5159,14 +5061,6 @@ binding slots have been popped." ;; For the compilation itself, we could largely get rid of this hunk-handler, ;; if it weren't for the fact that we need to figure out when a defalias ;; defines a macro, so as to add it to byte-compile-macro-environment. - ;; - ;; FIXME: we also use this hunk-handler to implement the function's - ;; dynamic docstring feature (via byte-compile-file-form-defmumble). - ;; We should probably actually implement it (more elegantly) in - ;; byte-compile-lambda so it applies to all lambdas. We did it here - ;; so the resulting .elc format was recognizable by make-docfile, - ;; but since then we stopped using DOC for the docstrings of - ;; preloaded elc files so that obstacle is gone. (let ((byte-compile-free-references nil) (byte-compile-free-assignments nil)) (pcase form @@ -5175,7 +5069,11 @@ binding slots have been popped." ;; - `arg' is the expression to which it is defined. ;; - `rest' is the rest of the arguments. (`(,_ ',name ,arg . ,rest) - (byte-compile-docstring-style-warn form) + (let ((doc (car rest))) + (when (stringp doc) + (setq rest (byte-compile--list-with-n + rest 0 + (byte-compile--docstring doc (nth 0 form) name))))) (pcase-let* ;; `macro' is non-nil if it defines a macro. ;; `fun' is the function part of `arg' (defaults to `arg'). diff --git a/lisp/faces.el b/lisp/faces.el index d5120f42b92..c3a54a08a3d 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -651,11 +651,11 @@ Optional argument INHERIT is passed to `face-attribute'." If FACE is a face-alias, get the documentation for the target face." (let ((alias (get face 'face-alias))) (if alias - (let ((doc (get alias 'face-documentation))) + (let ((doc (documentation-property alias 'face-documentation))) (format "%s is an alias for the face `%s'.%s" face alias (if doc (format "\n%s" doc) ""))) - (get face 'face-documentation)))) + (documentation-property face 'face-documentation)))) (defun set-face-documentation (face string) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 99642d08bbd..1ba848c107d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1799,9 +1799,8 @@ If FRAME is omitted or nil, use the selected frame." alias) "")))) (insert "\nDocumentation:\n" - (substitute-command-keys - (or (face-documentation face) - "Not documented as a face.")) + (or (face-documentation face) + "Not documented as a face.") "\n\n")) (with-current-buffer standard-output (save-excursion diff --git a/src/doc.c b/src/doc.c index a451b468ef2..b5a9ed498af 100644 --- a/src/doc.c +++ b/src/doc.c @@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file) return 1; } +DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp, + 1, 1, 0, + doc: /* Return non-nil if OBJECT is a well-formed docstring object. +OBJECT can be either a string or a reference if it's kept externally. */) + (Lisp_Object object) +{ + return (STRINGP (object) + || FIXNUMP (object) /* Reference to DOC. */ + || (CONSP (object) /* Reference to .elc. */ + && STRINGP (XCAR (object)) + && FIXNUMP (XCDR (object))) + ? Qt : Qnil); +} + DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, doc: /* Return the documentation string of FUNCTION. Unless a non-nil second argument RAW is given, the @@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) /* If it's a lisp form, stick it in the form. */ if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); - if (CONSP (fun)) - { - Lisp_Object tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload) - || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) - { - tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && FIXNUMP (XCAR (tem))) - /* FIXME: This modifies typically pure hash-cons'd data, so its - correctness is quite delicate. */ - XSETCAR (tem, make_fixnum (offset)); - } - } /* Lisp_Subrs have a slot for it. */ - else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) + if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun)) + XSUBR (fun)->doc = offset; + else { - XSUBR (fun)->doc = offset; - } - - /* Bytecode objects sometimes have slots for it. */ - else if (COMPILEDP (fun)) - { - /* This bytecode object must have a slot for the - docstring, since we've found a docstring for it. */ - if (PVSIZE (fun) > COMPILED_DOC_STRING - /* Don't overwrite a non-docstring value placed there, - * such as the symbols used for Oclosures. */ - && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING))) - ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); - else - { - AUTO_STRING (format, - (PVSIZE (fun) > COMPILED_DOC_STRING - ? "Docstring slot busy for %s" - : "No docstring slot for %s")); - CALLN (Fmessage, format, - (SYMBOLP (obj) - ? SYMBOL_NAME (obj) - : build_string (""))); - } + AUTO_STRING (format, "Ignoring DOC string on non-subr: %S"); + CALLN (Fmessage, format, obj); } } @@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case. */); doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */); /* Initialized by ‘main’. */ + defsubr (&Sdocumentation_stringp); defsubr (&Sdocumentation); defsubr (&Ssubr_documentation); defsubr (&Sdocumentation_property); diff --git a/src/print.c b/src/print.c index c6a3dba3163..c2beff0ed55 100644 --- a/src/print.c +++ b/src/print.c @@ -1412,7 +1412,7 @@ print_preprocess (Lisp_Object obj) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) { /* OBJ appears more than once. Let's remember that. */ - if (!FIXNUMP (num)) + if (SYMBOLP (num)) /* In practice, nil or t. */ { print_number_index++; /* Negative number indicates it hasn't been printed yet. */ @@ -2265,6 +2265,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; } } + else if (STRINGP (num)) + { + strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun); + goto next_obj; + } } print_depth++; @@ -2554,11 +2559,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) goto next_obj; case PVEC_SUB_CHAR_TABLE: { - /* Make each lowest sub_char_table start a new line. - Otherwise we'll make a line extremely long, which - results in slow redisplay. */ - if (XSUB_CHAR_TABLE (obj)->depth == 3) - printchar ('\n', printcharfun); print_c_string ("#^^[", printcharfun); int n = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth, @@ -2664,7 +2664,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* With the print-circle feature. */ Lisp_Object num = Fgethash (next, Vprint_number_table, Qnil); - if (FIXNUMP (num)) + if (!(NILP (num) || EQ (num, Qt))) { print_c_string (" . ", printcharfun); obj = next; @@ -2928,7 +2928,10 @@ This variable should not be set with `setq'; bind it with a `let' instead. */); DEFVAR_LISP ("print-number-table", Vprint_number_table, doc: /* A vector used internally to produce `#N=' labels and `#N#' references. The Lisp printer uses this vector to detect Lisp objects referenced more -than once. +than once. If an entry contains a number, then the corresponding key is +referenced more than once: a positive sign indicates that it's already been +printed, and the absolute value indicates the number to use when printing. +If an entry contains a string, that string is printed instead. When you bind `print-continuous-numbering' to t, you should probably also bind `print-number-table' to nil. This ensures that the value of From 82e50a23fea8bc435bfae8390008702aa7d74bda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 2 Feb 2024 18:59:21 -0500 Subject: [PATCH 044/385] cperl-mode.el: Don't use obsolete `special-display-popup-frame` * lisp/progmodes/cperl-mode.el (cperl-info-on-command): Simplify, to let `pop-to-buffer` decide whether to create a new frame or not, so it can be controlled by `display-buffer-alist`. --- lisp/progmodes/cperl-mode.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index bfc1742610c..758a6e17f72 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6612,14 +6612,13 @@ and \"Whitesmith\"." read)))) (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" - pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner + pos isvar height iniheight frheight buf win iniwin not-loner max-height char-height buf-list) (if (string-match "^-[a-zA-Z]$" command) (setq cmd-desc "^-X[ \t\n]")) (setq isvar (string-match "^[$@%]" command) buf (cperl-info-buffer isvar) - iniwin (selected-window) - fr1 (window-frame iniwin)) + iniwin (selected-window)) (set-buffer buf) (goto-char (point-min)) (or isvar @@ -6640,11 +6639,7 @@ and \"Whitesmith\"." (or (not win) (eq (window-buffer win) buf) (set-window-buffer win buf)) - (and win (setq fr2 (window-frame win))) - (if (or (not fr2) (eq fr1 fr2)) - (pop-to-buffer buf) - (special-display-popup-frame buf) ; Make it visible - (select-window win)) + (pop-to-buffer buf) (goto-char pos) ; Needed (?!). ;; Resize (setq iniheight (window-height) From bb894845ed6a06e8b301251d62f8b4a73a09d5ea Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 29 Jan 2024 19:04:58 -0800 Subject: [PATCH 045/385] Teach customize-option about erc-modules * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable): Use `setq' instead of `setopt' because the latter isn't defined in Emacs 27 and 28. This fix is unrelated to the main thrust of this commit. * lisp/erc/erc.el (erc-modules): Make good on decades old language in info node "(erc) Modules" by ensuring `customize-option' can find this option before its containing library is loaded. Like `gnus-select-method', this option serves as an entry point for configuring the application and is presented that way in tutorials and library front matter. Moreover, it can't be reasonably autoloaded in the traditional way because of its many dependencies and large textual footprint. (erc-display-message): Revise doc string. --- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 37 ++++++++++++++++++++----------------- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 8293994c5d4..7e30b1060fd 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -83,7 +83,7 @@ be experimental. It currently only works with Emacs 28+." (when (and erc-scrolltobottom-all (< emacs-major-version 28)) (erc-button--display-error-notice-with-keys "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") - (setopt erc-scrolltobottom-all nil)) + (setq erc-scrolltobottom-all nil)) (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index edac1060c3e..67c31d961e3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2183,13 +2183,17 @@ buffer rather than a server buffer.") (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) +;;;###autoload(custom-autoload 'erc-modules "erc") + (defcustom erc-modules '( autojoin button completion fill imenu irccontrols list match menu move-to-prompt netsplit networks readonly ring stamp track) - "A list of modules which ERC should enable. -If you set the value of this without using `customize' remember to call -\(erc-update-modules) after you change it. When using `customize', modules -removed from the list will be disabled." + "Modules to enable while connecting. +When modifying this option in lisp code, use a Custom-friendly +facilitator, like `setopt', or call `erc-update-modules' +afterward. This ensures a consistent ordering and disables +removed modules. It also gives packages access to the hook +`erc-before-connect'." :get (lambda (sym) ;; replace outdated names with their newer equivalents (erc-migrate-modules (symbol-value sym))) @@ -3828,14 +3832,14 @@ TYPE, when non-nil, to be a symbol handled by string MSG). Expect BUFFER to be among the sort accepted by the function `erc-display-line'. -Expect BUFFER to be a live `erc-mode' buffer, a list of such -buffers, or the symbols `all' or `active'. If `all', insert -STRING in all buffers for the current session. If `active', -defer to the function `erc-active-buffer', which may return the -session's server buffer if the previously active buffer has been -killed. If BUFFER is nil or a network process, pretend it's set -to the appropriate server buffer. Otherwise, use the current -buffer. +When non-nil, expect BUFFER to be a live `erc-mode' buffer, a +list of such buffers, or the symbols `all' or `active'. If +`all', insert STRING in all buffers for the current session. If +`active', defer to the function `erc-active-buffer', which may +return the session's server buffer if the previously active +buffer has been killed. If BUFFER is nil or a network process, +pretend it's set to the appropriate server buffer. Otherwise, +use the current buffer. When TYPE is a list of symbols, call handlers from left to right without influencing how they behave when encountering existing @@ -3848,11 +3852,10 @@ being (erc-error-face erc-notice-face) throughout MSG when `erc-notice-highlight-type' is left at its default, `all'. As of ERC 5.6, assume third-party code will use this function -instead of lower-level ones, like `erc-insert-line', when needing -ERC to process arbitrary informative messages as if they'd been -sent from a server. That is, guarantee \"local\" messages, for -which PARSED is typically nil, will be subject to buttonizing, -filling, and other effects." +instead of lower-level ones, like `erc-insert-line', to insert +arbitrary informative messages as if sent by the server. That +is, tell modules to treat a \"local\" message for which PARSED is +nil like any other server-sent message." (let* ((erc--msg-props (or erc--msg-props (let ((table (make-hash-table)) From b7cdce097003a645ae396470cfab221bf789189e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 30 Jan 2024 18:17:41 -0800 Subject: [PATCH 046/385] Fix local variable persistence in erc-stamp * etc/ERC-NEWS: Mention renaming of `erc-munge-invisible-property'. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-disable): Remove correct function from `erc-mode-hook'. (erc-stamp--recover-on-reconnect): Revise doc string. (erc-munge-invisibility-spec, erc-stamp--manage-local-options-state): Mark former name as obsolete and rename to latter. Don't use helper macro meant only for local modules. This bug originated from c68dc778 "Manage some text props for ERC insertion-hook members", which stemmed from bug#60936. (erc-stamp--setup, erc-hide-timestamps, erc-show-timestamps) (erc-toggle-timestamps): Use new name for `erc-munge-invisibility-spec'. * lisp/erc/erc.el (erc--restore-initialize-priors): Raise error at runtime if mode var doesn't belong to a local module. * test/lisp/erc/erc-stamp-tests.el (erc-stamp-tests--insert-right) (erc-timestamp-intangible--left): Use new name for `erc-munge-invisibility-spec'. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Shadow `erc-last-input-time'. (erc--restore-initialize-priors): Add error form to expected expansion, and skip test on Emacs 27. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--make-bindings): Shadow `erc-last-input-time'. --- etc/ERC-NEWS | 9 +++-- lisp/erc/erc-stamp.el | 39 ++++++++++++------- lisp/erc/erc.el | 4 +- test/lisp/erc/erc-stamp-tests.el | 4 +- test/lisp/erc/erc-tests.el | 5 +++ .../erc/resources/erc-scenarios-common.el | 1 + 6 files changed, 42 insertions(+), 20 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f91d3fcb351..1e88500d169 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -435,9 +435,12 @@ contains unique closures and thus no longer proves effective for traversing inserted messages. For now, ERC only provides an internal means of visiting messages, but a public interface is forthcoming. Also affecting the 'stamp' module is the deprecation of the function -'erc-insert-aligned' and its removal from client code. Additionally, -the module now merges its 'invisible' property with existing ones and -includes all white space around stamps when doing so. +'erc-insert-aligned' and its removal from the default client's code. +In the same library, the function 'erc-munge-invisibility-spec' has +been renamed to 'erc-stamp--manage-local-options-state' to better +reflect its purpose. Additionally, the module now merges its +'invisible' property with existing ones and includes all white space +around stamps when doing so. This "propertizing" of surrounding white space extends to all 'stamp'-applied properties, like 'field', in all intervening space diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 558afd19427..a11739a4195 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -184,7 +184,7 @@ from entering them and instead jump over them." (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) - ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) @@ -198,6 +198,7 @@ from entering them and instead jump over them." "Escape hatch for omitting stamps when first char is invisible.") (defun erc-stamp--recover-on-reconnect () + "Attempt to restore \"last-inserted\" snapshots from prior session." (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left @@ -854,12 +855,20 @@ Return the empty string if FORMAT is nil." (defvar-local erc-stamp--csf-props-updated-p nil) -;; This function is used to munge `buffer-invisibility-spec' to an -;; appropriate value. Currently, it only handles timestamps, thus its -;; location. If you add other features which affect invisibility, -;; please modify this function and move it to a more appropriate -;; location. -(defun erc-munge-invisibility-spec () +(define-obsolete-function-alias 'erc-munge-invisibility-spec + #'erc-stamp--manage-local-options-state "30.1" + "Perform setup and teardown of `stamp'-owned options. + +Note that this function's role in practice has long defied its +stated mandate as claimed in a now deleted comment, which +envisioned it as evolving into a central toggle for modifying +`buffer-invisibility-spec' on behalf of options and features +ERC-wide.") +(defun erc-stamp--manage-local-options-state () + "Perform local setup and teardown for `stamp'-owned options. +For `erc-timestamp-intangible', toggle `cursor-intangible-mode'. +For `erc-echo-timestamps', integrate with `cursor-sensor-mode'. +For `erc-hide-timestamps, modify `buffer-invisibility-spec'." (if erc-timestamp-intangible (cursor-intangible-mode +1) ; idempotent (when (bound-and-true-p cursor-intangible-mode) @@ -869,10 +878,12 @@ Return the empty string if FORMAT is nil." (unless erc-stamp--permanent-cursor-sensor-functions (dolist (hook '(erc-insert-post-hook erc-send-post-hook)) (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t)) - (erc--restore-initialize-priors erc-stamp-mode - erc-stamp--csf-props-updated-p nil) + (setq erc-stamp--csf-props-updated-p + (alist-get 'erc-stamp--csf-props-updated-p + (or erc--server-reconnecting erc--target-priors))) (unless erc-stamp--csf-props-updated-p (setq erc-stamp--csf-props-updated-p t) + ;; Spoof `erc--ts' as being non-nil. (let ((erc--msg-props (map-into '((erc--ts . t)) 'hash-table))) (with-silent-modifications (erc--traverse-inserted @@ -902,9 +913,9 @@ Return the empty string if FORMAT is nil." (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' (kill-local-variable 'erc-stamp--last-stamp) @@ -916,7 +927,7 @@ Return the empty string if FORMAT is nil." "Hide timestamp information from display." (interactive) (setq erc-hide-timestamps t) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) (defun erc-show-timestamps () "Show timestamp information on display. @@ -924,7 +935,7 @@ This function only works if `erc-timestamp-format' was previously set, and timestamping is already active." (interactive) (setq erc-hide-timestamps nil) - (erc-munge-invisibility-spec)) + (erc-stamp--manage-local-options-state)) (defun erc-toggle-timestamps () "Hide or show timestamps in ERC buffers. @@ -938,7 +949,7 @@ enabled when the message was inserted." (setq erc-hide-timestamps t)) (mapc (lambda (buffer) (with-current-buffer buffer - (erc-munge-invisibility-spec))) + (erc-stamp--manage-local-options-state))) (erc-buffer-list))) (defvar-local erc-stamp--last-stamp nil) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 67c31d961e3..ef047201251 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1531,7 +1531,7 @@ Bound to local variables from an existing (logical) session's buffer during local-module setup and `erc-mode-hook' activation.") (defmacro erc--restore-initialize-priors (mode &rest vars) - "Restore local VARS for MODE from a previous session." + "Restore local VARS for local minor MODE from a previous session." (declare (indent 1)) (let ((priors (make-symbol "priors")) (initp (make-symbol "initp")) @@ -1541,6 +1541,8 @@ buffer during local-module setup and `erc-mode-hook' activation.") (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) (,initp (and ,priors (alist-get ',mode ,priors)))) + (unless (local-variable-if-set-p ',mode) + (error "Not a local minor mode var: %s" ',mode)) (setq ,@(mapcan #'identity (nreverse forms)))))) (defun erc--target-from-string (string) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index ef292ccb618..70ca224ac74 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -46,7 +46,7 @@ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") (erc-mode) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc--initialize-markers (point) nil) (erc-tests-common-init-server-proc "sleep" "1") @@ -235,7 +235,7 @@ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") (erc-mode) (erc--initialize-markers (point) nil) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc-display-message nil 'notice (current-buffer) "Welcome") ;; ;; Pretend `fill' is active and that these lines are diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b51bd67ae04..7890049a325 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -302,6 +302,7 @@ (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook + (erc-last-input-time 0) (erc-modules (remq 'stamp erc-modules)) (erc-send-input-line-function #'ignore) (erc--input-review-functions erc--input-review-functions) @@ -1189,12 +1190,16 @@ (should (erc--valid-local-channel-p "&local"))))) (ert-deftest erc--restore-initialize-priors () + (unless (>= emacs-major-version 28) + (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'")) (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode foo (ignore 1 2 3) bar #'spam baz nil)) (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) (,q (and ,p (alist-get 'erc-my-mode ,p)))) + (unless (local-variable-if-set-p 'erc-my-mode) + (error "Not a local minor mode var: %s" 'erc-my-mode)) (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) bar (if ,q (alist-get 'bar ,p) #'spam) baz (if ,q (alist-get 'baz ,p) nil))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0ec48d766ef..042b3a8c05b 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -151,6 +151,7 @@ (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) + (erc-last-input-time 0) (erc-d-linger-secs 10) ,@bindings))) From aa6315ee685185dd1b9b63ee94636e662d68106b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 31 Jan 2024 06:01:54 -0800 Subject: [PATCH 047/385] Reassociate erc-networks--id for orphaned queries * lisp/erc/erc-networks.el (erc-networks--examine-targets): Adopt the server's network ID in query buffers created before MOTD's end. Do this to avoid a type error in the process filter when renaming buffers. * lisp/erc/erc-networks.el (erc-networks--examine-targets): New test. * test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el (erc-scenarios-upstream-recon--znc/severed): New test. * test/lisp/erc/erc-scenarios-misc.el (erc-scenarios-base-mask-target-routing): Adjust timeout. * test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld: New file. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Use NAME parameter for creating ID. --- lisp/erc/erc-networks.el | 25 +++++- test/lisp/erc/erc-networks-tests.el | 46 ++++++++++ .../erc-scenarios-base-upstream-recon-znc.el | 46 ++++++++++ test/lisp/erc/erc-scenarios-misc.el | 2 +- .../base/upstream-reconnect/znc-severed.eld | 87 +++++++++++++++++++ test/lisp/erc/resources/erc-tests-common.el | 2 +- 6 files changed, 202 insertions(+), 6 deletions(-) create mode 100644 test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 99c3c0563d0..1b26afa1164 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1123,10 +1123,27 @@ TARGET to be an `erc--target' object." (lambda () (when (and erc--target (eq (erc--target-symbol erc--target) (erc--target-symbol target))) - (let ((oursp (if (erc--target-channel-local-p target) - (equal announced erc-server-announced-name) - (erc-networks--id-equal-p identity erc-networks--id)))) - (funcall (if oursp on-dupe on-collision)))))))) + ;; When a server sends administrative queries immediately + ;; after connection registration and before the session has a + ;; net-id, the buffer remains orphaned until reassociated + ;; here retroactively. + (unless erc-networks--id + (let ((id (erc-with-server-buffer erc-networks--id)) + (server-buffer (process-buffer erc-server-process))) + (apply #'erc-button--display-error-notice-with-keys + server-buffer + (concat "Missing network session (ID) for %S. " + (if id "Using `%S' from %S." "Ignoring.")) + (current-buffer) + (and id (list (erc-networks--id-symbol + (setq erc-networks--id id)) + server-buffer))))) + (when erc-networks--id + (let ((oursp (if (erc--target-channel-local-p target) + (equal announced erc-server-announced-name) + (erc-networks--id-equal-p identity + erc-networks--id)))) + (funcall (if oursp on-dupe on-collision))))))))) (defconst erc-networks--qualified-sep "@" "Separator used for naming a target buffer.") diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d8d8c6fa9cd..53cff8f489c 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1761,4 +1761,50 @@ (should (equal (erc-ports-list (nth 4 srv)) '(6697 9999)))))) +(ert-deftest erc-networks--examine-targets () + (with-current-buffer (erc-tests-common-make-server-buf "foonet") + (erc--open-target "#chan") + (erc--open-target "#spam")) + + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + (with-current-buffer (erc--open-target "*query") + (setq erc-networks--id nil)) + (with-current-buffer (erc--open-target "#chan") + (let ((calls ()) + (snap (lambda (parameter) + (list parameter + (erc-target) + (erc-networks--id-symbol erc-networks--id))))) + + ;; Search for "#chan" dupes among targets of all servers. + (should (equal + (erc-networks--examine-targets erc-networks--id erc--target + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "#chan@foonet") + (get-buffer "#chan@barnet")))) + + (should (equal (pop calls) '(ON-DUPE "#chan" barnet))) + (should (equal (pop calls) '(ON-COLL "#chan" foonet))) + (should-not calls) + (should-not (get-buffer "#chan")) + (should (get-buffer "#chan@barnet")) + (should (get-buffer "#chan@foonet")) + + ;; Search for "*query" dupes among targets of all servers. + (should (equal (erc-networks--examine-targets erc-networks--id + (buffer-local-value 'erc--target + (get-buffer "*query")) + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "*query")))) + + (should (equal (pop calls) '(ON-DUPE "*query" barnet))) + (should-not calls))) + + (goto-char (point-min)) + (should (search-forward "Missing network session" nil t))) + + (erc-tests-common-kill-buffers)) + ;;; erc-networks-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index bbd9c79f593..f3905974a11 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el @@ -42,4 +42,50 @@ 'znc-foonet 'znc-barnet)) +;; Here, the upstream connection is already severed when first +;; connecting. The bouncer therefore sends query messages from an +;; administrative bot before the first numerics burst, which results +;; in a target buffer not being associated with an `erc-networks--id'. +;; The problem only manifests later, when the buffer-association +;; machinery checks the names of all target buffers and assumes a +;; non-nil `erc-networks--id'. +(ert-deftest erc-scenarios-upstream-recon--znc/severed () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/upstream-reconnect") + (erc-d-t-cleanup-sleep-secs 1) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'znc-severed)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester@vanilla/foonet" + :password "changeme" + :full-name "tester") + (erc-scenarios-common-assert-initial-buf-name nil port) + (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status")) + (funcall expect 10 "Connection Refused. Reconnecting...") + (funcall expect 10 "Connected!")) + + (ert-info ("Join #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " tester, welcome!") + (funcall expect 10 " alice: And see a fearful sight") + (funcall expect 10 " hola") + (funcall expect 10 " hell o") + ;; + (funcall expect 10 " bob: Or to drown my clothes"))) + + (ert-info ("Buffer not renamed with net id") + (should (get-buffer "*status"))) + + (ert-info ("No error") + (with-current-buffer (messages-buffer) + (funcall expect -0.1 "error in process filter"))))) + ;;; erc-scenarios-base-upstream-recon-znc.el ends here diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index 8f6042de5c2..2afa1ce67a4 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el @@ -126,7 +126,7 @@ (erc-d-t-wait-for 10 (get-buffer "foonet")) (ert-info ("Channel buffer #foo playback received") - (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) (funcall expect 10 "Excellent workman"))) (ert-info ("Global notices routed to server buffer") diff --git a/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld new file mode 100644 index 00000000000..32d05cc8a3a --- /dev/null +++ b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld @@ -0,0 +1,87 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER tester@vanilla/foonet 0 * :tester") + (0.00 ":irc.znc.in 001 tester :Welcome to ZNC") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + + (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.") + (0.02 ":irc.foonet.org 221 tester +Zi") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.") + (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.") + (0.01 ":irc.foonet.org 324 tester #chan +Cnt") + (0.03 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.") + (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.") + (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola") + (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel") + (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.") + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.") + + (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...") + (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester +i") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.02 ":irc.foonet.org 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.") + (0.03 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") + (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped.")) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 05dbe1d50d6..99f15b89b03 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -122,7 +122,7 @@ Use NAME for the network and the session server as well." erc--isupport-params (make-hash-table) erc-session-port 6667 erc-network (intern name) - erc-networks--id (erc-networks--id-create nil)) + erc-networks--id (erc-networks--id-create name)) (current-buffer))) (defun erc-tests-common-string-to-propertized-parts (string) From 138decdc9e68a5fc9dddd1a212ed5d63d77d5d22 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 2 Feb 2024 22:53:23 -0800 Subject: [PATCH 048/385] Pacify gcc -Wpointer-sign MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/print.c (print_object): SDATA → SSDATA. --- src/print.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/print.c b/src/print.c index c2beff0ed55..e2252562915 100644 --- a/src/print.c +++ b/src/print.c @@ -2267,7 +2267,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else if (STRINGP (num)) { - strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun); + strout (SSDATA (num), SCHARS (num), SBYTES (num), printcharfun); goto next_obj; } } From d49124fc14b0bb37617b34b5839f873cea3817c8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:09:36 +0200 Subject: [PATCH 049/385] Avoid signaling errors from 'pixel-fill-region' * lisp/textmodes/pixel-fill.el (pixel-fill-region): Make sure the selected window displays the current buffer. This is important when this function is called inside 'with-current-buffer' or similar forms which temporarily change the buffer displayed in the selected window. (Bug#67791) --- lisp/textmodes/pixel-fill.el | 68 +++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 33 deletions(-) diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el index 25c0b46cee9..d26eaec2111 100644 --- a/lisp/textmodes/pixel-fill.el +++ b/lisp/textmodes/pixel-fill.el @@ -73,39 +73,41 @@ lines that are visually wider than PIXEL-WIDTH. If START isn't at the start of a line, the horizontal position of START, converted to pixel units, will be used as the indentation prefix on subsequent lines." - (save-excursion - (goto-char start) - (let ((indentation - (car (window-text-pixel-size nil (line-beginning-position) - (point)))) - (newline-end nil)) - (when (> indentation pixel-width) - (error "The indentation (%s) is wider than the fill width (%s)" - indentation pixel-width)) - (save-restriction - (narrow-to-region start end) - (goto-char (point-max)) - (when (looking-back "\n[ \t]*" (point-min)) - (setq newline-end t)) - (goto-char (point-min)) - ;; First replace all whitespace with space. - (while (re-search-forward "[ \t\n]+" nil t) - (cond - ((or (= (match-beginning 0) start) - (= (match-end 0) end)) - (delete-region (match-beginning 0) (match-end 0))) - ;; If there's just a single space here, don't replace. - ((not (and (= (- (match-end 0) (match-beginning 0)) 1) - (= (char-after (match-beginning 0)) ?\s))) - (replace-match - ;; We need to use a space that has an appropriate width. - (propertize " " 'face - (get-text-property (match-beginning 0) 'face)))))) - (goto-char start) - (pixel-fill--fill-line pixel-width indentation) - (goto-char (point-max)) - (when newline-end - (insert "\n")))))) + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (save-excursion + (goto-char start) + (let ((indentation + (car (window-text-pixel-size nil (line-beginning-position) + (point)))) + (newline-end nil)) + (when (> indentation pixel-width) + (error "The indentation (%s) is wider than the fill width (%s)" + indentation pixel-width)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-max)) + (when (looking-back "\n[ \t]*" (point-min)) + (setq newline-end t)) + (goto-char (point-min)) + ;; First replace all whitespace with space. + (while (re-search-forward "[ \t\n]+" nil t) + (cond + ((or (= (match-beginning 0) start) + (= (match-end 0) end)) + (delete-region (match-beginning 0) (match-end 0))) + ;; If there's just a single space here, don't replace. + ((not (and (= (- (match-end 0) (match-beginning 0)) 1) + (= (char-after (match-beginning 0)) ?\s))) + (replace-match + ;; We need to use a space that has an appropriate width. + (propertize " " 'face + (get-text-property (match-beginning 0) 'face)))))) + (goto-char start) + (pixel-fill--fill-line pixel-width indentation) + (goto-char (point-max)) + (when newline-end + (insert "\n"))))))) (defun pixel-fill--goto-pixel (width) (vertical-motion (cons (/ width (frame-char-width)) 0))) From 2f69353e4a756cf53459c14c5618bd262331b568 Mon Sep 17 00:00:00 2001 From: Vincenzo Pupillo Date: Thu, 1 Feb 2024 16:57:39 +0100 Subject: [PATCH 050/385] Fix incompatibility with tree-sitter-javascript >= 0.20.2 Starting from version 0.20.2 the grammar's primary expression "function" has been renamed to "function_expression". A new function checks if the new primary expression is available, and if so, it returns the correct rules. * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): New function. (js--treesit-font-lock-settings): Use it. (Bug#68879) --- lisp/progmodes/js.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e4ccfd73cc7..12c4d0aedb8 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3427,6 +3427,26 @@ This function is intended for use in `after-change-functions'." ;;; Tree sitter integration +(defun js--treesit-font-lock-compatibility-definition-feature () + "Font lock helper, to handle different releases of tree-sitter-javascript. +Check if a node type is available, then return the right font lock rules +for \"definition\" feature." + (condition-case nil + (progn (treesit-query-capture 'javascript '((function_expression) @cap)) + ;; starting from 0.20.2 + '((function_expression + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function_expression) (arrow_function)]))) + (error + ;; older version + '((function + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]))))) + (defun js-jsx--treesit-indent-compatibility-bb1f97b () "Indent rules helper, to handle different releases of tree-sitter-javascript. Check if a node type is available, then return the right indent rules." @@ -3538,8 +3558,7 @@ Check if a node type is available, then return the right indent rules." :language 'javascript :feature 'definition - '((function - name: (identifier) @font-lock-function-name-face) + `(,@(js--treesit-font-lock-compatibility-definition-feature) (class_declaration name: (identifier) @font-lock-type-face) @@ -3558,10 +3577,6 @@ Check if a node type is available, then return the right indent rules." (variable_declarator name: (identifier) @font-lock-variable-name-face) - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - (variable_declarator name: [(array_pattern (identifier) @font-lock-variable-name-face) (object_pattern From b91f0ee2fcc52b6ef2d747c5fc7f37573adc7ca5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:20:11 +0200 Subject: [PATCH 051/385] ; Fix last change * lisp/progmodes/js.el (js--treesit-font-lock-compatibility-definition-feature): Fix comments. --- lisp/progmodes/js.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 12c4d0aedb8..20350c0ccb6 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3433,14 +3433,14 @@ Check if a node type is available, then return the right font lock rules for \"definition\" feature." (condition-case nil (progn (treesit-query-capture 'javascript '((function_expression) @cap)) - ;; starting from 0.20.2 + ;; Starting from version 0.20.2 of the grammar. '((function_expression name: (identifier) @font-lock-function-name-face) (variable_declarator name: (identifier) @font-lock-function-name-face value: [(function_expression) (arrow_function)]))) (error - ;; older version + ;; An older version of the grammar. '((function name: (identifier) @font-lock-function-name-face) (variable_declarator From 37efb63a3df969fb2eeed70dfe7fcf6c187e05be Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 11:52:30 +0200 Subject: [PATCH 052/385] ; * lisp/eshell/em-unix.el (eshell/cp, eshell/ln): Delete extra space. Bug#68862. --- lisp/eshell/em-unix.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index a88c7e09946..78dfd0654e2 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -590,7 +590,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. :external "cp" :show-usage :usage "[OPTION]... SOURCE DEST - or: cp [OPTION]... SOURCE... DIRECTORY + or: cp [OPTION]... SOURCE... DIRECTORY Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") (if archive (setq preserve t no-dereference t em-recursive t)) @@ -619,7 +619,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") :external "ln" :show-usage :usage "[OPTION]... TARGET [LINK_NAME] - or: ln [OPTION]... TARGET... DIRECTORY + or: ln [OPTION]... TARGET... DIRECTORY Create a link to the specified TARGET with optional LINK_NAME. If there is more than one TARGET, the last argument must be a directory; create links in DIRECTORY to each TARGET. Create hard links by default, symbolic links From 492e16f2ff33e7ff65ff965e9cd2ba658c9f9a45 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 13:00:15 +0200 Subject: [PATCH 053/385] Fix downcasing of mode-name in compile.el * lisp/progmodes/compile.el (compilation--downcase-mode-name): New function. (compilation-start, kill-compilation): Use it instead of calling 'downcase' on 'mode-name'. (Bug#68795) --- lisp/progmodes/compile.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 51c81b9d2f6..11d400e145a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1890,6 +1890,12 @@ process from additional information inserted by Emacs." (defvar-local compilation--start-time nil "The time when the compilation started as returned by `float-time'.") +(defun compilation--downcase-mode-name (mode) + "Downcase the name of major MODE, even if MODE is not a string. +The function `downcase' will barf if passed the name of a `major-mode' +which is not a string, but instead a symbol or a list." + (downcase (format-mode-line mode))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -2081,11 +2087,12 @@ Returns the compilation buffer created." (get-buffer-process (with-no-warnings (comint-exec - outbuf (downcase mode-name) + outbuf (compilation--downcase-mode-name mode-name) shell-file-name nil `(,shell-command-switch ,command))))) - (start-file-process-shell-command (downcase mode-name) - outbuf command)))) + (start-file-process-shell-command + (compilation--downcase-mode-name mode-name) + outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process '((:propertize ":%s" face compilation-mode-line-run) @@ -2790,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (let ((buffer (compilation-find-buffer))) (if (get-buffer-process buffer) (interrupt-process (get-buffer-process buffer)) - (error "The %s process is not running" (downcase mode-name))))) + (error "The %s process is not running" + (compilation--downcase-mode-name mode-name))))) (defalias 'compile-mouse-goto-error 'compile-goto-error) From 5e4a0a29fa3562ce9b2b8e497c6e71e6bc169082 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 30 Nov 2023 06:00:44 -0600 Subject: [PATCH 054/385] Make sure read-symbol-shorthands is permanently local bug#63480, bug#67390 * lisp/files.el (permanently-enabled-local-variables): Add read-symbol-shorthands. --- lisp/files.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 9c8914bfc50..fd9088206d7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3754,7 +3754,8 @@ function is allowed to change the contents of this alist. This hook is called only if there is at least one file-local variable to set.") -(defvar permanently-enabled-local-variables '(lexical-binding) +(defvar permanently-enabled-local-variables + '(lexical-binding read-symbol-shorthands) "A list of file-local variables that are always enabled. This overrides any `enable-local-variables' setting.") From c2aaa8f15aa8fb3415a6c9f421f539ee34b7f52c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 30 Nov 2023 06:00:38 -0600 Subject: [PATCH 055/385] Process read-symbol-shorthands from longest to shortest (bug#67390) This ensures that overlapping shorthands are handled correctly and consistently even if specified out-of-order by the user. * doc/lispref/symbols.texi (Shorthands): Describe shorthand sort order. * lisp/files.el (hack-local-variables--find-variables): Specially handle read-symbol-shorthands. --- doc/lispref/symbols.texi | 17 +++++++++++++++++ lisp/files.el | 7 +++++++ 2 files changed, 24 insertions(+) diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 367bd195f16..e95e53d972d 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -761,6 +761,23 @@ instead of @code{snu-}. ;; End: @end example +Note that if you have two shorthands in the same file where one is the +prefix of the other, the longer shorthand will be attempted first. +This happens regardless of the order you specify shorthands in the +local variables section of your file. + +@example +'( + t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo' + t/foo ; reads to 'my-tricks-foo' + ) + +;; Local Variables: +;; read-symbol-shorthands: (("t/" . "my-tricks-") +;; ("t//" . "my-tricks--") +;; End: +@end example + @subsection Exceptions There are two exceptions to rules governing Shorthand transformations: diff --git a/lisp/files.el b/lisp/files.el index fd9088206d7..172237ceb82 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4191,6 +4191,13 @@ major-mode." ;; to use 'thisbuf's name in the ;; warning message. (or (buffer-file-name thisbuf) "")))))) + ((eq var 'read-symbol-shorthands) + ;; Sort automatically by shorthand length + ;; descending + (setq val (sort val + (lambda (sh1 sh2) (> (length (car sh1)) + (length (car sh2)))))) + (push (cons 'read-symbol-shorthands val) result)) ((and (eq var 'mode) handle-mode)) (t (ignore-errors From 17c3610c56155dd5b1efd5b7e8d6a58112f43a59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 29 Nov 2023 06:21:29 -0600 Subject: [PATCH 056/385] Consider read-symbol-shorthands in check-declare.el (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-verify): Consider read-symbol-shorthands. --- lisp/emacs-lisp/check-declare.el | 101 ++++++++++++++++--------------- 1 file changed, 53 insertions(+), 48 deletions(-) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 8e40b227b65..b4a7b4b33e6 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -145,64 +145,69 @@ is a string giving details of the error." (if (file-regular-p fnfile) (with-temp-buffer (insert-file-contents fnfile) + (unless cflag + ;; If in Elisp, ensure syntax and shorthands available + (set-syntax-table emacs-lisp-mode-syntax-table) + (let (enable-local-variables) (hack-local-variables))) ;; defsubst's don't _have_ to be known at compile time. - (setq re (format (if cflag - "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" - "^[ \t]*(\\(fset[ \t]+'\\|\ + (setq re (if cflag + (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" + (regexp-opt (mapcar 'cadr fnlist) t)) + "^[ \t]*(\\(fset[ \t]+'\\|\ cl-def\\(?:generic\\|method\\|un\\)\\|\ def\\(?:un\\|subst\\|foo\\|method\\|class\\|\ ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\ \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\ ine-overloadable-function\\)\\)\ -[ \t]*%s\\([ \t;]+\\|$\\)") - (regexp-opt (mapcar 'cadr fnlist) t))) +[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)")) (while (re-search-forward re nil t) (skip-chars-forward " \t\n") - (setq fn (match-string 2) - type (match-string 1) - ;; (min . max) for a fixed number of arguments, or - ;; arglists with optional elements. - ;; (min) for arglists with &rest. - ;; sig = 'err means we could not find an arglist. - sig (cond (cflag - (or - (when (search-forward "," nil t 3) - (skip-chars-forward " \t\n") - ;; Assuming minargs and maxargs on same line. - (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ + (setq fn (symbol-name (car (read-from-string (match-string 2))))) + (when (member fn (mapcar 'cadr fnlist)) + (setq type (match-string 1) + ;; (min . max) for a fixed number of arguments, or + ;; arglists with optional elements. + ;; (min) for arglists with &rest. + ;; sig = 'err means we could not find an arglist. + sig (cond (cflag + (or + (when (search-forward "," nil t 3) + (skip-chars-forward " \t\n") + ;; Assuming minargs and maxargs on same line. + (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\ \\([0-9]+\\|MANY\\|UNEVALLED\\)") - (setq minargs (string-to-number - (match-string 1)) - maxargs (match-string 2)) - (cons minargs (unless (string-match "[^0-9]" - maxargs) - (string-to-number - maxargs))))) - 'err)) - ((string-match - "\\`define-\\(derived\\|generic\\)-mode\\'" - type) - '(0 . 0)) - ((string-match - "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" - type) - '(0 . 1)) - ;; Prompt to update. - ((string-match - "\\`define-obsolete-function-alias\\>" - type) - 'obsolete) - ;; Can't easily check arguments in these cases. - ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ + (setq minargs (string-to-number + (match-string 1)) + maxargs (match-string 2)) + (cons minargs (unless (string-match "[^0-9]" + maxargs) + (string-to-number + maxargs))))) + 'err)) + ((string-match + "\\`define-\\(derived\\|generic\\)-mode\\'" + type) + '(0 . 0)) + ((string-match + "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'" + type) + '(0 . 1)) + ;; Prompt to update. + ((string-match + "\\`define-obsolete-function-alias\\>" + type) + 'obsolete) + ;; Can't easily check arguments in these cases. + ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) - t) - ((looking-at "\\((\\|nil\\)") - (byte-compile-arglist-signature - (read (current-buffer)))) - (t - 'err)) - ;; alist of functions and arglist signatures. - siglist (cons (cons fn sig) siglist))))) + t) + ((looking-at "\\((\\|nil\\)") + (byte-compile-arglist-signature + (read (current-buffer)))) + (t + 'err)) + ;; alist of functions and arglist signatures. + siglist (cons (cons fn sig) siglist)))))) (dolist (e fnlist) (setq arglist (nth 2 e) type From 0f715f9c154a47de57a2f24f19b4a402604e6dc0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 29 Nov 2023 16:48:34 -0600 Subject: [PATCH 057/385] Improve shorthands-font-lock-shorthands (bug#67390) Add font locking to the shorthand prefix of a given printed symbol name by checking if any of the shorthand prefixes in read-symbol-shorthands are a prefix for that print name. Although this does more string comparisons, it didn't prove to be any slower than the existing approach, and is more correct. This version is more accurate when highlighting files with many overlapping shorthands. Given: ;; Local Variables: ;; read-symbol-shorthands: (("bc-" . "breadcrumb-") ;; ("aw-" . "ace-window-") ;; ("zorglub/" . "ace-window-") ;; ("he//" . "hyperdrive-entry--") ;; ("h//" . "hyperdrive--") ;; ("he/" . "hyperdrive-entry-") ;; ("h/" . "hyperdrive-")) ;; End: The following are correct highlights on print names '(zorglub/blerh ; hilits "zorglub/" reads to 'ace-window-blerh' he/foo ; hilits "he/" reads to 'hyperdrive-entry-foo' he//bar ; hilits "he//" reads to 'hyperdrive-entry--bar' h/coiso ; hilits "h/" reads to 'hyperdrive-coiso' h//thingy ; hilits "h//" reads to 'hyperdrive--thingy' bc-yo ; hilits "bc-" reads to 'breadcrumb-yo' aw-thingy ; hilits "aw-" reads to 'ace-window-thingy' ) Co-authored-by: Jonas Bernoulli Co-authored-by: Joseph Turner * lisp/emacs-lisp/shorthands.el (shorthands-font-lock-shorthands): --- lisp/emacs-lisp/shorthands.el | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 6348aaccf93..379fb0baec9 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -52,38 +52,26 @@ :version "28.1" :group 'font-lock-faces) -(defun shorthands--mismatch-from-end (str1 str2) - "Tell index of first mismatch in STR1 and STR2, from end. -The index is a valid 0-based index on STR1. Returns nil if STR1 -equals STR2. Return 0 if STR1 is a suffix of STR2." - (cl-loop with l1 = (length str1) with l2 = (length str2) - for i from 1 - for i1 = (- l1 i) for i2 = (- l2 i) - while (eq (aref str1 i1) (aref str2 i2)) - if (zerop i2) return (if (zerop i1) nil i1) - if (zerop i1) return 0 - finally (return i1))) - (defun shorthands-font-lock-shorthands (limit) + "Font lock until LIMIT considering `read-symbol-shorthands'." (when read-symbol-shorthands (while (re-search-forward (concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>") limit t) (let* ((existing (get-text-property (match-beginning 1) 'face)) + (print-name (match-string 1)) (probe (and (not (memq existing '(font-lock-comment-face font-lock-string-face))) - (intern-soft (match-string 1)))) - (sname (and probe (symbol-name probe))) - (mismatch (and sname (shorthands--mismatch-from-end - (match-string 1) sname))) - (guess (and mismatch (1+ mismatch)))) - (when guess - (when (and (< guess (1- (length (match-string 1)))) - ;; In bug#67390 we allow other separators - (eq (char-syntax (aref (match-string 1) guess)) ?_)) - (setq guess (1+ guess))) + (intern-soft print-name))) + (symbol-name (and probe (symbol-name probe))) + (prefix (and symbol-name + (not (string-equal print-name symbol-name)) + (car (assoc print-name + read-symbol-shorthands + #'string-prefix-p))))) + (when prefix (add-face-text-property (match-beginning 1) - (+ (match-beginning 1) guess) + (+ (match-beginning 1) (length prefix)) 'elisp-shorthand-font-lock-face)))))) (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t) From c52d17d91ade6c789d8672dbd1301ba86ba4d7d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 29 Nov 2023 20:09:57 -0600 Subject: [PATCH 058/385] Also teach loaddefs-gen.el about shorthands (bug#63480) * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Make aware of read-symbol-shorthands. --- lisp/emacs-lisp/loaddefs-gen.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 5f152d3b509..bf5cd24f161 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -378,6 +378,7 @@ don't include." (let ((defs nil) (load-name (loaddefs-generate--file-load-name file main-outfile)) (compute-prefixes t) + read-symbol-shorthands local-outfile inhibit-autoloads) (with-temp-buffer (insert-file-contents file) @@ -399,7 +400,19 @@ don't include." (setq inhibit-autoloads (read (current-buffer))))) (save-excursion (when (re-search-forward "autoload-compute-prefixes: *" nil t) - (setq compute-prefixes (read (current-buffer)))))) + (setq compute-prefixes (read (current-buffer))))) + (save-excursion + ;; since we're "open-coding" we have to repeat more + ;; complicated logic in `hack-local-variables'. + (when (re-search-forward "read-symbol-shorthands: *" nil t) + (let* ((commentless (replace-regexp-in-string + "\n\\s-*;+" "" + (buffer-substring (point) (point-max)))) + (unsorted-shorthands (car (read-from-string commentless)))) + (setq read-symbol-shorthands + (sort unsorted-shorthands + (lambda (sh1 sh2) + (> (length (car sh1)) (length (car sh2)))))))))) ;; We always return the package version (even for pre-dumped ;; files). From 817140a852e79c5ef3cf7dc5e4c50aa710e8c4a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 30 Nov 2023 07:32:50 -0600 Subject: [PATCH 059/385] Fix prefix discovery for files with read-symbol-shorthands (bug#67325) In a previous commit, the local-variable read-symbol-shorthands is already read into the temporary buffer used for the autoload parsing aerobatics, so all we needed to do in 'l-g--compute-prefixes' is use 'read' to give 'read-symbol-shorthands' a chance to kick in. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): --- lisp/emacs-lisp/loaddefs-gen.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index bf5cd24f161..8aacbf406b6 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -499,7 +499,11 @@ don't include." (while (re-search-forward "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) - (let ((name (match-string-no-properties 2))) + (let* ((name (match-string-no-properties 2)) + ;; Consider `read-symbol-shorthands'. + (probe (let ((obarray (obarray-make))) + (car (read-from-string name))))) + (setq name (symbol-name probe)) (when (save-excursion (goto-char (match-beginning 0)) (or (bobp) From 9a51fbb69fc9dc4aa415308889ae667ee65660d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 3 Feb 2024 08:27:27 -0600 Subject: [PATCH 060/385] ; Also consider shorthands in check-declare-scan (bug#67523) * lisp/emacs-lisp/check-declare.el (check-declare-scan): Also consider shorthands here. --- lisp/emacs-lisp/check-declare.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index b4a7b4b33e6..a6d1a330d90 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -85,6 +85,9 @@ don't know how to recognize (e.g. some macros)." (let (alist) (with-temp-buffer (insert-file-contents file) + ;; Ensure shorthands available, as we will be `read'ing Elisp + ;; (bug#67523) + (let (enable-local-variables) (hack-local-variables)) ;; FIXME we could theoretically be inside a string. (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t) (let ((pos (match-beginning 1))) @@ -147,6 +150,7 @@ is a string giving details of the error." (insert-file-contents fnfile) (unless cflag ;; If in Elisp, ensure syntax and shorthands available + ;; (bug#67523) (set-syntax-table emacs-lisp-mode-syntax-table) (let (enable-local-variables) (hack-local-variables))) ;; defsubst's don't _have_ to be known at compile time. From f266622cdb34044f364976796a4e7ac003d7a1b3 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Sat, 3 Feb 2024 08:32:37 -0600 Subject: [PATCH 061/385] ; Optimize shorthand insertion in loaddefs-generate--parse-file * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Optimize. --- lisp/emacs-lisp/loaddefs-gen.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8aacbf406b6..fe29469d08c 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -404,10 +404,13 @@ don't include." (save-excursion ;; since we're "open-coding" we have to repeat more ;; complicated logic in `hack-local-variables'. - (when (re-search-forward "read-symbol-shorthands: *" nil t) - (let* ((commentless (replace-regexp-in-string + (when-let ((beg + (re-search-forward "read-symbol-shorthands: *" nil t))) + ;; `read-symbol-shorthands' alist ends with two parens. + (let* ((end (re-search-forward ")[;\n\s]*)")) + (commentless (replace-regexp-in-string "\n\\s-*;+" "" - (buffer-substring (point) (point-max)))) + (buffer-substring beg end))) (unsorted-shorthands (car (read-from-string commentless)))) (setq read-symbol-shorthands (sort unsorted-shorthands From ecb69c8bd8c3dba205187c6296c8cac9b6a65121 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 18:05:55 +0200 Subject: [PATCH 062/385] ; Fix a comment in loaddefs-gen.el --- lisp/emacs-lisp/loaddefs-gen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index fe29469d08c..7eced43e735 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -402,7 +402,7 @@ don't include." (when (re-search-forward "autoload-compute-prefixes: *" nil t) (setq compute-prefixes (read (current-buffer))))) (save-excursion - ;; since we're "open-coding" we have to repeat more + ;; Since we're "open-coding", we have to repeat more ;; complicated logic in `hack-local-variables'. (when-let ((beg (re-search-forward "read-symbol-shorthands: *" nil t))) From 8fc7e8c2b0cb33b0e8e9822f116e6dbb530ab1b6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Feb 2024 18:09:35 +0200 Subject: [PATCH 063/385] ; * lisp/files.el (hack-local-variables--find-variables): Fix comment. --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 172237ceb82..229771810fb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4193,7 +4193,7 @@ major-mode." (or (buffer-file-name thisbuf) "")))))) ((eq var 'read-symbol-shorthands) ;; Sort automatically by shorthand length - ;; descending + ;; in descending order. (setq val (sort val (lambda (sh1 sh2) (> (length (car sh1)) (length (car sh2)))))) From d41cdceb133e30c71a95fe893d70645472b326e3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 16:07:24 -0500 Subject: [PATCH 064/385] textconv.c: Fix warnings with-wide-int * src/textconv.c (set_composing_region, textconv_set_point_and_mark): Use `min/max`. --- src/textconv.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/textconv.c b/src/textconv.c index 0d35ec19c55..0941848dd09 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -1705,11 +1705,8 @@ set_composing_region (struct frame *f, ptrdiff_t start, { struct text_conversion_action *action, **last; - if (start > MOST_POSITIVE_FIXNUM) - start = MOST_POSITIVE_FIXNUM; - - if (end > MOST_POSITIVE_FIXNUM) - end = MOST_POSITIVE_FIXNUM; + start = min (start, MOST_POSITIVE_FIXNUM); + end = min (end, MOST_POSITIVE_FIXNUM); action = xmalloc (sizeof *action); action->operation = TEXTCONV_SET_COMPOSING_REGION; @@ -1734,8 +1731,7 @@ textconv_set_point_and_mark (struct frame *f, ptrdiff_t point, { struct text_conversion_action *action, **last; - if (point > MOST_POSITIVE_FIXNUM) - point = MOST_POSITIVE_FIXNUM; + point = min (point, MOST_POSITIVE_FIXNUM); action = xmalloc (sizeof *action); action->operation = TEXTCONV_SET_POINT_AND_MARK; From b0049c942b8fa4093a02a9bb4ffc9c5da2261765 Mon Sep 17 00:00:00 2001 From: Richard M Stallman Date: Sat, 3 Feb 2024 17:47:02 -0500 Subject: [PATCH 065/385] bytecomp.el: Warn for `,' not within backquote construct (bytecomp--report-comma): New function with `compiler-macro' property. --- lisp/emacs-lisp/bytecomp.el | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6e66771658e..5d2aa3355be 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5742,6 +5742,16 @@ and corresponding effects." (eval form) form))) +;; Report comma operator used outside of backquote. +;; Inside backquote, backquote will transform it before it gets here. + +(put '\, 'compiler-macro #'bytecomp--report-comma) +(defun bytecomp--report-comma (form &rest _ignore) + (macroexp-warn-and-return + (format-message "`%s' called -- perhaps used not within backquote" + (car form)) + form (list 'suspicious (car form)) t)) + ;; Check for (in)comparable constant values in calls to `eq', `memq' etc. (defun bytecomp--dodgy-eq-arg-p (x number-ok) From ecf3488477c6a4382737b97698443fdf26db8bd1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 18:22:05 -0500 Subject: [PATCH 066/385] * doc/emacs/buffers.texi (List Buffers): Update example --- doc/emacs/buffers.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index d9113a6811a..00160afd844 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -205,7 +205,7 @@ Here is an example of a buffer list: @smallexample CRM Buffer Size Mode File -. * .emacs 3294 Emacs-Lisp ~/.emacs +. * .emacs 3294 ELisp/l ~/.emacs % *Help* 101 Help search.c 86055 C ~/cvs/emacs/src/search.c % src 20959 Dired by name ~/cvs/emacs/src/ From 4ebded3f5ee8617ac6b1debaa01706cd78206f39 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 18:22:41 -0500 Subject: [PATCH 067/385] * lisp/emacs-lisp/easy-mmode.el (easy-mmode--mode-docstring): Add comment --- lisp/emacs-lisp/easy-mmode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 05b23a86fc0..4fa05008dd8 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -132,7 +132,7 @@ it is disabled.") (string-replace "'" "\\='" (format "%S" getter))))) (let ((start (point))) (insert argdoc) - (when (fboundp 'fill-region) + (when (fboundp 'fill-region) ;Don't break bootstrap! (fill-region start (point) 'left t)))) ;; Finally, insert the keymap. (when (and (boundp keymap-sym) From 45125e019c3698ff74ccb2183b789c25f9d3f574 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Feb 2024 23:05:03 -0500 Subject: [PATCH 068/385] tramp: Tweak the ls-lisp declarations * lisp/net/tramp-sh.el (ls-lisp-use-insert-directory-program): Don't declare its existence... (tramp-sh-handle-insert-directory): ...test it instead. * lisp/net/tramp.el (ls-lisp-dirs-first, ls-lisp-emulation) (ls-lisp-ignore-case, ls-lisp-use-insert-directory-program) (ls-lisp-verbosity): Move declaration... (tramp-handle-insert-directory): ...to the point where we have a good reason to think these variables exist. --- lisp/net/tramp-sh.el | 3 +-- lisp/net/tramp.el | 10 +++++----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6bb1d976ec5..7656da81dcc 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -38,7 +38,6 @@ (declare-function dired-compress-file "dired-aux") (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) -(defvar ls-lisp-use-insert-directory-program) ;; Added in Emacs 28.1. (defvar process-file-return-signal-string) (defvar vc-handled-backends) @@ -2636,7 +2635,7 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." - (if (and (featurep 'ls-lisp) + (if (and (boundp 'ls-lisp-use-insert-directory-program) (not ls-lisp-use-insert-directory-program)) (tramp-handle-insert-directory filename switches wildcard full-directory-p) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 74d95757e46..7800efc2a5e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -67,11 +67,6 @@ (declare-function file-notify-rm-watch "filenotify") (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) -(defvar ls-lisp-dirs-first) -(defvar ls-lisp-emulation) -(defvar ls-lisp-ignore-case) -(defvar ls-lisp-use-insert-directory-program) -(defvar ls-lisp-verbosity) (defvar tramp-prefix-format) (defvar tramp-prefix-regexp) (defvar tramp-method-regexp) @@ -4189,6 +4184,11 @@ Let-bind it when necessary.") (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (require 'ls-lisp) + (defvar ls-lisp-dirs-first) + (defvar ls-lisp-emulation) + (defvar ls-lisp-ignore-case) + (defvar ls-lisp-use-insert-directory-program) + (defvar ls-lisp-verbosity) (unless switches (setq switches "")) ;; Mark trailing "/". (when (and (directory-name-p filename) From dd81e767b7782c275af4221fe258fa3d2948724a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 4 Feb 2024 11:45:15 +0200 Subject: [PATCH 069/385] Fix display of invisible text with opposite directionality * src/xdisp.c (handle_invisible_prop): Skip invisible text correctly when it starts at position whose resolved bidi level is above the base paragraph level. (Bug#68446) --- src/xdisp.c | 191 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 158 insertions(+), 33 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 4ff689b2df7..40311ee8ea7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5062,31 +5062,169 @@ handle_invisible_prop (struct it *it) { enum prop_handled handled = HANDLED_NORMALLY; int invis; - Lisp_Object prop; + ptrdiff_t curpos, endpos; + Lisp_Object prop, pos, overlay; + /* Get the value of the invisible text property at the current + position. Value will be nil if there is no such property. */ if (STRINGP (it->string)) { - Lisp_Object end_charpos, limit; + curpos = IT_STRING_CHARPOS (*it); + endpos = SCHARS (it->string); + pos = make_fixnum (curpos); + prop = Fget_text_property (pos, Qinvisible, it->string); + } + else /* buffer */ + { + curpos = IT_CHARPOS (*it); + endpos = ZV; + pos = make_fixnum (curpos); + prop = get_char_property_and_overlay (pos, Qinvisible, it->window, + &overlay); + } - /* Get the value of the invisible text property at the - current position. Value will be nil if there is no such - property. */ - end_charpos = make_fixnum (IT_STRING_CHARPOS (*it)); - prop = Fget_text_property (end_charpos, Qinvisible, it->string); - invis = TEXT_PROP_MEANS_INVISIBLE (prop); + /* Do we have anything to do here? */ + invis = TEXT_PROP_MEANS_INVISIBLE (prop); + if (invis == 0 || curpos >= it->end_charpos) + return handled; + + /* If not bidi, or the bidi iteration is at base paragraph level, we + can use a faster method; otherwise we need to check invisibility + of every character while bidi-iterating out of invisible text. */ + bool slow = it->bidi_p && !BIDI_AT_BASE_LEVEL (it->bidi_it); + /* Record whether we have to display an ellipsis for the + invisible text. */ + bool display_ellipsis_p = (invis == 2); + + handled = HANDLED_RECOMPUTE_PROPS; + + if (slow) + { + if (it->bidi_it.first_elt && it->bidi_it.charpos < endpos) + bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); + + if (STRINGP (it->string)) + { + bool done = false; + /* Bidi-iterate out of the invisible part of the string. */ + do + { + bidi_move_to_visually_next (&it->bidi_it); + if (it->bidi_it.charpos < 0 || it->bidi_it.charpos >= endpos) + done = true; + else + { + pos = make_fixnum (it->bidi_it.charpos); + prop = Fget_text_property (pos, Qinvisible, it->string); + invis = TEXT_PROP_MEANS_INVISIBLE (prop); + /* If there are adjacent invisible texts, don't lose + the second one's ellipsis. */ + if (invis == 2) + display_ellipsis_p = true; + } + } + while (!done && invis != 0); + + if (display_ellipsis_p) + it->ellipsis_p = true; + IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; + IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; + if (IT_STRING_BYTEPOS (*it) >= endpos) + { + /* The rest of the string is invisible. If this is an + overlay string, proceed with the next overlay string + or whatever comes and return a character from there. */ + if (it->current.overlay_string_index >= 0 + && !display_ellipsis_p) + { + next_overlay_string (it); + /* Don't check for overlay strings when we just + finished processing them. */ + handled = HANDLED_OVERLAY_STRING_CONSUMED; + } + } + } + else + { + bool done = false; + /* Bidi-iterate out of the invisible text. */ + do + { + bidi_move_to_visually_next (&it->bidi_it); + if (it->bidi_it.charpos < BEGV || it->bidi_it.charpos >= endpos) + done = true; + else + { + pos = make_fixnum (it->bidi_it.charpos); + prop = Fget_char_property (pos, Qinvisible, it->window); + invis = TEXT_PROP_MEANS_INVISIBLE (prop); + /* If there are adjacent invisible texts, don't lose + the second one's ellipsis. */ + if (invis == 2) + display_ellipsis_p = true; + } + } + while (!done && invis != 0); + + IT_CHARPOS (*it) = it->bidi_it.charpos; + IT_BYTEPOS (*it) = it->bidi_it.bytepos; + if (display_ellipsis_p) + { + /* Make sure that the glyphs of the ellipsis will get + correct `charpos' values. See below for detailed + explanation why this is needed. */ + it->position.charpos = IT_CHARPOS (*it) - 1; + it->position.bytepos = CHAR_TO_BYTE (it->position.charpos); + } + /* If there are before-strings at the start of invisible + text, and the text is invisible because of a text + property, arrange to show before-strings because 20.x did + it that way. (If the text is invisible because of an + overlay property instead of a text property, this is + already handled in the overlay code.) */ + if (NILP (overlay) + && get_overlay_strings (it, it->stop_charpos)) + { + handled = HANDLED_RECOMPUTE_PROPS; + if (it->sp > 0) + { + it->stack[it->sp - 1].display_ellipsis_p = display_ellipsis_p; + /* The call to get_overlay_strings above recomputes + it->stop_charpos, but it only considers changes + in properties and overlays beyond iterator's + current position. This causes us to miss changes + that happen exactly where the invisible property + ended. So we play it safe here and force the + iterator to check for potential stop positions + immediately after the invisible text. Note that + if get_overlay_strings returns true, it + normally also pushed the iterator stack, so we + need to update the stop position in the slot + below the current one. */ + it->stack[it->sp - 1].stop_charpos + = CHARPOS (it->stack[it->sp - 1].current.pos); + } + } + else if (display_ellipsis_p) + { + it->ellipsis_p = true; + /* Let the ellipsis display before + considering any properties of the following char. + Fixes jasonr@gnu.org 01 Oct 07 bug. */ + handled = HANDLED_RETURN; + } + } + } + else if (STRINGP (it->string)) + { + Lisp_Object end_charpos = pos, limit; if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos) { - /* Record whether we have to display an ellipsis for the - invisible text. */ - bool display_ellipsis_p = (invis == 2); - ptrdiff_t len, endpos; - - handled = HANDLED_RECOMPUTE_PROPS; + ptrdiff_t len = endpos; /* Get the position at which the next visible text can be found in IT->string, if any. */ - endpos = len = SCHARS (it->string); XSETINT (limit, len); do { @@ -5137,7 +5275,7 @@ handle_invisible_prop (struct it *it) IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; - if (IT_CHARPOS (*it) >= endpos) + if (IT_STRING_CHARPOS (*it) >= endpos) it->prev_stop = endpos; } else @@ -5167,27 +5305,14 @@ handle_invisible_prop (struct it *it) } } } - else + else /* we are iterating over buffer text at base paragraph level */ { - ptrdiff_t newpos, next_stop, start_charpos, tem; - Lisp_Object pos, overlay; - - /* First of all, is there invisible text at this position? */ - tem = start_charpos = IT_CHARPOS (*it); - pos = make_fixnum (tem); - prop = get_char_property_and_overlay (pos, Qinvisible, it->window, - &overlay); - invis = TEXT_PROP_MEANS_INVISIBLE (prop); + ptrdiff_t newpos, next_stop, tem = curpos; + Lisp_Object pos; /* If we are on invisible text, skip over it. */ - if (invis != 0 && start_charpos < it->end_charpos) + if (invis != 0 && curpos < it->end_charpos) { - /* Record whether we have to display an ellipsis for the - invisible text. */ - bool display_ellipsis_p = invis == 2; - - handled = HANDLED_RECOMPUTE_PROPS; - /* Loop skipping over invisible text. The loop is left at ZV or with IT on the first char being visible again. */ do From fc8b09484a2fbe182a0351c47afc3bf71f3b2a1b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 09:48:04 +0100 Subject: [PATCH 070/385] ; Fix typos --- ChangeLog.3 | 4 ++-- admin/codespell/codespell.exclude | 2 ++ lisp/erc/erc-common.el | 2 +- lisp/erc/erc.el | 2 +- lisp/eshell/esh-arg.el | 2 +- lisp/forms.el | 2 +- lisp/progmodes/eglot.el | 2 +- src/fns.c | 2 +- 8 files changed, 10 insertions(+), 8 deletions(-) diff --git a/ChangeLog.3 b/ChangeLog.3 index dc712df43ad..7db4986410d 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -137530,7 +137530,7 @@ Bind `enable-local-variables' in `hack-connection-local-variables' * lisp/files-x.el (hack-connection-local-variables): - Bind `enable-local-variables', instead of re-declaring + Bind `enable-local-variables', instead of redeclaring `safe-local-variable-p'. 2019-03-23 Eli Zaretskii @@ -163179,7 +163179,7 @@ Quieten compilation of octave.el - * lisp/progmodes/octave.el (compilation-forget-errors): Re-declare. + * lisp/progmodes/octave.el (compilation-forget-errors): Redeclare. 2018-02-28 Glenn Morris diff --git a/admin/codespell/codespell.exclude b/admin/codespell/codespell.exclude index 416d79cf131..6413a73701b 100644 --- a/admin/codespell/codespell.exclude +++ b/admin/codespell/codespell.exclude @@ -1583,3 +1583,5 @@ VERY VERY LONG STRIN | VERY VERY LONG STRIN (ert-info ("Joined by bouncer to #chan@foonet, pal persent") (ert-info ("Joined by bouncer to #chan@barnet, pal persent") .UE . + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index abcdc4c8843..8388efe062c 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -171,7 +171,7 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter." ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) - "Return preferred SYMBOL for `erc--modules'." + "Return preferred SYMBOL for `erc--module'." (while-let ((canonical (get symbol 'erc--module)) ((not (eq canonical symbol)))) (setq symbol canonical)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ef047201251..08dfa4b8f1b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6815,7 +6815,7 @@ stand-in from the fallback value \"(qaohv)~&@%+\"." "Return numeric rank for CHAR or nil if unknown. For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a -`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to +`erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to be a prefix instead." (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) (pos (erc--strpos char (if from-prefix-p diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 97ddac58629..78cf28d785a 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -285,7 +285,7 @@ QUOTED is passed to `eshell-concat' (which see) and, if non-nil, allows values to be converted to numbers where appropriate. ARGS should be a list of lists of arguments, such as that -produced by `eshell-prepare-slice'. \"Adjacent\" values of +produced by `eshell-prepare-splice'. \"Adjacent\" values of consecutive arguments will be passed to `eshell-concat'. For example, if ARGS is diff --git a/lisp/forms.el b/lisp/forms.el index 009667af273..3a3160a0c8b 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -343,7 +343,7 @@ suitable for forms processing.") (defvar forms-write-file-filter nil "The name of a function that is called before writing the data file. -This can be used to undo the effects of `form-read-file-filter'.") +This can be used to undo the effects of `forms-read-file-filter'.") (defvar forms-new-record-filter nil "The name of a function that is called when a new record is created.") diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index df8a287b4f2..2f32a8e6eda 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -591,7 +591,7 @@ It is nil if Eglot is not byte-complied.") (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") ;;; Message verification helpers diff --git a/src/fns.c b/src/fns.c index 1262e3e749e..08908d481a3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5374,7 +5374,7 @@ mark_fns (void) } } -/* Find the hash_table_test object correponding to the (bare) symbol TEST, +/* Find the hash_table_test object corresponding to the (bare) symbol TEST, creating one if none existed. */ static struct hash_table_test * get_hash_table_user_test (Lisp_Object test) From 56d0fbd99a87858717e08488df57db7fc08a2891 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 10:28:18 +0100 Subject: [PATCH 071/385] Add alias progress-reporter-make * lisp/subr.el (progress-reporter-make): New alias for 'make-progress-reporter'. --- lisp/subr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index a97824965b5..582415a9761 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1,7 +1,6 @@ ;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2024 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-2024 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -6736,6 +6735,8 @@ effectively rounded up." (progress-reporter-update reporter (or current-value min-value)) reporter)) +(defalias 'progress-reporter-make #'make-progress-reporter) + (defun progress-reporter-force-update (reporter &optional value new-message suffix) "Report progress of an operation in the echo area unconditionally. From 9bbf8232dba746db90b90285e9e4ed6d299d251a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 10:28:40 +0100 Subject: [PATCH 072/385] Delete compat code in `url` library * lisp/url/url-cid.el (url-cid): Delete compat code for ancient Gnus. * lisp/url/url-ldap.el (url-ldap-certificate-formatter): Delete compat code; ssl.el has never been in Emacs. * lisp/url/url-mailto.el (url-mail): Make into alias for 'message-mail', since it is always fboundp. --- lisp/url/url-cid.el | 11 +++-------- lisp/url/url-ldap.el | 10 +++------- lisp/url/url-mailto.el | 17 ++++------------- 3 files changed, 10 insertions(+), 28 deletions(-) diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el index 17a0318e652..d80037f8fe9 100644 --- a/lisp/url/url-cid.el +++ b/lisp/url/url-cid.el @@ -1,6 +1,6 @@ ;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*- -;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1998-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -52,12 +52,7 @@ ;;;###autoload (defun url-cid (url) - (cond - ((fboundp 'mm-get-content-id) - ;; Using Pterodactyl Gnus or later - (with-current-buffer (generate-new-buffer " *url-cid*") - (url-cid-gnus (url-filename url)))) - (t - (message "Unable to handle CID URL: %s" url)))) + (with-current-buffer (generate-new-buffer " *url-cid*") + (url-cid-gnus (url-filename url)))) ;;; url-cid.el ends here diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index 1bdd5099637..6aaea606c27 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el @@ -1,6 +1,6 @@ ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- -;; Copyright (C) 1998-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1998-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -92,12 +92,8 @@ "'>" dn "")) (defun url-ldap-certificate-formatter (data) - (condition-case () - (require 'ssl) - (error nil)) - (let ((vals (if (fboundp 'ssl-certificate-information) - (ssl-certificate-information data) - (tls-certificate-information data)))) + ;; FIXME: tls.el is obsolete. + (let ((vals (tls-certificate-information data))) (if (not vals) "Unable to parse certificate" (concat "\n" diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index c2d347a1646..50293ab3f05 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -1,6 +1,6 @@ ;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*- -;; Copyright (C) 1996-1999, 2004-2024 Free Software Foundation, Inc. +;; Copyright (C) 1996-2024 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -28,12 +28,7 @@ (require 'url-util) ;;;###autoload -(defun url-mail (&rest args) - (interactive "P") - (if (fboundp 'message-mail) - (apply 'message-mail args) - (or (apply 'mail args) - (error "Mail aborted")))) +(defalias 'url-mail #'message-mail) (defun url-mail-goto-field (field) (if (not field) @@ -57,8 +52,6 @@ (save-excursion (insert "\n")))))) -(declare-function mail-send-and-exit "sendmail") - ;;;###autoload (defun url-mailto (url) "Handle the mailto: URL syntax." @@ -111,8 +104,6 @@ ;; (setq func (intern-soft (concat "mail-" (caar args)))) (insert (mapconcat 'identity (cdar args) ", "))) (setq args (cdr args))) - ;; (url-mail-goto-field "User-Agent") -;; (insert url-package-name "/" url-package-version " URL/" url-version) (if (not url-request-data) (progn (set-buffer-modified-p nil) @@ -128,8 +119,8 @@ (goto-char (point-max)) (insert url-request-data) ;; It seems Microsoft-ish to send without warning. - ;; Fixme: presumably this should depend on a privacy setting. - (if (y-or-n-p "Send this auto-generated mail? ") + ;; FIXME: presumably this should depend on a privacy setting. + (if (y-or-n-p "Send this auto-generated mail?") (let ((buffer (current-buffer))) (cond ((eq url-mail-command 'compose-mail) (funcall (get mail-user-agent 'sendfunc) nil)) From e44b9f35793d642d5155fde035e3bc92102d13a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 11:26:43 +0100 Subject: [PATCH 073/385] * lisp/speedbar.el (imenu): Require unconditionally. --- lisp/speedbar.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 1cb72dc23e6..2ed97986fe7 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3488,7 +3488,7 @@ functions to do caching and flushing if appropriate." nil -(eval-when-compile (condition-case nil (require 'imenu) (error nil))) +(eval-when-compile (require 'imenu)) (declare-function imenu--make-index-alist "imenu" (&optional no-error)) (defun speedbar-fetch-dynamic-imenu (file) From 4d57187a248d3243dcc8b5da5d8365cb1b54a347 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 3 Feb 2024 16:46:59 +0100 Subject: [PATCH 074/385] Prevent cache of diff-mode buffers to grow without bounds Previously, these " *diff-syntax:..." buffers were never removed. Now we discard the least recently used half of them every hour. * lisp/vc/diff-mode.el (diff--cached-revision-buffers) (diff--cache-clean-interval, diff--cache-clean-timer, diff--cache-clean) (diff--cache-schedule-clean, diff--get-revision-properties): New. (diff-syntax-fontify-hunk): Use diff--get-revision-properties. --- lisp/vc/diff-mode.el | 69 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 53 insertions(+), 16 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 83d580d98dd..34a4b70691d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2817,6 +2817,57 @@ and the position in MAX." (defvar-local diff--syntax-file-attributes nil) (put 'diff--syntax-file-attributes 'permanent-local t) +(defvar diff--cached-revision-buffers nil + "List of ((FILE . REVISION) . BUFFER) in MRU order.") + +(defvar diff--cache-clean-timer nil) +(defconst diff--cache-clean-interval 3600) ; seconds + +(defun diff--cache-clean () + "Discard the least recently used half of the cache." + (let ((n (/ (length diff--cached-revision-buffers) 2))) + (mapc #'kill-buffer (mapcar #'cdr (nthcdr n diff--cached-revision-buffers))) + (setq diff--cached-revision-buffers + (ntake n diff--cached-revision-buffers))) + (diff--cache-schedule-clean)) + +(defun diff--cache-schedule-clean () + (setq diff--cache-clean-timer + (and diff--cached-revision-buffers + (run-with-timer diff--cache-clean-interval nil + #'diff--cache-clean)))) + +(defun diff--get-revision-properties (file revision text line-nb) + "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB." + (let* ((file-rev (cons file revision)) + (entry (assoc file-rev diff--cached-revision-buffers)) + (buffer (cdr entry))) + (if (buffer-live-p buffer) + (progn + ;; Don't re-initialize the buffer (which would throw + ;; away the previous fontification work). + (setq file nil) + (setq diff--cached-revision-buffers + (cons entry + (delq entry diff--cached-revision-buffers)))) + ;; Cache miss: create a new entry. + (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*" + file revision))) + (condition-case nil + (vc-find-revision-no-save file revision diff-vc-backend buffer) + (error + (kill-buffer buffer) + (setq buffer nil)) + (:success + (push (cons file-rev buffer) + diff--cached-revision-buffers)))) + (when diff--cache-clean-timer + (cancel-timer diff--cache-clean-timer)) + (diff--cache-schedule-clean) + (and buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb))))) + (defun diff-syntax-fontify-hunk (beg end old) "Highlight source language syntax in diff hunk between BEG and END. When OLD is non-nil, highlight the hunk from the old source." @@ -2867,22 +2918,8 @@ When OLD is non-nil, highlight the hunk from the old source." (insert-file-contents file) (setq diff--syntax-file-attributes attrs))) (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - file revision)) - (buffer (get-buffer buffer-name))) - (if buffer - ;; Don't re-initialize the buffer (which would throw - ;; away the previous fontification work). - (setq file nil) - (setq buffer (ignore-errors - (vc-find-revision-no-save - file revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when buffer - (with-current-buffer buffer - (diff-syntax-fontify-props file text line-nb)))))))) + (diff--get-revision-properties file revision + text line-nb))))) (let ((file (car (diff-hunk-file-names old)))) (cond ((and file diff-default-directory From 70c10204f0025eac844a88b0ef85cfca44cff61c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 13:16:59 +0100 Subject: [PATCH 075/385] Prefer setq-local in more places * lisp/erc/erc-compat.el (erc-set-write-file-functions): * lisp/obsolete/iswitchb.el (iswitchb-minibuffer-setup-hook) (iswitchb-minibuffer-setup): * lisp/obsolete/longlines.el (longlines-mode): * lisp/obsolete/rcompile.el (remote-compile): * lisp/progmodes/cperl-mode.el (cperl-file-style): * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Prefer setq-local. --- lisp/erc/erc-compat.el | 2 +- lisp/obsolete/iswitchb.el | 4 ++-- lisp/obsolete/longlines.el | 14 +++++--------- lisp/obsolete/rcompile.el | 14 +++++++------- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 6 files changed, 17 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index dede833a93d..37fcdebbe7b 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -102,7 +102,7 @@ See `erc-encoding-coding-alist'." (defun erc-set-write-file-functions (new-val) (declare (obsolete nil "28.1")) - (set (make-local-variable 'write-file-functions) new-val)) + (setq-local 'write-file-functions new-val)) (defvar erc-emacs-build-time (if (or (stringp emacs-build-time) (not emacs-build-time)) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 3f05b7fe7ac..d541dc085c6 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." This hook is run during minibuffer setup if `iswitchb' is active. For instance: \(add-hook \\='iswitchb-minibuffer-setup-hook - \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3))) + \\='\(lambda () (setq-local \\='max-mini-window-height 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." :type 'hook) @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." "Set up minibuffer for `iswitchb-buffer'. Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) - (set (make-local-variable 'iswitchb-use-mycompletion) t) + (setq-local 'iswitchb-use-mycompletion t) (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index 6aa388805f2..e73e9e0c85b 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -116,17 +116,14 @@ newlines are indicated with a symbol." ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) - (set (make-local-variable 'require-final-newline) nil) + (setq-local 'require-final-newline nil) (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'longlines-auto-wrap) - (set (make-local-variable 'isearch-search-fun-function) - #'longlines-search-function) - (set (make-local-variable 'replace-search-function) - #'longlines-search-forward) - (set (make-local-variable 'replace-re-search-function) - #'longlines-re-search-forward) + (setq-local 'isearch-search-fun-function #'longlines-search-function) + (setq-local 'replace-search-function #'longlines-search-forward) + (setq-local 'replace-re-search-function #'longlines-re-search-forward) (add-function :filter-return (local 'filter-buffer-substring-function) #'longlines-encode-string) (when longlines-wrap-follows-window-size @@ -136,8 +133,7 @@ newlines are indicated with a symbol." (window-width))) longlines-wrap-follows-window-size 2))) - (set (make-local-variable 'fill-column) - (- (window-width) dw))) + (setq-local 'fill-column (- (window-width) dw))) (add-hook 'window-configuration-change-hook #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index e0826475e32..877a143f6ad 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -169,12 +169,12 @@ See \\[compile]." ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer next-error-last-buffer (when (fboundp 'tramp-make-tramp-file-name) - (set (make-local-variable 'comint-file-name-prefix) - (funcall - #'tramp-make-tramp-file-name - nil ;; method. - remote-compile-user - remote-compile-host - "")))))) + (setq-local 'comint-file-name-prefix + (funcall + #'tramp-make-tramp-file-name + nil ;; method. + remote-compile-user + remote-compile-host + "")))))) ;;; rcompile.el ends here diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 758a6e17f72..dc3b31c79ac 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." (let ((option (car setting)) (value (cdr setting))) (set (make-local-variable option) value))) - (set (make-local-variable 'cperl-file-style) style)) + (setq-local 'cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7890049a325..440b52fe106 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,7 +1278,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) + (setq-local 'erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) From a4587646fabf2b7f0cb19a7e0bee090f9106a73a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 4 Feb 2024 13:20:15 +0100 Subject: [PATCH 076/385] ; Fix my last commit --- lisp/erc/erc-compat.el | 2 +- lisp/obsolete/iswitchb.el | 4 ++-- lisp/obsolete/longlines.el | 10 +++++----- lisp/obsolete/rcompile.el | 2 +- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 37fcdebbe7b..9b8699f6949 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -102,7 +102,7 @@ See `erc-encoding-coding-alist'." (defun erc-set-write-file-functions (new-val) (declare (obsolete nil "28.1")) - (setq-local 'write-file-functions new-val)) + (setq-local write-file-functions new-val)) (defvar erc-emacs-build-time (if (or (stringp emacs-build-time) (not emacs-build-time)) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index d541dc085c6..e1ea9141f0d 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -370,7 +370,7 @@ See documentation of `walk-windows' for useful values." This hook is run during minibuffer setup if `iswitchb' is active. For instance: \(add-hook \\='iswitchb-minibuffer-setup-hook - \\='\(lambda () (setq-local \\='max-mini-window-height 3))) + \\='\(lambda () (setq-local max-mini-window-height 3))) will constrain the minibuffer to a maximum height of 3 lines when iswitchb is running." :type 'hook) @@ -1262,7 +1262,7 @@ Modified from `icomplete-completions'." "Set up minibuffer for `iswitchb-buffer'. Copied from `icomplete-minibuffer-setup-hook'." (when (iswitchb-entryfn-p) - (setq-local 'iswitchb-use-mycompletion t) + (setq-local iswitchb-use-mycompletion t) (add-hook 'pre-command-hook #'iswitchb-pre-command nil t) (add-hook 'post-command-hook #'iswitchb-post-command nil t) (run-hooks 'iswitchb-minibuffer-setup-hook))) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index e73e9e0c85b..f065bcaff26 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -116,14 +116,14 @@ newlines are indicated with a symbol." ;; Turn on longlines mode (progn (use-hard-newlines 1 'never) - (setq-local 'require-final-newline nil) + (setq-local require-final-newline nil) (add-to-list 'buffer-file-format 'longlines) (add-hook 'change-major-mode-hook #'longlines-mode-off nil t) (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t) (make-local-variable 'longlines-auto-wrap) - (setq-local 'isearch-search-fun-function #'longlines-search-function) - (setq-local 'replace-search-function #'longlines-search-forward) - (setq-local 'replace-re-search-function #'longlines-re-search-forward) + (setq-local isearch-search-fun-function #'longlines-search-function) + (setq-local replace-search-function #'longlines-search-forward) + (setq-local replace-re-search-function #'longlines-re-search-forward) (add-function :filter-return (local 'filter-buffer-substring-function) #'longlines-encode-string) (when longlines-wrap-follows-window-size @@ -133,7 +133,7 @@ newlines are indicated with a symbol." (window-width))) longlines-wrap-follows-window-size 2))) - (setq-local 'fill-column (- (window-width) dw))) + (setq-local fill-column (- (window-width) dw))) (add-hook 'window-configuration-change-hook #'longlines-window-change-function nil t)) (let ((buffer-undo-list t) diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index 877a143f6ad..258b2b519d9 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -169,7 +169,7 @@ See \\[compile]." ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer next-error-last-buffer (when (fboundp 'tramp-make-tramp-file-name) - (setq-local 'comint-file-name-prefix + (setq-local comint-file-name-prefix (funcall #'tramp-make-tramp-file-name nil ;; method. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index dc3b31c79ac..113eed64917 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6557,7 +6557,7 @@ and \"Whitesmith\"." (let ((option (car setting)) (value (cdr setting))) (set (make-local-variable option) value))) - (setq-local 'cperl-file-style style)) + (setq-local cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 440b52fe106..7d189d37929 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1278,7 +1278,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (setq-local 'erc-send-completed-hook nil) ; skip t (globals) + (setq-local erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) From d0673ea0d42048c140f4e5c6db18f78a43303256 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 4 Feb 2024 16:11:20 +0200 Subject: [PATCH 077/385] ; * etc/PROBLEMS: Workaround for Windows key "stuck" (bug#68914). --- etc/PROBLEMS | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 1254f6a3bc9..60904408af8 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -476,6 +476,29 @@ You are probably using a shell that doesn't support job control, even though the system itself is capable of it. Either use a different shell, or set the variable 'cannot-suspend' to a non-nil value. +*** Emacs running on WSL receives stray characters as input. + +For example, you could see Emacs inserting 'z' characters even though +nothing is typed on the keyboard, and even if you unplug the keyboard. + +The reason is a bug in the WSL X server's handling of key-press and +key-repeat events. A workaround is to use the Cygwin or native +MS-Windows build of Emacs instead. + +*** On MS-Windows, the Windows key gets "stuck". +When this problem happens, Windows behaves as if the Windows key were +permanently pressed down. This could be a side effect of Emacs on +MS-Windows hooking keyboard input on a low level, in order to support +registering the Windows keys as hot keys. If that hook takes too much +time for some reason, Windows can decide to remove the hook, which +then has this effect. + +This is arguably a bug in Emacs, for which we don't yet have a +solution. To work around, set the 'LowLevelHooksTimeout' value in the +registry key "HKEY_CURRENT_USER\Control Panel\Desktop" to a number +higher than 200 msec; the maximum allowed value is 1000 msec (create +the value if it doesn't exist under that key). + ** Mailers and other helper programs *** movemail compiled with POP support can't connect to the POP server. @@ -545,15 +568,6 @@ As a workaround, input the passphrase with a GUI-capable pinentry program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you can use the 'pinentry' package from Emacs 25. -*** Emacs running on WSL receives stray characters as input. - -For example, you could see Emacs inserting 'z' characters even though -nothing is typed on the keyboard, and even if you unplug the keyboard. - -The reason is a bug in the WSL X server's handling of key-press and -key-repeat events. A workaround is to use the Cygwin or native -MS-Windows build of Emacs instead. - ** Problems with hostname resolution *** Emacs does not know your host's fully-qualified domain name. From 4749699370370a6bf0d50612dafe871dbaf52924 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 4 Feb 2024 19:22:21 +0200 Subject: [PATCH 078/385] * doc/lispref/parsing.texi (Retrieving Nodes): Improve documentation. Update optional arguments 'predicate' and 'include-node' of 'treesit-node-top-level'. --- doc/lispref/parsing.texi | 25 ++++++++++++++----------- test/src/treesit-tests.el | 2 +- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 26204164243..fbd739b76d5 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -785,7 +785,7 @@ that comes after it in the buffer position order, i.e., nodes with start positions greater than the end position of @var{start}. In the tree shown above, @code{treesit-search-subtree} traverses node -@samp{S} (@var{start}) and nodes marked with @code{o}, where this +@samp{S} (@var{start}) and nodes marked with @code{o}, whereas this function traverses the nodes marked with numbers. This function is useful for answering questions like ``what is the first node after @var{start} in the buffer that satisfies some condition?'' @@ -860,32 +860,35 @@ nodes. @defun treesit-parent-until node predicate &optional include-node This function repeatedly finds the parents of @var{node}, and returns -the parent that satisfies @var{pred}, a function that takes a node as +the parent that satisfies @var{predicate}, a function that takes a node as argument and returns a boolean that indicates a match. If no parent -satisfies @var{pred}, this function returns @code{nil}. +satisfies @var{predicate}, this function returns @code{nil}. Normally this function only looks at the parents of @var{node} but not @var{node} itself. But if @var{include-node} is non-@code{nil}, this -function returns @var{node} if @var{node} satisfies @var{pred}. +function returns @var{node} if @var{node} satisfies @var{predicate}. @end defun -@defun treesit-parent-while node pred +@defun treesit-parent-while node predicate This function goes up the tree starting from @var{node}, and keeps -doing so as long as the nodes satisfy @var{pred}, a function that +doing so as long as the nodes satisfy @var{predicate}, a function that takes a node as argument. That is, this function returns the highest -parent of @var{node} that still satisfies @var{pred}. Note that if -@var{node} satisfies @var{pred} but its immediate parent doesn't, +parent of @var{node} that still satisfies @var{predicate}. Note that if +@var{node} satisfies @var{predicate} but its immediate parent doesn't, @var{node} itself is returned. @end defun -@defun treesit-node-top-level node &optional type +@defun treesit-node-top-level node &optional predicate include-node This function returns the highest parent of @var{node} that has the same type as @var{node}. If no such parent exists, it returns @code{nil}. Therefore this function is also useful for testing whether @var{node} is top-level. -If @var{type} is non-@code{nil}, this function matches each parent's -type with @var{type} as a regexp, rather than using @var{node}'s type. +If @var{predicate} is @code{nil}, this function uses @var{node}'s type +to find the parent. If @var{predicate} is non-@code{nil}, this +function searches the parent that satisfies @var{predicate}. If +@var{include-node} is non-@code{nil}, this function returns @var{node} +if @var{node} satisfies @var{predicate}. @end defun @node Accessing Node Information diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 1cd783bd05e..3eda6fd3c53 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -243,7 +243,7 @@ (should (eq nil (treesit-node-text (treesit-search-subtree subarray "\\[")))) - ;; If ALL=nil, searching for number should still find the + ;; If ALL=t, searching for number should still find the ;; numbers. (should (equal "1" (treesit-node-text (treesit-search-subtree From 57024e1e9314501b103a4d36b9b166761a2ad756 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 12:50:55 -0500 Subject: [PATCH 079/385] (w->base_line_number): Rework the way we flush the cache * src/xdisp.c (BASE_LINE_NUMBER_VALID_P): New macro. (try_scrolling): Use it. (redisplay_window, Fformat_mode_line): Use it to flush the base_line_number (if it's stale) once at the beginning. (decode_mode_spec): Don't use (or set) `w->start` and `w->base_line_number` when operating on another buffer! --- src/xdisp.c | 82 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 36 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 40311ee8ea7..750ebb703a6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -18861,6 +18861,14 @@ enum `scroll-conservatively' and the Emacs manual. */ #define SCROLL_LIMIT 100 +/* The freshness of the w->base_line_number cache is only ensured at every + redisplay cycle, so the cache can be used only if there's been + no relevant changes to the buffer since the last redisplay. */ +#define BASE_LINE_NUMBER_VALID_P(w) \ + (eassert (current_buffer == XBUFFER ((w)->contents)), \ + !current_buffer->clip_changed \ + && BEG_UNCHANGED >= (w)->base_line_pos) + static int try_scrolling (Lisp_Object window, bool just_this_one_p, intmax_t arg_scroll_conservatively, intmax_t scroll_step, @@ -19161,9 +19169,10 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, else { /* Maybe forget recorded base line for line number display. */ - if (!just_this_one_p - || current_buffer->clip_changed - || BEG_UNCHANGED < CHARPOS (startp)) + /* FIXME: Why do we need this? `try_scrolling` can only be called from + `redisplay_window` which should have flushed this cache already when + eeded. */ + if (!BASE_LINE_NUMBER_VALID_P (w)) w->base_line_number = 0; /* If cursor ends up on a partially visible line, @@ -19933,9 +19942,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Record it now because it's overwritten. */ bool current_matrix_up_to_date_p = false; bool used_current_matrix_p = false; - /* This is less strict than current_matrix_up_to_date_p. - It indicates that the buffer contents and narrowing are unchanged. */ - bool buffer_unchanged_p = false; bool temp_scroll_step = false; specpdl_ref count = SPECPDL_INDEX (); int rc; @@ -20041,11 +20047,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) specbind (Qinhibit_point_motion_hooks, Qt); - buffer_unchanged_p - = (w->window_end_valid - && !current_buffer->clip_changed - && !window_outdated (w)); - /* When windows_or_buffers_changed is non-zero, we can't rely on the window end being valid, so set it to zero there. */ if (windows_or_buffers_changed) @@ -20185,6 +20186,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) } } + if (!BASE_LINE_NUMBER_VALID_P (w)) + /* Forget any recorded base line for line number display. */ + w->base_line_number = 0; + force_start: /* Handle case where place to start displaying has been specified, @@ -20205,10 +20210,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) w->preserve_vscroll_p = false; w->window_end_valid = false; - /* Forget any recorded base line for line number display. */ - if (!buffer_unchanged_p) - w->base_line_number = 0; - /* Redisplay the mode line. Select the buffer properly for that. Also, run the hook window-scroll-functions because we have scrolled. */ @@ -20537,12 +20538,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) if (w->cursor.vpos >= 0) { - if (!just_this_one_p - || current_buffer->clip_changed - || BEG_UNCHANGED < CHARPOS (startp)) - /* Forget any recorded base line for line number display. */ - w->base_line_number = 0; - if (!cursor_row_fully_visible_p (w, true, false, false)) { clear_glyph_matrix (w->desired_matrix); @@ -20613,10 +20608,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) debug_method_add (w, "recenter"); #endif - /* Forget any previously recorded base line for line number display. */ - if (!buffer_unchanged_p) - w->base_line_number = 0; - /* Determine the window start relative to point. */ init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); it.current_y = it.last_visible_y; @@ -24783,6 +24774,13 @@ maybe_produce_line_number (struct it *it) if (!last_line) { /* If possible, reuse data cached by line-number-mode. */ + /* NOTE: We use `base_line_number` without checking + BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window` + has already flushed this cache for us when needed. + NOTE²: Checking BASE_LINE_NUMBER_VALID_P here would be + overly pessimistic because it might say that the cache + was invalid before entering `redisplay_window` yet the + value has just been refreshed. */ if (it->w->base_line_number > 0 && it->w->base_line_pos > 0 && it->w->base_line_pos <= IT_CHARPOS (*it) @@ -28175,6 +28173,11 @@ are the selected window and the WINDOW's buffer). */) init_iterator (&it, w, -1, -1, NULL, face_id); + /* Make sure `base_line_number` is fresh in case we encounter a `%l`. */ + if (current_buffer == XBUFFER ((w)->contents) + && !BASE_LINE_NUMBER_VALID_P (w)) + w->base_line_number = 0; + if (no_props) { mode_line_target = MODE_LINE_NOPROP; @@ -28627,30 +28630,29 @@ decode_mode_spec (struct window *w, register int c, int field_width, when the buffer's restriction was changed, but the window wasn't yet redisplayed after that. If that happens, we need to determine a new base line. */ - if (!(BUF_BEGV_BYTE (b) <= startpos_byte + if (current_buffer != XBUFFER (w->contents) + || !(BUF_BEGV_BYTE (b) <= startpos_byte && startpos_byte <= BUF_ZV_BYTE (b))) { startpos = BUF_BEGV (b); startpos_byte = BUF_BEGV_BYTE (b); - w->base_line_pos = 0; - w->base_line_number = 0; } /* If we decided that this buffer isn't suitable for line numbers, - don't forget that too fast. */ + don't forget that too fast. + FIXME: What if `current_buffer != w->contents`? */ if (w->base_line_pos == -1) goto no_value; /* If the buffer is very big, don't waste time. */ if (FIXNUMP (Vline_number_display_limit) && BUF_ZV (b) - BUF_BEGV (b) > XFIXNUM (Vline_number_display_limit)) - { - w->base_line_pos = 0; - w->base_line_number = 0; - goto no_value; - } + goto no_value; - if (w->base_line_number > 0 + /* Callers of `display_mode_element` are in charge of flushing + any stale `base_line_number` cache. */ + if (current_buffer == XBUFFER ((w)->contents) + && w->base_line_number > 0 && w->base_line_pos > 0 && w->base_line_pos <= startpos) { @@ -28676,7 +28678,9 @@ decode_mode_spec (struct window *w, register int c, int field_width, or too far away, or if we did not have one. "Too close" means it's plausible a scroll-down would go back past it. */ - if (startpos == BUF_BEGV (b)) + if (current_buffer != XBUFFER (w->contents)) + ; /* The base line is for another buffer, don't touch it! */ + else if (startpos == BUF_BEGV (b)) { w->base_line_number = topline; w->base_line_pos = BUF_BEGV (b); @@ -28713,6 +28717,12 @@ decode_mode_spec (struct window *w, register int c, int field_width, goto no_value; } + /* NOTE: if `clip_changed` is set or if `BEG_UNCHANGED` is + before `position`, this new cached value may get flushed + soon needlessly, because we can't reset `BEG_UNCHANGED` or + `clip_changed` from here (since they reflect the changes + since the last redisplay so they can only be reset from + `mark_window_display_accurate_1`). :-( */ w->base_line_number = topline - nlines; w->base_line_pos = BYTE_TO_CHAR (position); } From a1aa9028f83e5d3da71bdb5877d8baa5d6c1e98a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 12:52:01 -0500 Subject: [PATCH 080/385] * src/window.c (set_window_buffer): Flush the `base_line_number` cache --- src/window.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/window.c b/src/window.c index 915f591221d..565ad00804f 100644 --- a/src/window.c +++ b/src/window.c @@ -4151,6 +4151,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, buffer); w->start_at_line_beg = false; w->force_start = false; + /* Flush the base_line cache since it applied to another buffer. */ + w->base_line_number = 0; } wset_redisplay (w); From 52abeaf1333427f156a23f0acf057e81bcc5e9e2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 12:58:56 -0500 Subject: [PATCH 081/385] * src/lread.c (build_load_history): Be careful with in-place updates Don't leave a "broken" value in `Vcurrent_load_list`. --- src/lread.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/lread.c b/src/lread.c index cc55b009ab9..b1b109315f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2369,8 +2369,14 @@ build_load_history (Lisp_Object filename, bool entire) front of load-history, the most-recently-loaded position. Also do this if we didn't find an existing member for the file. */ if (entire || !foundit) - Vload_history = Fcons (Fnreverse (Vcurrent_load_list), - Vload_history); + { + Lisp_Object tem = Fnreverse (Vcurrent_load_list); + eassert (EQ (filename, Fcar (tem))); + Vload_history = Fcons (tem, Vload_history); + /* FIXME: There should be an unbind_to right after calling us which + should re-establish the previous value of Vcurrent_load_list. */ + Vcurrent_load_list = Qt; + } } static void From 7d3c3cad9392d3f8e59f85522053c249aff062e5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 13:51:13 -0500 Subject: [PATCH 082/385] * src/lread.c (bytecode_from_rev_list): Fix assertion failure The assertion failure was raised at lread.c:411 during the `lread-invalid-bytecodes` test in `test/src/lread-tests.el`. I suspect we could remove the assertion instead. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index b1b109315f9..b5eeb55bb70 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3496,7 +3496,7 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) Lisp_Object *vec = XVECTOR (obj)->contents; ptrdiff_t size = ASIZE (obj); - if (size >= COMPILED_CONSTANTS) + if (infile && size >= COMPILED_CONSTANTS) { /* Always read 'lazily-loaded' bytecode (generated by the `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to From b2d350cfc0bf8f0e3198bffcebe60a43341fb340 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 4 Feb 2024 14:39:02 -0500 Subject: [PATCH 083/385] * lisp/emacs-lisp/comp.el (comp--native-compile): Use `error-message-string` --- lisp/emacs-lisp/comp.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2a516246ed4..dcdc973e6c5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3398,16 +3398,18 @@ the deferred compilation mechanism." (if (and comp-async-compilation (not (eq (car err) 'native-compiler-error))) (progn - (message (if err-val - "%s: Error: %s %s" - "%s: Error %s") + (message "%s: Error %s" function-or-file - (get (car err) 'error-message) - (car-safe err-val)) + (error-message-string err)) (kill-emacs -1)) ;; Otherwise re-signal it adding the compilation input. + ;; FIXME: We can't just insert arbitrary info in the + ;; error-data part of an error: the handler may expect + ;; specific data at specific positions! (signal (car err) (if (consp err-val) (cons function-or-file err-val) + ;; FIXME: `err-val' is supposed to be + ;; a list, so it can only be nil here! (list function-or-file err-val))))))) (if (stringp function-or-file) data From 9dbbf93a4a08f71cf5f2278ec2a22a722fe0e0f7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 3 Feb 2024 21:24:29 -0800 Subject: [PATCH 084/385] Improve treesit-forward-sexp behavior for leaf nodes (bug#68899) treesit-forward-sexp uses treesit--navigate-thing with 'restricted' tactic. In this tactic we don't move over the parent thing. However, this makes forward-sexp useless for symbols when point is in the symbol rather than at the beginning of it: in that case, the symbol is considered parent and treesit-forward-sexp won't move to the end of it. To solve that, we allow to move across the parent even in 'restricted' mode if the parent is a leaf thing. Here, "leaf thing" is defined as "doesn't have any child 'thing' inside it". * lisp/treesit.el (treesit--navigate-thing): Move over parent in 'restricted' tactic if the parent is a leaf thing. --- lisp/treesit.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index fab2ddd88e6..93b6b56534d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2662,9 +2662,17 @@ function is called recursively." (setq parent (treesit-node-top-level parent thing t) prev nil next nil)) - ;; If TACTIC is `restricted', the implementation is very simple. + ;; If TACTIC is `restricted', the implementation is simple. + ;; In principle we don't go to parent's beg/end for + ;; `restricted' tactic, but if the parent is a "leaf thing" + ;; (doesn't have any child "thing" inside it), then we can + ;; move to the beg/end of it (bug#68899). (if (eq tactic 'restricted) - (setq pos (funcall advance (if (> arg 0) next prev))) + (setq pos (funcall + advance + (cond ((and (null next) (null prev)) parent) + ((> arg 0) next) + (t prev)))) ;; For `nested', it's a bit more work: ;; Move... (if (> arg 0) From be6de56906f0d1c09a0fad4f5165d864dddbc3ee Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 4 Feb 2024 19:26:42 -0800 Subject: [PATCH 085/385] Use treesit-node-match-p in treesit-parent-until/while * lisp/treesit.el (treesit-parent-until): Use treesit-node-match-p. (treesit-parent-while): Update docstring. * doc/lispref/parsing.texi (Retrieving Nodes): Update docstring. --- doc/lispref/parsing.texi | 17 ++++++++++------- lisp/treesit.el | 12 +++++------- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5d79c4b27f4..ac11f88ae4d 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -916,8 +916,10 @@ nodes. @defun treesit-parent-until node predicate &optional include-node This function repeatedly finds the parents of @var{node}, and returns -the parent that satisfies @var{pred}, a function that takes a node as -argument and returns a boolean that indicates a match. If no parent +the parent that satisfies @var{pred}. @var{pred} can be either a +function that takes a node as argument and returns @code{t} or +@code{nil}, or a regexp matching node type names, or other valid +predicates described in @var{treesit-thing-settings}. If no parent satisfies @var{pred}, this function returns @code{nil}. Normally this function only looks at the parents of @var{node} but not @@ -927,11 +929,12 @@ function returns @var{node} if @var{node} satisfies @var{pred}. @defun treesit-parent-while node pred This function goes up the tree starting from @var{node}, and keeps -doing so as long as the nodes satisfy @var{pred}, a function that -takes a node as argument. That is, this function returns the highest -parent of @var{node} that still satisfies @var{pred}. Note that if -@var{node} satisfies @var{pred} but its immediate parent doesn't, -@var{node} itself is returned. +doing so as long as the nodes satisfy @var{pred}. That is, this +function returns the highest parent of @var{node} that still satisfies +@var{pred}. Note that if @var{node} satisfies @var{pred} but its +immediate parent doesn't, @var{node} itself is returned. + +@var{pred} is the same as in @code{treesit-parent-until} above. @end defun @defun treesit-node-top-level node &optional type diff --git a/lisp/treesit.el b/lisp/treesit.el index 93b6b56534d..f179204d89c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -344,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it returns that ancestor node. It returns nil if no ancestor node was found that satisfies PRED. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match. +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." (let ((node (if include-node node (treesit-node-parent node)))) - (while (and node (not (funcall pred node))) + (while (and node (not (treesit-node-match-p node pred))) (setq node (treesit-node-parent node))) node)) @@ -364,9 +363,8 @@ no longer satisfies the predicate PRED; it returns the last examined node that satisfies PRED. If no node satisfies PRED, it returns nil. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match." +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'." (let ((last nil)) (while (and node (funcall pred node)) (setq last node From 5c43ef86bf169a79b87bd082d2f884757f7c2efc Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 15 Aug 2023 18:51:20 -0700 Subject: [PATCH 086/385] Document arguments to Eshell's built-in commands * lisp/eshell/em-unix.el (eshell/ln): LINK_NAME is required. * lisp/eshell/esh-ext.el (eshell/addpath): * lisp/eshell/esh-var.el (eshell/env): Improve help strings slightly. * doc/misc/eshell.texi (Scripts): Explain $0, $1, etc. (Dollars Expansion): Use "@dots{}" instead of "...". (Built-ins, Tramp extensions, Extra built-in commands): Document command-line arguments. --- doc/misc/eshell.texi | 660 ++++++++++++++++++++++++++++++----------- lisp/eshell/em-unix.el | 8 +- lisp/eshell/esh-ext.el | 6 +- lisp/eshell/esh-var.el | 2 +- 4 files changed, 500 insertions(+), 176 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index da5e1ef1d03..5d3e5c7dbd6 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -481,72 +481,88 @@ loaded as part of the eshell-xtra module. @xref{Extension modules}. @table @code -@item . +@item . @var{file} [@var{argument}]@dots{} @cmindex . -Source an Eshell file in the current environment. This is not to be -confused with the command @command{source}, which sources a file in a -subshell environment. +Source an Eshell script named @var{file} in the current environment, +passing any @var{arguments} to the script (@pxref{Scripts}). This is +not to be confused with the command @command{source}, which sources a +file in a subshell environment. @item addpath +@itemx addpath [-b] @var{directory}@dots{} @cmindex addpath -Adds a given path or set of paths to the PATH environment variable, or, -with no arguments, prints the current paths in this variable. +Adds each specified @var{directory} to the @code{$PATH} environment +variable. By default, this adds the directories to the end of +@code{$PATH}, in the order they were passed on the command line; by +passing @code{-b} or @code{--begin}, Eshell will instead add the +directories to the beginning. + +With no directories, print the list of directories currently stored in +@code{$PATH}. @item alias +@itemx alias @var{name} [@var{command}] @cmindex alias -Define an alias (@pxref{Aliases}). This adds it to the aliases file. +Define an alias named @var{name} and expanding to @var{command}, +adding it to the aliases file (@pxref{Aliases}). If @var{command} is +omitted, delete the alias named @var{name}. With no arguments at all, +list all the currently-defined aliases. -@item basename +@item basename @var{filename} @cmindex basename -Return a file name without its directory. +Return @var{filename} without its directory. -@item cat +@item cat @var{file}@dots{} @cmindex cat -Concatenate file contents into standard output. If in a pipeline, or -if the file is not a regular file, directory, or symlink, then this -command reverts to the system's definition of @command{cat}. +Concatenate the contents of @var{file}s to standard output. If in a +pipeline, or if any of the files is not a regular file, directory, or +symlink, then this command reverts to the system's definition of +@command{cat}. @item cd +@itemx cd @var{directory} +@itemx cd -[@var{n}] +@itemx cd =[@var{regexp}] @cmindex cd -This command changes the current working directory. Usually, it is -invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new -working directory. But @command{cd} knows about a few special -arguments: +Change the current working directory. This command can take several +forms: -@itemize @minus{} -@item -When it receives no argument at all, it changes to the home directory. +@table @code -@item -Giving the command @kbd{cd -} changes back to the previous working -directory (this is the same as @kbd{cd $-}). +@item cd +Change to the user's home directory. -@item -The command @kbd{cd =} shows the directory ring. Each line is -numbered. +@item cd @var{directory} +Change to the specified @var{directory}. -@item -With @kbd{cd =foo}, Eshell searches the directory ring for a directory -matching the regular expression @samp{foo}, and changes to that -directory. +@item cd - +Change back to the previous working directory (this is the same as +@kbd{cd $-}). -@item -With @kbd{cd -42}, you can access the directory stack slots by number. +@item cd -@var{n} +Change to the directory in the @var{nth} slot of the directory stack. + +@item cd = +Show the directory ring. Each line is numbered. + +@item cd =@var{regexp} +Search the directory ring for a directory matching the regular +expression @var{regexp} and change to that directory. + +@end table -@item @vindex eshell-cd-shows-directory @vindex eshell-list-files-after-cd If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd} will report the directory it changes to. If @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} is called with any remaining arguments after changing directories. -@end itemize -@item clear +@item clear [@var{scrollback}] @cmindex clear Scrolls the contents of the Eshell window out of sight, leaving a -blank window. If provided with an optional non-@code{nil} argument, -the scrollback contents are cleared instead. +blank window. If @var{scrollback} is non-@code{nil}, the scrollback +contents are cleared instead, as with @command{clear-scrollback}. @item clear-scrollback @cmindex clear-scrollback @@ -554,21 +570,30 @@ Clear the scrollback contents of the Eshell window. Unlike the command @command{clear}, this command deletes content in the Eshell buffer. -@item compile +@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} @cmindex compile Run an external command, sending its output to a compilation buffer if the command would output to the screen and is not part of a pipeline -or subcommand. This is particularly useful when defining aliases, so +or subcommand. + +With the @code{-p} or @code{--plain} options, always send the output +to the Eshell buffer; similarly, with @code{-i} or +@code{--interactive}, always send the output to a compilation buffer. +You can also set the mode of the compilation buffer with @code{-m +@var{mode-name}} or @code{--mode @var{mode-name}}. + +@command{compile} is particularly useful when defining aliases, so that interactively, the output shows up in a compilation buffer, but you can still pipe the output elsewhere if desired. For example, if you have a grep-like command on your system, you might define an alias for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep $*'}. -@item cp +@item cp [@var{option}@dots{}] @var{source} @var{dest} +@item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory} @cmindex cp -Copy a file to a new location or copy multiple files to the same -directory. +Copy the file @var{source} to @var{dest} or @var{source} into +@var{directory}. @vindex eshell-cp-overwrite-files @vindex eshell-cp-interactive-query @@ -577,26 +602,59 @@ If @code{eshell-cp-overwrite-files} is non-@code{nil}, then @code{eshell-cp-interactive-query} is non-@code{nil}, then @command{cp} will ask before overwriting anything. -@item date +@command{cp} accepts the following options: + +@table @asis + +@item @code{-a}, @code{--archive} +Equivalent to @code{--no-dereference --preserve --recursive}. + +@item @code{-d}, @code{--no-dereference} +Don't dereference symbolic links when copying; instead, copy the link +itself. + +@item @code{-f}, @code{--force} +Never prompt for confirmation before copying a file. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before copying a file if the target already +exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't copy anything. This is useful if you +want to preview what would be removed when calling @command{cp}. + +@item @code{-p}, @code{--preserve} +Attempt to preserve file attributes when copying. + +@item @code{-r}, @code{-R}, @code{--recursive} +Copy any specified directories and their contents recursively. + +@item @code{-v}, @code{--verbose} +Print the name of each file before copying it. + +@end table + +@item date [@var{specified-time} [@var{zone}]] @cmindex date Print the current local time as a human-readable string. This command -is similar to, but slightly different from, the GNU Coreutils -@command{date} command. +is an alias to the Emacs Lisp function @code{current-time-string} +(@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}). -@item diff +@item diff [@var{option}]@dots{} @var{old} @var{new} @cmindex diff -Compare files using Emacs's internal @code{diff} (not to be confused -with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs -Manual}. +Compare the files @var{old} and @var{new} using Emacs's internal +@code{diff} (not to be confused with @code{ediff}). @xref{Comparing +Files, , , emacs, The GNU Emacs Manual}. @vindex eshell-plain-diff-behavior If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this command does not use Emacs's internal @code{diff}. This is the same as using @samp{alias diff '*diff $@@*'}. -@item dirname +@item dirname @var{filename} @cmindex dirname -Return the directory component of a file name. +Return the directory component of @var{filename}. @item dirs @cmindex dirs @@ -604,25 +662,75 @@ Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, respectively. -@item du +@item du [@var{option}]@dots{} @var{file}@dots{} @cmindex du -Summarize disk usage for each file. +Summarize disk usage for each file, recursing into directories. -@item echo +@command{du} accepts the following options: + +@table @asis + +@item @code{-a}, @code{--all} +Print sizes for files, not just directories. + +@item @code{--block-size=@var{size}} +Print sizes as number of blocks of size @var{size}. + +@item @code{-b}, @code{--bytes} +Print file sizes in bytes. + +@item @code{-c}, @code{--total} +Print a grand total of the sizes at the end. + +@item @code{-d}, @code{--max-depth=@var{depth}} +Only print sizes for directories (or files with @code{--all}) that are +@var{depth} or fewer levels below the command line arguments. + +@item @code{-h}, @code{--human-readable} +Print sizes in human-readable format, with binary prefixes (so 1 KB is +1024 bytes). + +@item @code{-H}, @code{--si} +Print sizes in human-readable format, with decimal prefixes (so 1 KB +is 1000 bytes). + +@item @code{-k}, @code{--kilobytes} +Print file sizes in kilobytes (like @code{--block-size=1024}). + +@item @code{-L}, @code{--dereference} +Follow symbolic links when traversing files. + +@item @code{-m}, @code{--megabytes} +Print file sizes in megabytes (like @code{--block-size=1048576}). + +@item @code{-s}, @code{--summarize} +Don't recurse into subdirectories (like @code{--max-depth=0}). + +@item @code{-x}, @code{--one-file-system} +Skip any directories that reside on different filesystems. + +@end table + +@item echo [-n | -N] [@var{arg}]@dots{} @cmindex echo -Echoes its input. By default, this prints in a Lisp-friendly fashion -(so that the value is useful to a Lisp command using the result of -@command{echo} as an argument). If a single argument is passed, -@command{echo} prints that; if multiple arguments are passed, it -prints a list of all the arguments; otherwise, it prints the empty -string. +Prints the value of each @var{arg}. By default, this prints in a +Lisp-friendly fashion (so that the value is useful to a Lisp command +using the result of @command{echo} as an argument). If a single +argument is passed, @command{echo} prints that; if multiple arguments +are passed, it prints a list of all the arguments; otherwise, it +prints the empty string. @vindex eshell-plain-echo-behavior If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo} will try to behave more like a plain shell's @command{echo}, printing each argument as a string, separated by a space. -@item env +You can control whether @command{echo} outputs a trailing newline +using @code{-n} to disable the trailing newline (the default behavior) +or @code{-N} to enable it (the default when +@code{eshell-plain-echo-behavior} is non-@code{nil}). + +@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} @cmindex env With no arguments, print the current environment variables. If you pass arguments to this command, then @command{env} will execute the @@ -630,7 +738,7 @@ arguments as a command. If you pass any initial arguments of the form @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} to @var{value} before running the command. -@item eshell-debug +@item eshell-debug [error | form | process]@dots{} @cmindex eshell-debug Toggle debugging information for Eshell itself. You can pass this command one or more of the following arguments: @@ -658,65 +766,86 @@ Exit Eshell and save the history. By default, this command kills the Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then the buffer is merely buried instead. -@item export +@item export [@var{name}=@var{value}]@dots{} @cmindex export Set environment variables using input like Bash's @command{export}, as in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. -@item grep +@item grep [@var{arg}]@dots{} @cmindex grep -@itemx agrep +@itemx agrep [@var{arg}]@dots{} @cmindex agrep -@itemx egrep +@itemx egrep [@var{arg}]@dots{} @cmindex egrep -@itemx fgrep +@itemx fgrep [@var{arg}]@dots{} @cmindex fgrep -@itemx rgrep +@itemx rgrep [@var{arg}]@dots{} @cmindex rgrep -@itemx glimpse +@itemx glimpse [@var{arg}]@dots{} @cmindex glimpse The @command{grep} commands are compatible with GNU @command{grep}, -but use Emacs's internal @code{grep} instead. +but open a compilation buffer in @code{grep-mode} instead. @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. @vindex eshell-plain-grep-behavior If @code{eshell-plain-grep-behavior} is non-@code{nil}, then these -commands do not use Emacs's internal @code{grep}. This is the same as -using @samp{alias grep '*grep $@@*'}, though this setting applies to -all of the built-in commands for which you would need to create a -separate alias. +commands do not use open a compilation buffer, instead printing output +to Eshell's buffer. This is the same as using @samp{alias grep '*grep +$@@*'}, though this setting applies to all of the built-in commands +for which you would need to create a separate alias. -@item history +@item history [@var{n}] +@itemx history [-arw] [@var{filename}] @cmindex history -Prints Eshell's input history. With a numeric argument @var{N}, this -command prints the @var{N} most recent items in the history. +Prints Eshell's input history. With a numeric argument @var{n}, this +command prints the @var{n} most recent items in the history. +Alternately, you can specify the following options: -@item info +@table @asis + +@item @code{-a}, @code{--append} +Append new history items to the history file. + +@item @code{-r}, @code{--read} +Read history items from the history file and append them to the +current shell's history. + +@item @code{-w}, @code{--write} +Write the current history list to the history file. + +@end table + +@item info [@var{manual} [@var{item}]@dots{}] @cmindex info -Browse the available Info documentation. This command is the same as -the external @command{info} command, but uses Emacs's internal Info -reader. -@xref{Misc Help, , , emacs, The GNU Emacs Manual}. +Browse the available Info documentation. With no arguments, browse +the top-level menu. Otherwise, show the manual for @var{manual}, +selecting the menu entry for @var{item}. + +This command is the same as the external @command{info} command, but +uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The +GNU Emacs Manual}. @item jobs @cmindex jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. -@item kill +@item kill [-@var{signal}] [@var{pid} | @var{process}] @cmindex kill Kill processes. Takes a PID or a process object and an optional -signal specifier which can either be a number or a signal name. +@var{signal} specifier which can either be a number or a signal name. -@item listify +@item listify [@var{arg}]@dots{} @cmindex listify -Eshell version of @code{list}. Allows you to create a list using Eshell -syntax, rather than Elisp syntax. For example, @samp{listify foo bar} -and @code{("foo" "bar")} both evaluate to @code{("foo" "bar")}. +Return the arguments as a single list. With a single argument, return +it as-is if it's already a list, or otherwise wrap it in a list. With +multiple arguments, return a list of all of them. -@item ln +@item ln [@var{option}]@dots{} @var{target} [@var{link-name}] +@itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory} @cmindex ln -Create links to files. +Create a link to the specified @var{target} named @var{link-name} or +create links to multiple @var{targets} in @var{directory}. @vindex eshell-ln-overwrite-files @vindex eshell-ln-interactive-query @@ -725,7 +854,30 @@ will overwrite files without warning. If @code{eshell-ln-interactive-query} is non-@code{nil}, then @command{ln} will ask before overwriting files. -@item locate +@command{ln} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before linking a target. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before linking to an item if the source +already exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't move anything. This is useful if you +want to preview what would be linked when calling @command{ln}. + +@item @code{-s}, @code{--symbolic} +Make symbolic links instead of hard links. + +@item @code{-v}, @code{--verbose} +Print the name of each file before linking it. + +@end table + +@item locate @var{arg}@dots{} @cmindex locate Alias to Emacs's @code{locate} function, which simply runs the external @command{locate} command and parses the results. @@ -736,21 +888,11 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's internal @code{locate} is not used. This is the same as using @samp{alias locate '*locate $@@*'}. -@item ls +@item ls [@var{option}]@dots{} [@var{file}]@dots{} @cmindex ls -Lists the contents of directories. - -@vindex eshell-ls-use-colors -If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a -directory is color-coded according to file type and status. These -colors and the regexps used to identify their corresponding files can -be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}. - -@vindex eshell-ls-date-format -The user option @code{eshell-ls-date-format} determines how the date -is displayed when using the @option{-l} option. The date is produced -using the function @code{format-time-string} (@pxref{Time Parsing,,, -elisp, GNU Emacs Lisp Reference Manual}). +List information about each @var{file}, including the contents of any +specified directories. If @var{file} is unspecified, list the +contents of the current directory. @vindex eshell-ls-initial-args The user option @code{eshell-ls-initial-args} contains a list of @@ -758,29 +900,117 @@ arguments to include with any call to @command{ls}. For example, you can include the option @option{-h} to always use a more human-readable format. -@vindex eshell-ls-default-blocksize -The user option @code{eshell-ls-default-blocksize} determines the -default blocksize used when displaying file sizes with the option -@option{-s}. +@vindex eshell-ls-use-colors +If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a +directory is color-coded according to file type and status. These +colors and the regexps used to identify their corresponding files can +be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls +@key{RET}}}. -@item make +@command{ls} supports the following options: + +@table @asis + +@item @code{-a}, @code{--all} +List all files, including ones starting with @samp{.}. + +@item @code{-A}, @code{--almost-all} +Like @code{--all}, but don't list the current directory (@file{.}) or +the parent directory (@file{..}). + +@item @code{-c}, @code{--by-ctime} +Sort files by last status change time, with newest files first. + +@item @code{-C} +List entries by columns. + +@item @code{-d}, @code{--directory} +List directory entries instead of their contents. + +@item @code{-h}, @code{--human-readable} +Print sizes in human-readable format, with binary prefixes (so 1 KB is +1024 bytes). + +@item @code{-H}, @code{--si} +Print sizes in human-readable format, with decimal prefixes (so 1 KB +is 1000 bytes). + +@item @code{-I@var{pattern}}, @code{--ignore=@var{pattern}} +Don't list directory entries matching @var{pattern}. + +@item @code{-k}, @code{--kilobytes} +Print sizes as 1024-byte kilobytes. + +@vindex eshell-ls-date-format +@item @code{-l} +Use a long listing format showing details for each file. The user +option @code{eshell-ls-date-format} determines how the date is +displayed when using this option. The date is produced using the +function @code{format-time-string} (@pxref{Time Parsing,,, elisp, GNU +Emacs Lisp Reference Manual}). + +@item @code{-L}, @code{--dereference} +Follow symbolic links when listing entries. + +@item @code{-n}, @code{--numeric-uid-gid} +Show UIDs and GIDs numerically, instead of using their names. + +@item @code{-r}, @code{--reverse} +Reverse order when sorting. + +@item @code{-R}, @code{--recursive} +List subdirectories recursively. + +@item @code{-s}, @code{--size} +Show the size of each file in blocks. + +@vindex eshell-ls-default-blocksize +@item @code{-S} +Sort by file size, with largest files first. The user option +@code{eshell-ls-default-blocksize} determines the default blocksize +used when displaying file sizes with this option. + +@item @code{-t} +Sort by modification time, with newest files first. + +@item @code{-u} +Sort by last access time, with newest files first. + +@item @code{-U} +Do not sort results. Instead, list entries in their directory order. + +@item @code{-x} +List entries by lines instead of by columns. + +@item @code{-X} +Sort alphabetically by file extension. + +@item @code{-1} +List one file per line. + +@end table + +@item make [@var{arg}]@dots{} @cmindex make Run @command{make} through @code{compile} when run asynchronously (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs Manual}. Otherwise call the external @command{make} command. -@item man +@item man [@var{arg}]@dots{} @cmindex man Display Man pages using the Emacs @code{man} command. @xref{Man Page, , , emacs, The GNU Emacs Manual}. -@item mkdir +@item mkdir [-p] @var{directory}@dots{} @cmindex mkdir -Make new directories. +Make new directories. With @code{-p} or @code{--parents}, +automatically make any necessary parent directories as well. -@item mv +@item mv [@var{option}]@dots{} @var{source} @var{dest} +@itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory} @cmindex mv -Move or rename files. +Rename the file @var{source} to @var{dest} or move @var{source} into +@var{directory}. @vindex eshell-mv-overwrite-files @vindex eshell-mv-interactive-query @@ -789,40 +1019,93 @@ will overwrite files without warning. If @code{eshell-mv-interactive-query} is non-@code{nil}, @command{mv} will prompt before overwriting anything. -@item occur +@command{mv} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before moving an item. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before moving an item if the target already +exists. + +@item @code{-n}, @code{--preview} +Run the command, but don't move anything. This is useful if you +want to preview what would be moved when calling @command{mv}. + +@item @code{-v}, @code{--verbose} +Print the name of each item before moving it. + +@end table + +@item occur @var{regexp} [@var{nlines}] @cmindex occur Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. @item popd +@item popd +@var{n} @cmindex popd Pop a directory from the directory stack and switch to a another place -in the stack. +in the stack. This command can take the following forms: -@item printnl +@table @code + +@item popd +Remove the current directory from the directory stack and change to +the directory beneath it. + +@item popd +@var{n} +Remove the current directory from the directory stack and change to +the @var{nth} directory in the stack (counting from zero). + +@end table + +@item printnl [@var{arg}]@dots{} @cmindex printnl -Print the arguments separated by newlines. +Print all the @var{arg}s separated by newlines. @item pushd +@itemx pushd @var{directory} +@itemx pushd +@var{n} @cmindex pushd Push the current directory onto the directory stack, then change to -another directory. +another directory. This command can take the following forms: + +@table @code + +@vindex eshell-pushd-tohome +@item pushd +Swap the current directory with the directory on the top of the stack. +If @code{eshell-pushd-tohome} is non-@code{nil}, push the current +directory onto the stack and change to the user's home directory (like +@samp{pushd ~}). @vindex eshell-pushd-dunique +@item pushd @var{directory} +Push the current directory onto the stack and change to +@var{directory}. If @code{eshell-pushd-dunique} is non-@code{nil}, +then only unique directories will be added to the stack. + @vindex eshell-pushd-dextract -If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique -directories will be added to the stack. If -@code{eshell-pushd-dextract} is non-@code{nil}, then @samp{pushd -+@var{n}} will pop the @var{n}th directory to the top of the stack. +@item pushd +@var{n} +Change to the @var{nth} directory in the directory stack (counting +from zero), and ``rotate'' the stack by moving any elements before the +@var{nth} to the bottom. If @code{eshell-pushd-dextract} is +non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the +@var{n}th directory to the top of the stack. + +@end table @item pwd @cmindex pwd Prints the current working directory. -@item rm +@item rm [@var{option}]@dots{} @var{item}@dots{} @cmindex rm Removes files, buffers, processes, or Emacs Lisp symbols, depending on -the argument. +the type of each @var{item}. @vindex eshell-rm-interactive-query @vindex eshell-rm-removes-directories @@ -832,56 +1115,84 @@ will prompt before removing anything. If @command{rm} can also remove directories. Otherwise, @command{rmdir} is required. -@item rmdir +@command{rm} accepts the following options: + +@table @asis + +@item @code{-f}, @code{--force} +Never prompt for confirmation before removing an item. + +@item @code{-i}, @code{--interactive} +Prompt for confirmation before removing each item. + +@item @code{-n}, @code{--preview} +Run the command, but don't remove anything. This is useful if you +want to preview what would be removed when calling @command{rm}. + +@item @code{-r}, @code{-R}, @code{--recursive} +Remove any specified directories and their contents recursively. + +@item @code{-v}, @code{--verbose} +Print the name of each item before removing it. + +@end table + +@item rmdir @var{directory}@dots{} @cmindex rmdir Removes directories if they are empty. -@item set +@item set [@var{var} @var{value}]@dots{} @cmindex set Set variable values, using the function @code{set} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -A variable name can be a symbol, in which case it refers to a Lisp -variable, or a string, referring to an environment variable +The value of @var{var} can be a symbol, in which case it refers to a +Lisp variable, or a string, referring to an environment variable (@pxref{Arguments}). -@item setq +@item setq [@var{symbol} @var{value}]@dots{} @cmindex setq Set variable values, using the function @code{setq} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -@item source +@item source @var{file} [@var{argument}]@dots{} @cmindex source -Source an Eshell file in a subshell environment. This is not to be -confused with the command @command{.}, which sources a file in the -current environment. +Source an Eshell script named @var{file} in a subshell environment, +passing any @var{argument}s to the script (@pxref{Scripts}). This is +not to be confused with the command @command{.}, which sources a file +in the current environment. -@item time +@item time @var{command}@dots{} @cmindex time -Show the time elapsed during a command's execution. +Show the time elapsed during the execution of @var{command}. -@item umask +@item umask [-S] +@itemx umask @var{mode} @cmindex umask -Set or view the default file permissions for newly created files and -directories. +View the default file permissions for newly created files and +directories. If you pass @code{-S} or @code{--symbolic}, view the +mode symbolically. With @var{mode}, set the default permissions to +this value. -@item unset +@item unset [@var{var}]@dots{} @cmindex unset -Unset one or more variables. As with @command{set}, a variable name -can be a symbol, in which case it refers to a Lisp variable, or a -string, referring to an environment variable. +Unset one or more variables. As with @command{set}, the value of +@var{var} can be a symbol, in which case it refers to a Lisp variable, +or a string, referring to an environment variable. -@item wait +@item wait [@var{process}]@dots{} @cmindex wait -Wait until a process has successfully completed. +Wait until each specified @var{process} has exited. -@item which +@item which @var{command}@dots{} @cmindex which -Identify a command and its location. +For each @var{command}, identify what kind of command it is and its +location. @item whoami @cmindex whoami -Print the current user. This Eshell version of @command{whoami} -supports Tramp. +Print the current user. This Eshell version of @command{whoami} is +connection-aware, so for remote directories, it will print the user +associated with that connection. @end table @subsection Defining new built-in commands @@ -1353,6 +1664,11 @@ sequence of commands, as with almost any other shell script. Scripts are invoked from Eshell with @command{source}, or from anywhere in Emacs with @code{eshell-source-file}. +Like with aliases (@pxref{Aliases}), Eshell scripts can accept any +number of arguments. Within the script, you can refer to these with +the special variables @code{$0}, @code{$1}, @dots{}, @code{$9}, and +@code{$*}. + @cmindex . If you wish to load a script into your @emph{current} environment, rather than in a subshell, use the @code{.} command. @@ -1452,7 +1768,7 @@ As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation @command{@var{command}}, but writes the output to a temporary file and returns the file name. -@item $@var{expr}[@var{i...}] +@item $@var{expr}[@var{i@dots{}}] Expands to the @var{i}th element of the result of @var{expr}, an expression in one of the above forms listed here. If multiple indices are supplied, this will return a list containing the elements for each @@ -1501,7 +1817,7 @@ Multiple sets of indices can also be specified. For example, if expand to @code{2}, i.e.@: the second element of the first list member (all indices are zero-based). -@item $@var{expr}[@var{regexp} @var{i...}] +@item $@var{expr}[@var{regexp} @var{i@dots{}}] As above (when @var{expr} expands to a string), but use @var{regexp} to split the string. @var{regexp} can be any form other than a number. For example, @samp{$@var{var}[: 0]} will return the first @@ -2275,15 +2591,23 @@ external commands. To enable it, add @code{eshell-tramp} to @table @code -@item su +@item su [- | -l] [@var{user}] @cmindex su -@itemx sudo +Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp, +The Tramp Manual}) to change the current user to @var{user} (or root +if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide +a login environment. + +@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex sudo -@itemx doas +@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] @cmindex doas -Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method -(@pxref{Inline methods, , , tramp, The Tramp Manual}) to run a command -via @command{su}, @command{sudo}, or @command{doas}. +Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline +methods, , , tramp, The Tramp Manual}) to run @var{command} as root +via @command{sudo} or @command{doas}. When specifying @code{-u +@var{user}} or @code{--user @var{user}}, run the command as @var{user} +instead. With @code{-s} or @code{--shell}, start a shell instead of +running @var{command}. @end table @@ -2296,58 +2620,58 @@ add @code{eshell-xtra} to @code{eshell-modules-list}. @table @code -@item count +@item count @var{item} @var{seq} [@var{option}]@dots{} @cmindex count A wrapper around the function @code{cl-count} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item expr +@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} @cmindex expr An implementation of @command{expr} using the Calc package. @xref{Top,,, calc, The GNU Emacs Calculator}. -@item ff +@item ff @var{directory} @var{pattern} @cmindex ff Shorthand for the the function @code{find-name-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item gf +@item gf @var{directory} @var{regexp} @cmindex gf Shorthand for the the function @code{find-grep-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item intersection +@item intersection @var{list1} @var{list2} [@var{option}]@dots{} @cmindex intersection A wrapper around the function @code{cl-intersection} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item mismatch +@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} @cmindex mismatch A wrapper around the function @code{cl-mismatch} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-difference +@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-difference A wrapper around the function @code{cl-set-difference} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-exclusive-or +@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-exclusive-or A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item substitute +@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} @cmindex substitute A wrapper around the function @code{cl-substitute} (@pxref{Sequence Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item union +@item union @var{list1} @var{list2} [@var{option}]@dots{} @cmindex union A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 78dfd0654e2..23028576f45 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -618,11 +618,11 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") :preserve-args :external "ln" :show-usage - :usage "[OPTION]... TARGET [LINK_NAME] + :usage "[OPTION]... TARGET LINK_NAME or: ln [OPTION]... TARGET... DIRECTORY -Create a link to the specified TARGET with optional LINK_NAME. If there is -more than one TARGET, the last argument must be a directory; create links -in DIRECTORY to each TARGET. Create hard links by default, symbolic links +Create a link to the specified TARGET with LINK_NAME. If there is more +than one TARGET, the last argument must be a directory; create links in +DIRECTORY to each TARGET. Create hard links by default, symbolic links with `--symbolic'. When creating hard links, each TARGET must exist.") (let ((no-dereference t)) (eshell-mvcpln-template "ln" "linking" diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index dc2b93e574b..44861c222b8 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -253,10 +253,10 @@ An external command simply means external to Emacs." "Add a set of paths to PATH." (eshell-eval-using-options "addpath" args - '((?b "begin" nil prepend "add path element at beginning") + '((?b "begin" nil prepend "add to beginning of $PATH") (?h "help" nil nil "display this usage message") - :usage "[-b] PATH -Adds the given PATH to $PATH.") + :usage "[-b] DIR... +Adds the given DIR to $PATH.") (let ((path (eshell-get-path t))) (if args (progn diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 537bc4b0641..02b5c785625 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -433,7 +433,7 @@ the values of nil for each." (?h "help" nil nil "show this usage screen") :external "env" :parse-leading-options-only - :usage "[NAME=VALUE]... [COMMAND [ARG]...]") + :usage "[NAME=VALUE]... [COMMAND]...") (if args (or (eshell-parse-local-variables args) (eshell-named-command (car args) (cdr args))) From 7756e9c73611c25002a90194b4a32c23051cb234 Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Thu, 23 Feb 2023 20:58:00 +0800 Subject: [PATCH 087/385] filesets: Safely invoke `shell-command*' functions * lisp/filesets.el: (filesets-select-command, filesets-quote): Remove unused functions. (filesets-external-viewers): Remove old comments. (filesets-which-command, filesets-get-quoted-selection) (filesets-spawn-external-viewer): Use `shell-quote-argument'. (Bug#61709) --- lisp/filesets.el | 40 +++++++++------------------------------- 1 file changed, 9 insertions(+), 31 deletions(-) diff --git a/lisp/filesets.el b/lisp/filesets.el index 4e2de8fed1b..bc113b80e07 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -161,18 +161,9 @@ COND-FN takes one argument: the current element." (define-obsolete-function-alias 'filesets-member #'cl-member "28.1") (define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1") -(defun filesets-select-command (cmd-list) - "Select one command from CMD-LIST -- a string with space separated names." - (let ((this (shell-command-to-string - (format "which --skip-alias %s 2> %s | head -n 1" - cmd-list null-device)))) - (if (equal this "") - nil - (file-name-nondirectory (substring this 0 (- (length this) 1)))))) - (defun filesets-which-command (cmd) "Call \"which CMD\"." - (shell-command-to-string (format "which %s" cmd))) + (shell-command-to-string (format "which %s" (shell-quote-argument cmd)))) (defun filesets-which-command-p (cmd) "Call \"which CMD\" and return non-nil if the command was found." @@ -547,16 +538,6 @@ the filename." (defcustom filesets-external-viewers (let - ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer) - ;; (filesets-select-command "ggv gv"))) - ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer) - ;; (filesets-select-command "xpdf acroread"))) - ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer) - ;; (filesets-select-command "xdvi tkdvi"))) - ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer) - ;; (filesets-select-command "antiword"))) - ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer) - ;; (filesets-select-command "gqview ee display")))) ((ps-cmd "ggv") (pdf-cmd "xpdf") (dvi-cmd "xdvi") @@ -1084,10 +1065,6 @@ Return full path if FULL-FLAG is non-nil." (t (error "Filesets: %s does not exist" dir)))) -(defun filesets-quote (txt) - "Return TXT in quotes." - (concat "\"" txt "\"")) - (defun filesets-get-selection () "Get the text between mark and point -- i.e. the selection or region." (let ((m (mark)) @@ -1098,7 +1075,7 @@ Return full path if FULL-FLAG is non-nil." (defun filesets-get-quoted-selection () "Return the currently selected text in quotes." - (filesets-quote (filesets-get-selection))) + (shell-quote-argument (filesets-get-selection))) (defun filesets-get-shortcut (n) "Create menu shortcuts based on number N." @@ -1245,12 +1222,13 @@ Use the viewer defined in EV-ENTRY (a valid element of (if fmt (mapconcat (lambda (this) - (if (stringp this) (format this file) - (format "%S" (if (functionp this) - (funcall this) - this)))) + (if (stringp this) + (format this (shell-quote-argument file)) + (shell-quote-argument (if (functionp this) + (funcall this) + this)))) fmt "") - (format "%S" file)))) + (shell-quote-argument file)))) (output (cond ((and (functionp vwr) co-flag) @@ -1259,7 +1237,7 @@ Use the viewer defined in EV-ENTRY (a valid element of (funcall vwr file) nil) (co-flag - (shell-command-to-string (format "%s %s" vwr args))) + (shell-command-to-string (format "%s %s" vwr args))) (t (shell-command (format "%s %s&" vwr args)) nil)))) From ea53a26d03da8d03652696939431b3a7e63053d7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 5 Feb 2024 08:30:31 +0100 Subject: [PATCH 088/385] ; Fix last change * lisp/filesets.el (filesets-quote): Resurrect as obsolete alias for 'shell-quote-argument'. --- lisp/filesets.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/filesets.el b/lisp/filesets.el index bc113b80e07..68133ba2255 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -2461,11 +2461,15 @@ Set up hooks, load the cache file -- if existing -- and build the menu." (setq filesets-menu-use-cached-flag t))) (filesets-build-menu))) +;;; obsolete + (defun filesets-error (_class &rest args) "`error' wrapper." (declare (obsolete error "28.1")) (error "%s" (mapconcat #'identity args " "))) +(define-obsolete-function-alias 'filesets-quote #'shell-quote-argument "30.1") + (provide 'filesets) ;;; filesets.el ends here From 98d62c5f7675b24ad66e010765ce3012046f2ff8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 5 Feb 2024 17:17:51 +0800 Subject: [PATCH 089/385] Don't respect ROUND_XY_TO_GRID when decomposing uninterpreted glyph * src/sfnt.c (sfnt_decompose_compound_glyph): Remove useless code; don't pretend to round glyph coordinates. --- src/sfnt.c | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/src/sfnt.c b/src/sfnt.c index 6df43af4293..8598b052044 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -2798,12 +2798,6 @@ sfnt_decompose_compound_glyph (struct sfnt_glyph *glyph, if (component->flags & 04000) /* SCALED_COMPONENT_OFFSET */ sfnt_transform_coordinates (component, &x, &y, 1, 0, 0); - - if (component->flags & 04) /* ROUND_XY_TO_GRID */ - { - x = sfnt_round_fixed (x); - y = sfnt_round_fixed (y); - } } else { @@ -20800,8 +20794,8 @@ main (int argc, char **argv) return 1; } -#define FANCY_PPEM 12 -#define EASY_PPEM 12 +#define FANCY_PPEM 18 +#define EASY_PPEM 18 interpreter = NULL; head = sfnt_read_head_table (fd, font); From c1f8fe09e6641cc6c1195edcb8666ace1e6e8829 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 5 Feb 2024 18:34:22 +0800 Subject: [PATCH 090/385] Fix frame focus tracking under Android * java/org/gnu/emacs/EmacsActivity.java (invalidateFocus): New argument WHENCE, a unique number identifying the circumstances leading up to the call. All callers changed. (attachWindow): Call `invalidateFocus' from the UI thread. (onWindowFocusChanged): Don't remove activity from `focusedActivities' if it already exists should `hasWindowFocus' return true. --- java/org/gnu/emacs/EmacsActivity.java | 32 ++++++++++++++++++++------- java/org/gnu/emacs/EmacsWindow.java | 4 ++-- 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index 3237f650240..b821694b18a 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -97,7 +97,7 @@ public class EmacsActivity extends Activity } public static void - invalidateFocus () + invalidateFocus (int whence) { EmacsWindow oldFocus; @@ -144,7 +144,7 @@ public class EmacsActivity extends Activity layout.removeView (window.view); window = null; - invalidateFocus (); + invalidateFocus (0); } } @@ -172,8 +172,17 @@ public class EmacsActivity extends Activity if (isPaused) window.noticeIconified (); - /* Invalidate the focus. */ - invalidateFocus (); + /* Invalidate the focus. Since attachWindow may be called from + either the main or the UI thread, post this to the UI thread. */ + + runOnUiThread (new Runnable () { + @Override + public void + run () + { + invalidateFocus (1); + } + }); } @Override @@ -261,7 +270,7 @@ public class EmacsActivity extends Activity isMultitask = this instanceof EmacsMultitaskActivity; manager.removeWindowConsumer (this, isMultitask || isFinishing ()); focusedActivities.remove (this); - invalidateFocus (); + invalidateFocus (2); /* Remove this activity from the static field, lest it leak. */ if (lastFocusedActivity == this) @@ -274,9 +283,16 @@ public class EmacsActivity extends Activity public final void onWindowFocusChanged (boolean isFocused) { - if (isFocused && !focusedActivities.contains (this)) + /* At times and on certain versions of Android ISFOCUSED does not + reflect whether the window actually holds focus, so replace it + with the value of `hasWindowFocus'. */ + isFocused = hasWindowFocus (); + + if (isFocused) { - focusedActivities.add (this); + if (!focusedActivities.contains (this)) + focusedActivities.add (this); + lastFocusedActivity = this; /* Update the window insets as the focus change may have @@ -291,7 +307,7 @@ public class EmacsActivity extends Activity else focusedActivities.remove (this); - invalidateFocus (); + invalidateFocus (3); } @Override diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 304304a328b..b75d96b2b5a 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -240,7 +240,7 @@ private static class Coordinate } } - EmacsActivity.invalidateFocus (); + EmacsActivity.invalidateFocus (4); if (!children.isEmpty ()) throw new IllegalStateException ("Trying to destroy window with " @@ -760,7 +760,7 @@ private static class Coordinate public void onFocusChanged (boolean gainFocus) { - EmacsActivity.invalidateFocus (); + EmacsActivity.invalidateFocus (gainFocus ? 6 : 5); } /* Notice that the activity has been detached or destroyed. From c7539a363b8b109d24457aaeb60fb51bd0a03e4f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:54:03 +0100 Subject: [PATCH 091/385] Fix stale cache in Tramp * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Flush file properties in time. (Bug#68805) --- lisp/net/tramp-sh.el | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7656da81dcc..68ee541bee6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2009,7 +2009,7 @@ ID-FORMAT valid values are `string' and `integer'." #'copy-directory (list dirname newname keep-date parents copy-contents)))) - ;; When newname did exist, we have wrong cached values. + ;; NEWNAME has wrong cached values. (when t2 (with-parsed-tramp-file-name (expand-file-name newname) nil (tramp-flush-file-properties v localname))))))) @@ -2148,6 +2148,16 @@ file names." ;; One of them must be a Tramp file. (error "Tramp implementation says this cannot happen"))) + ;; In case of `rename', we must flush the cache of the source file. + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename v1 + (tramp-flush-file-properties v1 v1-localname))) + + ;; NEWNAME has wrong cached values. + (when t2 + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname))) + ;; Handle `preserve-extended-attributes'. We ignore ;; possible errors, because ACL strings could be ;; incompatible. @@ -2156,16 +2166,6 @@ file names." (ignore-errors (set-file-extended-attributes newname attributes))) - ;; In case of `rename', we must flush the cache of the source file. - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename v1 - (tramp-flush-file-properties v1 v1-localname))) - - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname v2 - (tramp-flush-file-properties v2 v2-localname))) - ;; KEEP-DATE handling. (when (and keep-date (not copy-keep-date)) (tramp-compat-set-file-times @@ -2437,7 +2437,7 @@ The method used must be an out-of-band method." copy-program (tramp-get-method-parameter v 'tramp-copy-program) copy-args ;; " " has either been a replacement of "%k" (when - ;; keep-date argument is non-nil), or a replacement for + ;; KEEP-DATE argument is non-nil), or a replacement for ;; the whole keep-date sublist. (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) ;; `tramp-ssh-controlmaster-options' is a string instead @@ -5353,7 +5353,7 @@ connection if a previous connection has died for some reason." "2>" (tramp-get-remote-null-device previous-hop)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("&&" "exit")) '("||" "exit")) + (when r-shell '("&&" "exit")) '("||" "exit")) " ")) ;; Send the command. From edf61edfd6f04ab97785dca92fc68e8e5783586e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:54:56 +0100 Subject: [PATCH 092/385] Adapt cache handling in Tramp * lisp/net/tramp-cache.el (with-tramp-saved-file-property) (with-tramp-saved-file-properties) (with-tramp-saved-connection-property) (with-tramp-saved-connection-properties): Do not change KEY destructively. --- lisp/net/tramp-cache.el | 105 ++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 58 deletions(-) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 25123a6e282..225a26ad1cd 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." (defun tramp-get-file-property (key file property &optional default) "Get the PROPERTY of FILE from the cache context of KEY. Return DEFAULT if not set." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (if (eq key tramp-cache-undefined) default (let* ((hash (tramp-get-hash-table key)) @@ -191,7 +190,6 @@ Return DEFAULT if not set." (defun tramp-set-file-property (key file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. Return VALUE." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (if (eq key tramp-cache-undefined) value (let ((hash (tramp-get-hash-table key))) @@ -224,7 +222,6 @@ Return VALUE." ;;;###tramp-autoload (defun tramp-flush-file-property (key file property) "Remove PROPERTY of FILE in the cache context of KEY." - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (remhash property (tramp-get-hash-table key)) @@ -239,7 +236,6 @@ Return VALUE." ;; `file-name-directory' can return nil, for example for "~". (when-let ((file (file-name-directory file)) (file (directory-file-name file))) - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (dolist (property (hash-table-keys (tramp-get-hash-table key))) @@ -254,7 +250,6 @@ Return VALUE." (defun tramp-flush-file-properties (key file) "Remove all properties of FILE in the cache context of KEY." (let ((truename (tramp-get-file-property key file "file-truename"))) - ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) (unless (eq key tramp-cache-undefined) (tramp-message key 8 "%s" (tramp-file-name-localname key)) @@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified via KEY." "Save PROPERTY, run BODY, reset PROPERTY. Preserve timestamps." (declare (indent 3) (debug t)) - `(progn - ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setf ,key (tramp-file-name-unify ,key ,file)) - (let* ((hash (tramp-get-hash-table ,key)) - (cached (and (hash-table-p hash) (gethash ,property hash)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (if (consp cached) - (puthash ,property cached hash) - (remhash ,property hash)))))) + `(let* ((key (tramp-file-name-unify ,key ,file)) + (hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) (gethash ,property hash)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTY. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (if (consp cached) + (puthash ,property cached hash) + (remhash ,property hash))))) ;;;###tramp-autoload (defmacro with-tramp-saved-file-properties (key file properties &rest body) @@ -356,22 +349,20 @@ Preserve timestamps." PROPERTIES is a list of file properties (strings). Preserve timestamps." (declare (indent 3) (debug t)) - `(progn - ;; Unify localname. Remove hop from `tramp-file-name' structure. - (setf ,key (tramp-file-name-unify ,key ,file)) - (let* ((hash (tramp-get-hash-table ,key)) - (values - (and (hash-table-p hash) - (mapcar - (lambda (property) (cons property (gethash property hash))) - ,properties)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (consp (cdr value)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + `(let* ((key (tramp-file-name-unify ,key ,file)) + (hash (tramp-get-hash-table key)) + (values + (and (hash-table-p hash) + (mapcar + (lambda (property) (cons property (gethash property hash))) + ,properties)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (dolist (value values) + (if (consp (cdr value)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash)))))) ;;; -- Properties -- @@ -473,38 +464,36 @@ used to cache connection properties of the local machine." (defmacro with-tramp-saved-connection-property (key property &rest body) "Save PROPERTY, run BODY, reset PROPERTY." (declare (indent 2) (debug t)) - `(progn - (setf ,key (tramp-file-name-unify ,key)) - (let* ((hash (tramp-get-hash-table ,key)) - (cached (and (hash-table-p hash) - (gethash ,property hash tramp-cache-undefined)))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTY. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (if (not (eq cached tramp-cache-undefined)) - (puthash ,property cached hash) - (remhash ,property hash)))))) + `(let* ((key (tramp-file-name-unify ,key)) + (hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) + (gethash ,property hash tramp-cache-undefined)))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTY. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (if (not (eq cached tramp-cache-undefined)) + (puthash ,property cached hash) + (remhash ,property hash))))) ;;;###tramp-autoload (defmacro with-tramp-saved-connection-properties (key properties &rest body) "Save PROPERTIES, run BODY, reset PROPERTIES. PROPERTIES is a list of file properties (strings)." (declare (indent 2) (debug t)) - `(progn - (setf ,key (tramp-file-name-unify ,key)) - (let* ((hash (tramp-get-hash-table ,key)) - (values - (mapcar - (lambda (property) - (cons property (gethash property hash tramp-cache-undefined))) - ,properties))) - (unwind-protect (progn ,@body) - ;; Reset PROPERTIES. Recompute hash, it could have been flushed. - (setq hash (tramp-get-hash-table ,key)) - (dolist (value values) - (if (not (eq (cdr value) tramp-cache-undefined)) - (puthash (car value) (cdr value) hash) - (remhash (car value) hash))))))) + `(let* ((key (tramp-file-name-unify ,key)) + (hash (tramp-get-hash-table key)) + (values + (mapcar + (lambda (property) + (cons property (gethash property hash tramp-cache-undefined))) + ,properties))) + (unwind-protect (progn ,@body) + ;; Reset PROPERTIES. Recompute hash, it could have been flushed. + (setq hash (tramp-get-hash-table key)) + (dolist (value values) + (if (not (eq (cdr value) tramp-cache-undefined)) + (puthash (car value) (cdr value) hash) + (remhash (car value) hash)))))) ;;;###tramp-autoload (defun tramp-cache-print (table) From dbc5fafa311823f3a78d4ad5a395e4d87d31d9bd Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:55:27 +0100 Subject: [PATCH 093/385] * lisp/net/tramp.el (tramp-local-host-regexp): Adapt :version. --- lisp/net/tramp-archive.el | 4 ++-- lisp/net/tramp-compat.el | 2 +- lisp/net/tramp.el | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 298cacdb0e0..752462d8fa3 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -389,7 +389,7 @@ arguments to pass to the OPERATION." "Add archive file name handler to `file-name-handler-alist'." (when (and tramp-archive-enabled (not - (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) + (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) @@ -443,7 +443,7 @@ arguments to pass to the OPERATION." (and (tramp-archive-file-name-p name) (match-string 2 name))) -(defvar tramp-archive-hash (make-hash-table :test 'equal) +(defvar tramp-archive-hash (make-hash-table :test #'equal) "Hash table for archive local copies. The hash key is the archive name. The value is a cons of the used `tramp-file-name' structure for tramp-gvfs, and the file diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 87b20b982f9..061766090a0 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -309,7 +309,7 @@ Also see `ignore'." ;; Macro `connection-local-p' is new in Emacs 30.1. (if (macrop 'connection-local-p) - (defalias 'tramp-compat-connection-local-p #'connection-local-p) + (defalias 'tramp-compat-connection-local-p 'connection-local-p) (defmacro tramp-compat-connection-local-p (variable) "Non-nil if VARIABLE has a connection-local binding in `default-directory'." `(let (connection-local-variables-alist file-local-variables-alist) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7800efc2a5e..8e114912527 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -557,7 +557,7 @@ host runs a restricted shell, it shall be added to this list, too." eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." - :version "30.1" + :version "29.3" :type '(choice (const :tag "Chrooted environment" nil) (regexp :tag "Host regexp"))) From 798310f0100e7819bc79fb7f9bdcf59b8f534b4b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 5 Feb 2024 12:56:36 +0100 Subject: [PATCH 094/385] ; * etc/NEWS: Fix typos. --- etc/NEWS | 74 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 38 insertions(+), 36 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 816613de4ec..5180c26aa92 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -76,7 +76,7 @@ see the variable 'url-request-extra-headers'. +++ ** 'completion-auto-help' now affects 'icomplete-in-buffer'. -Previously, completion-auto-help mostly affected only minibuffer +Previously, 'completion-auto-help' mostly affected only minibuffer completion. Now, if 'completion-auto-help' has the value 'lazy', then Icomplete's in-buffer display of possible completions will only appear after the 'completion-at-point' command has been invoked twice, and if @@ -85,12 +85,12 @@ completely suppressed. Thus, if you use 'icomplete-in-buffer', ensure 'completion-auto-help' is not customized to 'lazy' or nil. +++ -** The *Completions* buffer now always accompanies 'icomplete-in-buffer'. -Previously, it was not consistent when the *Completions* buffer would -appear when using 'icomplete-in-buffer'. Now the *Completions* buffer +** The "*Completions*" buffer now always accompanies 'icomplete-in-buffer'. +Previously, it was not consistent whether the "*Completions*" buffer would +appear when using 'icomplete-in-buffer'. Now the "*Completions*" buffer and Icomplete's in-buffer display of possible completions always appear together. If you would prefer to see only Icomplete's -in-buffer display, and not the *Completions* buffer, you can add this +in-buffer display, and not the "*Completions*" buffer, you can add this to your init: (advice-add 'completion-at-point :after #'minibuffer-hide-completions) @@ -258,7 +258,7 @@ right-aligned to is controlled by the new user option ** Windows -*** New action alist entry 'post-command-select-window' for display-buffer. +*** New action alist entry 'post-command-select-window' for 'display-buffer'. It specifies whether the window of the displayed buffer should be selected or deselected at the end of executing the current command. @@ -305,8 +305,7 @@ between the auto save file and the current file. --- ** 'ffap-lax-url' now defaults to nil. -Previously, it was set to 'ffap-lax-url' to t but this broke remote file -name detection. +Previously, it was set to t but this broke remote file name detection. * Editing Changes in Emacs 30.1 @@ -433,7 +432,7 @@ configurations such as X11 when the X server does not support at least version 2.1 of the X Input Extension, and 'xterm-mouse-mode'. ** 'xterm-mouse-mode' -This mode now emits `wheel-up/down/right/left' events instead of +This mode now emits 'wheel-up/down/right/left' events instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the 'mouse-wheel-up/down/left/right-event' variables to decide which button maps to which wheel event (if any). @@ -442,7 +441,7 @@ variables to decide which button maps to which wheel event (if any). --- *** New user option 'Info-url-alist'. -This user option associates manual-names with URLs. It affects the +This user option associates manual names with URLs. It affects the 'Info-goto-node-web' command. By default, associations for all Emacs-included manuals are set. Further associations can be added for arbitrary Info manuals. @@ -691,7 +690,7 @@ arguments of the form 'VAR=VALUE', 'env' will first set 'VAR' to Now, you can pass an argument like "u+w,o-r" to Eshell's 'umask' command, which will give write permission for owners of newly-created files and deny read permission for users who are not members of the -file's group. See the Info node '(coreutils)File permissions' for +file's group. See the Info node "(coreutils) File permissions" for more information on this notation. +++ @@ -810,14 +809,14 @@ in the minibuffer history, with more recent candidates appearing first. *** 'completion-category-overrides' supports more metadata. The new supported completion properties are 'cycle-sort-function', 'display-sort-function', 'annotation-function', 'affixation-function', -'group-function'. You can now customize them for any category in +and 'group-function'. You can now customize them for any category in 'completion-category-overrides' that will override the properties defined in completion metadata. +++ *** 'completion-extra-properties' supports more metadata. The new supported completion properties are 'category', -'group-function', 'display-sort-function', 'cycle-sort-function'. +'group-function', 'display-sort-function', and 'cycle-sort-function'. ** Pcomplete @@ -1059,8 +1058,8 @@ which calls 'xref-find-definitions'. If the previous one worked better for you, use 'define-key' in your init script to bind 'js-find-symbol' to that combination again. -** Json mode -`js-json-mode` does not derive from `js-mode` any more so as not +** Json mode. +'js-json-mode' does not derive from 'js-mode' any more so as not to confuse tools like Eglot or YASnippet into thinking that those buffers contain Javascript code. @@ -1195,8 +1194,8 @@ comment, like Perl mode does. *** New command 'cperl-file-style'. This command sets the indentation style for the current buffer. To -change the default style, either use the option with the same name or -use the command cperl-set-style. +change the default style, either use the user option with the same name +or use the command 'cperl-set-style'. *** Commands using the Perl info page are obsolete. The Perl documentation in info format is no longer distributed with @@ -1309,16 +1308,19 @@ chat buffers use by default. +++ *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". + ** Calc + +++ -*** Calc parses fractions written using U+2044 FRACTION SLASH -Fractions of the form 123⁄456 are handled as if written 123:456. Note -in particular the difference in behavior from U+2215 DIVISION SLASH +*** Calc parses fractions written using U+2044 FRACTION SLASH. +Fractions of the form "123⁄456" are handled as if written "123:456". +Note in particular the difference in behavior from U+2215 DIVISION SLASH and U+002F SOLIDUS, which result in division rather than a rational -fraction. You may also be interested to know that precomposed -fraction characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are -also recognized as rational fractions. They have been since 2004, but -it looks like it was never mentioned in the NEWS, or even the manual. +fraction. You may also be interested to know that precomposed fraction +characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also +recognized as rational fractions. They have been since 2004, but it +looks like it was never mentioned in the NEWS, or even the manual. + * New Modes and Packages in Emacs 30.1 @@ -1378,19 +1380,19 @@ files and save the changes. * Incompatible Lisp Changes in Emacs 30.1 --- -** Old 'derived.el' functions removed. +** Old derived.el functions removed. The following functions have been deleted because they were only used by code compiled with Emacs<21: -'derived-mode-setup-function-name', 'derived-mode-init-mode-variables', -'derived-mode-set-keymap', 'derived-mode-set-syntax-table', -'derived-mode-set-abbrev-table', 'derived-mode-run-hooks', +'derived-mode-init-mode-variables', 'derived-mode-merge-abbrev-tables', 'derived-mode-merge-keymaps', 'derived-mode-merge-syntax-tables', -'derived-mode-merge-abbrev-tables'. +'derived-mode-run-hooks', 'derived-mode-set-abbrev-table', +'derived-mode-set-keymap', 'derived-mode-set-syntax-table', +'derived-mode-setup-function-name'. +++ ** 'M-TAB' now invokes 'completion-at-point' also in Text mode. By default, Text mode no longer binds 'M-TAB' to -'ispell-complete-word'. Instead this mode arranges for +'ispell-complete-word'. Instead, this mode arranges for 'completion-at-point', globally bound to 'M-TAB', to perform word completion as well. You can have Text mode bind 'M-TAB' to 'ispell-complete-word' as it did in previous Emacs versions, or @@ -1498,8 +1500,8 @@ values. * Lisp Changes in Emacs 30.1 +++ -** 'define-advice' now sets the new advice's 'name' property to NAME -Named advice defined with 'define-advice' can now be removed with +** 'define-advice' now sets the new advice's 'name' property to NAME. +Named advices defined with 'define-advice' can now be removed with '(advice-remove SYMBOL NAME)' in addition to '(advice-remove SYMBOL SYMBOL@NAME)'. @@ -1516,10 +1518,10 @@ It puts a limit to the amount by which Emacs can temporarily increase +++ ** New special form 'handler-bind'. -Provides a functionality similar to `condition-case` except it runs the -handler code without unwinding the stack, such that we can record the -backtrace and other dynamic state at the point of the error. -See the Info node "(elisp) Handling Errors". +It provides a functionality similar to 'condition-case' except it runs +the handler code without unwinding the stack, such that we can record +the backtrace and other dynamic state at the point of the error. See +the Info node "(elisp) Handling Errors". +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. From 95c8bfb11ec82e67652e5903495c1fcb5c61ace2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 10:13:56 -0500 Subject: [PATCH 095/385] (edebug-signal): Simplify Also, prefer #' to quote function names. * lisp/emacs-lisp/edebug.el (edebug-signal): Instead of re-signaling the error, let `signal_or_quit` continue processing it. --- lisp/emacs-lisp/edebug.el | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a8a51502503..4c7dbb4ef8c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -481,7 +481,7 @@ just FUNCTION is printed." (edebug--eval-defun #'eval-defun edebug-it))) ;;;###autoload -(defalias 'edebug-defun 'edebug-eval-top-level-form) +(defalias 'edebug-defun #'edebug-eval-top-level-form) ;;;###autoload (defun edebug-eval-top-level-form () @@ -1729,7 +1729,7 @@ contains a circular object." (defun edebug-match-form (cursor) (list (edebug-form cursor))) -(defalias 'edebug-match-place 'edebug-match-form) +(defalias 'edebug-match-place #'edebug-match-form) ;; Currently identical to edebug-match-form. ;; This is for common lisp setf-style place arguments. @@ -2277,12 +2277,7 @@ only be active while Edebug is. It checks `debug-on-error' to see whether it should call the debugger. When execution is resumed, the error is signaled again." (if (and (listp debug-on-error) (memq signal-name debug-on-error)) - (edebug 'error (cons signal-name signal-data))) - ;; If we reach here without another non-local exit, then send signal again. - ;; i.e. the signal is not continuable, yet. - ;; Avoid infinite recursion. - (let ((signal-hook-function nil)) - (signal signal-name signal-data))) + (edebug 'error (cons signal-name signal-data)))) ;;; Entering Edebug @@ -2326,6 +2321,12 @@ and run its entry function, and set up `edebug-before' and (debug-on-error (or debug-on-error edebug-on-error)) (debug-on-quit edebug-on-quit)) (unwind-protect + ;; FIXME: We could replace this `signal-hook-function' with + ;; a cleaner `handler-bind' but then we wouldn't be able to + ;; install it here (i.e. once and for all when entering + ;; an Edebugged function), but instead it would have to + ;; be installed into a modified `edebug-after' which wraps + ;; the `handler-bind' around its argument(s). :-( (let ((signal-hook-function #'edebug-signal)) (setq edebug-execution-mode (or edebug-next-execution-mode edebug-initial-mode @@ -3348,7 +3349,7 @@ With prefix argument, make it a temporary breakpoint." (message "%s" msg))) -(defalias 'edebug-step-through-mode 'edebug-step-mode) +(defalias 'edebug-step-through-mode #'edebug-step-mode) (defun edebug-step-mode () "Proceed to next stop point." @@ -3836,12 +3837,12 @@ be installed in `emacs-lisp-mode-map'.") ;; Global GUD bindings for all emacs-lisp-mode buffers. (unless edebug-inhibit-emacs-lisp-mode-bindings - (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode) - (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" #'edebug-step-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" #'edebug-next-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" #'edebug-go-mode) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" #'edebug-where) ;; The following isn't a GUD binding. - (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode)) + (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" #'edebug-set-initial-mode)) (defvar-keymap edebug-mode-map :parent emacs-lisp-mode-map From 5e69376292994ffe69b7f8f52ae1ad85c60c2d29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 5 Feb 2024 17:56:11 +0100 Subject: [PATCH 096/385] Grudgingly accept function values in the function position * lisp/emacs-lisp/cconv.el (cconv-convert): Warn about (F ...) where F is a non-symbol function value (bytecode object etc), but let it pass for compatibility's sake (bug#68931). * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--fun-value-as-head): New test. --- lisp/emacs-lisp/cconv.el | 12 ++++++++---- test/lisp/emacs-lisp/bytecomp-tests.el | 16 ++++++++++++++++ 2 files changed, 24 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e210cfdf5ce..4ff47971351 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -621,12 +621,16 @@ places where they originally did not directly appear." (cconv-convert exp env extend)) (`(,func . ,forms) - (if (symbolp func) + (if (or (symbolp func) (functionp func)) ;; First element is function or whatever function-like forms are: ;; or, and, if, catch, progn, prog1, while, until - `(,func . ,(mapcar (lambda (form) - (cconv-convert form env extend)) - forms)) + (let ((args (mapcar (lambda (form) (cconv-convert form env extend)) + forms))) + (unless (symbolp func) + (byte-compile-warn-x + form + "Use `funcall' instead of `%s' in the function position" func)) + `(,func . ,args)) (byte-compile-warn-x form "Malformed function `%S'" func) nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index dcb72e4105a..8ccac492141 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -848,6 +848,22 @@ byte-compiled. Run with dynamic binding." (should (equal (bytecomp-tests--eval-interpreted form) (bytecomp-tests--eval-compiled form))))))) +(ert-deftest bytecomp--fun-value-as-head () + ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931). + ;; (There is also a warning but this test does not check that.) + (dolist (lb '(nil t)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let* ((lexical-binding lb) + (s-int '(lambda (x) (1+ x))) + (s-comp (byte-compile s-int)) + (v-int (lambda (x) (1+ x))) + (v-comp (byte-compile v-int)) + (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3))))))) + (should (equal (funcall comp s-int) 4)) + (should (equal (funcall comp s-comp) 4)) + (should (equal (funcall comp v-int) 4)) + (should (equal (funcall comp v-comp) 4)))))) + (defmacro bytecomp-tests--with-fresh-warnings (&rest body) `(let ((macroexp--warned ; oh dear (make-hash-table :test #'equal :weakness 'key))) From aedfb4f04837ef7b6f50d6a9d833a3ec0f33b11d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 14:50:45 -0500 Subject: [PATCH 097/385] (gitmerge-mode-font-lock-keywords): Don't use font-lock-*-face vars * admin/gitmerge.el (gitmerge-mode-font-lock-keywords): Refer to the faces directly. --- admin/gitmerge.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 7c815c729e5..32d5c3c1bea 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -111,10 +111,10 @@ If nil, the function `gitmerge-default-branch' guesses.") (defvar gitmerge-mode-font-lock-keywords `((,gitmerge-log-regexp - (1 font-lock-warning-face) - (2 font-lock-constant-face) - (3 font-lock-builtin-face) - (4 font-lock-comment-face)))) + (1 'font-lock-warning-face) + (2 'font-lock-constant-face) + (3 'font-lock-builtin-face) + (4 'font-lock-comment-face)))) (defvar gitmerge--commits nil) (defvar gitmerge--from nil) From 10faaa3c91045390755791c21349cd562546fdea Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Feb 2024 17:58:47 -0500 Subject: [PATCH 098/385] Prefer `ITREE_FOREACH` over `overlays_in` Use `ITREE_FOREACH` instead of `overlays_in` if that can save us from allocating an array. * src/buffer.c (overlays_in): Mark as static. (mouse_face_overlay_overlaps): Use `ITREE_FOREACH` instead of `overlays_in`. (disable_line_numbers_overlay_at_eob): Same, and also change return value to a boolean. * src/buffer.h (overlays_in): Don't declare. * src/editfns.c (overlays_around): Delete function. (Fget_pos_property): Use `ITREE_FOREACH` and keep the "best so far" instead of using `overlays_in` and sorting the elements. * src/lisp.h (disable_line_numbers_overlay_at_eob): Change return type to a boolean. * src/xdisp.c (should_produce_line_number): Adjust accordingly. --- src/buffer.c | 60 +++++++++++++---------------------- src/buffer.h | 2 -- src/editfns.c | 86 +++++++++++++++++---------------------------------- src/lisp.h | 2 +- src/xdisp.c | 2 +- 5 files changed, 51 insertions(+), 101 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 352aca8ddfd..d67e1d67cd6 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3002,7 +3002,7 @@ the normal hook `change-major-mode-hook'. */) But still return the total number of overlays. */ -ptrdiff_t +static ptrdiff_t overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend, Lisp_Object **vec_ptr, ptrdiff_t *len_ptr, bool empty, bool trailing, @@ -3125,56 +3125,38 @@ mouse_face_overlay_overlaps (Lisp_Object overlay) { ptrdiff_t start = OVERLAY_START (overlay); ptrdiff_t end = OVERLAY_END (overlay); - ptrdiff_t n, i, size; - Lisp_Object *v, tem; - Lisp_Object vbuf[10]; - USE_SAFE_ALLOCA; + Lisp_Object tem; + struct itree_node *node; - size = ARRAYELTS (vbuf); - v = vbuf; - n = overlays_in (start, end, 0, &v, &size, true, false, NULL); - if (n > size) + ITREE_FOREACH (node, current_buffer->overlays, + start, min (end, ZV) + 1, + ASCENDING) { - SAFE_NALLOCA (v, 1, n); - overlays_in (start, end, 0, &v, &n, true, false, NULL); + if (node->begin < end && node->end > start + && node->begin < node->end + && !EQ (node->data, overlay) + && (tem = Foverlay_get (overlay, Qmouse_face), + !NILP (tem))) + return true; } - - for (i = 0; i < n; ++i) - if (!EQ (v[i], overlay) - && (tem = Foverlay_get (overlay, Qmouse_face), - !NILP (tem))) - break; - - SAFE_FREE (); - return i < n; + return false; } /* Return the value of the 'display-line-numbers-disable' property at EOB, if there's an overlay at ZV with a non-nil value of that property. */ -Lisp_Object +bool disable_line_numbers_overlay_at_eob (void) { - ptrdiff_t n, i, size; - Lisp_Object *v, tem = Qnil; - Lisp_Object vbuf[10]; - USE_SAFE_ALLOCA; + Lisp_Object tem = Qnil; + struct itree_node *node; - size = ARRAYELTS (vbuf); - v = vbuf; - n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL); - if (n > size) + ITREE_FOREACH (node, current_buffer->overlays, ZV, ZV, ASCENDING) { - SAFE_NALLOCA (v, 1, n); - overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL); + if ((tem = Foverlay_get (node->data, Qdisplay_line_numbers_disable), + !NILP (tem))) + return true; } - - for (i = 0; i < n; ++i) - if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable), - !NILP (tem))) - break; - - SAFE_FREE (); - return tem; + return false; } diff --git a/src/buffer.h b/src/buffer.h index 9e0982f5da7..87ba2802b39 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1174,8 +1174,6 @@ extern void delete_all_overlays (struct buffer *); extern void reset_buffer (struct buffer *); extern void compact_buffer (struct buffer *); extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *, ptrdiff_t *); -extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **, - ptrdiff_t *, bool, bool, ptrdiff_t *); extern ptrdiff_t previous_overlay_change (ptrdiff_t); extern ptrdiff_t next_overlay_change (ptrdiff_t); extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *); diff --git a/src/editfns.c b/src/editfns.c index 0cecd81c07f..cce52cddbf8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -272,24 +272,6 @@ If you set the marker not to point anywhere, the buffer will have no mark. */) } -/* Find all the overlays in the current buffer that touch position POS. - Return the number found, and store them in a vector in VEC - of length LEN. - - Note: this can return overlays that do not touch POS. The caller - should filter these out. */ - -static ptrdiff_t -overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len) -{ - /* Find all potentially rear-advance overlays at (POS - 1). Find - all overlays at POS, so end at (POS + 1). Find even empty - overlays, which due to the way 'overlays-in' works implies that - we might also fetch empty overlays starting at (POS + 1). */ - return overlays_in (pos - 1, pos + 1, false, &vec, &len, - true, false, NULL); -} - DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0, doc: /* Return the value of POSITION's property PROP, in OBJECT. Almost identical to `get-char-property' except for the following difference: @@ -315,53 +297,41 @@ at POSITION. */) else { EMACS_INT posn = XFIXNUM (position); - ptrdiff_t noverlays; - Lisp_Object *overlay_vec, tem; + Lisp_Object tem; struct buffer *obuf = current_buffer; - USE_SAFE_ALLOCA; + struct itree_node *node; + struct sortvec items[2]; + struct sortvec *result = NULL; + struct buffer *b = XBUFFER (object); + Lisp_Object res = Qnil; - set_buffer_temp (XBUFFER (object)); + set_buffer_temp (b); - /* First try with room for 40 overlays. */ - Lisp_Object overlay_vecbuf[40]; - noverlays = ARRAYELTS (overlay_vecbuf); - overlay_vec = overlay_vecbuf; - noverlays = overlays_around (posn, overlay_vec, noverlays); - - /* If there are more than 40, - make enough space for all, and try again. */ - if (ARRAYELTS (overlay_vecbuf) < noverlays) + ITREE_FOREACH (node, b->overlays, posn - 1, posn + 1, ASCENDING) { - SAFE_ALLOCA_LISP (overlay_vec, noverlays); - noverlays = overlays_around (posn, overlay_vec, noverlays); - } - noverlays = sort_overlays (overlay_vec, noverlays, NULL); + Lisp_Object ol = node->data; + tem = Foverlay_get (ol, prop); + if (NILP (tem) + /* Check the overlay is indeed active at point. */ + || ((node->begin == posn + && OVERLAY_FRONT_ADVANCE_P (ol)) + || (node->end == posn + && ! OVERLAY_REAR_ADVANCE_P (ol)) + || node->begin > posn + || node->end < posn)) + /* The overlay will not cover a char inserted at point. */ + continue; + struct sortvec *this = (result == items ? items + 1 : items); + if (NILP (res) + || (make_sortvec_item (this, node->data), + compare_overlays (result, this) < 0)) + res = tem; + } set_buffer_temp (obuf); - /* Now check the overlays in order of decreasing priority. */ - while (--noverlays >= 0) - { - Lisp_Object ol = overlay_vec[noverlays]; - tem = Foverlay_get (ol, prop); - if (!NILP (tem)) - { - /* Check the overlay is indeed active at point. */ - if ((OVERLAY_START (ol) == posn - && OVERLAY_FRONT_ADVANCE_P (ol)) - || (OVERLAY_END (ol) == posn - && ! OVERLAY_REAR_ADVANCE_P (ol)) - || OVERLAY_START (ol) > posn - || OVERLAY_END (ol) < posn) - ; /* The overlay will not cover a char inserted at point. */ - else - { - SAFE_FREE (); - return tem; - } - } - } - SAFE_FREE (); + if (!NILP (res)) + return res; { /* Now check the text properties. */ int stickiness = text_property_stickiness (prop, position, object); diff --git a/src/lisp.h b/src/lisp.h index 75134425a07..e6fd8cacb1b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4802,7 +4802,7 @@ extern void syms_of_editfns (void); /* Defined in buffer.c. */ extern bool mouse_face_overlay_overlaps (Lisp_Object); -extern Lisp_Object disable_line_numbers_overlay_at_eob (void); +extern bool disable_line_numbers_overlay_at_eob (void); extern AVOID nsberror (Lisp_Object); extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool); extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t); diff --git a/src/xdisp.c b/src/xdisp.c index 750ebb703a6..2dcf0d58a14 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25060,7 +25060,7 @@ should_produce_line_number (struct it *it) because get-char-property always returns nil for ZV, except if the property is in 'default-text-properties'. */ if (NILP (val) && IT_CHARPOS (*it) >= ZV) - val = disable_line_numbers_overlay_at_eob (); + return !disable_line_numbers_overlay_at_eob (); return NILP (val) ? true : false; } From cebd26b2e16d75a939e2a9f91becc6ec702122a7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 5 Feb 2024 23:12:36 -0800 Subject: [PATCH 099/385] Use treesit-node-match-p in treesit-parent-while The previous commit should've done this, but I missed it. * lisp/treesit.el (treesit-parent-while): Use treesit-node-match-p. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index f179204d89c..6a485ae591a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -366,7 +366,7 @@ returns nil. PRED can be a predicate function, a regexp matching node type, and more; see docstring of `treesit-thing-settings'." (let ((last nil)) - (while (and node (funcall pred node)) + (while (and node (treesit-node-match-p node pred)) (setq last node node (treesit-node-parent node))) last)) From 0d2b7120783255fbb0f8e98717573c35425f4df6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 6 Feb 2024 13:10:57 +0800 Subject: [PATCH 100/385] Don't forcibly display dialogs on Android if a keyboard is present * java/org/gnu/emacs/EmacsService.java (detectKeyboard): New function. * lisp/subr.el (use-dialog-box-p): Don't always return t if a keyboard is present on Android. * src/android.c (android_init_emacs_service): Link to new function. (android_detect_keyboard): New function. * src/android.h: Update prototypes. * src/androidfns.c (Fandroid_detect_keyboard) (syms_of_androidfns): New function. --- java/org/gnu/emacs/EmacsService.java | 10 ++++++++++ lisp/subr.el | 6 +++++- src/android.c | 16 ++++++++++++++++ src/android.h | 2 ++ src/androidfns.c | 20 ++++++++++++++++++++ 5 files changed, 53 insertions(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 5cb1ceca0aa..93e34e6e694 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -60,6 +60,7 @@ import android.content.pm.PackageManager; import android.content.res.AssetManager; +import android.content.res.Configuration; import android.hardware.input.InputManager; @@ -581,6 +582,15 @@ invocation of app_process (through android-emacs) can return false; } + public boolean + detectKeyboard () + { + Configuration configuration; + + configuration = getResources ().getConfiguration (); + return configuration.keyboard != Configuration.KEYBOARD_NOKEYS; + } + public String nameKeysym (int keysym) { diff --git a/lisp/subr.el b/lisp/subr.el index 582415a9761..e53ef505522 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3829,13 +3829,17 @@ confusing to some users.") (defvar from--tty-menu-p nil "Non-nil means the current command was invoked from a TTY menu.") + +(declare-function android-detect-keyboard "androidfns.c") + (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." (and last-input-event ; not during startup (or (consp last-nonmenu-event) ; invoked by a mouse event (and (null last-nonmenu-event) (consp last-input-event)) - (featurep 'android) ; Prefer dialog boxes on Android. + (and (featurep 'android) ; Prefer dialog boxes on Android. + (not (android-detect-keyboard))) ; If no keyboard is connected. from--tty-menu-p) ; invoked via TTY menu use-dialog-box)) diff --git a/src/android.c b/src/android.c index 4a74f5b2af4..2c0e4f845f4 100644 --- a/src/android.c +++ b/src/android.c @@ -1593,6 +1593,7 @@ android_init_emacs_service (void) FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I"); FIND_METHOD (get_screen_height, "getScreenHeight", "(Z)I"); FIND_METHOD (detect_mouse, "detectMouse", "()Z"); + FIND_METHOD (detect_keyboard, "detectKeyboard", "()Z"); FIND_METHOD (name_keysym, "nameKeysym", "(I)Ljava/lang/String;"); FIND_METHOD (browse_url, "browseUrl", "(Ljava/lang/String;Z)" "Ljava/lang/String;"); @@ -5626,6 +5627,21 @@ android_detect_mouse (void) return rc; } +bool +android_detect_keyboard (void) +{ + bool rc; + jmethodID method; + + method = service_class.detect_keyboard; + rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env, + emacs_service, + service_class.class, + method); + android_exception_check (); + return rc; +} + void android_set_dont_focus_on_map (android_window handle, bool no_focus_on_map) diff --git a/src/android.h b/src/android.h index 2f5f32037c5..bd19c4d9ac8 100644 --- a/src/android.h +++ b/src/android.h @@ -103,6 +103,7 @@ extern int android_get_screen_height (void); extern int android_get_mm_width (void); extern int android_get_mm_height (void); extern bool android_detect_mouse (void); +extern bool android_detect_keyboard (void); extern void android_set_dont_focus_on_map (android_window, bool); extern void android_set_dont_accept_focus (android_window, bool); @@ -265,6 +266,7 @@ struct android_emacs_service jmethodID get_screen_width; jmethodID get_screen_height; jmethodID detect_mouse; + jmethodID detect_keyboard; jmethodID name_keysym; jmethodID browse_url; jmethodID restart_emacs; diff --git a/src/androidfns.c b/src/androidfns.c index eaecb78338b..48c3f3046d6 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2476,6 +2476,25 @@ there is no mouse. */) #endif } +DEFUN ("android-detect-keyboard", Fandroid_detect_keyboard, + Sandroid_detect_keyboard, 0, 0, 0, + doc: /* Return whether a keyboard is connected. +Return non-nil if a key is connected to this computer, or nil +if there is no keyboard. */) + (void) +{ +#ifndef ANDROID_STUBIFY + /* If no display connection is present, just return nil. */ + + if (!android_init_gui) + return Qnil; + + return android_detect_keyboard () ? Qt : Qnil; +#else /* ANDROID_STUBIFY */ + return Qt; +#endif /* ANDROID_STUBIFY */ +} + DEFUN ("android-toggle-on-screen-keyboard", Fandroid_toggle_on_screen_keyboard, Sandroid_toggle_on_screen_keyboard, 2, 2, 0, @@ -3560,6 +3579,7 @@ language to be US English if LANGUAGE is empty. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sandroid_detect_mouse); + defsubr (&Sandroid_detect_keyboard); defsubr (&Sandroid_toggle_on_screen_keyboard); defsubr (&Sx_server_vendor); defsubr (&Sx_server_version); From 42db7292c3e05920bc9f2fa5c3478eb2ba835c5c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 6 Feb 2024 17:52:33 +0800 Subject: [PATCH 101/385] Implement Lisp threading on Android Much like the NS port, only the main thread receives input from the user interface, which is fortunately not a major problem for packages such as lsp-mode that create Lisp threads. * configure.ac: Enable with_threads under Android. * src/android.c (android_init_events): Set `main_thread_id' to the ID of the main thread. (setEmacsParams): Set new global variable `android_jvm' to the JVM object, for the purpose of attaching Lisp threads to the JVM. (android_select): [THREADS_ENABLED]: If the caller isn't the main thread, resort to pselect. Don't check query before select returns. (android_check_query): Export. * src/android.h (_ANDROID_H_): Define new macro and update prototypes. * src/process.c (android_select_wrapper): New function. (wait_reading_process_output): If THREADS_ENABLED, call thread_select through the Android select wrapper. * src/thread.c (post_acquire_global_lock): Call android_check_query; replace android_java_env with the incoming Lisp thread's. (run_thread): Attach and detach the thread created to the JVM. (init_threads): Set the main thread's JNI environment object. * src/thread.h (struct thread_state) : New field. --- configure.ac | 3 ++- src/android.c | 34 ++++++++++++++++++++++++++++------ src/android.h | 7 +++++++ src/process.c | 33 ++++++++++++++++++++++++++++++--- src/thread.c | 39 +++++++++++++++++++++++++++++++++++++++ src/thread.h | 11 +++++++++++ 6 files changed, 117 insertions(+), 10 deletions(-) diff --git a/configure.ac b/configure.ac index fa8b04ec685..901980c4d8e 100644 --- a/configure.ac +++ b/configure.ac @@ -1231,6 +1231,7 @@ package will likely install on older systems but crash on startup.]) passthrough="$passthrough --with-mailutils=$with_mailutils" passthrough="$passthrough --with-pop=$with_pop" passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" + passthrough="$passthrough --with-threads=$with_png" # Now pass through some checking options. emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" @@ -1321,6 +1322,7 @@ if test "$ANDROID" = "yes"; then with_pop=no with_harfbuzz=no with_native_compilation=no + with_threads=no fi with_rsvg=no @@ -1331,7 +1333,6 @@ if test "$ANDROID" = "yes"; then with_gpm=no with_dbus=no with_gsettings=no - with_threads=no with_ns=no # zlib is available in android. diff --git a/src/android.c b/src/android.c index 2c0e4f845f4..46f4dcd5546 100644 --- a/src/android.c +++ b/src/android.c @@ -40,6 +40,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include /* Old NDK versions lack MIN and MAX. */ #include @@ -152,6 +153,13 @@ static char *android_files_dir; /* The Java environment being used for the main thread. */ JNIEnv *android_java_env; +#ifdef THREADS_ENABLED + +/* The Java VM new threads attach to. */ +JavaVM *android_jvm; + +#endif /* THREADS_ENABLED */ + /* The EmacsGC class. */ static jclass emacs_gc_class; @@ -496,6 +504,9 @@ android_handle_sigusr1 (int sig, siginfo_t *siginfo, void *arg) This should ideally be defined further down. */ static sem_t android_query_sem; +/* ID of the Emacs thread. */ +static pthread_t main_thread_id; + /* Set up the global event queue by initializing the mutex and two condition variables, and the linked list of events. This must be called before starting the Emacs thread. Also, initialize the @@ -531,6 +542,8 @@ android_init_events (void) event_queue.events.next = &event_queue.events; event_queue.events.last = &event_queue.events; + main_thread_id = pthread_self (); + #if __ANDROID_API__ >= 16 /* Before starting the select thread, make sure the disposition for @@ -579,10 +592,6 @@ android_pending (void) return i; } -/* Forward declaration. */ - -static void android_check_query (void); - /* Wait for events to become available synchronously. Return once an event arrives. Also, reply to the UI thread whenever it requires a response. */ @@ -732,6 +741,12 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, static char byte; #endif +#ifdef THREADS_ENABLED + if (!pthread_equal (pthread_self (), main_thread_id)) + return pselect (nfds, readfds, writefds, exceptfds, timeout, + NULL); +#endif /* THREADS_ENABLED */ + /* Since Emacs is reading keyboard input again, signify that queries from input methods are no longer ``urgent''. */ @@ -837,9 +852,11 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, if (nfds_return < 0) errno = EINTR; +#ifndef THREADS_ENABLED /* Now check for and run anything the UI thread wants to run in the main thread. */ android_check_query (); +#endif /* THREADS_ENABLED */ return nfds_return; } @@ -1315,12 +1332,17 @@ NATIVE_NAME (setEmacsParams) (JNIEnv *env, jobject object, const char *java_string; struct stat statb; +#ifdef THREADS_ENABLED + /* Save the Java VM. */ + if ((*env)->GetJavaVM (env, &android_jvm)) + emacs_abort (); +#endif /* THREADS_ENABLED */ + /* Set the Android API level early, as it is used by `android_vfs_init'. */ android_api_level = api_level; /* This function should only be called from the main thread. */ - android_pixel_density_x = pixel_density_x; android_pixel_density_y = pixel_density_y; android_scaled_pixel_density = scaled_density; @@ -6717,7 +6739,7 @@ static void *android_query_context; /* Run any function that the UI thread has asked to run, and then signal its completion. */ -static void +void android_check_query (void) { void (*proc) (void *); diff --git a/src/android.h b/src/android.h index bd19c4d9ac8..e1834cebf68 100644 --- a/src/android.h +++ b/src/android.h @@ -24,6 +24,8 @@ along with GNU Emacs. If not, see . */ a table of function pointers. */ #ifndef _ANDROID_H_ +#define _ANDROID_H_ + #ifndef ANDROID_STUBIFY #include #include @@ -226,6 +228,7 @@ extern void android_display_toast (const char *); /* Event loop functions. */ +extern void android_check_query (void); extern void android_check_query_urgent (void); extern int android_run_in_emacs_thread (void (*) (void *), void *); extern void android_write_event (union android_event *); @@ -299,6 +302,10 @@ struct android_emacs_service extern JNIEnv *android_java_env; +#ifdef THREADS_ENABLED +extern JavaVM *android_jvm; +#endif /* THREADS_ENABLED */ + /* The EmacsService object. */ extern jobject emacs_service; diff --git a/src/process.c b/src/process.c index ddab9ed6c01..48a2c0c8e53 100644 --- a/src/process.c +++ b/src/process.c @@ -5209,6 +5209,27 @@ wait_reading_process_output_1 (void) { } +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY \ + && defined THREADS_ENABLED + +/* Wrapper around `android_select' that exposes a calling interface with + an extra argument for compatibility with `thread_pselect'. */ + +static int +android_select_wrapper (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, const struct timespec *timeout, + const sigset_t *sigmask) +{ + /* sigmask is not supported. */ + if (sigmask) + emacs_abort (); + + return android_select (nfds, readfds, writefds, exceptfds, + (struct timespec *) timeout); +} + +#endif /* HAVE_ANDROID && !ANDROID_STUBIFY && THREADS_ENABLED */ + /* Read and dispose of subprocess output while waiting for timeout to elapse and/or keyboard input to be available. @@ -5701,13 +5722,19 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timeout = short_timeout; #endif - /* Android doesn't support threads and requires using a - replacement for pselect in android.c to poll for - events. */ + /* Android requires using a replacement for pselect in + android.c to poll for events. */ #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY +#ifndef THREADS_ENABLED nfds = android_select (max_desc + 1, &Available, (check_write ? &Writeok : 0), NULL, &timeout); +#else /* THREADS_ENABLED */ + nfds = thread_select (android_select_wrapper, + max_desc + 1, + &Available, (check_write ? &Writeok : 0), + NULL, &timeout, NULL); +#endif /* THREADS_ENABLED */ #else /* Non-macOS HAVE_GLIB builds call thread_select in diff --git a/src/thread.c b/src/thread.c index 040ca39511e..2f5d7a08838 100644 --- a/src/thread.c +++ b/src/thread.c @@ -106,6 +106,12 @@ post_acquire_global_lock (struct thread_state *self) { struct thread_state *prev_thread = current_thread; + /* Switch the JNI interface pointer to the environment assigned to the + current thread. */ +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + android_java_env = self->java_env; +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + /* Do this early on, so that code below could signal errors (e.g., unbind_for_thread_switch might) correctly, because we are already running in the context of the thread pointed by SELF. */ @@ -126,6 +132,12 @@ post_acquire_global_lock (struct thread_state *self) set_buffer_internal_2 (current_buffer); } +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* This step is performed in android_select when built without + threads. */ + android_check_query (); +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + /* We could have been signaled while waiting to grab the global lock for the first time since this thread was created, in which case we didn't yet have the opportunity to set up the handlers. Delay @@ -756,6 +768,11 @@ run_thread (void *state) struct thread_state *self = state; struct thread_state **iter; +#ifdef THREADS_ENABLED +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + jint rc; +#endif /* #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ +#endif /* THREADS_ENABLED */ #ifdef HAVE_NS /* Allocate an autorelease pool in case this thread calls any @@ -766,6 +783,16 @@ run_thread (void *state) void *pool = ns_alloc_autorelease_pool (); #endif +#ifdef THREADS_ENABLED +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + rc + = (*android_jvm)->AttachCurrentThread (android_jvm, &self->java_env, + NULL); + if (rc != JNI_OK) + emacs_abort (); +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ +#endif /* THREADS_ENABLED */ + self->m_stack_bottom = self->stack_top = &stack_pos.c; self->thread_id = sys_thread_self (); @@ -812,6 +839,14 @@ run_thread (void *state) ns_release_autorelease_pool (pool); #endif +#ifdef THREADS_ENABLED +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + rc = (*android_jvm)->DetachCurrentThread (android_jvm); + if (rc != JNI_OK) + emacs_abort (); +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ +#endif /* THREADS_ENABLED */ + /* Unlink this thread from the list of all threads. Note that we have to do this very late, after broadcasting our death. Otherwise the GC may decide to reap the thread_state object, @@ -1131,6 +1166,10 @@ init_threads (void) sys_mutex_init (&global_lock); sys_mutex_lock (&global_lock); current_thread = &main_thread.s; +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + current_thread->java_env = android_java_env; +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + main_thread.s.thread_id = sys_thread_self (); init_bc_thread (&main_thread.s.bc); } diff --git a/src/thread.h b/src/thread.h index 6ce2b7f30df..1844cf03967 100644 --- a/src/thread.h +++ b/src/thread.h @@ -30,6 +30,12 @@ along with GNU Emacs. If not, see . */ #include /* sigset_t */ #endif +#ifdef HAVE_ANDROID +#ifndef ANDROID_STUBIFY +#include "android.h" +#endif /* ANDROID_STUBIFY */ +#endif /* HAVE_ANDROID */ + #include "sysselect.h" /* FIXME */ #include "systhread.h" @@ -84,6 +90,11 @@ struct thread_state Lisp_Object event_object; /* event_object must be the last Lisp field. */ +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* Pointer to an object to call Java functions through. */ + JNIEnv *java_env; +#endif /* HAVE_ANDROID && !ANDROID_STUBIFY */ + /* An address near the bottom of the stack. Tells GC how to save a copy of the stack. */ char const *m_stack_bottom; From f6225d125c07bbde8c828b40eb6e81333e051c2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 6 Feb 2024 12:39:11 +0100 Subject: [PATCH 102/385] Optionally show internal buffers in Buffer Menu mode Internal buffers were never shown before but they can be of interest to Elisp developers, especially since there is no general mechanism to remove unused buffers. * lisp/buff-menu.el (Buffer-menu-show-internal) (Buffer-menu--selection-message, Buffer-menu-toggle-internal): New. (Buffer-menu-mode-map): Bind to `I`. (Buffer-menu-mode-menu): Add menu entry. (list-buffers--refresh): Extend filtering logic. * etc/NEWS: Announce. --- etc/NEWS | 6 ++++++ lisp/buff-menu.el | 33 +++++++++++++++++++++++++++++---- 2 files changed, 35 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5180c26aa92..f980d612a57 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1303,6 +1303,12 @@ will return the URL for that bug. This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. +--- +*** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. +This command toggles the display of internal buffers in Buffer Menu mode; +that is, buffers not visiting a file and whose names start with a space. +Previously, such buffers were never shown. + ** Customize +++ diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 5796544c534..9561141f0c3 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -100,6 +100,10 @@ as it is by default." This is set by the prefix argument to `buffer-menu' and related commands.") +(defvar-local Buffer-menu-show-internal nil + "Non-nil if the current Buffer Menu lists internal buffers. +Internal buffers are those whose names start with a space.") + (defvar-local Buffer-menu-filter-predicate nil "Function to filter out buffers in the buffer list. Buffers that don't satisfy the predicate will be skipped. @@ -140,6 +144,7 @@ then the buffer will be displayed in the buffer list.") "V" #'Buffer-menu-view "O" #'Buffer-menu-view-other-window "T" #'Buffer-menu-toggle-files-only + "I" #'Buffer-menu-toggle-internal "M-s a C-s" #'Buffer-menu-isearch-buffers "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp "M-s a C-o" #'Buffer-menu-multi-occur @@ -197,6 +202,10 @@ then the buffer will be displayed in the buffer list.") :help "Toggle whether the current buffer-menu displays only file buffers" :style toggle :selected Buffer-menu-files-only] + ["Show Internal Buffers" Buffer-menu-toggle-internal + :help "Toggle whether the current buffer-menu displays internal buffers" + :style toggle + :selected Buffer-menu-show-internal] "---" ["Refresh" revert-buffer :help "Refresh the *Buffer List* buffer contents"] @@ -317,6 +326,11 @@ ARG, show only buffers that are visiting files." (interactive "P") (display-buffer (list-buffers-noselect arg))) +(defun Buffer-menu--selection-message () + (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") + (Buffer-menu-show-internal "Showing all buffers.") + (t "Showing all non-internal buffers.")))) + (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. With a positive ARG, display only file buffers. With zero or @@ -325,9 +339,18 @@ negative ARG, display other buffers as well." (setq Buffer-menu-files-only (cond ((not arg) (not Buffer-menu-files-only)) ((> (prefix-numeric-value arg) 0) t))) - (message (if Buffer-menu-files-only - "Showing only file-visiting buffers." - "Showing all non-internal buffers.")) + (Buffer-menu--selection-message) + (revert-buffer)) + +(defun Buffer-menu-toggle-internal (arg) + "Toggle whether the current `buffer-menu' displays internal buffers. +With a positive ARG, display non-internal buffers only. With zero or +negative ARG, display internal buffers as well." + (interactive "P" Buffer-menu-mode) + (setq Buffer-menu-show-internal + (cond ((not arg) (not Buffer-menu-show-internal)) + ((> (prefix-numeric-value arg) 0) t))) + (Buffer-menu--selection-message) (revert-buffer)) (define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort @@ -667,6 +690,7 @@ See more at `Buffer-menu-filter-predicate'." (marked-buffers (Buffer-menu-marked-buffers)) (buffer-menu-buffer (current-buffer)) (show-non-file (not Buffer-menu-files-only)) + (show-internal Buffer-menu-show-internal) (filter-predicate (and (functionp Buffer-menu-filter-predicate) Buffer-menu-filter-predicate)) entries name-width) @@ -686,7 +710,8 @@ See more at `Buffer-menu-filter-predicate'." (file buffer-file-name)) (when (and (buffer-live-p buffer) (or buffer-list - (and (or (not (string= (substring name 0 1) " ")) + (and (or show-internal + (not (string= (substring name 0 1) " ")) file) (not (eq buffer buffer-menu-buffer)) (or file show-non-file) From e66870400d45e3d08265df9f6acd4631a5712139 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 15 Jan 2024 09:25:02 +0100 Subject: [PATCH 103/385] Change hash range reduction from remainder to multiplication This makes both lookups and rehashing cheaper. The index vector size is now always a power of 2. The first table size is reduced to 6 (from 8), because index vectors would become excessively big otherwise. * src/lisp.h (struct Lisp_Hash_Table): Replace index_size with index_bits. All references adapted. (hash_table_index_size): New accessor; use it where applicable. * src/fns.c (hash_index_size): Replace with... (compute_hash_index_bits): ...this new function, returning the log2 of the index size. All callers adapted. (hash_index_index): Knuth multiplicative hashing instead of remainder. (maybe_resize_hash_table): Reduce first table size from 8 to 6. --- src/alloc.c | 7 +++-- src/fns.c | 76 +++++++++++++++++++++++++-------------------------- src/lisp.h | 13 +++++++-- src/pdumper.c | 2 +- 4 files changed, 53 insertions(+), 45 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 15bb65cf74f..6abe9e28650 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3443,7 +3443,7 @@ cleanup_vector (struct Lisp_Vector *vector) struct Lisp_Hash_Table *h = PSEUDOVEC_STRUCT (vector, Lisp_Hash_Table); if (h->table_size > 0) { - eassert (h->index_size > 1); + eassert (h->index_bits > 0); xfree (h->index); xfree (h->key_and_value); xfree (h->next); @@ -3451,7 +3451,7 @@ cleanup_vector (struct Lisp_Vector *vector) ptrdiff_t bytes = (h->table_size * (2 * sizeof *h->key_and_value + sizeof *h->hash + sizeof *h->next) - + h->index_size * sizeof *h->index); + + hash_table_index_size (h) * sizeof *h->index); hash_table_allocated_bytes -= bytes; } } @@ -5959,7 +5959,8 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) for (ptrdiff_t i = 0; i < nvalues; i++) pure->key_and_value[i] = purecopy (table->key_and_value[i]); - ptrdiff_t index_bytes = table->index_size * sizeof *table->index; + ptrdiff_t index_bytes = hash_table_index_size (table) + * sizeof *table->index; pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); memcpy (pure->index, table->index, index_bytes); } diff --git a/src/fns.c b/src/fns.c index 08908d481a3..7de2616b359 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4291,7 +4291,7 @@ set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val) static void set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val) { - eassert (idx >= 0 && idx < h->index_size); + eassert (idx >= 0 && idx < hash_table_index_size (h)); h->index[idx] = val; } @@ -4392,7 +4392,7 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx) static ptrdiff_t HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) { - eassert (idx >= 0 && idx < h->index_size); + eassert (idx >= 0 && idx < hash_table_index_size (h)); return h->index[idx]; } @@ -4527,26 +4527,19 @@ allocate_hash_table (void) return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE); } -/* Compute the size of the index from the table capacity. */ -static ptrdiff_t -hash_index_size (ptrdiff_t size) +/* Compute the size of the index (as log2) from the table capacity. */ +static int +compute_hash_index_bits (hash_idx_t size) { - /* An upper bound on the size of a hash table index. It must fit in - ptrdiff_t and be a valid Emacs fixnum. */ - ptrdiff_t upper_bound = min (MOST_POSITIVE_FIXNUM, - min (TYPE_MAXIMUM (hash_idx_t), - PTRDIFF_MAX / sizeof (ptrdiff_t))); - /* Single-element index vectors are used iff size=0. */ - eassert (size > 0); - ptrdiff_t lower_bound = 2; - ptrdiff_t index_size = size + max (size >> 2, 1); /* 1.25x larger */ - if (index_size < upper_bound) - index_size = (index_size < lower_bound - ? lower_bound - : next_almost_prime (index_size)); - if (index_size > upper_bound) + /* An upper bound on the size of a hash table index index. */ + hash_idx_t upper_bound = min (MOST_POSITIVE_FIXNUM, + min (TYPE_MAXIMUM (hash_idx_t), + PTRDIFF_MAX / sizeof (hash_idx_t))); + /* Use next higher power of 2. This works even for size=0. */ + int bits = elogb (size) + 1; + if (bits >= TYPE_WIDTH (uintmax_t) || ((uintmax_t)1 << bits) > upper_bound) error ("Hash table too large"); - return index_size; + return bits; } /* Constant hash index vector used when the table size is zero. @@ -4587,7 +4580,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->key_and_value = NULL; h->hash = NULL; h->next = NULL; - h->index_size = 1; + h->index_bits = 0; h->index = (hash_idx_t *)empty_hash_index_vector; h->next_free = -1; } @@ -4605,8 +4598,9 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->next[i] = i + 1; h->next[size - 1] = -1; - int index_size = hash_index_size (size); - h->index_size = index_size; + int index_bits = compute_hash_index_bits (size); + h->index_bits = index_bits; + ptrdiff_t index_size = hash_table_index_size (h); h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; @@ -4654,7 +4648,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2->next = hash_table_alloc_bytes (next_bytes); memcpy (h2->next, h1->next, next_bytes); - ptrdiff_t index_bytes = h1->index_size * sizeof *h1->index; + ptrdiff_t index_bytes = hash_table_index_size (h1) * sizeof *h1->index; h2->index = hash_table_alloc_bytes (index_bytes); memcpy (h2->index, h1->index, index_bytes); } @@ -4668,8 +4662,11 @@ copy_hash_table (struct Lisp_Hash_Table *h1) static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { - eassert (h->index_size > 0); - return hash % h->index_size; + /* Knuth multiplicative hashing, tailored for 32-bit indices + (avoiding a 64-bit multiply). */ + uint32_t alpha = 2654435769; /* 2**32/phi */ + /* Note the cast to uint64_t, to make it work for index_bits=0. */ + return (uint64_t)((uint32_t)hash * alpha) >> (32 - h->index_bits); } /* Resize hash table H if it's too full. If H cannot be resized @@ -4681,7 +4678,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (h->next_free < 0) { ptrdiff_t old_size = HASH_TABLE_SIZE (h); - ptrdiff_t min_size = 8; + ptrdiff_t min_size = 6; ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2); /* Grow aggressively at small sizes, then just double. */ ptrdiff_t new_size = @@ -4706,13 +4703,14 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) hash_hash_t *hash = hash_table_alloc_bytes (new_size * sizeof *hash); memcpy (hash, h->hash, old_size * sizeof *hash); - ptrdiff_t old_index_size = h->index_size; - ptrdiff_t index_size = hash_index_size (new_size); + ptrdiff_t old_index_size = hash_table_index_size (h); + ptrdiff_t index_bits = compute_hash_index_bits (new_size); + ptrdiff_t index_size = (ptrdiff_t)1 << index_bits; hash_idx_t *index = hash_table_alloc_bytes (index_size * sizeof *index); for (ptrdiff_t i = 0; i < index_size; i++) index[i] = -1; - h->index_size = index_size; + h->index_bits = index_bits; h->table_size = new_size; h->next_free = old_size; @@ -4778,18 +4776,19 @@ hash_table_thaw (Lisp_Object hash_table) h->key_and_value = NULL; h->hash = NULL; h->next = NULL; - h->index_size = 1; + h->index_bits = 0; h->index = (hash_idx_t *)empty_hash_index_vector; } else { - ptrdiff_t index_size = hash_index_size (size); - h->index_size = index_size; + ptrdiff_t index_bits = compute_hash_index_bits (size); + h->index_bits = index_bits; h->hash = hash_table_alloc_bytes (size * sizeof *h->hash); h->next = hash_table_alloc_bytes (size * sizeof *h->next); + ptrdiff_t index_size = hash_table_index_size (h); h->index = hash_table_alloc_bytes (index_size * sizeof *h->index); for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; @@ -4937,7 +4936,8 @@ hash_clear (struct Lisp_Hash_Table *h) set_hash_value_slot (h, i, Qnil); } - for (ptrdiff_t i = 0; i < h->index_size; i++) + ptrdiff_t index_size = hash_table_index_size (h); + for (ptrdiff_t i = 0; i < index_size; i++) h->index[i] = -1; h->next_free = 0; @@ -4976,7 +4976,7 @@ keep_entry_p (hash_table_weakness_t weakness, bool sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) { - ptrdiff_t n = h->index_size; + ptrdiff_t n = hash_table_index_size (h); bool marked = false; for (ptrdiff_t bucket = 0; bucket < n; ++bucket) @@ -5701,7 +5701,7 @@ DEFUN ("internal--hash-table-histogram", struct Lisp_Hash_Table *h = check_hash_table (hash_table); ptrdiff_t size = HASH_TABLE_SIZE (h); ptrdiff_t *freq = xzalloc (size * sizeof *freq); - ptrdiff_t index_size = h->index_size; + ptrdiff_t index_size = hash_table_index_size (h); for (ptrdiff_t i = 0; i < index_size; i++) { ptrdiff_t n = 0; @@ -5729,7 +5729,7 @@ Internal use only. */) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); Lisp_Object ret = Qnil; - ptrdiff_t index_size = h->index_size; + ptrdiff_t index_size = hash_table_index_size (h); for (ptrdiff_t i = 0; i < index_size; i++) { Lisp_Object bucket = Qnil; @@ -5750,7 +5750,7 @@ DEFUN ("internal--hash-table-index-size", (Lisp_Object hash_table) { struct Lisp_Hash_Table *h = check_hash_table (hash_table); - return make_int (h->index_size); + return make_int (hash_table_index_size (h)); } diff --git a/src/lisp.h b/src/lisp.h index e6fd8cacb1b..d6bbf15d83b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2475,14 +2475,14 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - hash_idx_t index_size; /* Size of the index vector. */ + int index_bits; /* log2 (size of the index vector). */ hash_idx_t table_size; /* Size of the next and hash vectors. */ /* Bucket vector. An entry of -1 indicates no item is present, and a nonnegative entry is the index of the first item in a collision chain. - This vector is index_size entries long. - If index_size is 1 (and table_size is 0), then this is the + This vector is 2**index_bits entries long. + If index_bits is 0 (and table_size is 0), then this is the constant read-only vector {-1}, shared between all instances. Otherwise it is heap-allocated. */ hash_idx_t *index; @@ -2597,6 +2597,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return h->table_size; } +/* Size of the index vector in hash table H. */ +INLINE ptrdiff_t +hash_table_index_size (const struct Lisp_Hash_Table *h) +{ + return (ptrdiff_t)1 << h->index_bits; +} + /* Hash value for KEY in hash table H. */ INLINE hash_hash_t hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key) diff --git a/src/pdumper.c b/src/pdumper.c index ee554cda55a..b8006b035ea 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2688,7 +2688,7 @@ hash_table_freeze (struct Lisp_Hash_Table *h) h->hash = NULL; h->index = NULL; h->table_size = 0; - h->index_size = 0; + h->index_bits = 0; h->frozen_test = hash_table_std_test (h->test); h->test = NULL; } From 05e3183ede3a08993a7d209fb14153abaed0c74e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 6 Feb 2024 15:23:53 +0100 Subject: [PATCH 104/385] Rearrange and pack hash table fields to reduce space * src/lisp.h (struct Lisp_Hash_Table): Move and reduce width of fields where possible; this saves an entire word at no apparent cost. --- src/lisp.h | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index d6bbf15d83b..5326824bf38 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2475,9 +2475,6 @@ struct Lisp_Hash_Table The table is physically split into three vectors (hash, next, key_and_value) which may or may not be beneficial. */ - int index_bits; /* log2 (size of the index vector). */ - hash_idx_t table_size; /* Size of the next and hash vectors. */ - /* Bucket vector. An entry of -1 indicates no item is present, and a nonnegative entry is the index of the first item in a collision chain. @@ -2514,20 +2511,24 @@ struct Lisp_Hash_Table /* Index of first free entry in free list, or -1 if none. */ hash_idx_t next_free; + hash_idx_t table_size; /* Size of the next and hash vectors. */ + + unsigned char index_bits; /* log2 (size of the index vector). */ + /* Weakness of the table. */ - hash_table_weakness_t weakness : 8; + hash_table_weakness_t weakness : 3; /* Hash table test (only used when frozen in dump) */ - hash_table_std_test_t frozen_test : 8; + hash_table_std_test_t frozen_test : 2; /* True if the table can be purecopied. The table cannot be changed afterwards. */ - bool purecopy; + bool_bf purecopy : 1; /* True if the table is mutable. Ordinarily tables are mutable, but pure tables are not, and while a table is being mutated it is immutable for recursive attempts to mutate it. */ - bool mutable; + bool_bf mutable : 1; /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. Used only during garbage From ce7365b591852dd5556e0a4bf6a0ba63a8733802 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Feb 2024 19:55:41 +0200 Subject: [PATCH 105/385] Use new variable Buffer-menu-show-internal in project-list-buffers. * lisp/progmodes/project.el (project-list-buffers): Add the new variable `Buffer-menu-show-internal' used to toggle internal buffers (bug#68949). --- lisp/progmodes/project.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da782ad5537..983c0ed2ac2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1515,7 +1515,8 @@ ARG, show only buffers that are visiting files." (lambda (buffer) (let ((name (buffer-name buffer)) (file (buffer-file-name buffer))) - (and (or (not (string= (substring name 0 1) " ")) + (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))))) @@ -1525,6 +1526,7 @@ ARG, show only buffers that are visiting files." (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)))))) (with-current-buffer buf From a2201a2034a86b4cc90132ab2d920456866c11e3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Feb 2024 13:21:22 -0500 Subject: [PATCH 106/385] (loaddefs-generate--parse-file): Be a bit more defensive * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Don't fail in case of an error while generating the prefixes. (loaddefs-generate--compute-prefixes): Don't burp when `read-from-string` returns something else than a symbol. --- lisp/emacs-lisp/loaddefs-gen.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 7eced43e735..7cfb14ace5f 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -489,10 +489,12 @@ don't include." (when (and autoload-compute-prefixes compute-prefixes) - (when-let ((form (loaddefs-generate--compute-prefixes load-name))) - ;; This output needs to always go in the main loaddefs.el, - ;; regardless of `generated-autoload-file'. - (push (list main-outfile file form) defs))))) + (with-demoted-errors "%S" + (when-let + ((form (loaddefs-generate--compute-prefixes load-name))) + ;; This output needs to always go in the main loaddefs.el, + ;; regardless of `generated-autoload-file'. + (push (list main-outfile file form) defs)))))) defs)) (defun loaddefs-generate--compute-prefixes (load-name) @@ -506,14 +508,15 @@ don't include." ;; Consider `read-symbol-shorthands'. (probe (let ((obarray (obarray-make))) (car (read-from-string name))))) - (setq name (symbol-name probe)) - (when (save-excursion - (goto-char (match-beginning 0)) - (or (bobp) - (progn - (forward-line -1) - (not (looking-at ";;;###autoload"))))) - (push name prefs))))) + (when (symbolp name) + (setq name (symbol-name probe)) + (when (save-excursion + (goto-char (match-beginning 0)) + (or (bobp) + (progn + (forward-line -1) + (not (looking-at ";;;###autoload"))))) + (push name prefs)))))) (loaddefs-generate--make-prefixes prefs load-name))) (defun loaddefs-generate--rubric (file &optional type feature compile) From ab318cce1e97f4b9c78adc3290784105b78f0728 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 6 Feb 2024 21:55:57 +0200 Subject: [PATCH 107/385] ; Fix last change in buffer-menu.el * etc/NEWS: Elaborate about the binding of the new command. * lisp/buff-menu.el (Buffer-menu--selection-message): Fix wording of new message. (Buffer-menu-toggle-internal): Doc fix. (Bug#68949) --- etc/NEWS | 3 ++- lisp/buff-menu.el | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index f980d612a57..ee7462cb2aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1307,7 +1307,8 @@ chat buffers use by default. *** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. -Previously, such buffers were never shown. +Previously, such buffers were never shown. This command is bound to 'I' +in Buffer menu mode. ** Customize diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 9561141f0c3..29ca3b41f0c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Showing all non-internal buffers.")))) + (t "Hiding internal buffers.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. @@ -344,7 +344,7 @@ negative ARG, display other buffers as well." (defun Buffer-menu-toggle-internal (arg) "Toggle whether the current `buffer-menu' displays internal buffers. -With a positive ARG, display non-internal buffers only. With zero or +With a positive ARG, don't show internal buffers. With zero or negative ARG, display internal buffers as well." (interactive "P" Buffer-menu-mode) (setq Buffer-menu-show-internal From 77f240012f1e9a7cfee60adedebc8e6a230ce49b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Feb 2024 15:36:18 -0500 Subject: [PATCH 108/385] (loaddefs-generate--compute-prefixes): Fix thinko in last change * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): Fix thinko in last change. Also, reduce memory allocation. --- lisp/emacs-lisp/loaddefs-gen.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 7cfb14ace5f..1e91e84157d 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -499,16 +499,17 @@ don't include." (defun loaddefs-generate--compute-prefixes (load-name) (goto-char (point-min)) - (let ((prefs nil)) + (let ((prefs nil) + (temp-obarray (obarray-make))) ;; Avoid (defvar ) by requiring a trailing space. (while (re-search-forward "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) (let* ((name (match-string-no-properties 2)) ;; Consider `read-symbol-shorthands'. - (probe (let ((obarray (obarray-make))) + (probe (let ((obarray temp-obarray)) (car (read-from-string name))))) - (when (symbolp name) + (when (symbolp probe) (setq name (symbol-name probe)) (when (save-excursion (goto-char (match-beginning 0)) From e25d11314d84cc3e606515d6551e878cec4cfee4 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Tue, 30 Jan 2024 22:08:50 -0800 Subject: [PATCH 109/385] Pass unquoted filename to user-supplied MUSTMATCH predicate * lisp/minibuffer.el (read-file-name-default): Pass REQUIRE-MATCH argument through substitute-in-file-name. * lisp/minibuffer.el (read-file-name): Update docstring. Resolves bug#68815. --- lisp/minibuffer.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index faa7f543ece..a9e3ec937f9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3262,9 +3262,10 @@ Fourth arg MUSTMATCH can take the following values: input, but she needs to confirm her choice if she called `minibuffer-complete' right before `minibuffer-complete-and-exit' and the input is not an existing file. -- a function, which will be called with the input as the - argument. If the function returns a non-nil value, the - minibuffer is exited with that argument as the value. +- a function, which will be called with a single argument, the + input unquoted by `substitute-in-file-name', which see. If the + function returns a non-nil value, the minibuffer is exited with + that argument as the value. - anything else behaves like t except that typing RET does not exit if it does non-null completion. @@ -3353,7 +3354,13 @@ See `read-file-name' for the meaning of the arguments." (let ((ignore-case read-file-name-completion-ignore-case) (minibuffer-completing-file-name t) (pred (or predicate 'file-exists-p)) - (add-to-history nil)) + (add-to-history nil) + (require-match (if (functionp mustmatch) + (lambda (input) + (funcall mustmatch + ;; User-supplied MUSTMATCH expects an unquoted filename + (substitute-in-file-name input))) + mustmatch))) (let* ((val (if (or (not (next-read-file-uses-dialog-p)) @@ -3389,7 +3396,7 @@ See `read-file-name' for the meaning of the arguments." (read-file-name--defaults dir initial)))) (set-syntax-table minibuffer-local-filename-syntax)) (completing-read prompt 'read-file-name-internal - pred mustmatch insdef + pred require-match insdef 'file-name-history default-filename))) ;; If DEFAULT-FILENAME not supplied and DIR contains ;; a file name, split it. From a45e1237b290a9c04b416703825b105321139608 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 7 Feb 2024 09:24:32 +0800 Subject: [PATCH 110/385] ; Fix typo in configure.ac * configure.ac: Fix typo. Reported by Juri Linkov . --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 901980c4d8e..b74eba879ab 100644 --- a/configure.ac +++ b/configure.ac @@ -1231,7 +1231,7 @@ package will likely install on older systems but crash on startup.]) passthrough="$passthrough --with-mailutils=$with_mailutils" passthrough="$passthrough --with-pop=$with_pop" passthrough="$passthrough --with-harfbuzz=$with_harfbuzz" - passthrough="$passthrough --with-threads=$with_png" + passthrough="$passthrough --with-threads=$with_threads" # Now pass through some checking options. emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type" From c1cdbb987299f6878072fec539bd363e2c3ca015 Mon Sep 17 00:00:00 2001 From: Wilhelm Kirschbaum Date: Fri, 29 Dec 2023 17:09:00 +0200 Subject: [PATCH 111/385] Add access_call fontification to elixir-ts-mode * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Add access_call queries to the elixir-variable feature (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index b493195eedd..2c7323c318d 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -546,7 +546,9 @@ (body (identifier) @font-lock-variable-name-face) (unary_operator operand: (identifier) @font-lock-variable-name-face) (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face)) + (do_block (identifier) @font-lock-variable-name-face) + (access_call target: (identifier) @font-lock-variable-name-face) + (access_call "[" key: (identifier) @font-lock-variable-name-face "]")) :language 'elixir :feature 'elixir-builtin From eb90fb52b08a16ae2bdc8bad6929492b9e693f72 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Feb 2024 03:54:29 +0200 Subject: [PATCH 112/385] elixir-ts-mode: Bring the faces' use closer to other ts modes * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Rename feature 'elixir-function-name' to 'elixir-definition' and update all deferences. Add parameters' highlighting with font-lock-variable-name-face. Change variable references' highlighting to use font-lock-variable-use-face. Move the feature 'elixir-variable' from feature level 3 to level 4, to match other ts modes (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 53 ++++++++++++++++---------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 2c7323c318d..57db211e881 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -360,13 +360,14 @@ (defvar elixir-ts--font-lock-settings (treesit-font-lock-rules :language 'elixir - :feature 'elixir-function-name + :feature 'elixir-definition `((call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments @@ -379,13 +380,15 @@ (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments (binary_operator - left: (call target: (identifier) @font-lock-function-name-face))) + left: (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face)))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (unary_operator @@ -521,8 +524,8 @@ operator: "/" right: (integer))) (call target: (dot right: (identifier) @font-lock-function-call-face)) - (unary_operator operator: "&" @font-lock-variable-name-face - operand: (integer) @font-lock-variable-name-face) + (unary_operator operator: "&" @font-lock-variable-use-face + operand: (integer) @font-lock-variable-use-face) (unary_operator operator: "&" @font-lock-operator-face operand: (list))) @@ -537,18 +540,18 @@ :language 'elixir :feature 'elixir-variable - '((binary_operator left: (identifier) @font-lock-variable-name-face) - (binary_operator right: (identifier) @font-lock-variable-name-face) - (arguments ( (identifier) @font-lock-variable-name-face)) - (tuple (identifier) @font-lock-variable-name-face) - (list (identifier) @font-lock-variable-name-face) - (pair value: (identifier) @font-lock-variable-name-face) - (body (identifier) @font-lock-variable-name-face) - (unary_operator operand: (identifier) @font-lock-variable-name-face) - (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face) - (access_call target: (identifier) @font-lock-variable-name-face) - (access_call "[" key: (identifier) @font-lock-variable-name-face "]")) + '((binary_operator left: (identifier) @font-lock-variable-use-face) + (binary_operator right: (identifier) @font-lock-variable-use-face) + (arguments ( (identifier) @font-lock-variable-use-face)) + (tuple (identifier) @font-lock-variable-use-face) + (list (identifier) @font-lock-variable-use-face) + (pair value: (identifier) @font-lock-variable-use-face) + (body (identifier) @font-lock-variable-use-face) + (unary_operator operand: (identifier) @font-lock-variable-use-face) + (interpolation (identifier) @font-lock-variable-use-face) + (do_block (identifier) @font-lock-variable-use-face) + (access_call target: (identifier) @font-lock-variable-use-face) + (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) :language 'elixir :feature 'elixir-builtin @@ -699,11 +702,10 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; Font-lock. (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name) + '(( elixir-comment elixir-doc elixir-definition) ( elixir-string elixir-keyword elixir-data-type) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number ))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number ))) ;; Imenu. @@ -736,13 +738,12 @@ Return nil if NODE is not a defun node or doesn't have a name." heex-ts--indent-rules)) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name + '(( elixir-comment elixir-doc elixir-definition heex-comment heex-keyword heex-doctype ) ( elixir-string elixir-keyword elixir-data-type heex-component heex-tag heex-attribute heex-string ) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number )))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number )))) (treesit-major-mode-setup) (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) From 8a39216ce920d82b86a40471429e30d75c6ee42d Mon Sep 17 00:00:00 2001 From: Wilhelm Kirschbaum Date: Wed, 7 Feb 2024 04:18:30 +0200 Subject: [PATCH 113/385] elixir-ts-mode: Highlight more method definitions * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Also highlight method definitions where the arguments are literal values, not identifiers (bug#67246). --- lisp/progmodes/elixir-ts-mode.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 57db211e881..f26c3a49203 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -362,6 +362,11 @@ :language 'elixir :feature 'elixir-definition `((call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier From 9ccaa09a63548770ca8902758985aeb2c609f5ad Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 7 Feb 2024 10:48:27 +0800 Subject: [PATCH 114/385] ; .dir-locals.el (log-edit-mode) : Set to 64. --- .dir-locals.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.dir-locals.el b/.dir-locals.el index 1f08c882e0b..89fb76a55f3 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -32,7 +32,8 @@ (mode . bug-reference-prog))) (log-edit-mode . ((log-edit-font-lock-gnu-style . t) (log-edit-setup-add-author . t) - (vc-git-log-edit-summary-target-len . 50))) + (vc-git-log-edit-summary-target-len . 50) + (fill-column . 64))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) (mode . bug-reference))) From ccae58a425674c36cb6f17bcebc4416d34f23a37 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Feb 2024 13:19:27 +0100 Subject: [PATCH 115/385] Declare function properties in Tramp * lisp/net/tramp-message.el (tramp-backtrace, tramp-error) (tramp-error-with-buffer, tramp-user-error): Declare `tramp-suppress-trace' property. --- lisp/net/tramp-message.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 96071e626a5..97e94a51e7a 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -353,6 +353,7 @@ applicable)." If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE forces the backtrace even if `tramp-verbose' is less than 10. This function is meant for debugging purposes." + (declare (tramp-suppress-trace t)) (let ((tramp-verbose (if force 10 tramp-verbose))) (when (>= tramp-verbose 10) (tramp-message @@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised with FMT-STRING and ARGUMENTS." + (declare (tramp-suppress-trace t)) (let (signal-hook-function) (tramp-backtrace vec-or-proc) (unless arguments @@ -391,6 +393,7 @@ tramp-tests.el.") "Emit an error, and show BUF. If BUF is nil, show the connection buf. Wait for 30\", or until an input event arrives. The other arguments are passed to `tramp-error'." + (declare (tramp-suppress-trace t)) (save-window-excursion (let* ((buf (or (and (bufferp buf) buf) (and (processp vec-or-proc) (process-buffer vec-or-proc)) @@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." (defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments) "Signal a user error (or \"pilot error\")." + (declare (tramp-suppress-trace t)) (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. From e5cb268b2cf612492dfaf39d28f43357710003a6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 7 Feb 2024 21:09:18 +0800 Subject: [PATCH 116/385] Fix DEBUG_THREADS in the Android port * java/org/gnu/emacs/EmacsService.java (EmacsService): New field `mainThread'. (onCreate): Set `mainThread' to the thread where the service's looper executes. (checkEmacsThread): Compare against SERVICE.mainThread. --- java/org/gnu/emacs/EmacsService.java | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index 93e34e6e694..b65b10b9528 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -136,6 +136,10 @@ public final class EmacsService extends Service been created yet. */ private EmacsSafThread storageThread; + /* The Thread object representing the Android user interface + thread. */ + private Thread mainThread; + static { servicingQuery = new AtomicInteger (); @@ -236,6 +240,7 @@ public final class EmacsService extends Service / metrics.density) * pixelDensityX); resolver = getContentResolver (); + mainThread = Thread.currentThread (); /* If the density used to compute the text size is lesser than 160, there's likely a bug with display density computation. @@ -384,7 +389,13 @@ invocation of app_process (through android-emacs) can { if (DEBUG_THREADS) { - if (Thread.currentThread () instanceof EmacsThread) + /* When SERVICE is NULL, Emacs is being executed non-interactively. */ + if (SERVICE == null + /* It was previously assumed that only instances of + `EmacsThread' were valid for graphics calls, but this is + no longer true now that Lisp threads can be attached to + the JVM. */ + || (Thread.currentThread () != SERVICE.mainThread)) return; throw new RuntimeException ("Emacs thread function" From d03f3a827d80e2a0962128216223bab21998cf0a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 7 Feb 2024 15:33:51 +0200 Subject: [PATCH 117/385] Don't compile lib/copy-file-range.c on MS-Windows * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_copy-file-range): Set to true to avoid compiling copy-file-range.c on MS-Windows. The function 'copy_file_range' is not used on MS-Windows, while compiling the file triggers warnings because lib/unistd.h, where its prototype is declared, is omitted in the MS-Windows build. --- nt/gnulib-cfg.mk | 1 + 1 file changed, 1 insertion(+) diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 5b1c2c88ba5..048f812724a 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -46,6 +46,7 @@ OMIT_GNULIB_MODULE_allocator = true OMIT_GNULIB_MODULE_at-internal = true OMIT_GNULIB_MODULE_canonicalize-lgpl = true OMIT_GNULIB_MODULE_careadlinkat = true +OMIT_GNULIB_MODULE_copy-file-range = true OMIT_GNULIB_MODULE_dirent = true OMIT_GNULIB_MODULE_dirfd = true OMIT_GNULIB_MODULE_fchmodat = true From ef3fed1a4898c3e3d6012ba01006d827a4aba0ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 7 Feb 2024 14:35:44 +0100 Subject: [PATCH 118/385] ; Fix last changes in buffer-menu.el and NEWS * etc/NEWS: Remove superfluous mention of key binding. * lisp/buff-menu.el (Buffer-menu--selection-message): Go back to previous wording. It's not about what is hidden but what is shown; the message is displayed in response to different actions. --- etc/NEWS | 2 +- lisp/buff-menu.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ee7462cb2aa..960ad2b95ac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1304,7 +1304,7 @@ This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. --- -*** New command 'Buffer-menu-toggle-internal', locally bound to 'I'. +*** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. Previously, such buffers were never shown. This command is bound to 'I' diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 29ca3b41f0c..be62fc51e4c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Hiding internal buffers.")))) + (t "Showing all non-internal buffers.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. From b068725d40dd1ab918178b3cbca7b5672037210f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:11:38 -0500 Subject: [PATCH 119/385] Use slot names rather than their :initargs * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-39-clone-instance-inheritor-with-args): * test/lisp/auth-source-tests.el (auth-source-ensure-ignored-backend) (auth-source-backend-parse-macos-keychain) (auth-source-backend-parse-macos-keychain-generic-string) (auth-source-backend-parse-macos-keychain-internet-string) (auth-source-backend-parse-macos-keychain-internet-symbol) (auth-source-backend-parse-macos-keychain-generic-symbol) (auth-source-backend-parse-macos-keychain-internet-default-string) (auth-source-backend-parse-plstore, auth-source-backend-parse-netrc) (auth-source-backend-parse-netrc-string) (auth-source-backend-parse-secrets) (auth-source-backend-parse-secrets-strings) (auth-source-backend-parse-secrets-alias) (auth-source-backend-parse-secrets-symbol) (auth-source-backend-parse-secrets-no-alias): Use slot names rather than their :initargs. --- test/lisp/auth-source-tests.el | 139 ++++++++++-------- .../emacs-lisp/eieio-tests/eieio-tests.el | 28 ++-- 2 files changed, 95 insertions(+), 72 deletions(-) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 0a3c1cce590..c091a7dd060 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -33,8 +33,8 @@ (require 'secrets) (defun auth-source-ensure-ignored-backend (source) - (auth-source-validate-backend source '((:source . "") - (:type . ignore)))) + (auth-source-validate-backend source '((source . "") + (type . ignore)))) (defun auth-source-validate-backend (source validation-alist) (let ((backend (auth-source-backend-parse source))) @@ -44,84 +44,101 @@ (ert-deftest auth-source-backend-parse-macos-keychain () (auth-source-validate-backend '(:source (:macos-keychain-generic foobar)) - '((:source . "foobar") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-generic) + (search-function . auth-source-macos-keychain-search) + (create-function . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-generic-string () (auth-source-validate-backend "macos-keychain-generic:foobar" - '((:source . "foobar") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-generic) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-string () (auth-source-validate-backend "macos-keychain-internet:foobar" - '((:source . "foobar") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol () (auth-source-validate-backend 'macos-keychain-internet - '((:source . "default") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol () (auth-source-validate-backend 'macos-keychain-generic - '((:source . "default") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-generic) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string () (auth-source-validate-backend 'macos-keychain-internet - '((:source . "default") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-plstore () (auth-source-validate-backend '(:source "foo.plist") - '((:source . "foo.plist") - (:type . plstore) - (:search-function . auth-source-plstore-search) - (:create-function . auth-source-plstore-create)))) + '((source . "foo.plist") + (type . plstore) + (search-function . auth-source-plstore-search) + (create-function + . auth-source-plstore-create)))) (ert-deftest auth-source-backend-parse-netrc () (auth-source-validate-backend '(:source "foo") - '((:source . "foo") - (:type . netrc) - (:search-function . auth-source-netrc-search) - (:create-function . auth-source-netrc-create)))) + '((source . "foo") + (type . netrc) + (search-function . auth-source-netrc-search) + (create-function + . auth-source-netrc-create)))) (ert-deftest auth-source-backend-parse-netrc-string () (auth-source-validate-backend "foo" - '((:source . "foo") - (:type . netrc) - (:search-function . auth-source-netrc-search) - (:create-function . auth-source-netrc-create)))) + '((source . "foo") + (type . netrc) + (search-function . auth-source-netrc-search) + (create-function + . auth-source-netrc-create)))) (ert-deftest auth-source-backend-parse-secrets () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) (auth-source-validate-backend '(:source (:secrets "foo")) - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create))))) (ert-deftest auth-source-backend-parse-secrets-strings () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) (auth-source-validate-backend "secrets:foo" - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create))))) (ert-deftest auth-source-backend-parse-secrets-alias () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -129,10 +146,12 @@ ;; Redefine `secrets-get-alias' to map 'foo to "foo" (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) (auth-source-validate-backend '(:source (:secrets foo)) - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-secrets-symbol () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -140,10 +159,12 @@ ;; Redefine `secrets-get-alias' to map 'default to "foo" (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) (auth-source-validate-backend 'default - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-secrets-no-alias () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -152,10 +173,12 @@ ;; "Login" is used by default (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil))) (auth-source-validate-backend '(:source (:secrets foo)) - '((:source . "Login") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "Login") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-invalid-or-nil-source () (provide 'secrets) ; simulates the presence of the `secrets' package diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 83fc476c911..bc226757ff2 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -1011,24 +1011,24 @@ Subclasses to override slot attributes.")) (B (clone A :b "bb")) (C (clone B :a "aa"))) - (should (string= "aa" (oref C :a))) - (should (string= "bb" (oref C :b))) + (should (string= "aa" (oref C a))) + (should (string= "bb" (oref C b))) - (should (slot-boundp A :a)) - (should-not (slot-boundp A :b)) - (should-not (slot-boundp A :c)) + (should (slot-boundp A 'a)) + (should-not (slot-boundp A 'b)) + (should-not (slot-boundp A 'c)) - (should-not (slot-boundp B :a)) - (should (slot-boundp B :b)) - (should-not (slot-boundp A :c)) + (should-not (slot-boundp B 'a)) + (should (slot-boundp B 'b)) + (should-not (slot-boundp A 'c)) - (should (slot-boundp C :a)) - (should-not (slot-boundp C :b)) - (should-not (slot-boundp C :c)) + (should (slot-boundp C 'a)) + (should-not (slot-boundp C 'b)) + (should-not (slot-boundp C 'c)) - (should (eieio-instance-inheritor-slot-boundp C :a)) - (should (eieio-instance-inheritor-slot-boundp C :b)) - (should-not (eieio-instance-inheritor-slot-boundp C :c)))) + (should (eieio-instance-inheritor-slot-boundp C 'a)) + (should (eieio-instance-inheritor-slot-boundp C 'b)) + (should-not (eieio-instance-inheritor-slot-boundp C 'c)))) ;;;; Interaction with defstruct From cc5d4f15f96f97b6c4eb8b58144d0a0f217d393a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:13:56 -0500 Subject: [PATCH 120/385] Use `defvar` for variables that are not constant * test/lisp/international/mule-tests.el (sgml-html-meta-pre) (sgml-html-meta-post): * test/lisp/net/tramp-archive-tests.el (tramp-archive-test-file-archive) (tramp-archive-test-archive): * test/lisp/emacs-lisp/macroexp-resources/vk.el (vk-b): Don't use `defconst` if it's not constant. --- test/lisp/emacs-lisp/macroexp-resources/vk.el | 2 +- test/lisp/international/mule-tests.el | 4 ++-- test/lisp/net/tramp-archive-tests.el | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el index 460b7a8e516..5358bcaeb5c 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/vk.el +++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el @@ -25,7 +25,7 @@ (if (macroexp--dynamic-variable-p var) ''dyn ''lex)) (defvar vk-a 1) -(defconst vk-b 2) +(defvar vk-b 2) (defvar vk-c) (defun vk-f1 (x) diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 5c742451a57..9a80ced55ae 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -96,10 +96,10 @@ ;;; Testing `sgml-html-meta-auto-coding-function'. -(defconst sgml-html-meta-pre "" +(defvar sgml-html-meta-pre "" "The beginning of a minimal HTML document.") -(defconst sgml-html-meta-post "" +(defvar sgml-html-meta-post "" "The end of a minimal HTML document.") (defun sgml-html-meta-run (coding-system) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 978342b1bb1..1ca2fa9b9b3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -77,7 +77,7 @@ A resource file is in the resource directory as per `ert-resource-directory'." `(expand-file-name ,file (ert-resource-directory))))) -(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") +(defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") "The test file archive.") (defun tramp-archive-test-file-archive-hexlified () @@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) (url-hexify-string tramp-archive-test-file-archive))) -(defconst tramp-archive-test-archive +(defvar tramp-archive-test-archive (file-name-as-directory tramp-archive-test-file-archive) "The test archive.") From 2f3c435056dac17242b2d147bc73df8742c3e374 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:15:59 -0500 Subject: [PATCH 121/385] * test/lisp/minibuffer-tests.el (completion-test--pcm-bug38458): New test --- test/lisp/minibuffer-tests.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 07c4dbc3197..c4a7de9e51f 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -201,6 +201,13 @@ 'completions-first-difference) return pos)) +(ert-deftest completion-test--pcm-bug38458 () + (should (equal (let ((completion-ignore-case t)) + (completion-pcm--merge-try '("tes" point "ing") + '("Testing" "testing") + "" "")) + '("testing" . 4)))) + (ert-deftest completion-pcm-test-1 () ;; Point is at end, this does not match anything (should (null From 12fb298e21d877c772a19fc8f2fec68a40bcda14 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:17:35 -0500 Subject: [PATCH 122/385] Prefer \` and \' when matching the beg/end of string * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case) (tramp-test01-file-name-syntax): Use more precise regexp --- test/lisp/net/tramp-tests.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 489b682d0c3..4a964f0daf0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -265,8 +265,8 @@ is greater than 10. `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) (debug-ignored-errors (append - '("^make-symbolic-link not supported$" - "^error with add-name-to-file") + '("\\`make-symbolic-link not supported\\'" + "\\`error with add-name-to-file") debug-ignored-errors)) inhibit-message) (unwind-protect @@ -379,7 +379,7 @@ is greater than 10. (let (tramp-mode) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; `tramp-ignored-file-name-regexp' suppresses Tramp. - (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) + (let ((tramp-ignored-file-name-regexp "\\`/method:user@host:")) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; Methods shall be at least two characters, except the ;; default method. From f9ffa0148c3fb9e07671fae8f8ca72dd2d403163 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Feb 2024 11:20:46 -0500 Subject: [PATCH 123/385] (file-notify--test-wait-event): Rename from `file-notify--test-read-event` * test/lisp/filenotify-tests.el (file-notify--test-wait-event): Rename to better reflect its purpose rather than its implementation. Also make it return nil so callers won't be tempted to use the return value. --- test/lisp/filenotify-tests.el | 53 ++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 11af1f75574..28f4d5fa181 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -74,8 +74,8 @@ (defvar file-notify--test-events nil) (defvar file-notify--test-monitors nil) -(defun file-notify--test-read-event () - "Read one event. +(defun file-notify--test-wait-event () + "Wait for one event. There are different timeouts for local and remote file notification libraries." (read-event nil nil @@ -87,7 +87,8 @@ There are different timeouts for local and remote file notification libraries." ;; for any monitor. ((file-notify--test-monitor) 7) ((file-remote-p temporary-file-directory) 0.1) - (t 0.01)))) + (t 0.01))) + nil) (defun file-notify--test-timeout () "Timeout to wait for arriving a bunch of events, in seconds." @@ -103,7 +104,7 @@ There are different timeouts for local and remote file notification libraries." TIMEOUT is the maximum time to wait for, in seconds." `(with-timeout (,timeout (ignore)) (while (null ,until) - (file-notify--test-read-event)))) + (file-notify--test-wait-event)))) (defun file-notify--test-no-descriptors () "Check that `file-notify-descriptors' is an empty hash table. @@ -452,7 +453,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Check, that removing watch descriptors out of order do not ;; harm. This fails on cygwin because of timing issues unless a ;; long `sit-for' is added before the call to - ;; `file-notify--test-read-event'. + ;; `file-notify--test-wait-event'. (unless (eq system-type 'cygwin) (let (results) (cl-flet ((first-callback (event) @@ -480,7 +481,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Remove first watch. (file-notify-rm-watch file-notify--test-desc) ;; Only the second callback shall run. - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile) (file-notify--test-wait-for-events (file-notify--test-timeout) results) @@ -622,7 +623,7 @@ delivered." (cons 'file-notify while-no-input-ignore-events)) create-lockfiles) ;; Flush pending actions. - (file-notify--test-read-event) + (file-notify--test-wait-event) (file-notify--test-wait-for-events (file-notify--test-timeout) (not (input-pending-p))) @@ -671,7 +672,7 @@ delivered." (t '(created changed deleted stopped))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -707,7 +708,7 @@ delivered." (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -755,7 +756,7 @@ delivered." (t '(created changed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -805,14 +806,14 @@ delivered." deleted deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; The next two events shall not be visible. - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-modes file-notify--test-tmpfile 000 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -860,10 +861,10 @@ delivered." (t '(created changed renamed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; After the rename, we won't get events anymore. - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -912,11 +913,11 @@ delivered." (t '(attribute-changed attribute-changed))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-modes file-notify--test-tmpfile 000 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -1087,7 +1088,7 @@ delivered." (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) ;; After deleting the file, the descriptor is not valid anymore. (should-not (file-notify-valid-p file-notify--test-desc)) @@ -1134,7 +1135,7 @@ delivered." (t '(created changed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) ;; After deleting the parent directory, the descriptor must ;; not be valid anymore. @@ -1247,9 +1248,9 @@ delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (write-region "" nil (pop source-file-list) nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (write-region "" nil (pop target-file-list) nil 'no-message)))) (file-notify--test-with-actions (cond @@ -1272,11 +1273,11 @@ delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (rename-file (pop source-file-list) (pop target-file-list) t)))) (file-notify--test-with-actions (make-list n 'deleted) (dolist (file target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file))) (delete-directory file-notify--test-tmpfile) (if (or (string-equal (file-notify--test-library) "w32notify") @@ -1464,7 +1465,7 @@ the file watch." ;; does not report the `changed' event. (make-list (/ n 2) 'created))) (dotimes (i n) - (file-notify--test-read-event) + (file-notify--test-wait-event) (if (zerop (mod i 2)) (write-region "any text" nil file-notify--test-tmpfile1 t 'no-message) From 2ecaa60f0521446c9d2c054a3493faaf46275223 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 7 Feb 2024 19:14:20 +0200 Subject: [PATCH 124/385] Improve wording of message in buff-menu.el * lisp/buff-menu.el (Buffer-menu--selection-message): Improve wording of selection messages. --- lisp/buff-menu.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index be62fc51e4c..10ea99eae9a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -329,7 +329,7 @@ ARG, show only buffers that are visiting files." (defun Buffer-menu--selection-message () (message (cond (Buffer-menu-files-only "Showing only file-visiting buffers.") (Buffer-menu-show-internal "Showing all buffers.") - (t "Showing all non-internal buffers.")))) + (t "Showing all buffers except internal ones.")))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current `buffer-menu' displays only file buffers. From f444786e58737a4ae6071957dfc60075bbd96edc Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Feb 2024 21:50:37 +0200 Subject: [PATCH 125/385] Mention 'C-h' in echo for unfinished commands * etc/NEWS: Mention it here. * lisp/cus-start.el (standard): Add type and version for it. * src/keyboard.c (echo-keystrokes-help): New user option (https://lists.gnu.org/archive/html/emacs-devel/2024-02/msg00174.html). * src/keyboard.c (echo_dash): Use it. --- etc/NEWS | 3 +++ lisp/cus-start.el | 1 + src/keyboard.c | 13 +++++++++++++ 3 files changed, 17 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 960ad2b95ac..f454b6d851c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,6 +307,9 @@ between the auto save file and the current file. ** 'ffap-lax-url' now defaults to nil. Previously, it was set to t but this broke remote file name detection. +** Unfinished commands' echo now ends with a suggestion to use Help. +Customize 'echo-keystrokes-help' to nil to prevent that. + * Editing Changes in Emacs 30.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 7e0b64e9067..3fe62c8d0da 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -371,6 +371,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (auto-save-timeout auto-save (choice (const :tag "off" nil) (integer :format "%v"))) (echo-keystrokes minibuffer number) + (echo-keystrokes-help minibuffer boolean "30.1") (polling-period keyboard float) (double-click-time mouse (restricted-sexp :match-alternatives (integerp 'nil 't))) diff --git a/src/keyboard.c b/src/keyboard.c index 1f7253a7da1..6d3db5ab615 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -589,6 +589,15 @@ echo_dash (void) AUTO_STRING (dash, "-"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), dash)); + + if (echo_keystrokes_help) + { + AUTO_STRING (help, " (\\`C-h' for help)"); + kset_echo_string (current_kboard, + concat2 (KVAR (current_kboard, echo_string), + calln (Qsubstitute_command_keys, help))); + } + echo_now (); } @@ -13228,6 +13237,10 @@ The value may be integer or floating point. If the value is zero, don't echo at all. */); Vecho_keystrokes = make_fixnum (1); + DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help, + doc: /* Non-nil means append small help text to the unfinished commands' echo. */); + echo_keystrokes_help = true; + DEFVAR_LISP ("polling-period", Vpolling_period, doc: /* Interval between polling for input during Lisp execution. The reason for polling is to make C-g work to stop a running program. From e34ebc0ccc6c27e7e1217baad9ca74dd7bea4c37 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 7 Feb 2024 13:17:57 -0800 Subject: [PATCH 126/385] Port better to Autoconf 2.72 * configure.ac: Set ac_cv_type_gid_t=yes to pacify Autoconf 2.72 AC_TYPE_GETGROUPS. Problem reported by Nick Bowler in: https://lists.gnu.org/r/autoconf-patches/2024-02/msg00001.html --- configure.ac | 1 + 1 file changed, 1 insertion(+) diff --git a/configure.ac b/configure.ac index b74eba879ab..847fdbd54d2 100644 --- a/configure.ac +++ b/configure.ac @@ -2337,6 +2337,7 @@ fi AC_DEFUN([AC_TYPE_SIZE_T]) # Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them. AC_DEFUN([AC_TYPE_UID_T]) +ac_cv_type_gid_t=yes # AC_TYPE_GETGROUPS needs this in Autoconf 2.72. # Check for all math.h functions that Emacs uses; on some platforms, # -lm is needed for some of these functions. From 1f9781ee7816ad3ec786ca7e10b4e82d1ad989c5 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 10:01:57 +0800 Subject: [PATCH 127/385] Fix earlier change to keyboard.c * src/keyboard.c (echo_dash): Do not pass automatic string to Lisp! (syms_of_keyboard) : Improve doc string. --- src/keyboard.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 6d3db5ab615..cd6ccbd77d0 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -592,7 +592,9 @@ echo_dash (void) if (echo_keystrokes_help) { - AUTO_STRING (help, " (\\`C-h' for help)"); + Lisp_Object help; + + help = build_string (" (\\`C-h' for help)"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), calln (Qsubstitute_command_keys, help))); @@ -13232,13 +13234,15 @@ Emacs also does a garbage collection if that seems to be warranted. */); XSETFASTINT (Vauto_save_timeout, 30); DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes, - doc: /* Nonzero means echo unfinished commands after this many seconds of pause. + doc: /* Nonzero means echo unfinished commands after this many seconds of pause. The value may be integer or floating point. If the value is zero, don't echo at all. */); Vecho_keystrokes = make_fixnum (1); DEFVAR_BOOL ("echo-keystrokes-help", echo_keystrokes_help, - doc: /* Non-nil means append small help text to the unfinished commands' echo. */); + doc: /* Whether to append help text to echoed commands. +When non-nil, a reference to `C-h' is printed after echoed +keystrokes. */); echo_keystrokes_help = true; DEFVAR_LISP ("polling-period", Vpolling_period, From ed2450e79b597e0306f14b542e934a90dfd9786f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 10:32:28 +0800 Subject: [PATCH 128/385] Prevent echo area help message from being printed repeatedly * src/keyboard.c (echo_dash): Detect echo_keystrokes_help messages and return if they be present. --- src/keyboard.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index cd6ccbd77d0..78ea1893ba1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -580,7 +580,10 @@ echo_dash (void) idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1); last_char = Faref (KVAR (current_kboard, echo_string), idx); - if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') + if ((XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ') + /* Or a keystroke help message. */ + || (echo_keystrokes_help + && XFIXNUM (last_char) == ')' && XFIXNUM (prev_char) == 'p')) return; } From 1db2255c7c7fc232e371d379cb60827a9931e24d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 8 Feb 2024 13:20:28 +0800 Subject: [PATCH 129/385] * lisp/touch-screen.el (touch-screen): Fix defgroup version. --- lisp/touch-screen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el index a1ec4bca89f..c8de1d8ee31 100644 --- a/lisp/touch-screen.el +++ b/lisp/touch-screen.el @@ -87,7 +87,7 @@ is being called from `read-sequence' or some similar function.") (defgroup touch-screen nil "Interact with Emacs from touch screen devices." :group 'mouse - :version "30.0") + :version "30.1") (defcustom touch-screen-display-keyboard nil "If non-nil, always display the on screen keyboard. From a48cf0c94ca4a4e3fe045be6149025955e9dfa4f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 08:48:20 +0200 Subject: [PATCH 130/385] ; * src/keyboard.c (echo_dash): Mention F1 in echo_keystrokes_help. --- src/keyboard.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index 78ea1893ba1..10cdef67348 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -597,7 +597,7 @@ echo_dash (void) { Lisp_Object help; - help = build_string (" (\\`C-h' for help)"); + help = build_string (" (\\`C-h' or \\`' for help)"); kset_echo_string (current_kboard, concat2 (KVAR (current_kboard, echo_string), calln (Qsubstitute_command_keys, help))); From d6c7092ff0713087f38b9492d53be0177af67514 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 08:56:42 +0200 Subject: [PATCH 131/385] ; Improve documentation of 'echo-keystrokes-help' * doc/emacs/display.texi (Display Custom): Document 'echo-keystrokes-help'. * etc/NEWS: Mark the 'echo-keystrokes-help' entry documented. --- doc/emacs/display.texi | 7 +++++++ etc/NEWS | 3 ++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 6db9e8344c6..d2557d6148e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2210,6 +2210,13 @@ keys; its value is the number of seconds of pause required to cause echoing to start, or zero, meaning don't echo at all. The value takes effect when there is something to echo. @xref{Echo Area}. +@vindex echo-keystrokes-help + If the variable @code{echo-keystrokes-help} is non-@code{nil} (the +default), the multi-character key sequence echo shown according to +@code{echo-keystrokes} will include a short help text about keys which +will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show +the list of commands for the prefix you already typed. + @cindex mouse pointer @cindex hourglass pointer display @vindex display-hourglass diff --git a/etc/NEWS b/etc/NEWS index f454b6d851c..4d3c652aebc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,7 +307,8 @@ between the auto save file and the current file. ** 'ffap-lax-url' now defaults to nil. Previously, it was set to t but this broke remote file name detection. -** Unfinished commands' echo now ends with a suggestion to use Help. ++++ +** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. From 08c81db7c8e522278fb2c8de8fbe556d109c135f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 8 Feb 2024 11:17:22 +0100 Subject: [PATCH 132/385] `file-remote-p' must not return an error * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler): `file-remote-p' must not return an error. (Bug#68976) --- lisp/net/tramp-gvfs.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 72589e7ce4a..4e949e7e60b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") "Invoke the GVFS related OPERATION and ARGS. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (unless tramp-gvfs-enabled + ;; `file-remote-p' must not return an error. (Bug#68976) + (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p)) (tramp-user-error nil "Package `tramp-gvfs' not supported")) (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) (tramp-gvfs-dbus-event-vector From bc099295dd24d059d3358acf5653ced9c9292e41 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 31 Jan 2024 21:37:18 +0100 Subject: [PATCH 133/385] ; Ensure 'thing-at-point-looking-at' finds full match * lisp/thingatpt.el (thing-at-point-looking-at): Regexp-search from the beginning forward, instead of the other way around. * test/lisp/thingatpt-tests.el (thing-at-point-test-data): Add tests. (Bug#68762) --- lisp/thingatpt.el | 43 +++++++++++------------------------- test/lisp/thingatpt-tests.el | 2 ++ 2 files changed, 15 insertions(+), 30 deletions(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 323d3d1cf6c..b532bafff82 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -619,36 +619,19 @@ point. Optional argument DISTANCE limits search for REGEXP forward and back from point." - (save-excursion - (let ((old-point (point)) - (forward-bound (and distance (+ (point) distance))) - (backward-bound (and distance (- (point) distance))) - match prev-pos new-pos) - (and (looking-at regexp) - (>= (match-end 0) old-point) - (setq match (point))) - ;; Search back repeatedly from end of next match. - ;; This may fail if next match ends before this match does. - (re-search-forward regexp forward-bound 'limit) - (setq prev-pos (point)) - (while (and (setq new-pos (re-search-backward regexp backward-bound t)) - ;; Avoid inflooping with some regexps, such as "^", - ;; matching which never moves point. - (< new-pos prev-pos) - (or (> (match-beginning 0) old-point) - (and (looking-at regexp) ; Extend match-end past search start - (>= (match-end 0) old-point) - (setq match (point)))))) - (if (not match) nil - (goto-char match) - ;; Back up a char at a time in case search skipped - ;; intermediate match straddling search start pos. - (while (and (not (bobp)) - (progn (backward-char 1) (looking-at regexp)) - (>= (match-end 0) old-point) - (setq match (point)))) - (goto-char match) - (looking-at regexp))))) + (let* ((old (point)) + (beg (if distance (max (point-min) (- old distance)) (point-min))) + (end (and distance (min (point-max) (+ old distance)))) + prev match) + (save-excursion + (goto-char beg) + (while (and (setq prev (point) + match (re-search-forward regexp end t)) + (< (match-end 0) old)) + ;; Avoid inflooping when `regexp' matches the empty string. + (unless (< prev (point)) (forward-char)))) + (and match (<= (match-beginning 0) old (match-end 0))))) + ;; Email addresses (defvar thing-at-point-email-regexp diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index ba51f375cc6..56bc4fdc9dc 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -92,6 +92,8 @@ ("1@example.com" 1 email "1@example.com") ;; email addresses user portion containing dots ("foo.bar@example.com" 1 email "foo.bar@example.com") + ("foo.bar@example.com" 5 email "foo.bar@example.com") + (" fo.ba@example.com" 6 email "fo.ba@example.com") (".foobar@example.com" 1 email nil) (".foobar@example.com" 2 email "foobar@example.com") ;; email addresses domain portion containing dots and dashes From e2682316867ecb22ee1db5e3028a8150d95d1a80 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 13:51:55 +0200 Subject: [PATCH 134/385] Don't skip links to "." and ".." in Dired when marking files * lisp/dired.el (dired-mark): Skip "." and "..", but not symlinks to those two. (Bug#38729) (Bug#68814) --- lisp/dired.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/dired.el b/lisp/dired.el index c33569d79a2..d9fbafb98c3 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4110,6 +4110,11 @@ this subdir." (prefix-numeric-value arg) (lambda () (when (or (not (looking-at-p dired-re-dot)) + ;; Don't skip symlinks to ".", "..", etc. + (save-excursion + (re-search-forward + dired-permission-flags-regexp nil t) + (eq (char-after (match-beginning 1)) ?l)) (not (equal dired-marker-char dired-del-marker))) (delete-char 1) (insert dired-marker-char)))))))) From ebf4ef2022a5f0a69cdd881eb41104e7b59d698e Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Sun, 4 Feb 2024 03:20:24 +0900 Subject: [PATCH 135/385] Fix 'browse-url-url-at-point' so that scheme does not duplicate * lisp/net/browse-url.el (browse-url-url-at-point): Prepend the default scheme only if no scheme present. (Bug#68913) --- lisp/net/browse-url.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 359453ca433..bc2a7db9a8b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist." (defun browse-url-url-at-point () (or (thing-at-point 'url t) ;; assume that the user is pointing at something like gnu.org/gnu - (let ((f (thing-at-point 'filename t))) - (and f (concat browse-url-default-scheme "://" f))))) + (when-let ((f (thing-at-point 'filename t))) + (if (string-match-p browse-url-button-regexp f) + f + (concat browse-url-default-scheme "://" f))))) ;; Having this as a separate function called by the browser-specific ;; functions allows them to be stand-alone commands, making it easier From 0b9c7148fd681c8ad63fd0eb3895db44403e9f8c Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Thu, 18 Jan 2024 12:00:00 +0800 Subject: [PATCH 136/385] Respect the delimiter of completer in Python shell completion * lisp/progmodes/python.el: (python-shell-completion-setup-code): Fix the completion code of IPython. Change the return value to JSON string and ... (python-shell-completion-get-completions): ... simplify parsing. (inferior-python-mode): Update docstring. (python-shell-readline-completer-delims): New variable indicating the word delimiters of readline completer. (python-shell-completion-native-setup): Set the completer delimiter. (python-shell-completion-native-get-completions): Convert output string to completions properly. (python-shell--get-multiline-input) (python-shell--extra-completion-context) (python-shell-completion-extra-context): New functions. (python-shell-completion-at-point): Send text beginning from the line start if the completion backend does not need word splitting. Remove the detection of import statement because it is not needed anymore. Create proper completion table based on completions returned from different backends. * test/lisp/progmodes/python-tests.el (python-tests--completion-module) (python-tests--completion-parameters) (python-tests--completion-extra-context): New helper functions. (python-shell-completion-at-point-jedi-completer) (python-shell-completion-at-point-ipython): New tests. (bug#68559) --- lisp/progmodes/python.el | 218 ++++++++++++++++++++++------ test/lisp/progmodes/python-tests.el | 92 ++++++++++++ 2 files changed, 263 insertions(+), 47 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9d840efb9da..b1654b6a5aa 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23")) +;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -128,9 +128,9 @@ ;; receiving escape sequences (with some limitations, i.e. completion ;; in blocks does not work). The code executed for the "fallback" ;; completion can be found in `python-shell-completion-setup-code' and -;; `python-shell-completion-string-code' variables. Their default -;; values enable completion for both CPython and IPython, and probably -;; any readline based shell (it's known to work with PyPy). If your +;; `python-shell-completion-get-completions'. Their default values +;; enable completion for both CPython and IPython, and probably any +;; readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), ;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any @@ -141,6 +141,12 @@ ;; If you see an error, then you need to either install pyreadline or ;; setup custom code that avoids that dependency. +;; By default, the "native" completion uses the built-in rlcompleter. +;; To use other readline completer (e.g. Jedi) or a custom one, you just +;; need to set it in the PYTHONSTARTUP file. You can set an +;; Emacs-specific completer by testing the environment variable +;; INSIDE_EMACS. + ;; Shell virtualenv support: The shell also contains support for ;; virtualenvs and other special environment modifications thanks to ;; `python-shell-process-environment' and `python-shell-exec-path'. @@ -3604,7 +3610,6 @@ interpreter is run. Variables `python-shell-prompt-block-regexp', `python-shell-font-lock-enable', `python-shell-completion-setup-code', -`python-shell-completion-string-code', `python-eldoc-setup-code', `python-ffap-setup-code' can customize this mode for different Python interpreters. @@ -4244,8 +4249,9 @@ def __PYTHON_EL_get_completions(text): completions = [] completer = None + import json try: - import readline + import readline, re try: import __builtin__ @@ -4256,16 +4262,29 @@ def __PYTHON_EL_get_completions(text): is_ipython = ('__IPYTHON__' in builtins or '__IPYTHON__active' in builtins) - splits = text.split() - is_module = splits and splits[0] in ('from', 'import') - if is_ipython and is_module: - from IPython.core.completerlib import module_completion - completions = module_completion(text.strip()) - elif is_ipython and '__IP' in builtins: - completions = __IP.complete(text) - elif is_ipython and 'get_ipython' in builtins: - completions = get_ipython().Completer.all_completions(text) + if is_ipython and 'get_ipython' in builtins: + def filter_c(prefix, c): + if re.match('_+(i?[0-9]+)?$', c): + return False + elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix): + return False + return True + + import IPython + try: + if IPython.version_info[0] >= 6: + from IPython.core.completer import provisionalcompleter + with provisionalcompleter(): + completions = [ + [c.text, c.start, c.end, c.type or '?', c.signature or ''] + for c in get_ipython().Completer.completions(text, len(text)) + if filter_c(text, c.text)] + else: + part, matches = get_ipython().Completer.complete(line_buffer=text) + completions = [text + m[len(part):] for m in matches if filter_c(text, m)] + except: + pass else: # Try to reuse current completer. completer = readline.get_completer() @@ -4288,7 +4307,7 @@ def __PYTHON_EL_get_completions(text): finally: if getattr(completer, 'PYTHON_EL_WRAPPED', False): completer.print_mode = True - return completions" + return json.dumps(completions)" "Code used to setup completion in inferior Python processes." :type 'string) @@ -4329,6 +4348,10 @@ When a match is found, native completion is disabled." :version "25.1" :type 'float) +(defvar python-shell-readline-completer-delims nil + "Word delimiters used by the readline completer. +It is automatically set by Python shell.") + (defvar python-shell-completion-native-redirect-buffer " *Python completions redirect*" "Buffer to be used to redirect output of readline commands.") @@ -4467,6 +4490,10 @@ def __PYTHON_EL_native_completion_setup(): __PYTHON_EL_native_completion_setup()" process))) (when (string-match-p "python\\.el: native completion setup loaded" output) + (setq-local python-shell-readline-completer-delims + (string-trim-right + (python-shell-send-string-no-output + "import readline; print(readline.get_completer_delims())"))) (python-shell-completion-native-try)))) (defun python-shell-completion-native-turn-off (&optional msg) @@ -4534,6 +4561,8 @@ With argument MSG show activation/deactivation message." (let* ((original-filter-fn (process-filter process)) (redirect-buffer (get-buffer-create python-shell-completion-native-redirect-buffer)) + (sep (if (string= python-shell-readline-completer-delims "") + "[\n\r]+" "[ \f\t\n\r\v()]+")) (trigger "\t") (new-input (concat input trigger)) (input-length @@ -4576,28 +4605,80 @@ With argument MSG show activation/deactivation message." process python-shell-completion-native-output-timeout comint-redirect-finished-regexp) (re-search-backward "0__dummy_completion__" nil t) - (cl-remove-duplicates - (split-string - (buffer-substring-no-properties - (line-beginning-position) (point-min)) - "[ \f\t\n\r\v()]+" t) - :test #'string=)))) + (let ((str (buffer-substring-no-properties + (line-beginning-position) (point-min)))) + ;; The readline completer is allowed to return a list + ;; of (text start end type signature) as a JSON + ;; string. See the return value for IPython in + ;; `python-shell-completion-setup-code'. + (if (string= "[" (substring str 0 1)) + (condition-case nil + (python--parse-json-array str) + (t (cl-remove-duplicates (split-string str sep t) + :test #'string=))) + (cl-remove-duplicates (split-string str sep t) + :test #'string=)))))) (set-process-filter process original-filter-fn))))) (defun python-shell-completion-get-completions (process input) "Get completions of INPUT using PROCESS." (with-current-buffer (process-buffer process) - (let ((completions - (python-util-strip-string - (python-shell-send-string-no-output - (format - "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))" + (python--parse-json-array + (python-shell-send-string-no-output + (format "%s\nprint(__PYTHON_EL_get_completions(%s))" python-shell-completion-setup-code (python-shell--encode-string input)) - process)))) - (when (> (length completions) 2) - (split-string completions - "^'\\|^\"\\|;\\|'$\\|\"$" t))))) + process)))) + +(defun python-shell--get-multiline-input () + "Return lines at a multi-line input in Python shell." + (save-excursion + (let ((p (point)) lines) + (when (progn + (beginning-of-line) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) p) lines) + (while (progn (comint-previous-prompt 1) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + lines))) + +(defun python-shell--extra-completion-context () + "Get extra completion context of current input in Python shell." + (let ((lines (python-shell--get-multiline-input)) + (python-indent-guess-indent-offset nil)) + (when (not (zerop (length lines))) + (with-temp-buffer + (delay-mode-hooks + (insert (string-join lines "\n")) + (python-mode) + (python-shell-completion-extra-context)))))) + +(defun python-shell-completion-extra-context (&optional pos) + "Get extra completion context at position POS in Python buffer. +If optional argument POS is nil, use current position. + +Readline completers could use current line as the completion +context, which may be insufficient. In this function, extra +context (e.g. multi-line function call) is found and reformatted +as one line, which is required by native completion." + (let (bound p) + (save-excursion + (and pos (goto-char pos)) + (setq bound (pos-bol)) + (python-nav-up-list -1) + (when (and (< (point) bound) + (or + (looking-back + (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t) + (progn + (forward-line 0) + (looking-at "^[ \t]*\\(from \\)")))) + (setq p (match-beginning 1)))) + (when p + (replace-regexp-in-string + "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound)))))) (defvar-local python-shell--capf-cache nil "Variable to store cached completions and invalidation keys.") @@ -4612,21 +4693,26 @@ using that one instead of current buffer's process." ;; Working on a shell buffer: use prompt end. (cdr (python-util-comint-last-prompt)) (line-beginning-position))) - (import-statement - (when (string-match-p - (rx (* space) word-start (or "from" "import") word-end space) - (buffer-substring-no-properties line-start (point))) - (buffer-substring-no-properties line-start (point)))) + (no-delims + (and (not (if is-shell-buffer + (eq 'font-lock-comment-face + (get-text-property (1- (point)) 'face)) + (python-syntax-context 'comment))) + (with-current-buffer (process-buffer process) + (if python-shell-completion-native-enable + (string= python-shell-readline-completer-delims "") + (string-match-p "ipython[23]?\\'" python-shell-interpreter))))) (start (if (< (point) line-start) (point) (save-excursion - (if (not (re-search-backward - (python-rx - (or whitespace open-paren close-paren - string-delimiter simple-operator)) - line-start - t 1)) + (if (or no-delims + (not (re-search-backward + (python-rx + (or whitespace open-paren close-paren + string-delimiter simple-operator)) + line-start + t 1))) line-start (forward-char (length (match-string-no-properties 0))) (point))))) @@ -4666,18 +4752,56 @@ using that one instead of current buffer's process." (t #'python-shell-completion-native-get-completions)))) (prev-prompt (car python-shell--capf-cache)) (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) - (prefix (buffer-substring-no-properties start end))) + (prefix (buffer-substring-no-properties start end)) + (prefix-offset 0) + (extra-context (when no-delims + (if is-shell-buffer + (python-shell--extra-completion-context) + (python-shell-completion-extra-context)))) + (extra-offset (length extra-context))) + (unless (zerop extra-offset) + (setq prefix (concat extra-context prefix))) ;; To invalidate the cache, we check if the prompt position or the ;; completion prefix changed. (unless (and (equal prev-prompt (car prompt-boundaries)) - (string-match re prefix)) + (string-match re prefix) + (setq prefix-offset (- (length prefix) (match-end 1)))) (setq python-shell--capf-cache `(,(car prompt-boundaries) ,(if (string-empty-p prefix) regexp-unmatchable - (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'")) - ,@(funcall completion-fn process (or import-statement prefix))))) - (list start end (cddr python-shell--capf-cache)))) + (concat "\\`\\(" (regexp-quote prefix) "\\)\\(?:\\sw\\|\\s_\\)*\\'")) + ,@(funcall completion-fn process prefix)))) + (let ((cands (cddr python-shell--capf-cache))) + (cond + ((stringp (car cands)) + (if no-delims + ;; Reduce completion candidates due to long prefix. + (if-let ((Lp (length prefix)) + ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) + (L (match-beginning 0))) + ;; If extra-offset is not zero: + ;; start end + ;; o------------------o---------o-------o + ;; |<- extra-offset ->| + ;; |<----------- L ------------>| + ;; new-start + (list (+ start L (- extra-offset)) end + (mapcar (lambda (s) (substring s L)) cands)) + (list end end (mapcar (lambda (s) (substring s Lp)) cands))) + (list start end cands))) + ;; python-shell-completion(-native)-get-completions may produce a + ;; list of (text start end type signature) for completion. + ((consp (car cands)) + (list (+ start (nth 1 (car cands)) (- extra-offset)) + ;; Candidates may be cached, so the end position should + ;; be adjusted according to current completion prefix. + (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset) + cands + :annotation-function + (lambda (c) (concat " " (nth 3 (assoc c cands)))) + :company-docsig + (lambda (c) (nth 4 (assoc c cands))))))))) (define-obsolete-function-alias 'python-shell-completion-complete-at-point diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 59957ff0712..af6c199b5bd 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -4799,6 +4799,98 @@ def foo(): (end-of-line 0) (should-not (nth 2 (python-shell-completion-at-point)))))) +(defun python-tests--completion-module () + "Check if modules can be completed in Python shell." + (insert "import datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "import datetime")) + (kill-line) + (insert "from datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime")) + (end-of-line) + (insert " import timed") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime import timedelta")) + (kill-line)) + +(defun python-tests--completion-parameters () + "Check if parameters can be completed in Python shell." + (insert "import re") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "re.split('b', 'abc', maxs") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0, ") + (should (python-shell-completion-at-point)) + ;; Test if cache is used. + (cl-letf (((symbol-function 'python-shell-completion-get-completions) + 'ignore) + ((symbol-function 'python-shell-completion-native-get-completions) + 'ignore)) + (insert "fla") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=0, flags=" + (buffer-substring (line-beginning-position) (point))))) + (beginning-of-line) + (kill-line)) + +(defun python-tests--completion-extra-context () + "Check if extra context is used for completion." + (insert "re.split('b', 'abc',") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "maxs") + (completion-at-point) + (should (string= "maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0)") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "from re import (") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "IGN") + (completion-at-point) + (should (string= "IGNORECASE" + (buffer-substring (line-beginning-position) (point))))) + +(ert-deftest python-shell-completion-at-point-jedi-completer () + "Check if Python shell completion works when Jedi completer is used." + (skip-unless (executable-find python-tests-shell-interpreter)) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context)))) + +(ert-deftest python-shell-completion-at-point-ipython () + "Check if Python shell completion works for IPython." + (let ((python-shell-interpreter "ipython") + (python-shell-interpreter-args "-i --simple-prompt")) + (skip-unless + (and + (executable-find python-shell-interpreter) + (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) ;;; PDB Track integration From 571ec583d644b718ce52f938f111d4aa98192471 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 21:07:10 +0200 Subject: [PATCH 137/385] ; Clarify "ChangeLog entries" in CONTRIBUTE. --- CONTRIBUTE | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index a71cc1b277a..049ca00089e 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -184,8 +184,9 @@ Here is an example commit message (indented): Deactivate the mark. Occasionally, commit messages are collected and prepended to a -ChangeLog file, where they can be corrected. It saves time to get -them right the first time, so here are guidelines for formatting them: +generated ChangeLog file, where they can be corrected. It saves time +to get them right the first time, so here are guidelines for +formatting them: - Start with a single unindented summary line explaining the change; do not end this line with a period. If possible, try to keep the @@ -194,9 +195,10 @@ them right the first time, so here are guidelines for formatting them: contexts. If the summary line starts with a semicolon and a space "; ", the - commit message will be ignored when generating the ChangeLog file. - Use this for minor commits that do not need separate ChangeLog - entries, such as changes in etc/NEWS. + commit message will be skipped and not added to the generated + ChangeLog file. Use this for minor commits that do not need to be + mentioned in the ChangeLog file, such as changes in etc/NEWS, typo + fixes, etc. - After the summary line, there should be an empty line. @@ -211,8 +213,8 @@ them right the first time, so here are guidelines for formatting them: enforced by a commit hook. - If only a single file is changed, the summary line can be the normal - file first line (starting with the asterisk). Then there is no - individual files section. + file first line (starting with the asterisk). Then there will be no + individual ChangeLog entries beyond the one in the summary line. - If the commit has more than one author, the commit message should contain separate lines to mention the other authors, like the @@ -245,10 +247,10 @@ them right the first time, so here are guidelines for formatting them: the rationale for a change; that can be done in the commit message between the summary line and the file entries. -- Emacs generally follows the GNU coding standards for ChangeLogs: see - https://www.gnu.org/prep/standards/html_node/Change-Logs.html - or run 'info "(standards)Change Logs"'. One exception is that - commits still sometimes quote `like-this' (as the standards used to +- Emacs follows the GNU coding standards for ChangeLog entries: see + https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run + 'info "(standards)Change Logs"'. One exception is that commits + still sometimes quote `like-this' (as the standards used to recommend) rather than 'like-this' or ‘like this’ (as they do now), as `...' is so widely used elsewhere in Emacs. @@ -261,9 +263,9 @@ them right the first time, so here are guidelines for formatting them: in Emacs; that includes spelling and leaving 2 blanks between sentences. - They are preserved indefinitely, and have a reasonable chance of - being read in the future, so it's better that they have good - presentation. + The ChangeLog entries are preserved indefinitely, and have a + reasonable chance of being read in the future, so it's better that + they have good presentation. - Use the present tense; describe "what the change does", not "what the change did". From d65499e79083fb764517447d4d40ea3222ea2fa2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 21:26:36 +0200 Subject: [PATCH 138/385] ; Another clarification in CONTRIBUTE. --- CONTRIBUTE | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 049ca00089e..687aa0888ab 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -213,8 +213,9 @@ formatting them: enforced by a commit hook. - If only a single file is changed, the summary line can be the normal - file first line (starting with the asterisk). Then there will be no - individual ChangeLog entries beyond the one in the summary line. + first line of a ChangeLog entry (starting with the asterisk). Then + there will be no individual ChangeLog entries beyond the one in the + summary line. - If the commit has more than one author, the commit message should contain separate lines to mention the other authors, like the @@ -245,7 +246,7 @@ formatting them: - Explaining the rationale for a design choice is best done in comments in the source code. However, sometimes it is useful to describe just the rationale for a change; that can be done in the commit message - between the summary line and the file entries. + between the summary line and the following ChangeLog entries. - Emacs follows the GNU coding standards for ChangeLog entries: see https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run From 31ca4e5501ffa7c80f114c1145ae0ea55fb76d11 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 8 Feb 2024 22:28:08 +0200 Subject: [PATCH 139/385] ; And another fix of CONTRIBUTE. --- CONTRIBUTE | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 687aa0888ab..69d7a2f114f 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -170,9 +170,9 @@ test 'out-of-tree' builds as well, i.e.: ** Commit messages -Ordinarily, a change you commit should contain a log entry in its -commit message and should not touch the repository's ChangeLog files. -Here is an example commit message (indented): +Ordinarily, a changeset you commit should contain a description of the +changes in its commit message and should not touch the repository's +ChangeLog files. Here is an example commit message (indented): Deactivate shifted region From 09c53b717d4941e2ddd113f3f6817bf65ae196f4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 8 Feb 2024 22:19:40 +0100 Subject: [PATCH 140/385] * admin/notes/kind-communication: New file. --- admin/notes/kind-communication | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 admin/notes/kind-communication diff --git a/admin/notes/kind-communication b/admin/notes/kind-communication new file mode 100644 index 00000000000..80b2afb27b2 --- /dev/null +++ b/admin/notes/kind-communication @@ -0,0 +1,21 @@ +The GNU Project encourages contributions from anyone who wishes to +advance the development of the GNU system, regardless of gender, race, +ethnic group, physical appearance, religion, cultural background, and +any other demographic characteristics, as well as personal political +views. + +People are sometimes discouraged from participating in GNU development +because of certain patterns of communication that strike them as +unfriendly, unwelcoming, rejecting, or harsh. This discouragement +particularly affects members of disprivileged demographics, but it is +not limited to them. Therefore, we ask all contributors to make a +conscious effort, in GNU Project discussions, to communicate in ways +that avoid that outcome — to avoid practices that will predictably and +unnecessarily risk putting some contributors off. + +The GNU Kind Communications Guidelines suggest specific ways to +accomplish that goal. You can find the latest version at +https://www.gnu.org/philosophy/kind-communication.html + +When sending messages to Emacs mailing lists, we ask you to read and +respect these guidelines. From 8290a1bacb019f5026caa08334a7087802ebc6f9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 9 Feb 2024 09:53:33 +0800 Subject: [PATCH 141/385] Replace a few calls to intern with constant strings * src/fns.c (do_yes_or_no_p, Fyes_or_no_p): Use symbol globals rather than intern. (syms_of_fns) : New symbols. * src/lread.c (readevalloop): Use symbol global. (syms_of_lread) : New symbol. --- src/fns.c | 6 ++++-- src/lread.c | 7 ++++++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/fns.c b/src/fns.c index 7de2616b359..61d87752777 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3211,7 +3211,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) Lisp_Object do_yes_or_no_p (Lisp_Object prompt) { - return call1 (intern ("yes-or-no-p"), prompt); + return call1 (Qyes_or_no_p, prompt); } DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, @@ -3256,7 +3256,7 @@ by a mouse, or by some window-system gesture, or via a menu. */) } if (use_short_answers) - return call1 (intern ("y-or-n-p"), prompt); + return call1 (Qy_or_n_p, prompt); { char *s = SSDATA (prompt); @@ -6618,4 +6618,6 @@ For best results this should end in a space. */); DEFSYM (Qreal_this_command, "real-this-command"); DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p"); + DEFSYM (Qyes_or_no_p, "yes-or-no-p"); + DEFSYM (Qy_or_n_p, "y-or-n-p"); } diff --git a/src/lread.c b/src/lread.c index b5eeb55bb70..5aa7466cc12 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2443,11 +2443,13 @@ readevalloop (Lisp_Object readcharfun, bool whole_buffer = 0; /* True on the first time around. */ bool first_sexp = 1; - Lisp_Object macroexpand = intern ("internal-macroexpand-for-load"); + Lisp_Object macroexpand; if (!NILP (sourcename)) CHECK_STRING (sourcename); + macroexpand = Qinternal_macroexpand_for_load; + if (NILP (Ffboundp (macroexpand)) || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) /* Don't macroexpand before the corresponding function is defined @@ -6016,4 +6018,7 @@ See Info node `(elisp)Shorthands' for more details. */); doc: /* List of variables declared dynamic in the current scope. Only valid during macro-expansion. Internal use only. */); Vmacroexp__dynvars = Qnil; + + DEFSYM (Qinternal_macroexpand_for_load, + "internal-macroexpand-for-load"); } From 5af4e346b0b078d6e8f3dd90bb66899d3ed99810 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 9 Feb 2024 10:43:48 +0800 Subject: [PATCH 142/385] Don't lose track of adstyles during face merging * src/xfaces.c (merge_face_vectors): If an adstyle exists in FROM, guarantee that a font spec will exist in TO with the same. --- src/xfaces.c | 35 +++++++++++++++++++++++++++-------- 1 file changed, 27 insertions(+), 8 deletions(-) diff --git a/src/xfaces.c b/src/xfaces.c index b9a78328661..a558e7328c0 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2245,20 +2245,20 @@ merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid) /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and store the resulting attributes in TO, which must be already be - completely specified and contain only absolute attributes. - Every specified attribute of FROM overrides the corresponding - attribute of TO; relative attributes in FROM are merged with the - absolute value in TO and replace it. NAMED_MERGE_POINTS is used - internally to detect loops in face inheritance/remapping; it should - be 0 when called from other places. If window W is non-NULL, use W - to interpret face specifications. */ + completely specified and contain only absolute attributes. Every + specified attribute of FROM overrides the corresponding attribute of + TO; merge relative attributes in FROM with the absolute value in TO, + which attributes also replace it. Use NAMED_MERGE_POINTS internally + to detect loops in face inheritance/remapping; it should be 0 when + called from other places. If window W is non-NULL, use W to + interpret face specifications. */ static void merge_face_vectors (struct window *w, struct frame *f, const Lisp_Object *from, Lisp_Object *to, struct named_merge_point *named_merge_points) { int i; - Lisp_Object font = Qnil; + Lisp_Object font = Qnil, tospec, adstyle; /* If FROM inherits from some other faces, merge their attributes into TO before merging FROM's direct attributes. Note that an :inherit @@ -2318,6 +2318,25 @@ merge_face_vectors (struct window *w, to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (font); if (! NILP (AREF (font, FONT_WIDTH_INDEX))) to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (font); + + if (!NILP (AREF (font, FONT_ADSTYLE_INDEX))) + { + /* If an adstyle is specified in FROM's font spec, create a + font spec for TO if none exists, and transfer the adstyle + there. */ + + tospec = to[LFACE_FONT_INDEX]; + adstyle = AREF (font, FONT_ADSTYLE_INDEX); + + if (!NILP (tospec)) + tospec = copy_font_spec (tospec); + else + tospec = Ffont_spec (0, NULL); + + to[LFACE_FONT_INDEX] = tospec; + ASET (tospec, FONT_ADSTYLE_INDEX, adstyle); + } + ASET (font, FONT_SIZE_INDEX, Qnil); } From b3821357696d44e3f553af14c209a21e69187c32 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 9 Feb 2024 13:15:57 +0800 Subject: [PATCH 143/385] Set adstyle within sfnt font objects * src/sfntfont.c (sfntfont_open): Don't incorrectly clear desc->adstyle. --- src/sfntfont.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/sfntfont.c b/src/sfntfont.c index 860fc446184..3be770f650e 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -3308,7 +3308,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, ASET (font_object, FONT_TYPE_INDEX, sfnt_vendor_name); ASET (font_object, FONT_FOUNDRY_INDEX, desc->designer); ASET (font_object, FONT_FAMILY_INDEX, Fintern (desc->family, Qnil)); - ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); + ASET (font_object, FONT_ADSTYLE_INDEX, desc->adstyle); ASET (font_object, FONT_REGISTRY_INDEX, sfntfont_registry_for_desc (desc)); @@ -3326,8 +3326,6 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, make_fixnum (desc->slant)); - ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); - /* Clear various offsets. */ font_info->font.baseline_offset = 0; font_info->font.relative_compose = 0; @@ -3412,7 +3410,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity, AREF (tem, 3)); FONT_SET_STYLE (font_object, FONT_SLANT_INDEX, AREF (tem, 4)); - ASET (font_object, FONT_ADSTYLE_INDEX, Qnil); + ASET (font_object, FONT_ADSTYLE_INDEX, AREF (tem, 1)); } } From 4e5068b7b3a06aaba6b93dff759a93b385ab8fd0 Mon Sep 17 00:00:00 2001 From: Dominique Quatravaux Date: Thu, 8 Feb 2024 10:19:10 +0100 Subject: [PATCH 144/385] Fix treesit_traverse_get_predicate (bug#68954) Commit d005e685e1df7692085378633348db39a5190374 should have used assq_no_signal, but didn't, this commit fixes that. * src/treesit.c (treesit_traverse_get_predicate): Replace assq_no_quit with assq_no_signal. Copyright-paperwork-exempt: yes --- src/treesit.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/treesit.c b/src/treesit.c index 12915ea9a10..d86ab501187 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -3275,11 +3275,11 @@ treesit_traverse_child_helper (TSTreeCursor *cursor, static Lisp_Object treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language) { - Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings); + Lisp_Object cons = assq_no_signal (language, Vtreesit_thing_settings); if (NILP (cons)) return Qnil; Lisp_Object definitions = XCDR (cons); - Lisp_Object entry = assq_no_quit (thing, definitions); + Lisp_Object entry = assq_no_signal (thing, definitions); if (NILP (entry)) return Qnil; /* ENTRY looks like (THING PRED). */ From 7d3a144486461869b943f04a45e84c0c3d926732 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 9 Feb 2024 08:49:55 +0200 Subject: [PATCH 145/385] ; Mention defface's and their :version tags in CONTRIBUTE. --- CONTRIBUTE | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 69d7a2f114f..cdb47911d76 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -115,9 +115,10 @@ mode after hiding the body of each entry. Doc-strings should be updated together with the code. -New defcustom's should always have a ':version' tag stating the first -Emacs version in which they will appear. Likewise with defcustom's -whose value is changed -- update their ':version' tag. +New defcustom's and defface's should always have a ':version' tag +stating the first Emacs version in which they will appear. Likewise +with defcustom's or defface's whose value is changed -- update their +':version' tag. Think about whether your change requires updating the manuals. If you know it does not, mark the NEWS entry with "---" before the entry. If From 8d09e1def55e57a8c627ba704289f796c48a085d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 8 Feb 2024 23:17:04 -0800 Subject: [PATCH 146/385] Port to GNU Make 03ecd94488b85adc38746ec3e7c2a297a522598e MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Collin Funk (Bug#68996). * GNUmakefile (.): New macro. (help): Use ‘$.’ instead of ‘$ ’. * cross/verbose.mk.android, src/verbose.mk.in (.): New macro. (AM_V_AR, AM_V_CC, AM_V_CXX, AM_V_CCLD, AM_V_CXXLD, AM_V_GEN): Use ‘$.’ instead of ‘$ ’. * lib-src/Makefile.in (install): Use ‘$.’ instead of ‘$ ’. --- GNUmakefile | 50 +++++++++++++++++++++------------------- cross/verbose.mk.android | 13 ++++++----- lib-src/Makefile.in | 4 ++-- src/verbose.mk.in | 29 ++++++++++++----------- 4 files changed, 50 insertions(+), 46 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index 16064672c65..58c0281e895 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -27,6 +27,8 @@ # newly-built Makefile. If the source tree is already configured, # this file defers to the existing Makefile. +. := + # If you want non-default build options, or if you want to build in an # out-of-source tree, you should run 'configure' before running 'make'. # But run 'autogen.sh' first, if the source was checked out directly @@ -36,30 +38,30 @@ ifeq (help,$(filter help,$(MAKECMDGOALS))) help: - $(info $ NOTE: This is a brief summary of some common make targets.) - $(info $ For more detailed information, please read the files INSTALL,) - $(info $ INSTALL.REPO, Makefile or visit this URL:) - $(info $ https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) - $(info $ ) - $(info $ make all -- compile and build Emacs) - $(info $ make install -- install Emacs) - $(info $ make TAGS -- update tags tables) - $(info $ make clean -- delete built files but preserve configuration) - $(info $ make mostlyclean -- like 'make clean', but leave those files that) - $(info $ usually do not need to be recompiled) - $(info $ make distclean -- delete all build and configuration files,) - $(info $ leave only files included in source distribution) - $(info $ make maintainer-clean -- delete almost everything that can be regenerated) - $(info $ make extraclean -- like maintainer-clean, and also delete) - $(info $ backup and autosave files) - $(info $ make bootstrap -- delete all compiled files to force a new bootstrap) - $(info $ from a clean slate, then build in the normal way) - $(info $ make uninstall -- remove files installed by 'make install') - $(info $ make check -- run the Emacs test suite) - $(info $ make docs -- generate Emacs documentation in info format) - $(info $ make html -- generate documentation in html format) - $(info $ make ps -- generate documentation in ps format) - $(info $ make pdf -- generate documentation in pdf format ) + $(info $.NOTE: This is a brief summary of some common make targets.) + $(info $.For more detailed information, please read the files INSTALL,) + $(info $.INSTALL.REPO, Makefile or visit this URL:) + $(info $.https://www.gnu.org/prep/standards/html_node/Standard-Targets.html) + $(info $.) + $(info $.make all -- compile and build Emacs) + $(info $.make install -- install Emacs) + $(info $.make TAGS -- update tags tables) + $(info $.make clean -- delete built files but preserve configuration) + $(info $.make mostlyclean -- like 'make clean', but leave those files that) + $(info $. usually do not need to be recompiled) + $(info $.make distclean -- delete all build and configuration files,) + $(info $. leave only files included in source distribution) + $(info $.make maintainer-clean -- delete almost everything that can be regenerated) + $(info $.make extraclean -- like maintainer-clean, and also delete) + $(info $. backup and autosave files) + $(info $.make bootstrap -- delete all compiled files to force a new bootstrap) + $(info $. from a clean slate, then build in the normal way) + $(info $.make uninstall -- remove files installed by 'make install') + $(info $.make check -- run the Emacs test suite) + $(info $.make docs -- generate Emacs documentation in info format) + $(info $.make html -- generate documentation in html format) + $(info $.make ps -- generate documentation in ps format) + $(info $.make pdf -- generate documentation in pdf format ) @: .PHONY: help diff --git a/cross/verbose.mk.android b/cross/verbose.mk.android index 958cf237c58..7b9af76404b 100644 --- a/cross/verbose.mk.android +++ b/cross/verbose.mk.android @@ -44,12 +44,13 @@ have_working_info = $(filter notintermediate,$(value .FEATURES)) # The workaround is done only for AM_V_ELC and AM_V_ELN, # since the bug is not annoying elsewhere. -AM_V_AR = @$(info $ AR $@) +. := +AM_V_AR = @$(info $. AR $@) AM_V_at = @ -AM_V_CC = @$(info $ CC $@) -AM_V_CXX = @$(info $ CXX $@) -AM_V_CCLD = @$(info $ CCLD $@) -AM_V_CXXLD = @$(info $ CXXLD $@) -AM_V_GEN = @$(info $ GEN $@) +AM_V_CC = @$(info $. CC $@) +AM_V_CXX = @$(info $. CXX $@) +AM_V_CCLD = @$(info $. CCLD $@) +AM_V_CXXLD = @$(info $. CXXLD $@) +AM_V_GEN = @$(info $. GEN $@) AM_V_NO_PD = --no-print-directory endif diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 7c059640862..3cdf1620781 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -319,7 +319,7 @@ maybe-blessmail: $(BLESSMAIL_TARGET) ## up if chown or chgrp fails, as the package responsible for ## installing Emacs can fix this problem later. $(DESTDIR)${archlibdir}: all - $(info $ ) + $(info $.) $(info Installing utilities run internally by Emacs.) umask 022 && ${MKDIR_P} "$(DESTDIR)${archlibdir}" exp_archlibdir=`cd "$(DESTDIR)${archlibdir}" && pwd -P` && \ @@ -361,7 +361,7 @@ $(DESTDIR)${archlibdir}: all .PHONY: bootstrap-clean check tags install: $(DESTDIR)${archlibdir} - $(info $ ) + $(info $.) $(info Installing utilities for users to run.) umask 022 && ${MKDIR_P} "$(DESTDIR)${bindir}" for file in ${INSTALLABLES} ; do \ diff --git a/src/verbose.mk.in b/src/verbose.mk.in index e72c182f276..6efb6b9416b 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in @@ -53,38 +53,39 @@ have_working_info = $(filter notintermediate,$(value .FEATURES)) # The workaround is done only for AM_V_ELC and AM_V_ELN, # since the bug is not annoying elsewhere. -AM_V_AR = @$(info $ AR $@) +. := +AM_V_AR = @$(info $. AR $@) AM_V_at = @ -AM_V_CC = @$(info $ CC $@) -AM_V_CXX = @$(info $ CXX $@) -AM_V_CCLD = @$(info $ CCLD $@) -AM_V_CXXLD = @$(info $ CXXLD $@) +AM_V_CC = @$(info $. CC $@) +AM_V_CXX = @$(info $. CXX $@) +AM_V_CCLD = @$(info $. CCLD $@) +AM_V_CXXLD = @$(info $. CXXLD $@) ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--) ifneq (,$(have_working_info)) -AM_V_ELC = @$(info $ ELC+ELN $@) -AM_V_ELN = @$(info $ ELN $@) +AM_V_ELC = @$(info $. ELC+ELN $@) +AM_V_ELN = @$(info $. ELN $@) else AM_V_ELC = @echo " ELC+ELN " $@; AM_V_ELN = @echo " ELN " $@; endif else ifneq (,$(have_working_info)) -AM_V_ELC = @$(info $ ELC $@) +AM_V_ELC = @$(info $. ELC $@) else AM_V_ELC = @echo " ELC " $@; endif AM_V_ELN = endif -AM_V_GEN = @$(info $ GEN $@) -AM_V_GLOBALS = @$(info $ GEN globals.h) +AM_V_GEN = @$(info $. GEN $@) +AM_V_GLOBALS = @$(info $. GEN globals.h) AM_V_NO_PD = --no-print-directory -AM_V_RC = @$(info $ RC $@) +AM_V_RC = @$(info $. RC $@) # These are used for the Android port. -AM_V_JAVAC = @$(info $ JAVAC $@) -AM_V_D8 = @$(info $ D8 $@) -AM_V_AAPT = @$(info $ AAPT $@) +AM_V_JAVAC = @$(info $. JAVAC $@) +AM_V_D8 = @$(info $. D8 $@) +AM_V_AAPT = @$(info $. AAPT $@) AM_V_SILENT = @ endif From f1e7b5230ad93aab20af1fd7b09931a746a89d5d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Feb 2024 11:05:14 +0100 Subject: [PATCH 147/385] Tramp: Handle PIN requests from security keys (don't merge) * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Use `tramp-security-key-pin-regexp'. * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. (tramp-action-show-and-confirm-message): Expand for PIN requests. --- doc/misc/tramp.texi | 9 +++++++-- lisp/net/tramp-sh.el | 2 ++ lisp/net/tramp.el | 33 ++++++++++++++++++++++----------- 3 files changed, 31 insertions(+), 13 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 3be88d1767a..d6031d96d6b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5070,9 +5070,14 @@ Does @value{tramp} support @acronym{SSH} security keys? Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware devices via special key types @option{*-sk}. @value{tramp} supports the additional handshaking messages for them. This requires at least -@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible -security key, like yubikey, solokey, nitrokey, or titankey. +@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or +@acronym{FIDO2} compatible security key, like yubikey, solokey, +nitrokey, or titankey. +@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} +@strong{Note} that there are reports on problems of handling yubikey +residential keys by @command{ssh-agent}. As workaround, you might +disable @command{ssh-agent} for such keys. @item @value{tramp} does not connect to Samba or MS Windows hosts running diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 44c0bdc7aea..3e6fb384a8f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -544,6 +544,7 @@ shell from reading its init file." (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -563,6 +564,7 @@ corresponding PATTERN matches, the ACTION function is called.") (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bd556753261..f3da56e7a4f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -224,7 +224,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: set this to any value other than \"/bin/sh\": Tramp wants to use a shell which groks tilde expansion, but it can search for it. Also note that \"/bin/sh\" exists on all Unixen - except Andtoid, this might not be true for the value that you + except Android, this might not be true for the value that you decide to use. You Have Been Warned. * `tramp-remote-shell-login' @@ -788,6 +788,13 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +(defcustom tramp-security-key-pin-regexp + (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) + "Regular expression matching security key PIN prompt. +The regexp should match at end of buffer." + :version "29.3" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") @@ -5589,7 +5596,7 @@ of." prompt) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (setq prompt (concat (match-string 1) " ")) + (setq prompt (concat (string-trim (match-string 1)) " ")) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -5665,14 +5672,17 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message - (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) + (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. (while (not (tramp-compat-ignore-error file-error (tramp-wait-for-regexp - proc 0.1 tramp-security-key-confirmed-regexp))) + proc 0.1 + (tramp-compat-rx + (| (regexp tramp-security-key-confirmed-regexp) + (regexp tramp-security-key-pin-regexp) + (regexp tramp-security-key-timeout-regexp)))))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) (throw 'tramp-action 'timeout)) (redisplay 'force))) @@ -6726,12 +6736,13 @@ Consults the auth-source package." (tramp-get-connection-property key "login-as"))) (host (tramp-file-name-host-port vec)) (pw-prompt - (or prompt - (with-current-buffer (process-buffer proc) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (if (string-match-p "passphrase" (match-string 1)) - (match-string 0) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (string-trim-left + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key)))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) From 8d6a8e573f9a1e4eb9ebbc0ec244907263e61bb8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Feb 2024 11:21:05 +0100 Subject: [PATCH 148/385] Tramp: Handle PIN requests from security keys * doc/misc/tramp.texi (Frequently Asked Questions): Clarify FIDO entry. * lisp/net/tramp-sh.el (tramp-actions-before-shell) (tramp-actions-copy-out-of-band): Use `tramp-security-key-pin-regexp'. * lisp/net/tramp.el (tramp-security-key-pin-regexp): New defcustom. (tramp-action-otp-password, tramp-read-passwd): Trim password prompt. (tramp-action-show-and-confirm-message): Expand for PIN requests. --- doc/misc/tramp.texi | 9 +++++++-- lisp/net/tramp-sh.el | 2 ++ lisp/net/tramp.el | 30 ++++++++++++++++++++---------- 3 files changed, 29 insertions(+), 12 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56945d3071c..90824024c03 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5238,9 +5238,14 @@ Does @value{tramp} support @acronym{SSH} security keys? Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware devices via special key types @option{*-sk}. @value{tramp} supports the additional handshaking messages for them. This requires at least -@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible -security key, like yubikey, solokey, nitrokey, or titankey. +@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} or +@acronym{FIDO2} compatible security key, like yubikey, solokey, +nitrokey, or titankey. +@c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} +@strong{Note} that there are reports on problems of handling yubikey +residential keys by @command{ssh-agent}. As workaround, you might +disable @command{ssh-agent} for such keys. @item @value{tramp} does not connect to Samba or MS Windows hosts running diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 68ee541bee6..3557b3a1b64 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -547,6 +547,7 @@ shell from reading its init file." (tramp-terminal-prompt-regexp tramp-action-terminal) (tramp-antispoof-regexp tramp-action-confirm-message) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-process-alive)) "List of pattern/action pairs. Whenever a pattern matches, the corresponding action is performed. @@ -566,6 +567,7 @@ corresponding PATTERN matches, the ACTION function is called.") (tramp-wrong-passwd-regexp tramp-action-permission-denied) (tramp-copy-failed-regexp tramp-action-permission-denied) (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message) + (tramp-security-key-pin-regexp tramp-action-otp-password) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8e114912527..ae59915b1e8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -770,6 +770,13 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +(defcustom tramp-security-key-pin-regexp + (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) + "Regular expression matching security key PIN prompt. +The regexp should match at end of buffer." + :version "29.3" + :type 'regexp) + (defcustom tramp-operation-not-permitted-regexp (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank) "Operation not permitted") @@ -5435,7 +5442,7 @@ of." prompt) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (setq prompt (concat (match-string 1) " ")) + (setq prompt (concat (string-trim (match-string 1)) " ")) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the ;; password from the debug buffer and the traces. @@ -5511,14 +5518,16 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message - (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) + (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. (while (not (ignore-error file-error (tramp-wait-for-regexp - proc 0.1 tramp-security-key-confirmed-regexp))) + proc 0.1 + (rx (| (regexp tramp-security-key-confirmed-regexp) + (regexp tramp-security-key-pin-regexp) + (regexp tramp-security-key-timeout-regexp)))))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) (throw 'tramp-action 'timeout)) (redisplay 'force)))))) @@ -6564,12 +6573,13 @@ Consults the auth-source package." (tramp-get-connection-property key "login-as"))) (host (tramp-file-name-host-port vec)) (pw-prompt - (or prompt - (with-current-buffer (process-buffer proc) - (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (if (string-match-p "passphrase" (match-string 1)) - (match-string 0) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (string-trim-left + (or prompt + (with-current-buffer (process-buffer proc) + (tramp-check-for-regexp proc tramp-password-prompt-regexp) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key)))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) From c4ec6d0472beac2a0cb4f5c8baec79e39dfc410b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:08:51 -0500 Subject: [PATCH 149/385] * lisp/subr.el (read-char-from-minibuffer): Fix bug#68995 --- lisp/subr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index e53ef505522..f41bb34045e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3726,10 +3726,10 @@ There is no need to explicitly add `help-char' to CHARS; (this-command this-command) (result (minibuffer-with-setup-hook (lambda () + (setq-local post-self-insert-hook nil) (add-hook 'post-command-hook (lambda () - ;; FIXME: Should we use `<='? - (if (= (1+ (minibuffer-prompt-end)) + (if (<= (1+ (minibuffer-prompt-end)) (point-max)) (exit-minibuffer))) nil 'local)) From 3c3702b9bbc79f63026606dc0f391da3d795226d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:13:29 -0500 Subject: [PATCH 150/385] * lisp/subr.el (with-output-to-temp-buffer): Add `indent` rule --- lisp/emacs-lisp/lisp-mode.el | 1 - lisp/subr.el | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ad0525e24be..3475d944337 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1347,7 +1347,6 @@ Lisp function does not specify a special indentation." (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) -(put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) (defun indent-sexp (&optional endpos) diff --git a/lisp/subr.el b/lisp/subr.el index f41bb34045e..c317d558e24 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5019,7 +5019,7 @@ read-only, and scans it for function and variable names to make them into clickable cross-references. See the related form `with-temp-buffer-window'." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((old-dir (make-symbol "old-dir")) (buf (make-symbol "buf"))) `(let* ((,old-dir default-directory) From efedb8f479f1f2cf4d7ce703c6411dd756d2843d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Feb 2024 14:22:14 -0500 Subject: [PATCH 151/385] modula2.el: Avoid font-lock-*-face variables * lisp/progmodes/modula2.el (m3-font-lock-keywords-1) (m3-font-lock-keywords-2): Refer to the font-lock faces directly --- lisp/progmodes/modula2.el | 47 +++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 09cb848fd52..2bb31988290 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -325,20 +325,20 @@ followed by the first character of the construct. ;; ;; Module definitions. ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t)) ;; ;; Import directives. ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" - (1 font-lock-keyword-face) + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-constant-face))) + (1 'font-lock-constant-face))) ;; ;; Pragmas as warnings. ;; Spencer Allain says do them as comments... ;; ("<\\*.*\\*>" . font-lock-warning-face) ;; ... but instead we fontify the first word. - ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) + ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend) ) "Subdued level highlighting for Modula-3 modes.") @@ -366,26 +366,29 @@ followed by the first character of the construct. "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) ) - (list - ;; - ;; Keywords except those fontified elsewhere. - (concat "\\<\\(" m3-keywords "\\)\\>") - ;; - ;; Builtins. - (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) - ;; - ;; Type names. - (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify tokens as function names. - '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" - (1 font-lock-keyword-face) + `( + ;; + ;; Keywords except those fontified elsewhere. + ,(concat "\\<\\(" m3-keywords "\\)\\>") + ;; + ;; Builtins. + (,(concat "\\<\\(" m3-builtins "\\)\\>") + (0 'font-lock-builtin-face)) + ;; + ;; Type names. + (,(concat "\\<\\(" m3-types "\\)\\>") + (0 'font-lock-type-face)) + ;; + ;; Fontify tokens as function names. + ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-function-name-face))) - ;; - ;; Fontify constants as references. - '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) + (1 'font-lock-function-name-face))) + ;; + ;; Fontify constants as references. + ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" + (0 'font-lock-constant-face)) )))) "Gaudy level highlighting for Modula-3 modes.") From 7a13e705b1aead8f527dfa5407d9f87301b1f252 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 7 Feb 2024 17:58:31 -0800 Subject: [PATCH 152/385] Put the list of built-in Eshell commands in its own manual node * doc/misc/eshell.texi (Built-ins): Fix capitalization of node to be more consistent with the rest of the manual. Fix a cross reference. List child nodes. (List of Built-ins): New section and node. (Defining New Built-ins): Make this a node. Fix capitalization. --- doc/misc/eshell.texi | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 5d3e5c7dbd6..9e5eea6cb61 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -416,7 +416,7 @@ elisp, The Emacs Lisp Reference Manual}). @end table @node Built-ins -@section Built-in commands +@section Built-in Commands Eshell provides a number of built-in commands, many of them implementing common command-line utilities, but enhanced for Eshell. (These built-in commands are just ordinary Lisp functions whose names @@ -477,7 +477,16 @@ default target for the commands @command{cp}, @command{mv}, and @command{ln} is the current directory. A few commands are wrappers for more niche Emacs features, and can be -loaded as part of the eshell-xtra module. @xref{Extension modules}. +loaded as part of the @code{eshell-xtra} module. @xref{Extra built-in +commands}. + +@menu +* List of Built-ins:: +* Defining New Built-ins:: +@end menu + +@node List of Built-ins +@subsection List of Built-in Commands @table @code @@ -1195,7 +1204,8 @@ connection-aware, so for remote directories, it will print the user associated with that connection. @end table -@subsection Defining new built-in commands +@node Defining New Built-ins +@subsection Defining New Built-in Commands While Eshell can run Lisp functions directly as commands, it may be more convenient to provide a special built-in command for Eshell. Built-in commands are just ordinary Lisp functions designed From b5b80de49c5a37778945d7a0234090b09acc104f Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 8 Feb 2024 11:31:17 -0800 Subject: [PATCH 153/385] In Eshell manual, put command index anchors above the item This makes sure that when navigating to the command's documentation from the index, it shows the item heading (which lists the supported arguments). * doc/misc/eshell.texi (List of Built-ins, Tramp extensions) (Extra built-in commands): Adjust placement of '@cmindex'. --- doc/misc/eshell.texi | 134 +++++++++++++++++++++---------------------- 1 file changed, 67 insertions(+), 67 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 9e5eea6cb61..3ff8e55ed03 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -490,16 +490,16 @@ commands}. @table @code -@item . @var{file} [@var{argument}]@dots{} @cmindex . +@item . @var{file} [@var{argument}]@dots{} Source an Eshell script named @var{file} in the current environment, passing any @var{arguments} to the script (@pxref{Scripts}). This is not to be confused with the command @command{source}, which sources a file in a subshell environment. +@cmindex addpath @item addpath @itemx addpath [-b] @var{directory}@dots{} -@cmindex addpath Adds each specified @var{directory} to the @code{$PATH} environment variable. By default, this adds the directories to the end of @code{$PATH}, in the order they were passed on the command line; by @@ -509,30 +509,30 @@ directories to the beginning. With no directories, print the list of directories currently stored in @code{$PATH}. +@cmindex alias @item alias @itemx alias @var{name} [@var{command}] -@cmindex alias Define an alias named @var{name} and expanding to @var{command}, adding it to the aliases file (@pxref{Aliases}). If @var{command} is omitted, delete the alias named @var{name}. With no arguments at all, list all the currently-defined aliases. -@item basename @var{filename} @cmindex basename +@item basename @var{filename} Return @var{filename} without its directory. -@item cat @var{file}@dots{} @cmindex cat +@item cat @var{file}@dots{} Concatenate the contents of @var{file}s to standard output. If in a pipeline, or if any of the files is not a regular file, directory, or symlink, then this command reverts to the system's definition of @command{cat}. +@cmindex cd @item cd @itemx cd @var{directory} @itemx cd -[@var{n}] @itemx cd =[@var{regexp}] -@cmindex cd Change the current working directory. This command can take several forms: @@ -567,20 +567,20 @@ will report the directory it changes to. If @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} is called with any remaining arguments after changing directories. -@item clear [@var{scrollback}] @cmindex clear +@item clear [@var{scrollback}] Scrolls the contents of the Eshell window out of sight, leaving a blank window. If @var{scrollback} is non-@code{nil}, the scrollback contents are cleared instead, as with @command{clear-scrollback}. -@item clear-scrollback @cmindex clear-scrollback +@item clear-scrollback Clear the scrollback contents of the Eshell window. Unlike the command @command{clear}, this command deletes content in the Eshell buffer. -@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} @cmindex compile +@item compile [-p | -i] [-m @var{mode-name}] @var{command}@dots{} Run an external command, sending its output to a compilation buffer if the command would output to the screen and is not part of a pipeline or subcommand. @@ -598,9 +598,9 @@ you have a grep-like command on your system, you might define an alias for it like so: @samp{alias mygrep 'compile --mode=grep-mode -- mygrep $*'}. +@cmindex cp @item cp [@var{option}@dots{}] @var{source} @var{dest} @item cp [@var{option}@dots{}] @var{source}@dots{} @var{directory} -@cmindex cp Copy the file @var{source} to @var{dest} or @var{source} into @var{directory}. @@ -644,14 +644,14 @@ Print the name of each file before copying it. @end table -@item date [@var{specified-time} [@var{zone}]] @cmindex date +@item date [@var{specified-time} [@var{zone}]] Print the current local time as a human-readable string. This command is an alias to the Emacs Lisp function @code{current-time-string} (@pxref{Time of Day,,, elisp, GNU Emacs Lisp Reference Manual}). -@item diff [@var{option}]@dots{} @var{old} @var{new} @cmindex diff +@item diff [@var{option}]@dots{} @var{old} @var{new} Compare the files @var{old} and @var{new} using Emacs's internal @code{diff} (not to be confused with @code{ediff}). @xref{Comparing Files, , , emacs, The GNU Emacs Manual}. @@ -661,18 +661,18 @@ If @code{eshell-plain-diff-behavior} is non-@code{nil}, then this command does not use Emacs's internal @code{diff}. This is the same as using @samp{alias diff '*diff $@@*'}. -@item dirname @var{filename} @cmindex dirname +@item dirname @var{filename} Return the directory component of @var{filename}. -@item dirs @cmindex dirs +@item dirs Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, respectively. -@item du [@var{option}]@dots{} @var{file}@dots{} @cmindex du +@item du [@var{option}]@dots{} @var{file}@dots{} Summarize disk usage for each file, recursing into directories. @command{du} accepts the following options: @@ -720,8 +720,8 @@ Skip any directories that reside on different filesystems. @end table -@item echo [-n | -N] [@var{arg}]@dots{} @cmindex echo +@item echo [-n | -N] [@var{arg}]@dots{} Prints the value of each @var{arg}. By default, this prints in a Lisp-friendly fashion (so that the value is useful to a Lisp command using the result of @command{echo} as an argument). If a single @@ -739,16 +739,16 @@ using @code{-n} to disable the trailing newline (the default behavior) or @code{-N} to enable it (the default when @code{eshell-plain-echo-behavior} is non-@code{nil}). -@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} @cmindex env +@item env [@var{var}=@var{value}]@dots{} [@var{command}]@dots{} With no arguments, print the current environment variables. If you pass arguments to this command, then @command{env} will execute the arguments as a command. If you pass any initial arguments of the form @samp{@var{var}=@var{value}}, @command{env} will first set @var{var} to @var{value} before running the command. -@item eshell-debug [error | form | process]@dots{} @cmindex eshell-debug +@item eshell-debug [error | form | process]@dots{} Toggle debugging information for Eshell itself. You can pass this command one or more of the following arguments: @@ -768,30 +768,30 @@ buffer @code{*eshell last cmd*}; or @end itemize -@item exit @cmindex exit +@item exit @vindex eshell-kill-on-exit Exit Eshell and save the history. By default, this command kills the Eshell buffer, but if @code{eshell-kill-on-exit} is @code{nil}, then the buffer is merely buried instead. -@item export [@var{name}=@var{value}]@dots{} @cmindex export +@item export [@var{name}=@var{value}]@dots{} Set environment variables using input like Bash's @command{export}, as in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. -@item grep [@var{arg}]@dots{} @cmindex grep -@itemx agrep [@var{arg}]@dots{} +@item grep [@var{arg}]@dots{} @cmindex agrep -@itemx egrep [@var{arg}]@dots{} +@itemx agrep [@var{arg}]@dots{} @cmindex egrep -@itemx fgrep [@var{arg}]@dots{} +@itemx egrep [@var{arg}]@dots{} @cmindex fgrep -@itemx rgrep [@var{arg}]@dots{} +@itemx fgrep [@var{arg}]@dots{} @cmindex rgrep -@itemx glimpse [@var{arg}]@dots{} +@itemx rgrep [@var{arg}]@dots{} @cmindex glimpse +@itemx glimpse [@var{arg}]@dots{} The @command{grep} commands are compatible with GNU @command{grep}, but open a compilation buffer in @code{grep-mode} instead. @xref{Grep Searching, , , emacs, The GNU Emacs Manual}. @@ -803,9 +803,9 @@ to Eshell's buffer. This is the same as using @samp{alias grep '*grep $@@*'}, though this setting applies to all of the built-in commands for which you would need to create a separate alias. +@cmindex history @item history [@var{n}] @itemx history [-arw] [@var{filename}] -@cmindex history Prints Eshell's input history. With a numeric argument @var{n}, this command prints the @var{n} most recent items in the history. Alternately, you can specify the following options: @@ -824,8 +824,8 @@ Write the current history list to the history file. @end table -@item info [@var{manual} [@var{item}]@dots{}] @cmindex info +@item info [@var{manual} [@var{item}]@dots{}] Browse the available Info documentation. With no arguments, browse the top-level menu. Otherwise, show the manual for @var{manual}, selecting the menu entry for @var{item}. @@ -834,25 +834,25 @@ This command is the same as the external @command{info} command, but uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The GNU Emacs Manual}. -@item jobs @cmindex jobs +@item jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. -@item kill [-@var{signal}] [@var{pid} | @var{process}] @cmindex kill +@item kill [-@var{signal}] [@var{pid} | @var{process}] Kill processes. Takes a PID or a process object and an optional @var{signal} specifier which can either be a number or a signal name. -@item listify [@var{arg}]@dots{} @cmindex listify +@item listify [@var{arg}]@dots{} Return the arguments as a single list. With a single argument, return it as-is if it's already a list, or otherwise wrap it in a list. With multiple arguments, return a list of all of them. +@cmindex ln @item ln [@var{option}]@dots{} @var{target} [@var{link-name}] @itemx ln [@var{option}]@dots{} @var{target}@dots{} @var{directory} -@cmindex ln Create a link to the specified @var{target} named @var{link-name} or create links to multiple @var{targets} in @var{directory}. @@ -886,8 +886,8 @@ Print the name of each file before linking it. @end table -@item locate @var{arg}@dots{} @cmindex locate +@item locate @var{arg}@dots{} Alias to Emacs's @code{locate} function, which simply runs the external @command{locate} command and parses the results. @xref{Dired and Find, , , emacs, The GNU Emacs Manual}. @@ -897,8 +897,8 @@ If @code{eshell-plain-locate-behavior} is non-@code{nil}, then Emacs's internal @code{locate} is not used. This is the same as using @samp{alias locate '*locate $@@*'}. -@item ls [@var{option}]@dots{} [@var{file}]@dots{} @cmindex ls +@item ls [@var{option}]@dots{} [@var{file}]@dots{} List information about each @var{file}, including the contents of any specified directories. If @var{file} is unspecified, list the contents of the current directory. @@ -999,25 +999,25 @@ List one file per line. @end table -@item make [@var{arg}]@dots{} @cmindex make +@item make [@var{arg}]@dots{} Run @command{make} through @code{compile} when run asynchronously (e.g., @samp{make &}). @xref{Compilation, , , emacs, The GNU Emacs Manual}. Otherwise call the external @command{make} command. -@item man [@var{arg}]@dots{} @cmindex man +@item man [@var{arg}]@dots{} Display Man pages using the Emacs @code{man} command. @xref{Man Page, , , emacs, The GNU Emacs Manual}. -@item mkdir [-p] @var{directory}@dots{} @cmindex mkdir +@item mkdir [-p] @var{directory}@dots{} Make new directories. With @code{-p} or @code{--parents}, automatically make any necessary parent directories as well. +@cmindex mv @item mv [@var{option}]@dots{} @var{source} @var{dest} @itemx mv [@var{option}]@dots{} @var{source}@dots{} @var{directory} -@cmindex mv Rename the file @var{source} to @var{dest} or move @var{source} into @var{directory}. @@ -1048,14 +1048,14 @@ Print the name of each item before moving it. @end table -@item occur @var{regexp} [@var{nlines}] @cmindex occur +@item occur @var{regexp} [@var{nlines}] Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. +@cmindex popd @item popd @item popd +@var{n} -@cmindex popd Pop a directory from the directory stack and switch to a another place in the stack. This command can take the following forms: @@ -1071,14 +1071,14 @@ the @var{nth} directory in the stack (counting from zero). @end table -@item printnl [@var{arg}]@dots{} @cmindex printnl +@item printnl [@var{arg}]@dots{} Print all the @var{arg}s separated by newlines. +@cmindex pushd @item pushd @itemx pushd @var{directory} @itemx pushd +@var{n} -@cmindex pushd Push the current directory onto the directory stack, then change to another directory. This command can take the following forms: @@ -1107,12 +1107,12 @@ non-@code{nil}, then @samp{pushd +@var{n}} will instead pop the @end table -@item pwd @cmindex pwd +@item pwd Prints the current working directory. -@item rm [@var{option}]@dots{} @var{item}@dots{} @cmindex rm +@item rm [@var{option}]@dots{} @var{item}@dots{} Removes files, buffers, processes, or Emacs Lisp symbols, depending on the type of each @var{item}. @@ -1146,59 +1146,59 @@ Print the name of each item before removing it. @end table -@item rmdir @var{directory}@dots{} @cmindex rmdir +@item rmdir @var{directory}@dots{} Removes directories if they are empty. -@item set [@var{var} @var{value}]@dots{} @cmindex set +@item set [@var{var} @var{value}]@dots{} Set variable values, using the function @code{set} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). The value of @var{var} can be a symbol, in which case it refers to a Lisp variable, or a string, referring to an environment variable (@pxref{Arguments}). -@item setq [@var{symbol} @var{value}]@dots{} @cmindex setq +@item setq [@var{symbol} @var{value}]@dots{} Set variable values, using the function @code{setq} like a command (@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). -@item source @var{file} [@var{argument}]@dots{} @cmindex source +@item source @var{file} [@var{argument}]@dots{} Source an Eshell script named @var{file} in a subshell environment, passing any @var{argument}s to the script (@pxref{Scripts}). This is not to be confused with the command @command{.}, which sources a file in the current environment. -@item time @var{command}@dots{} @cmindex time +@item time @var{command}@dots{} Show the time elapsed during the execution of @var{command}. +@cmindex umask @item umask [-S] @itemx umask @var{mode} -@cmindex umask View the default file permissions for newly created files and directories. If you pass @code{-S} or @code{--symbolic}, view the mode symbolically. With @var{mode}, set the default permissions to this value. -@item unset [@var{var}]@dots{} @cmindex unset +@item unset [@var{var}]@dots{} Unset one or more variables. As with @command{set}, the value of @var{var} can be a symbol, in which case it refers to a Lisp variable, or a string, referring to an environment variable. -@item wait [@var{process}]@dots{} @cmindex wait +@item wait [@var{process}]@dots{} Wait until each specified @var{process} has exited. -@item which @var{command}@dots{} @cmindex which +@item which @var{command}@dots{} For each @var{command}, identify what kind of command it is and its location. -@item whoami @cmindex whoami +@item whoami Print the current user. This Eshell version of @command{whoami} is connection-aware, so for remote directories, it will print the user associated with that connection. @@ -2601,17 +2601,17 @@ external commands. To enable it, add @code{eshell-tramp} to @table @code -@item su [- | -l] [@var{user}] @cmindex su +@item su [- | -l] [@var{user}] Uses TRAMP's @command{su} method (@pxref{Inline methods, , , tramp, The Tramp Manual}) to change the current user to @var{user} (or root if unspecified). With @code{-}, @code{-l}, or @code{--login}, provide a login environment. -@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex sudo -@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] +@item sudo [-u @var{user}] [-s | @var{command}@dots{}] @cmindex doas +@itemx doas [-u @var{user}] [-s | @var{command}@dots{}] Uses TRAMP's @command{sudo} or @command{doas} method (@pxref{Inline methods, , , tramp, The Tramp Manual}) to run @var{command} as root via @command{sudo} or @command{doas}. When specifying @code{-u @@ -2630,59 +2630,59 @@ add @code{eshell-xtra} to @code{eshell-modules-list}. @table @code -@item count @var{item} @var{seq} [@var{option}]@dots{} @cmindex count +@item count @var{item} @var{seq} [@var{option}]@dots{} A wrapper around the function @code{cl-count} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} @cmindex expr +@item expr @var{str} [@var{separator}] [@var{arg}]@dots{} An implementation of @command{expr} using the Calc package. @xref{Top,,, calc, The GNU Emacs Calculator}. -@item ff @var{directory} @var{pattern} @cmindex ff +@item ff @var{directory} @var{pattern} Shorthand for the the function @code{find-name-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item gf @var{directory} @var{regexp} @cmindex gf +@item gf @var{directory} @var{regexp} Shorthand for the the function @code{find-grep-dired} (@pxref{Dired and Find, , , emacs, The Emacs Editor}). -@item intersection @var{list1} @var{list2} [@var{option}]@dots{} @cmindex intersection +@item intersection @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-intersection} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} @cmindex mismatch +@item mismatch @var{seq1} @var{seq2} [@var{option}]@dots{} A wrapper around the function @code{cl-mismatch} (@pxref{Searching Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-difference +@item set-difference @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-set-difference} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} @cmindex set-exclusive-or +@item set-exclusive-or @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} @cmindex substitute +@item substitute @var{new} @var{old} @var{seq} [@var{option}]@dots{} A wrapper around the function @code{cl-substitute} (@pxref{Sequence Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. -@item union @var{list1} @var{list2} [@var{option}]@dots{} @cmindex union +@item union @var{list1} @var{list2} [@var{option}]@dots{} A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. From de5acc3b0d854aeb7dbf104c0977efe2f2266e1a Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 8 Feb 2024 11:44:05 -0800 Subject: [PATCH 154/385] Add concept indices for some Eshell commands * doc/misc/eshell.texi (List of Built-ins): Add indices for some directory- and process-related commands. (Aliases): Change to concept index. --- doc/misc/eshell.texi | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 3ff8e55ed03..30c85da795b 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -3,7 +3,7 @@ @setfilename ../../info/eshell.info @settitle Eshell: The Emacs Shell @include docstyle.texi -@defindex cm +@defcodeindex cm @syncodeindex vr fn @c %**end of header @@ -529,6 +529,7 @@ symlink, then this command reverts to the system's definition of @command{cat}. @cmindex cd +@cindex directories, changing @item cd @itemx cd @var{directory} @itemx cd -[@var{n}] @@ -666,6 +667,7 @@ as using @samp{alias diff '*diff $@@*'}. Return the directory component of @var{filename}. @cmindex dirs +@cindex directory stack, listing @item dirs Prints the directory stack. Directories can be added or removed from the stack using the commands @command{pushd} and @command{popd}, @@ -835,11 +837,13 @@ uses Emacs's internal Info reader. @xref{Misc Help, , , emacs, The GNU Emacs Manual}. @cmindex jobs +@cindex processes, listing @item jobs List subprocesses of the Emacs process, if any, using the function @code{list-processes}. @cmindex kill +@cindex processes, signaling @item kill [-@var{signal}] [@var{pid} | @var{process}] Kill processes. Takes a PID or a process object and an optional @var{signal} specifier which can either be a number or a signal name. @@ -1054,6 +1058,7 @@ Alias to Emacs's @code{occur}. @xref{Other Repeating Search, , , emacs, The GNU Emacs Manual}. @cmindex popd +@cindex directory stack, removing from @item popd @item popd +@var{n} Pop a directory from the directory stack and switch to a another place @@ -1076,6 +1081,7 @@ the @var{nth} directory in the stack (counting from zero). Print all the @var{arg}s separated by newlines. @cmindex pushd +@cindex directory stack, adding to @item pushd @itemx pushd @var{directory} @itemx pushd +@var{n} @@ -1189,6 +1195,7 @@ Unset one or more variables. As with @command{set}, the value of or a string, referring to an environment variable. @cmindex wait +@cindex processes, waiting for @item wait [@var{process}]@dots{} Wait until each specified @var{process} has exited. @@ -1501,7 +1508,7 @@ create and switch to a directory called @samp{foo}. @node Remote Access @section Remote Access -@cmindex remote access +@cindex remote access Since Eshell uses Emacs facilities for most of its functionality, you can access remote hosts transparently. To connect to a remote host, From 6568a9a0099e7745bfd142a0fd16b4d7215c0250 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Wed, 7 Feb 2024 23:00:08 +0100 Subject: [PATCH 155/385] Add option gnus-mode-line-logo * lisp/gnus/gnus.el (gnus-mode-line-logo): New option specifying whether and which logo will be displayed in the mode-line. * etc/NEWS: Announce the change. --- etc/NEWS | 5 +++++ lisp/gnus/gnus.el | 29 ++++++++++++++++++++--------- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 4d3c652aebc..76862bf500d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1102,6 +1102,11 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the user option 'nnweb-type' to 'gmane'. +*** New user option 'gnus-mode-line-logo'. +This allows the user to either disable the display of any logo or +specify which logo will be displayed as part of the +buffer-identification in the mode-line of Gnus-buffers. + ** Rmail --- diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 99833e4eeca..cf4c3f7841c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -309,12 +309,30 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) +(defcustom gnus-mode-line-logo + '((:type svg :file "gnus-pointer.svg" :ascent center) + (:type xpm :file "gnus-pointer.xpm" :ascent center) + (:type xbm :file "gnus-pointer.xbm" :ascent center)) + "Gnus logo displayed in mode-line. + +If non-nil, it should be a list of image specifications that will be +given as first argument to `find-image', which see. Then, in case of a +graphical display, the specified Gnus logo will be displayed as part of +the buffer-identification in the mode-line of Gnus-buffers. + +If nil, no logo will be displayed." + :group 'gnus-visual + :type '(choice + (repeat :tag "List of image specifications" (plist)) + (const :tag "No logo" nil))) + (defun gnus-mode-line-buffer-identification (line) (let* ((str (car-safe line)) (str (if (stringp str) (car (propertized-buffer-identification str)) str))) - (if (or (not (fboundp 'find-image)) + (if (or (not gnus-mode-line-logo) + (not (fboundp 'find-image)) (not (display-graphic-p)) (not (stringp str)) (not (string-match "^Gnus:" str))) @@ -325,14 +343,7 @@ be set in `.emacs' instead." (add-text-properties 0 5 (list 'display - (find-image - '((:type svg :file "gnus-pointer.svg" - :ascent center) - (:type xpm :file "gnus-pointer.xpm" - :ascent center) - (:type xbm :file "gnus-pointer.xbm" - :ascent center)) - t) + (find-image gnus-mode-line-logo t) 'help-echo (if gnus-emacs-version (format "This is %s, %s." From e7d1b12878ed83ad8c6995d8443f3367750ff0c9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 10 Feb 2024 15:02:39 +0800 Subject: [PATCH 156/385] Make miscellaneous improvements to the Android port * java/org/gnu/emacs/EmacsActivity.java (onCreate): Deal with omitted calls to onWindowFocusChanged after activity recreation. * java/org/gnu/emacs/EmacsService.java (clearWindow, clearArea): Delete redundant wrapper functions. (getUsefulContentResolver, getContentResolverContext): Delete functions. (openContentUri, checkContentUri): Stop searching for an activity content resolver, as that's actually not necessary. * src/android.c (android_init_emacs_service) (android_init_emacs_window, android_clear_window) (android_clear_area): Adjust to match. --- java/org/gnu/emacs/EmacsActivity.java | 4 ++ java/org/gnu/emacs/EmacsService.java | 67 +-------------------------- src/android.c | 23 +++++---- 3 files changed, 16 insertions(+), 78 deletions(-) diff --git a/java/org/gnu/emacs/EmacsActivity.java b/java/org/gnu/emacs/EmacsActivity.java index b821694b18a..66a1e41d84c 100644 --- a/java/org/gnu/emacs/EmacsActivity.java +++ b/java/org/gnu/emacs/EmacsActivity.java @@ -247,6 +247,10 @@ public class EmacsActivity extends Activity } super.onCreate (savedInstanceState); + + /* Call `onWindowFocusChanged' to read the focus state, which fails + to be called after an activity is recreated. */ + onWindowFocusChanged (false); } @Override diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index b65b10b9528..d17ba597d8e 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -449,21 +449,6 @@ invocation of app_process (through android-emacs) can EmacsDrawPoint.perform (drawable, gc, x, y); } - public void - clearWindow (EmacsWindow window) - { - checkEmacsThread (); - window.clearWindow (); - } - - public void - clearArea (EmacsWindow window, int x, int y, int width, - int height) - { - checkEmacsThread (); - window.clearArea (x, y, width, height); - } - @SuppressWarnings ("deprecation") public void ringBell (int duration) @@ -926,48 +911,6 @@ invocation of app_process (through android-emacs) can /* Content provider functions. */ - /* Return a ContentResolver capable of accessing as many files as - possible, namely the content resolver of the last selected - activity if available: only they posses the rights to access drag - and drop files. */ - - public ContentResolver - getUsefulContentResolver () - { - EmacsActivity activity; - - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) - /* Since the system predates drag and drop, return this resolver - to avoid any unforeseen difficulties. */ - return resolver; - - activity = EmacsActivity.lastFocusedActivity; - if (activity == null) - return resolver; - - return activity.getContentResolver (); - } - - /* Return a context whose ContentResolver is granted access to most - files, as in `getUsefulContentResolver'. */ - - public Context - getContentResolverContext () - { - EmacsActivity activity; - - if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N) - /* Since the system predates drag and drop, return this resolver - to avoid any unforeseen difficulties. */ - return this; - - activity = EmacsActivity.lastFocusedActivity; - if (activity == null) - return this; - - return activity; - } - /* Open a content URI described by the bytes BYTES, a non-terminated string; make it writable if WRITABLE, and readable if READABLE. Truncate the file if TRUNCATE. @@ -981,9 +924,6 @@ invocation of app_process (through android-emacs) can String name, mode; ParcelFileDescriptor fd; int i; - ContentResolver resolver; - - resolver = getUsefulContentResolver (); /* Figure out the file access mode. */ @@ -1045,12 +985,8 @@ invocation of app_process (through android-emacs) can ParcelFileDescriptor fd; Uri uri; int rc, flags; - Context context; - ContentResolver resolver; ParcelFileDescriptor descriptor; - context = getContentResolverContext (); - uri = Uri.parse (name); flags = 0; @@ -1060,7 +996,7 @@ invocation of app_process (through android-emacs) can if (writable) flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; - rc = context.checkCallingUriPermission (uri, flags); + rc = checkCallingUriPermission (uri, flags); if (rc == PackageManager.PERMISSION_GRANTED) return true; @@ -1074,7 +1010,6 @@ invocation of app_process (through android-emacs) can try { - resolver = context.getContentResolver (); descriptor = resolver.openFileDescriptor (uri, "r"); return true; } diff --git a/src/android.c b/src/android.c index 46f4dcd5546..4d56df1da3f 100644 --- a/src/android.c +++ b/src/android.c @@ -113,6 +113,8 @@ struct android_emacs_window jmethodID define_cursor; jmethodID damage_rect; jmethodID recreate_activity; + jmethodID clear_window; + jmethodID clear_area; }; struct android_emacs_cursor @@ -1605,10 +1607,6 @@ android_init_emacs_service (void) FIND_METHOD (draw_point, "drawPoint", "(Lorg/gnu/emacs/EmacsDrawable;" "Lorg/gnu/emacs/EmacsGC;II)V"); - FIND_METHOD (clear_window, "clearWindow", - "(Lorg/gnu/emacs/EmacsWindow;)V"); - FIND_METHOD (clear_area, "clearArea", - "(Lorg/gnu/emacs/EmacsWindow;IIII)V"); FIND_METHOD (ring_bell, "ringBell", "(I)V"); FIND_METHOD (query_tree, "queryTree", "(Lorg/gnu/emacs/EmacsWindow;)[S"); @@ -1832,6 +1830,8 @@ android_init_emacs_window (void) android_damage_window. */ FIND_METHOD (damage_rect, "damageRect", "(IIII)V"); FIND_METHOD (recreate_activity, "recreateActivity", "()V"); + FIND_METHOD (clear_window, "clearWindow", "()V"); + FIND_METHOD (clear_area, "clearArea", "(IIII)V"); #undef FIND_METHOD } @@ -3431,10 +3431,9 @@ android_clear_window (android_window handle) window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, - emacs_service, - service_class.class, - service_class.clear_window, - window); + window, + window_class.class, + window_class.clear_window); android_exception_check (); } @@ -4745,10 +4744,10 @@ android_clear_area (android_window handle, int x, int y, window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW); (*android_java_env)->CallNonvirtualVoidMethod (android_java_env, - emacs_service, - service_class.class, - service_class.clear_area, - window, (jint) x, (jint) y, + window, + window_class.class, + window_class.clear_area, + (jint) x, (jint) y, (jint) width, (jint) height); } From 6195a57b8e8ebff4eaaf4ff8d62719cbd55f579f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 09:28:11 +0200 Subject: [PATCH 157/385] ; Improve documentation of a recent change in Gnus * lisp/image.el (find-image): Doc fix. * lisp/gnus/gnus.el (gnus-mode-line-logo): Fix doc string and :type texts. Add :version. (Bug#68985) --- etc/NEWS | 1 + lisp/gnus/gnus.el | 15 ++++++++------- lisp/image.el | 26 +++++++++++++++----------- 3 files changed, 24 insertions(+), 18 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 76862bf500d..ca0a5ed8fc8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1102,6 +1102,7 @@ The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set the user option 'nnweb-type' to 'gmane'. +--- *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index cf4c3f7841c..dab66b60205 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -313,18 +313,19 @@ be set in `.emacs' instead." '((:type svg :file "gnus-pointer.svg" :ascent center) (:type xpm :file "gnus-pointer.xpm" :ascent center) (:type xbm :file "gnus-pointer.xbm" :ascent center)) - "Gnus logo displayed in mode-line. + "Image spec for the Gnus logo to be displayed in mode-line. -If non-nil, it should be a list of image specifications that will be -given as first argument to `find-image', which see. Then, in case of a -graphical display, the specified Gnus logo will be displayed as part of +If non-nil, it should be a list of image specifications to be passed +as the first argument to `find-image', which see. Then, if the display +is capable of showing images, the Gnus logo will be displayed as part of the buffer-identification in the mode-line of Gnus-buffers. -If nil, no logo will be displayed." +If nil, there will be no Gnus logo in the mode-line." :group 'gnus-visual :type '(choice - (repeat :tag "List of image specifications" (plist)) - (const :tag "No logo" nil))) + (repeat :tag "List of Gnus logo image specifications" (plist)) + (const :tag "Don't display Gnus logo" nil)) + :version "30.1") (defun gnus-mode-line-buffer-identification (line) (let* ((str (car-safe line)) diff --git a/lisp/image.el b/lisp/image.el index 73801f88d1e..2ebce59a98c 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -759,21 +759,25 @@ BUFFER nil or omitted means use the current buffer." ;;;###autoload (defun find-image (specs &optional cache) - "Find an image, choosing one of a list of image specifications. + "Find an image that satisfies one of a list of image specifications. SPECS is a list of image specifications. -Each image specification in SPECS is a property list. The contents of -a specification are image type dependent. All specifications must at -least contain either the property `:file FILE' or `:data DATA', -where FILE is the file to load the image from, and DATA is a string -containing the actual image data. If the property `:type TYPE' is -omitted or nil, try to determine the image type from its first few +Each image specification in SPECS is a property list. The +contents of a specification are image type dependent; see the +info node `(elisp)Image Descriptors' for details. All specifications +must at least contain either the property `:file FILE' or `:data DATA', +where FILE is the file from which to load the image, and DATA is a +string containing the actual image data. If the property `:type TYPE' +is omitted or nil, try to determine the image type from its first few bytes of image data. If that doesn't work, and the property `:file -FILE' provide a file name, use its file extension as image type. -If `:type TYPE' is provided, it must match the actual type -determined for FILE or DATA by `create-image'. Return nil if no -specification is satisfied. +FILE' provide a file name, use its file extension as idication of the +image type. If `:type TYPE' is provided, it must match the actual type +determined for FILE or DATA by `create-image'. + +The function returns the image specification for the first specification +in the list whose TYPE is supported and FILE, if specified, exists. It +returns nil if no specification in the list can be satisfied. If CACHE is non-nil, results are cached and returned on subsequent calls. From 4330eb2864181e49ace5736665c45d8683a5ce1d Mon Sep 17 00:00:00 2001 From: john muhl Date: Thu, 25 Jan 2024 21:23:45 -0600 Subject: [PATCH 158/385] Fix volume refresh bug in mpc * lisp/mpc.el (mpc-volume-refresh): Only refresh volume when mpd is playing. When stopped or paused, volume is nil. (Bug#68785) --- lisp/mpc.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/mpc.el b/lisp/mpc.el index 9577e0f2f42..768c70c2e3a 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1867,11 +1867,14 @@ A value of t means the main playlist.") (defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t) (defun mpc-volume-refresh () - ;; Maintain the volume. - (setq mpc-volume - (mpc-volume-widget - (string-to-number (cdr (assq 'volume mpc-status))))) - (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status))) + "Maintain the volume." + (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)) + (status-vol (cdr (assq 'volume mpc-status)))) + ;; If MPD is paused or stopped the volume is nil. + (when status-vol + (setq mpc-volume + (mpc-volume-widget + (string-to-number status-vol)))) (when (buffer-live-p status-buf) (with-current-buffer status-buf (force-mode-line-update))))) From 59b849d1eaffb8babb208f6a39c5e0dbc73e3127 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 10:35:18 +0200 Subject: [PATCH 159/385] Run 'read-only-mode-hook' when visiting a file that is not writable * lisp/files.el (after-find-file): Run 'read-only-mode-hook' when the visited file is not writable. (Bug#68648) --- lisp/files.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/files.el b/lisp/files.el index 229771810fb..f67b650cb92 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2747,6 +2747,10 @@ Fifth arg NOMODES non-nil means don't alter the file's modes. Finishes by calling the functions in `find-file-hook' unless NOMODES is non-nil." (setq buffer-read-only (not (file-writable-p buffer-file-name))) + ;; The above is sufficiently like turning on read-only-mode, so run + ;; the mode hook here by hand. + (if buffer-read-only + (run-hooks 'read-only-mode-hook)) (if noninteractive nil (let* (not-serious From 55aea7967604112343ff67597cbe9fc20acd9196 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 10 Feb 2024 09:50:12 +0100 Subject: [PATCH 160/385] Fix warning in tramp-register-archive-autoload-file-name-handler * lisp/net/tramp-archive.el (tramp-register-archive-autoload-file-name-handler): Do not use read syntax #' for `tramp-archive-file-name-handler', it isn't autoloaded. --- lisp/net/tramp-archive.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 752462d8fa3..59c4223794c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -387,9 +387,11 @@ arguments to pass to the OPERATION." ;;;###autoload (progn (defun tramp-register-archive-autoload-file-name-handler () "Add archive file name handler to `file-name-handler-alist'." + ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it + ;; isn't autoloaded. (when (and tramp-archive-enabled (not - (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) + (rassq 'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) From 20f7a022f817eaed5f6889d9a892c22fc46f0d2f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:04:22 +0200 Subject: [PATCH 161/385] Avoid errors in winner.el's 'post-command-hook' * lisp/winner.el (winner-save-old-configurations): Don't save configuration of dead frames. (Bug#68977) --- lisp/winner.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/winner.el b/lisp/winner.el index 2aa59a86b25..19641a05bfc 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -178,7 +178,8 @@ You may want to include buffer names such as *Help*, *Apropos*, (setq winner-last-frames nil) (setq winner-last-command this-command)) (dolist (frame winner-modified-list) - (winner-insert-if-new frame)) + (if (frame-live-p frame) + (winner-insert-if-new frame))) (setq winner-modified-list nil) (winner-remember))) From 86c5b7c49c0b61413e41f8a95a2f0c7f09cd1db7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:10:08 +0200 Subject: [PATCH 162/385] * lisp/bind-key.el (personal-keybindings): Autoload it (bug#68999). --- lisp/bind-key.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/bind-key.el b/lisp/bind-key.el index 94a39f795cd..378ad69b2bc 100644 --- a/lisp/bind-key.el +++ b/lisp/bind-key.el @@ -155,6 +155,7 @@ add keys to that keymap." (add-to-list 'emulation-mode-map-alists `((override-global-mode . ,override-global-map))) +;;;###autoload (defvar personal-keybindings nil "List of bindings performed by `bind-key'. From 13ee21eb48bedc1779985c3f60010aadbbd99630 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:20:22 +0200 Subject: [PATCH 163/385] Support Info files compressed by 'lzip' * lisp/info.el (Info-suffix-list): Support lzip compression of Info files. (Bug#69004) --- lisp/info.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/info.el b/lisp/info.el index e91cc7b8e54..d4d9085a787 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -499,6 +499,7 @@ or `Info-virtual-nodes'." (".info.bz2" . ("bzip2" "-dc")) (".info.xz" . "unxz") (".info.zst" . ("zstd" "-dc")) + (".info.lz" . ("lzip" "-dc")) (".info" . nil) ("-info.Z" . "uncompress") ("-info.Y" . "unyabba") @@ -507,6 +508,7 @@ or `Info-virtual-nodes'." ("-info.z" . "gunzip") ("-info.xz" . "unxz") ("-info.zst" . ("zstd" "-dc")) + ("-info.lz" . ("lzip" "-dc")) ("-info" . nil) ("/index.Z" . "uncompress") ("/index.Y" . "unyabba") @@ -515,6 +517,7 @@ or `Info-virtual-nodes'." ("/index.bz2" . ("bzip2" "-dc")) ("/index.xz" . "unxz") ("/index.zst" . ("zstd" "-dc")) + ("/index.lz" . ("lzip" "-dc")) ("/index" . nil) (".Z" . "uncompress") (".Y" . "unyabba") @@ -523,6 +526,7 @@ or `Info-virtual-nodes'." (".bz2" . ("bzip2" "-dc")) (".xz" . "unxz") (".zst" . ("zstd" "-dc")) + (".lz" . ("lzip" "-dc")) ("" . nil))) "List of file name suffixes and associated decoding commands. Each entry should be (SUFFIX . STRING); the file is given to From 7f3baf352bad03de50135556a561af0c7fb1bd6a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 11:22:01 +0200 Subject: [PATCH 164/385] ; * etc/NEWS: Announce support of 'lzip' compressed Info files (bug#69004). --- etc/NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index ca0a5ed8fc8..5ee1509859b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -450,6 +450,9 @@ This user option associates manual names with URLs. It affects the Emacs-included manuals are set. Further associations can be added for arbitrary Info manuals. +*** Emacs can now display Info manuals compressed with 'lzip'. +This requires the 'lzip' program to be installed on your system. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. From 717d8c4285fa6eecc0bbec9b5910f028f02aab59 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Feb 2024 13:00:51 +0200 Subject: [PATCH 165/385] Don't quote 't' in doc strings * lisp/outline.el (outline-minor-mode-use-buttons): Doc fix. Patch by Arash Esbati . (Bug#69012) --- lisp/outline.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/outline.el b/lisp/outline.el index 96e0d0df205..724263ef3d2 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -318,8 +318,8 @@ Using the value `insert' is not recommended in editable buffers because it modifies them. When the value is `in-margins', then clickable buttons are displayed in the margins before the headings. -When the value is `t', clickable buttons are displayed -in the buffer before the headings. The values `t' and +When the value is t, clickable buttons are displayed +in the buffer before the headings. The values t and `in-margins' can be used in editing buffers because they don't modify the buffer." ;; The value `insert' is not intended to be customizable. From 7e8b1863af8c820c2969c1a4666ae4451cbcea92 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Wed, 7 Feb 2024 20:41:44 +0100 Subject: [PATCH 166/385] Add support for deriving major modes in which-func * lisp/progmodes/which-func.el (which-func-try-to-enable) (which-func-ff-hook): Use `derived-mode-p' to check if the current major mode is within `which-func-modes' or `which-func-non-auto-modes'. (Bug#68981) --- lisp/progmodes/which-func.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index bd68672f905..631cb3b0aef 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (member major-mode which-func-modes))) + (apply #'derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (member major-mode which-func-non-auto-modes)) + (not (apply #'derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) From 55b4a743b6f3d452d98f135763b00965caba5240 Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 27 Jan 2024 08:17:08 -0800 Subject: [PATCH 167/385] Record dependencies in packages installed via package-vc * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): Record a package's declared dependencies in the package's metadata file. (Bug#68761) --- lisp/emacs-lisp/package-vc.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index db0cc515e46..fc402716dab 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -532,6 +532,7 @@ documentation and marking the package as installed." (setq deps)))))) (dolist (dep deps) (cl-callf version-to-list (cadr dep))) + (setf (package-desc-reqs pkg-desc) deps) (setf missing (package-vc-install-dependencies (delete-dups deps))) (setf missing (delq (assq (package-desc-name pkg-desc) missing) From 939187fd7a07249a1a76d98e8d91051fa76b8727 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 10 Feb 2024 17:30:27 +0100 Subject: [PATCH 168/385] ; Fix 'thing-at-point' edge case involving overlapping matches * lisp/thingatpt.el (thing-at-point-looking-at): When finding a match that ends before point, continue searching from the beginning of that match, not its end, in case the match we're looking is overlapping with this one. * test/lisp/thingatpt-tests.el (thing-at-point-looking-at-overlapping-matches): New test. --- lisp/thingatpt.el | 3 ++- test/lisp/thingatpt-tests.el | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index b532bafff82..83ddc640d35 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -621,13 +621,14 @@ Optional argument DISTANCE limits search for REGEXP forward and back from point." (let* ((old (point)) (beg (if distance (max (point-min) (- old distance)) (point-min))) - (end (and distance (min (point-max) (+ old distance)))) + (end (if distance (min (point-max) (+ old distance)))) prev match) (save-excursion (goto-char beg) (while (and (setq prev (point) match (re-search-forward regexp end t)) (< (match-end 0) old)) + (goto-char (match-beginning 0)) ;; Avoid inflooping when `regexp' matches the empty string. (unless (< prev (point)) (forward-char)))) (and match (<= (match-beginning 0) old (match-end 0))))) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 56bc4fdc9dc..e50738f1122 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -182,6 +182,13 @@ position to retrieve THING.") (should (thing-at-point-looking-at "2abcd")) (should (equal (match-data) m2))))) +(ert-deftest thing-at-point-looking-at-overlapping-matches () + (with-temp-buffer + (insert "foo.bar.baz") + (goto-char (point-max)) + (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+")) + (should (string= "bar.baz" (match-string 0))))) + (ert-deftest test-symbol-thing-1 () (with-temp-buffer (insert "foo bar zot") From 0a01b998d13027e5672592f9e60919aa683bad9e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 10 Feb 2024 19:34:23 +0200 Subject: [PATCH 169/385] * lisp/menu-bar.el (menu-bar-showhide-menu): Add "Outlines" (bug#68979). The menu item "Outlines" toggles 'outline-minor-mode' when one of outline-search-function/outline-regexp/outline-level is defined in the current buffer. --- lisp/menu-bar.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 47c6a8f0613..5b290899ff5 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1353,6 +1353,15 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) + (bindings--define-key menu [showhide-outline-minor-mode] + '(menu-item "Outlines" outline-minor-mode + :help "Turn outline-minor-mode on/off" + :visible (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)) + :button (:toggle . (and (boundp 'outline-minor-mode) + outline-minor-mode)))) + (bindings--define-key menu [showhide-tab-line-mode] '(menu-item "Window Tab Line" global-tab-line-mode :help "Turn window-local tab-lines on/off" From 3e5aba883770312536ca7a8f289bf679e55802f5 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 10 Feb 2024 19:56:39 +0200 Subject: [PATCH 170/385] * lisp/buff-menu.el: Force other-window commands to use other window. (Buffer-menu-other-window, Buffer-menu-switch-other-window): Let-bind 'display-buffer-overriding-action' to '(nil (inhibit-same-window . t))' that will force the buffer to be displayed in another window in any case (bug#68978). --- lisp/buff-menu.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 10ea99eae9a..e13c3b56b4e 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -592,13 +592,17 @@ If UNMARK is non-nil, unmark them." (defun Buffer-menu-other-window () "Select this line's buffer in other window, leaving buffer menu visible." (interactive nil Buffer-menu-mode) - (switch-to-buffer-other-window (Buffer-menu-buffer t))) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (switch-to-buffer-other-window (Buffer-menu-buffer t)))) (defun Buffer-menu-switch-other-window () "Make the other window select this line's buffer. The current window remains selected." (interactive nil Buffer-menu-mode) - (display-buffer (Buffer-menu-buffer t) t)) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (display-buffer (Buffer-menu-buffer t) t))) (defun Buffer-menu-2-window () "Select this line's buffer, with previous buffer in second window." From 7a0ee5d65f214102734dd22edb641b164a1b73af Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 10 Feb 2024 10:33:51 -0800 Subject: [PATCH 171/385] Fix behavior of gnus-summary-very-wide-reply with prefix arg * lisp/gnus/gnus-msg.el (gnus-summary-very-wide-reply): If a prefix argument has been given, the value of YANK will be a list containing the current article number. This should not be used to retrieve a number of work articles; that should be derived from the value of the current-prefix-arg (or marked articles). * doc/misc/gnus.texi: The interplay of prefix arg and marked articles is complex; attempt to clarify. --- doc/misc/gnus.texi | 9 +++++---- lisp/gnus/gnus-msg.el | 4 ++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 08554d0d9b9..2f8f97e5845 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -5832,10 +5832,11 @@ message to the mailing list, and include the original message @kindex S v @r{(Summary)} @findex gnus-summary-very-wide-reply Mail a very wide reply to the author of the current article -(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a reply -that goes out to all people listed in the @code{To}, @code{From} (or -@code{Reply-To}) and @code{Cc} headers in all the process/prefixed -articles. This command uses the process/prefix convention. +(@code{gnus-summary-very-wide-reply}). A @dfn{very wide reply} is a +reply that goes out to all people listed in the @code{To}, @code{From} +(or @code{Reply-To}) and @code{Cc} headers in all the process/prefixed +articles. This command uses the process/prefix convention. If given a +prefix argument, the body of the current article will also be yanked. @item S V @kindex S V @r{(Summary)} diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index fdf97e1aabd..b18ede58fbf 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1189,12 +1189,12 @@ Uses the process/prefix convention. The reply will include all From/Cc headers from the original messages as the To/Cc headers. -If prefix argument YANK is non-nil, the original article(s) will +If prefix argument YANK is non-nil, the original article will be yanked automatically." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1))) gnus-summary-mode) - (gnus-summary-reply yank t (gnus-summary-work-articles yank))) + (gnus-summary-reply yank t (gnus-summary-work-articles current-prefix-arg))) (defun gnus-summary-very-wide-reply-with-original (n) "Start composing a very wide reply mail a set of messages. From e67e7185ce81e59c90741f92c2ba3209412f417e Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 11 Feb 2024 10:00:33 +0800 Subject: [PATCH 172/385] Fix signed/unsigned promotion errors involving Emacs_Rectangle * src/androidterm.c (android_note_mouse_movement): * src/pgtkterm.c (note_mouse_movement): * src/xdisp.c (get_glyph_string_clip_rects, remember_mouse_glyph) (expose_area, expose_window, gui_intersect_rectangles): Cast width or height fields in Emacs_Rectangles to int before summing with or subtracting them from their coordinate fields, as they are unsigned outside X, and the sign of the coordinates is thus not preserved. --- src/androidterm.c | 4 ++-- src/pgtkterm.c | 4 ++-- src/xdisp.c | 33 +++++++++++++++++---------------- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/androidterm.c b/src/androidterm.c index d4612bb20fa..2bd2b45743d 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -495,8 +495,8 @@ android_note_mouse_movement (struct frame *frame, /* Has the mouse moved off the glyph it was on at the last sighting? */ r = &dpyinfo->last_mouse_glyph; if (frame != dpyinfo->last_mouse_glyph_frame - || event->x < r->x || event->x >= r->x + r->width - || event->y < r->y || event->y >= r->y + r->height) + || event->x < r->x || event->x >= r->x + (int) r->width + || event->y < r->y || event->y >= r->y + (int) r->height) { frame->mouse_moved = true; note_mouse_highlight (frame, event->x, event->y); diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b731f52983d..1ec6bfcda4e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -5825,8 +5825,8 @@ note_mouse_movement (struct frame *frame, /* Has the mouse moved off the glyph it was on at the last sighting? */ r = &dpyinfo->last_mouse_glyph; if (frame != dpyinfo->last_mouse_glyph_frame - || event->x < r->x || event->x >= r->x + r->width - || event->y < r->y || event->y >= r->y + r->height) + || event->x < r->x || event->x >= r->x + (int) r->width + || event->y < r->y || event->y >= r->y + (int) r->height) { frame->mouse_moved = true; dpyinfo->last_mouse_scroll_bar = NULL; diff --git a/src/xdisp.c b/src/xdisp.c index 2dcf0d58a14..0b8347214c7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2508,7 +2508,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int r.x = s->clip_head->x; } if (s->clip_tail) - if (r.x + r.width > s->clip_tail->x + s->clip_tail->background_width) + if (r.x + (int) r.width > s->clip_tail->x + s->clip_tail->background_width) { if (s->clip_tail->x + s->clip_tail->background_width >= r.x) r.width = s->clip_tail->x + s->clip_tail->background_width - r.x; @@ -2588,7 +2588,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int height = max (FRAME_LINE_HEIGHT (s->f), glyph->ascent + glyph->descent); if (height < r.height) { - max_y = r.y + r.height; + max_y = r.y + (int) r.height; r.y = min (max_y, max (r.y, s->ybase + glyph->descent - height)); r.height = min (max_y - r.y, height); } @@ -2629,7 +2629,7 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int if (s->for_overlaps & OVERLAPS_PRED) { rs[i] = r; - if (r.y + r.height > row_y) + if (r.y + (int) r.height > row_y) { if (r.y < row_y) rs[i].height = row_y - r.y; @@ -2643,10 +2643,10 @@ get_glyph_string_clip_rects (struct glyph_string *s, NativeRectangle *rects, int rs[i] = r; if (r.y < row_y + s->row->visible_height) { - if (r.y + r.height > row_y + s->row->visible_height) + if (r.y + (int) r.height > row_y + s->row->visible_height) { rs[i].y = row_y + s->row->visible_height; - rs[i].height = r.y + r.height - rs[i].y; + rs[i].height = r.y + (int) r.height - rs[i].y; } else rs[i].height = 0; @@ -2831,7 +2831,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) text_glyph: gr = 0; gy = 0; for (; r <= end_row && r->enabled_p; ++r) - if (r->y + r->height > y) + if (r->y + (int) r->height > y) { gr = r; gy = r->y; break; @@ -2931,7 +2931,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) row_glyph: gr = 0, gy = 0; for (; r <= end_row && r->enabled_p; ++r) - if (r->y + r->height > y) + if (r->y + (int) r->height > y) { gr = r; gy = r->y; break; @@ -36464,7 +36464,7 @@ expose_area (struct window *w, struct glyph_row *row, const Emacs_Rectangle *r, /* Use a signed int intermediate value to avoid catastrophic failures due to comparison between signed and unsigned, when x is negative (can happen for wide images that are hscrolled). */ - int r_end = r->x + r->width; + int r_end = r->x + (int) r->width; while (last < end && x < r_end) { x += last->pixel_width; @@ -36763,7 +36763,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr) /* Use a signed int intermediate value to avoid catastrophic failures due to comparison between signed and unsigned, when y0 or y1 is negative (can happen for tall images). */ - int r_bottom = r.y + r.height; + int r_bottom = r.y + (int) r.height; /* We must temporarily switch to the window's buffer, in case the fringe face has been remapped in that buffer's @@ -36810,7 +36810,7 @@ expose_window (struct window *w, const Emacs_Rectangle *fr) /* We must redraw a row overlapping the exposed area. */ if (y0 < r.y ? y0 + row->phys_height > r.y - : y0 + row->ascent - row->phys_ascent < r.y +r.height) + : y0 + row->ascent - row->phys_ascent < r.y + (int) r.height) { if (first_overlapping_row == NULL) first_overlapping_row = row; @@ -36989,7 +36989,7 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, const Emacs_Rectangle *upper, *lower; bool intersection_p = false; - /* Rearrange so that R1 is the left-most rectangle. */ + /* Rearrange so that left is the left-most rectangle. */ if (r1->x < r2->x) left = r1, right = r2; else @@ -36997,13 +36997,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, /* X0 of the intersection is right.x0, if this is inside R1, otherwise there is no intersection. */ - if (right->x <= left->x + left->width) + if (right->x <= left->x + (int) left->width) { result->x = right->x; /* The right end of the intersection is the minimum of the right ends of left and right. */ - result->width = (min (left->x + left->width, right->x + right->width) + result->width = (min (left->x + (int) left->width, + right->x + (int) right->width) - result->x); /* Same game for Y. */ @@ -37014,14 +37015,14 @@ gui_intersect_rectangles (const Emacs_Rectangle *r1, const Emacs_Rectangle *r2, /* The upper end of the intersection is lower.y0, if this is inside of upper. Otherwise, there is no intersection. */ - if (lower->y <= upper->y + upper->height) + if (lower->y <= upper->y + (int) upper->height) { result->y = lower->y; /* The lower end of the intersection is the minimum of the lower ends of upper and lower. */ - result->height = (min (lower->y + lower->height, - upper->y + upper->height) + result->height = (min (lower->y + (int) lower->height, + upper->y + (int) upper->height) - result->y); intersection_p = true; } From 9f9da26e0dcb242327af7cd8414fad7afedbbaa9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Lema=C3=AEtre?= Date: Sun, 11 Feb 2024 05:00:38 +0200 Subject: [PATCH 173/385] Handle typescript ts grammar breaking change for function_expression Starting from version 0.20.4 of the typescript/tsx grammar, "function" becomes "function_expression". The right expression is used depending on the grammar version. * lisp/progmodes/typescript-ts-mode.el (tsx-ts-mode--font-lock-compatibility-function-expression): New function (bug#69024). (typescript-ts-mode--font-lock-settings): Use it. Copyright-paperwork-exempt: yes --- lisp/progmodes/typescript-ts-mode.el | 288 ++++++++++++++------------- 1 file changed, 151 insertions(+), 137 deletions(-) diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 89ca47571eb..7021f012dcd 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -199,183 +199,197 @@ Argument LANGUAGE is either `typescript' or `tsx'." [(nested_identifier (identifier)) (identifier)] @typescript-ts-jsx-tag-face))))) +(defun tsx-ts-mode--font-lock-compatibility-function-expression (language) + "Handle tree-sitter grammar breaking change for `function' expression. + +LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the +typescript/tsx grammar, `function' becomes `function_expression'." + (condition-case nil + (progn (treesit-query-capture language '((function_expression) @cap)) + ;; New version of the grammar + 'function_expression) + (treesit-query-error + ;; Old version of the grammar + 'function))) + (defun typescript-ts-mode--font-lock-settings (language) "Tree-sitter font-lock settings. Argument LANGUAGE is either `typescript' or `tsx'." - (treesit-font-lock-rules - :language language - :feature 'comment - `([(comment) (hash_bang_line)] @font-lock-comment-face) + (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression language))) + (treesit-font-lock-rules + :language language + :feature 'comment + `([(comment) (hash_bang_line)] @font-lock-comment-face) - :language language - :feature 'constant - `(((identifier) @font-lock-constant-face - (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) + :language language + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) + [(true) (false) (null)] @font-lock-constant-face) - :language language - :feature 'keyword - `([,@typescript-ts-mode--keywords] @font-lock-keyword-face - [(this) (super)] @font-lock-keyword-face) + :language language + :feature 'keyword + `([,@typescript-ts-mode--keywords] @font-lock-keyword-face + [(this) (super)] @font-lock-keyword-face) - :language language - :feature 'string - `((regex pattern: (regex_pattern)) @font-lock-regexp-face - (string) @font-lock-string-face - (template_string) @js--fontify-template-string - (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) + :language language + :feature 'string + `((regex pattern: (regex_pattern)) @font-lock-regexp-face + (string) @font-lock-string-face + (template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) - :language language - :override t ;; for functions assigned to variables - :feature 'declaration - `((function - name: (identifier) @font-lock-function-name-face) - (function_declaration - name: (identifier) @font-lock-function-name-face) - (function_signature - name: (identifier) @font-lock-function-name-face) + :language language + :override t ;; for functions assigned to variables + :feature 'declaration + `((,func-exp + name: (identifier) @font-lock-function-name-face) + (function_declaration + name: (identifier) @font-lock-function-name-face) + (function_signature + name: (identifier) @font-lock-function-name-face) - (method_definition - name: (property_identifier) @font-lock-function-name-face) - (method_signature - name: (property_identifier) @font-lock-function-name-face) - (required_parameter (identifier) @font-lock-variable-name-face) - (optional_parameter (identifier) @font-lock-variable-name-face) + (method_definition + name: (property_identifier) @font-lock-function-name-face) + (method_signature + name: (property_identifier) @font-lock-function-name-face) + (required_parameter (identifier) @font-lock-variable-name-face) + (optional_parameter (identifier) @font-lock-variable-name-face) - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(,func-exp) (arrow_function)]) - (variable_declarator - name: (identifier) @font-lock-variable-name-face) + (variable_declarator + name: (identifier) @font-lock-variable-name-face) - (enum_declaration (identifier) @font-lock-type-face) + (enum_declaration (identifier) @font-lock-type-face) - (extends_clause value: (identifier) @font-lock-type-face) - ;; extends React.Component - (extends_clause value: (member_expression - object: (identifier) @font-lock-type-face - property: (property_identifier) @font-lock-type-face)) + (extends_clause value: (identifier) @font-lock-type-face) + ;; extends React.Component + (extends_clause value: (member_expression + object: (identifier) @font-lock-type-face + property: (property_identifier) @font-lock-type-face)) - (arrow_function - parameter: (identifier) @font-lock-variable-name-face) + (arrow_function + parameter: (identifier) @font-lock-variable-name-face) - (variable_declarator - name: (array_pattern - (identifier) - (identifier) @font-lock-function-name-face) - value: (array (number) (function))) + (variable_declarator + name: (array_pattern + (identifier) + (identifier) @font-lock-function-name-face) + value: (array (number) (,func-exp))) - (catch_clause - parameter: (identifier) @font-lock-variable-name-face) + (catch_clause + parameter: (identifier) @font-lock-variable-name-face) - ;; full module imports - (import_clause (identifier) @font-lock-variable-name-face) - ;; named imports with aliasing - (import_clause (named_imports (import_specifier - alias: (identifier) @font-lock-variable-name-face))) - ;; named imports without aliasing - (import_clause (named_imports (import_specifier - !alias - name: (identifier) @font-lock-variable-name-face))) + ;; full module imports + (import_clause (identifier) @font-lock-variable-name-face) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) - ;; full namespace import (* as alias) - (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) - :language language - :feature 'identifier - `((nested_type_identifier - module: (identifier) @font-lock-type-face) + :language language + :feature 'identifier + `((nested_type_identifier + module: (identifier) @font-lock-type-face) - (type_identifier) @font-lock-type-face + (type_identifier) @font-lock-type-face - (predefined_type) @font-lock-type-face + (predefined_type) @font-lock-type-face - (new_expression - constructor: (identifier) @font-lock-type-face) + (new_expression + constructor: (identifier) @font-lock-type-face) - (enum_body (property_identifier) @font-lock-type-face) + (enum_body (property_identifier) @font-lock-type-face) - (enum_assignment name: (property_identifier) @font-lock-type-face) + (enum_assignment name: (property_identifier) @font-lock-type-face) - (variable_declarator - name: (identifier) @font-lock-variable-name-face) + (variable_declarator + name: (identifier) @font-lock-variable-name-face) - (for_in_statement - left: (identifier) @font-lock-variable-name-face) + (for_in_statement + left: (identifier) @font-lock-variable-name-face) - (arrow_function - parameters: - [(_ (identifier) @font-lock-variable-name-face) - (_ (_ (identifier) @font-lock-variable-name-face)) - (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) + (arrow_function + parameters: + [(_ (identifier) @font-lock-variable-name-face) + (_ (_ (identifier) @font-lock-variable-name-face)) + (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) - :language language - :feature 'property - `((property_signature - name: (property_identifier) @font-lock-property-name-face) - (public_field_definition - name: (property_identifier) @font-lock-property-name-face) + :language language + :feature 'property + `((property_signature + name: (property_identifier) @font-lock-property-name-face) + (public_field_definition + name: (property_identifier) @font-lock-property-name-face) - (pair key: (property_identifier) @font-lock-property-use-face) + (pair key: (property_identifier) @font-lock-property-use-face) - ((shorthand_property_identifier) @font-lock-property-use-face)) + ((shorthand_property_identifier) @font-lock-property-use-face)) - :language language - :feature 'expression - '((assignment_expression - left: [(identifier) @font-lock-function-name-face - (member_expression - property: (property_identifier) @font-lock-function-name-face)] - right: [(function) (arrow_function)])) + :language language + :feature 'expression + `((assignment_expression + left: [(identifier) @font-lock-function-name-face + (member_expression + property: (property_identifier) @font-lock-function-name-face)] + right: [(,func-exp) (arrow_function)])) - :language language - :feature 'function - '((call_expression - function: - [(identifier) @font-lock-function-call-face - (member_expression - property: (property_identifier) @font-lock-function-call-face)])) + :language language + :feature 'function + '((call_expression + function: + [(identifier) @font-lock-function-call-face + (member_expression + property: (property_identifier) @font-lock-function-call-face)])) - :language language - :feature 'pattern - `((pair_pattern - key: (property_identifier) @font-lock-property-use-face - value: [(identifier) @font-lock-variable-name-face - (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) + :language language + :feature 'pattern + `((pair_pattern + key: (property_identifier) @font-lock-property-use-face + value: [(identifier) @font-lock-variable-name-face + (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) - (array_pattern (identifier) @font-lock-variable-name-face) + (array_pattern (identifier) @font-lock-variable-name-face) - ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) + ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) - :language language - :feature 'jsx - (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) - `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) + :language language + :feature 'jsx + (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) + `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) - :language language - :feature 'number - `((number) @font-lock-number-face - ((identifier) @font-lock-number-face - (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) + :language language + :feature 'number + `((number) @font-lock-number-face + ((identifier) @font-lock-number-face + (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) - :language language - :feature 'operator - `([,@typescript-ts-mode--operators] @font-lock-operator-face - (ternary_expression ["?" ":"] @font-lock-operator-face)) + :language language + :feature 'operator + `([,@typescript-ts-mode--operators] @font-lock-operator-face + (ternary_expression ["?" ":"] @font-lock-operator-face)) - :language language - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + :language language + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - :language language - :feature 'delimiter - '((["," "." ";" ":"]) @font-lock-delimiter-face) + :language language + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) - :language language - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face))) + :language language + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face)))) ;;;###autoload (define-derived-mode typescript-ts-base-mode prog-mode "TypeScript" From 30b4d902326546ca2b383d56caadbe0adaf0fe89 Mon Sep 17 00:00:00 2001 From: Mekeor Melire Date: Fri, 9 Feb 2024 23:30:52 +0100 Subject: [PATCH 174/385] In Info-url-alist, add .html extension to %e format-sequence * lisp/info.el (Info-url-for-node): Implement the change. (Bug#68970) (Info-url-alist): Document the change. * test/lisp/info-tests.el (test-info-urls): Adjust tests to account for the change and add a test for the "Top" node. --- lisp/info.el | 31 +++++++++++++++++-------------- test/lisp/info-tests.el | 16 +++++++++------- 2 files changed, 26 insertions(+), 21 deletions(-) diff --git a/lisp/info.el b/lisp/info.el index d4d9085a787..176bc9c0033 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -231,8 +231,9 @@ Each element of this list has the form (MANUALs . URL-SPEC). MANUALs represents the name of one or more manuals. It can either be a string or a list of strings. URL-SPEC can be a string in which the substring \"%m\" will be expanded to the -manual-name, \"%n\" to the node-name, and \"%e\" to the -URL-encoded node-name (without a `.html' suffix). (The +manual-name and \"%n\" to the node-name. \"%e\" will expand to +the URL-encoded node-name, including the `.html' extension; in +case of the Top node, it will expand to the empty string. (The URL-encoding of the node-name mimics GNU Texinfo, as documented at Info node `(texinfo)HTML Xref Node Name Expansion'.) Alternatively, URL-SPEC can be a function which is given @@ -1928,18 +1929,20 @@ NODE should be a string of the form \"(manual)Node\"." ;; (info "(texinfo) HTML Xref Node Name Expansion") (if (equal node "Top") "" - (url-hexify-string - (string-replace " " "-" - (mapconcat - (lambda (ch) - (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- - (<= 33 ch 47) ; !"#$%&'()*+,-./ - (<= 58 ch 64) ; :;<=>?@ - (<= 91 ch 96) ; [\]_` - (<= 123 ch 127)) ; {|}~ DEL - (format "_00%x" ch) - (char-to-string ch))) - node "")))))) + (concat + (url-hexify-string + (string-replace " " "-" + (mapconcat + (lambda (ch) + (if (or (< ch 32) ; ^@^A-^Z^[^\^]^^^- + (<= 33 ch 47) ; !"#$%&'()*+,-./ + (<= 58 ch 64) ; :;<=>?@ + (<= 91 ch 96) ; [\]_` + (<= 123 ch 127)) ; {|}~ DEL + (format "_00%x" ch) + (char-to-string ch))) + node ""))) + ".html")))) (cond ((stringp url-spec) (format-spec url-spec diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index 0dfdbf417e8..8020a7419cf 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el @@ -28,18 +28,20 @@ (require 'ert-x) (ert-deftest test-info-urls () + (should (equal (Info-url-for-node "(tramp)Top") + "https://www.gnu.org/software/emacs/manual/html_node/tramp/")) (should (equal (Info-url-for-node "(emacs)Minibuffer") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) (should (equal (Info-url-for-node "(emacs)Minibuffer File") - "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") - "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving")) + "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) (should (equal (Info-url-for-node "(eintr)car & cdr") - "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr")) + "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html")) (should (equal (Info-url-for-node "(emacs-mime)\tIndex") - "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index")) - (should (equal (Info-url-for-node "(gnus) Don't Panic") - "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic")) + "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html")) + (should (equal (Info-url-for-node "(gnus) Don't Panic") + "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html")) (should-error (Info-url-for-node "(nonexistent)Example"))) ;;; info-tests.el ends here From 614b244a7fa03fcb27d76757e14ef0fa895d6f23 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 11 Feb 2024 10:43:57 +0100 Subject: [PATCH 175/385] * Improve reproducibility of inferred values by native comp * lisp/emacs-lisp/comp-cstr.el (comp-normalize-valset): Do not try to reorder conses using 'sxhash-equal' as its behavior is not reproducible over different sessions. --- lisp/emacs-lisp/comp-cstr.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 812a79f070d..ecbe6e38a1d 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -203,6 +203,8 @@ Return them as multiple value." t) ((and (not (symbolp x)) (symbolp y)) nil) + ((or (consp x) (consp y) + nil)) (t (< (sxhash-equal x) (sxhash-equal y))))))) From 67486ab4158655dd8bfe0ddf7dabadc6dd21a3c1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 11 Feb 2024 15:21:14 +0200 Subject: [PATCH 176/385] Fix 'min-width' display property in 'buffer-text-pixel-size' * src/xdisp.c (display_min_width): Don't return without doing anything when called from the move_it_* functions. This is needed to have functions that simulate display layout handle the min-width display property correctly. (Bug#68374) --- src/xdisp.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 0b8347214c7..6087a25afcc 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5612,9 +5612,6 @@ display_min_width (struct it *it, ptrdiff_t bufpos, if (!NILP (it->min_width_property) && !EQ (width_spec, it->min_width_property)) { - if (!it->glyph_row) - return; - /* When called from display_string (i.e., the mode line), we're being called with a string as the object, and we may be called with many sub-strings belonging to the same From faa46eb8667c11a0725500a50e957eb78021c99f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 11 Feb 2024 12:31:13 +0100 Subject: [PATCH 177/385] Rename a number of native compiler functions * lisp/emacs-lisp/comp.el (comp-passes): Update. (comp-mvar): Update constructor name. (comp--loop-insn-in-block, comp--lex-byte-func-p) (comp--spill-decl-spec, comp--spill-speed) (comp--decrypt-arg-list, comp--byte-frame-size) (comp--add-func-to-ctxt, comp--spill-lap-function) (comp--intern-func-in-ctxt, comp--spill-lap-function) (comp--spill-lap, comp--lap-eob-p, comp--lap-fall-through-p) (comp--sp, comp--with-sp, comp--slot-n, comp--slot, comp-slot+1) (comp--label-to-addr, comp--mark-curr-bb-closed) (comp--bb-maybe-add, comp--call, comp--callref, make-comp-mvar) (comp--new-frame, comp--emit, comp--emit-set-call) (comp--copy-slot, comp--emit-annotation, comp--emit-setimm) (comp--make-curr-block, comp--latch-make-fill) (comp--emit-uncond-jump, comp--emit-cond-jump) (comp--emit-handler, comp--limplify-listn, comp--new-block-sym) (comp--fill-label-h, comp--jump-table-optimizable) (comp--emit-switch, comp--emit-set-call-subr, comp--op-to-fun) (comp--body-eff, comp--op-case, comp--limplify-lap-inst) (comp--emit-narg-prologue, comp--limplify-finalize-function) (comp--prepare-args-for-top-level, comp--emit-for-top-level) (comp--emit-lambda-for-top-level, comp--limplify-top-level) (comp--addr-to-bb-name, comp--limplify-block) (comp--limplify-function, comp--limplify, comp--mvar-used-p) (comp--collect-mvars, comp--collect-rhs) (comp--negate-arithm-cmp-fun, comp--reverse-arithm-fun) (comp--emit-assume, comp--maybe-add-vmvar) (comp--add-new-block-between, comp--cond-cstrs-target-mvar) (comp--add-cond-cstrs-target-block, comp--add-cond-cstrs-simple) (comp--add-cond-cstrs, comp--insert-insn, comp--emit-call-cstr) (comp--lambda-list-gen, comp--add-call-cstr, comp--add-cstrs) (comp--collect-calls, comp--pure-infer-func, comp--ipa-pure) (make--comp--ssa-mvar, comp--clean-ssa, comp--compute-edges) (comp--collect-rev-post-order, comp--compute-dominator-tree) (comp--compute-dominator-frontiers, comp--log-block-info) (comp--place-phis, comp--dom-tree-walker, comp--ssa) (comp--ssa-rename-insn, comp--ssa-rename, comp--finalize-phis) (comp--remove-unreachable-blocks, comp--ssa) (comp--fwprop-max-insns-scan, comp--copy-insn) (comp--apply-in-env, comp--fwprop-prologue) (comp--function-foldable-p, comp--function-call-maybe-fold) (comp--fwprop-call, comp--fwprop-insn, comp--fwprop*) (comp--rewrite-non-locals, comp--fwprop, comp--func-in-unit) (comp--call-optim-form-call, comp--call-optim-func) (comp--call-optim, comp--collect-mvar-ids) (comp--dead-assignments-func, comp--dead-code) (comp--form-tco-call-seq, comp--tco-func, comp--tco) (comp--remove-type-hints-func, comp--remove-type-hints) (comp--args-to-lambda-list, comp--compute-function-type) (comp--finalize-container, comp--finalize-relocs) (comp--compile-ctxt-to-file, comp--final1, comp--final) (comp--make-lambda-list-from-subr, comp-trampoline-compile) (comp--write-bytecode-file): Rename and/or update due to renaming. * test/src/comp-resources/comp-test-funcs.el (comp-test-copy-insn-f): Update. * src/comp.c (Fcomp__compile_ctxt_to_file0): Rename. (syms_of_comp): Update. --- lisp/emacs-lisp/comp.el | 972 +++++++++++---------- src/comp.c | 6 +- test/src/comp-resources/comp-test-funcs.el | 4 +- 3 files changed, 492 insertions(+), 490 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index dcdc973e6c5..6879e6aeeb9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -43,7 +43,7 @@ (defvar native-comp-eln-load-path) (defvar native-comp-enable-subr-trampolines) -(declare-function comp--compile-ctxt-to-file "comp.c") +(declare-function comp--compile-ctxt-to-file0 "comp.c") (declare-function comp--init-ctxt "comp.c") (declare-function comp--release-ctxt "comp.c") (declare-function comp-el-to-eln-filename "comp.c") @@ -155,17 +155,17 @@ native compilation runs.") "Current allocation class. Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") -(defconst comp-passes '(comp-spill-lap - comp-limplify - comp-fwprop - comp-call-optim - comp-ipa-pure - comp-add-cstrs - comp-fwprop - comp-tco - comp-fwprop - comp-remove-type-hints - comp-final) +(defconst comp-passes '(comp--spill-lap + comp--limplify + comp--fwprop + comp--call-optim + comp--ipa-pure + comp--add-cstrs + comp--fwprop + comp--tco + comp--fwprop + comp--remove-type-hints + comp--final) "Passes to be executed in order.") (defvar comp-disabled-passes '() @@ -388,7 +388,7 @@ This is typically for top-level forms other than defun.") (closed nil :type boolean :documentation "t if closed.") ;; All the following are for SSA and CGF analysis. - ;; Keep in sync with `comp-clean-ssa'!! + ;; Keep in sync with `comp--clean-ssa'!! (in-edges () :type list :documentation "List of incoming edges.") (out-edges () :type list @@ -416,7 +416,7 @@ into it.") :documentation "Start block LAP address.") (non-ret-insn nil :type list :documentation "Insn known to perform a non local exit. -`comp-fwprop' may identify and store here basic blocks performing +`comp--fwprop' may identify and store here basic blocks performing non local exits and mark it rewrite it later.") (no-ret nil :type boolean :documentation "t when the block is known to perform a @@ -507,7 +507,7 @@ CFG is mutated by a pass.") (lambda-list nil :type list :documentation "Original lambda-list.")) -(cl-defstruct (comp-mvar (:constructor make--comp-mvar) +(cl-defstruct (comp-mvar (:constructor make--comp-mvar0) (:include comp-cstr)) "A meta-variable being a slot in the meta-stack." (id nil :type (or null number) @@ -516,6 +516,7 @@ CFG is mutated by a pass.") :documentation "Slot number in the array if a number or `scratch' for scratch slot.")) +;; In use by comp.c. (defun comp-mvar-type-hint-match-p (mvar type-hint) "Match MVAR against TYPE-HINT. In use by the back-end." @@ -636,7 +637,7 @@ VERBOSITY is a number between 0 and 3." -(defmacro comp-loop-insn-in-block (basic-block &rest body) +(defmacro comp--loop-insn-in-block (basic-block &rest body) "Loop over all insns in BASIC-BLOCK executing BODY. Inside BODY, `insn' and `insn-cell'can be used to read or set the current instruction or its cell." @@ -650,19 +651,19 @@ current instruction or its cell." ;;; spill-lap pass specific code. -(defun comp-lex-byte-func-p (f) +(defun comp--lex-byte-func-p (f) "Return t if F is a lexically-scoped byte compiled function." (and (byte-code-function-p f) (fixnump (aref f 0)))) -(defun comp-spill-decl-spec (function-name spec) +(defun comp--spill-decl-spec (function-name spec) "Return the declared specifier SPEC for FUNCTION-NAME." (plist-get (cdr (assq function-name byte-to-native-plist-environment)) spec)) -(defun comp-spill-speed (function-name) +(defun comp--spill-speed (function-name) "Return the speed for FUNCTION-NAME." - (or (comp-spill-decl-spec function-name 'speed) + (or (comp--spill-decl-spec function-name 'speed) (comp-ctxt-speed comp-ctxt))) ;; Autoloaded as might be used by `disassemble-internal'. @@ -701,7 +702,7 @@ clashes." ;; pick the first one. (concat prefix crypted "_" human-readable "_0")))) -(defun comp-decrypt-arg-list (x function-name) +(defun comp--decrypt-arg-list (x function-name) "Decrypt argument list X for FUNCTION-NAME." (unless (fixnump x) (signal 'native-compiler-error-dyn-func (list function-name))) @@ -716,21 +717,21 @@ clashes." :nonrest nonrest :rest rest)))) -(defsubst comp-byte-frame-size (byte-compiled-func) +(defsubst comp--byte-frame-size (byte-compiled-func) "Return the frame size to be allocated for BYTE-COMPILED-FUNC." (aref byte-compiled-func 3)) -(defun comp-add-func-to-ctxt (func) +(defun comp--add-func-to-ctxt (func) "Add FUNC to the current compiler context." (let ((name (comp-func-name func)) (c-name (comp-func-c-name func))) (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt)) (puthash c-name func (comp-ctxt-funcs-h comp-ctxt)))) -(cl-defgeneric comp-spill-lap-function (input) +(cl-defgeneric comp--spill-lap-function (input) "Byte-compile INPUT and spill lap for further stages.") -(cl-defmethod comp-spill-lap-function ((function-name symbol)) +(cl-defmethod comp--spill-lap-function ((function-name symbol)) "Byte-compile FUNCTION-NAME, spilling data from the byte compiler." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) @@ -746,9 +747,9 @@ clashes." (list (make-byte-to-native-func-def :name function-name :c-name c-name :byte-func byte-code))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(cl-defmethod comp-spill-lap-function ((form list)) +(cl-defmethod comp--spill-lap-function ((form list)) "Byte-compile FORM, spilling data from the byte compiler." (unless (memq (car-safe form) '(lambda closure)) (signal 'native-compiler-error @@ -762,9 +763,9 @@ clashes." (list (make-byte-to-native-func-def :name '--anonymous-lambda :c-name c-name :byte-func byte-code))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h))) -(defun comp-intern-func-in-ctxt (_ obj) +(defun comp--intern-func-in-ctxt (_ obj) "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'." (when-let ((byte-func (byte-to-native-lambda-byte-func obj))) (let* ((lap (byte-to-native-lambda-lap obj)) @@ -777,9 +778,9 @@ clashes." (name (when top-l-form (byte-to-native-func-def-name top-l-form))) (c-name (comp-c-func-name (or name "anonymous-lambda") "F")) - (func (if (comp-lex-byte-func-p byte-func) + (func (if (comp--lex-byte-func-p byte-func) (make-comp-func-l - :args (comp-decrypt-arg-list (aref byte-func 0) + :args (comp--decrypt-arg-list (aref byte-func 0) name)) (make-comp-func-d :lambda-list (aref byte-func 0))))) (setf (comp-func-name func) name @@ -789,9 +790,9 @@ clashes." (comp-func-command-modes func) (command-modes byte-func) (comp-func-c-name func) c-name (comp-func-lap func) lap - (comp-func-frame-size func) (comp-byte-frame-size byte-func) - (comp-func-speed func) (comp-spill-speed name) - (comp-func-pure func) (comp-spill-decl-spec name 'pure)) + (comp-func-frame-size func) (comp--byte-frame-size byte-func) + (comp-func-speed func) (comp--spill-speed name) + (comp-func-pure func) (comp--spill-decl-spec name 'pure)) ;; Store the c-name to have it retrievable from ;; `comp-ctxt-top-level-forms'. @@ -799,11 +800,11 @@ clashes." (setf (byte-to-native-func-def-c-name top-l-form) c-name)) (unless name (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt))) - (comp-add-func-to-ctxt func) + (comp--add-func-to-ctxt func) (comp-log (format "Function %s:\n" name) 1) (comp-log lap 1 t)))) -(cl-defmethod comp-spill-lap-function ((filename string)) +(cl-defmethod comp--spill-lap-function ((filename string)) "Byte-compile FILENAME, spilling data from the byte compiler." (byte-compile-file filename) (when (or (null byte-native-qualities) @@ -828,7 +829,7 @@ clashes." collect (if (and (byte-to-native-func-def-p form) (eq -1 - (comp-spill-speed (byte-to-native-func-def-name form)))) + (comp--spill-speed (byte-to-native-func-def-name form)))) (let ((byte-code (byte-to-native-func-def-byte-func form))) (remhash byte-code byte-to-native-lambdas-h) (make-byte-to-native-top-level @@ -836,11 +837,11 @@ clashes." ',(byte-to-native-func-def-name form) ,byte-code nil) - :lexical (comp-lex-byte-func-p byte-code))) + :lexical (comp--lex-byte-func-p byte-code))) form))) - (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h)) + (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)) -(defun comp-spill-lap (input) +(defun comp--spill-lap (input) "Byte-compile and spill the LAP representation for INPUT. If INPUT is a symbol, it is the function-name to be compiled. If INPUT is a string, it is the filename to be compiled." @@ -848,7 +849,7 @@ If INPUT is a string, it is the filename to be compiled." (byte-to-native-lambdas-h (make-hash-table :test #'eq)) (byte-to-native-top-level-forms ()) (byte-to-native-plist-environment ()) - (res (comp-spill-lap-function input))) + (res (comp--spill-lap-function input))) (comp-cstr-ctxt-update-type-slots comp-ctxt) res)) @@ -877,55 +878,55 @@ Points to the next slot to be filled.") byte-switch byte-pushconditioncase) "LAP end of basic blocks op codes.") -(defun comp-lap-eob-p (inst) +(defun comp--lap-eob-p (inst) "Return t if INST closes the current basic blocks, nil otherwise." (when (memq (car inst) comp-lap-eob-ops) t)) -(defun comp-lap-fall-through-p (inst) +(defun comp--lap-fall-through-p (inst) "Return t if INST falls through, nil otherwise." (when (not (memq (car inst) '(byte-goto byte-return))) t)) -(defsubst comp-sp () +(defsubst comp--sp () "Current stack pointer." (declare (gv-setter (lambda (val) `(setf (comp-limplify-sp comp-pass) ,val)))) (comp-limplify-sp comp-pass)) -(defmacro comp-with-sp (sp &rest body) +(defmacro comp--with-sp (sp &rest body) "Execute BODY setting the stack pointer to SP. Restore the original value afterwards." (declare (debug (form body)) (indent defun)) (let ((sym (gensym))) - `(let ((,sym (comp-sp))) - (setf (comp-sp) ,sp) + `(let ((,sym (comp--sp))) + (setf (comp--sp) ,sp) (progn ,@body) - (setf (comp-sp) ,sym)))) + (setf (comp--sp) ,sym)))) -(defsubst comp-slot-n (n) +(defsubst comp--slot-n (n) "Slot N into the meta-stack." (comp-vec-aref (comp-limplify-frame comp-pass) n)) -(defsubst comp-slot () +(defsubst comp--slot () "Current slot into the meta-stack pointed by sp." - (comp-slot-n (comp-sp))) + (comp--slot-n (comp--sp))) -(defsubst comp-slot+1 () +(defsubst comp--slot+1 () "Slot into the meta-stack pointed by sp + 1." - (comp-slot-n (1+ (comp-sp)))) + (comp--slot-n (1+ (comp--sp)))) -(defsubst comp-label-to-addr (label) +(defsubst comp--label-to-addr (label) "Find the address of LABEL." (or (gethash label (comp-limplify-label-to-addr comp-pass)) (signal 'native-ice (list "label not found" label)))) -(defsubst comp-mark-curr-bb-closed () +(defsubst comp--mark-curr-bb-closed () "Mark the current basic block as closed." (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t)) -(defun comp-bb-maybe-add (lap-addr &optional sp) +(defun comp--bb-maybe-add (lap-addr &optional sp) "If necessary create a pending basic block for LAP-ADDR with stack depth SP. The basic block is returned regardless it was already declared or not." (let ((bb (or (cl-loop ; See if the block was already limplified. @@ -943,24 +944,24 @@ The basic block is returned regardless it was already declared or not." (signal 'native-ice (list "incoherent stack pointers" sp (comp-block-lap-sp bb)))) bb) - (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym)) + (car (push (make--comp-block-lap lap-addr sp (comp--new-block-sym)) (comp-limplify-pending-blocks comp-pass)))))) -(defsubst comp-call (func &rest args) +(defsubst comp--call (func &rest args) "Emit a call for function FUNC with ARGS." `(call ,func ,@args)) -(defun comp-callref (func nargs stack-off) +(defun comp--callref (func nargs stack-off) "Emit a call using narg abi for FUNC. NARGS is the number of arguments. STACK-OFF is the index of the first slot frame involved." `(callref ,func ,@(cl-loop repeat nargs for sp from stack-off - collect (comp-slot-n sp)))) + collect (comp--slot-n sp)))) -(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg) +(cl-defun make--comp-mvar (&key slot (constant nil const-vld) type neg) "`comp-mvar' initializer." - (let ((mvar (make--comp-mvar :slot slot))) + (let ((mvar (make--comp-mvar0 :slot slot))) (when const-vld (comp--add-const-to-relocs constant) (setf (comp-cstr-imm mvar) constant)) @@ -970,49 +971,49 @@ STACK-OFF is the index of the first slot frame involved." (setf (comp-mvar-neg mvar) t)) mvar)) -(defun comp-new-frame (size vsize &optional ssa) +(defun comp--new-frame (size vsize &optional ssa) "Return a clean frame of meta variables of size SIZE and VSIZE. If SSA is non-nil, populate it with m-var in ssa form." (cl-loop with v = (make-comp-vec :beg (- vsize) :end size) for i from (- vsize) below size for mvar = (if ssa - (make-comp-ssa-mvar :slot i) - (make-comp-mvar :slot i)) + (make--comp--ssa-mvar :slot i) + (make--comp-mvar :slot i)) do (setf (comp-vec-aref v i) mvar) finally return v)) -(defun comp-emit (insn) +(defun comp--emit (insn) "Emit INSN into basic block BB." (let ((bb (comp-limplify-curr-block comp-pass))) (cl-assert (not (comp-block-closed bb))) (push insn (comp-block-insns bb)))) -(defun comp-emit-set-call (call) +(defun comp--emit-set-call (call) "Emit CALL assigning the result to the current slot frame. If the callee function is known to have a return type, propagate it." (cl-assert call) - (comp-emit (list 'set (comp-slot) call))) + (comp--emit (list 'set (comp--slot) call))) -(defun comp-copy-slot (src-n &optional dst-n) +(defun comp--copy-slot (src-n &optional dst-n) "Set slot number DST-N to slot number SRC-N as source. If DST-N is specified, use it; otherwise assume it to be the current slot." - (comp-with-sp (or dst-n (comp-sp)) - (let ((src-slot (comp-slot-n src-n))) + (comp--with-sp (or dst-n (comp--sp)) + (let ((src-slot (comp--slot-n src-n))) (cl-assert src-slot) - (comp-emit `(set ,(comp-slot) ,src-slot))))) + (comp--emit `(set ,(comp--slot) ,src-slot))))) -(defsubst comp-emit-annotation (str) +(defsubst comp--emit-annotation (str) "Emit annotation STR." - (comp-emit `(comment ,str))) + (comp--emit `(comment ,str))) -(defsubst comp-emit-setimm (val) +(defsubst comp--emit-setimm (val) "Set constant VAL to current slot." (comp--add-const-to-relocs val) ;; Leave relocation index nil on purpose, will be fixed-up in final ;; by `comp-finalize-relocs'. - (comp-emit `(setimm ,(comp-slot) ,val))) + (comp--emit `(setimm ,(comp--slot) ,val))) -(defun comp-make-curr-block (block-name entry-sp &optional addr) +(defun comp--make-curr-block (block-name entry-sp &optional addr) "Create a basic block with BLOCK-NAME and set it as current block. ENTRY-SP is the sp value when entering. Add block to the current function and return it." @@ -1024,104 +1025,104 @@ Add block to the current function and return it." (puthash (comp-block-name bb) bb (comp-func-blocks comp-func)) bb)) -(defun comp-latch-make-fill (target) +(defun comp--latch-make-fill (target) "Create a latch pointing to TARGET and fill it. Return the created latch." - (let ((latch (make-comp-latch :name (comp-new-block-sym "latch"))) + (let ((latch (make-comp-latch :name (comp--new-block-sym "latch"))) (curr-bb (comp-limplify-curr-block comp-pass))) - ;; See `comp-make-curr-block'. + ;; See `comp--make-curr-block'. (setf (comp-limplify-curr-block comp-pass) latch) (when (< (comp-func-speed comp-func) 3) ;; At speed 3 the programmer is responsible to manually ;; place `comp-maybe-gc-or-quit'. - (comp-emit '(call comp-maybe-gc-or-quit))) - ;; See `comp-emit-uncond-jump'. - (comp-emit `(jump ,(comp-block-name target))) - (comp-mark-curr-bb-closed) + (comp--emit '(call comp-maybe-gc-or-quit))) + ;; See `comp--emit-uncond-jump'. + (comp--emit `(jump ,(comp-block-name target))) + (comp--mark-curr-bb-closed) (puthash (comp-block-name latch) latch (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) curr-bb) latch)) -(defun comp-emit-uncond-jump (lap-label) +(defun comp--emit-uncond-jump (lap-label) "Emit an unconditional branch to LAP-LABEL." (cl-destructuring-bind (label-num . stack-depth) lap-label (when stack-depth - (cl-assert (= (1- stack-depth) (comp-sp)))) - (let* ((target-addr (comp-label-to-addr label-num)) - (target (comp-bb-maybe-add target-addr - (comp-sp))) + (cl-assert (= (1- stack-depth) (comp--sp)))) + (let* ((target-addr (comp--label-to-addr label-num)) + (target (comp--bb-maybe-add target-addr + (comp--sp))) (latch (when (< target-addr (comp-limplify-pc comp-pass)) - (comp-latch-make-fill target))) + (comp--latch-make-fill target))) (eff-target-name (comp-block-name (or latch target)))) - (comp-emit `(jump ,eff-target-name)) - (comp-mark-curr-bb-closed)))) + (comp--emit `(jump ,eff-target-name)) + (comp--mark-curr-bb-closed)))) -(defun comp-emit-cond-jump (a b target-offset lap-label negated) +(defun comp--emit-cond-jump (a b target-offset lap-label negated) "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. TARGET-OFFSET is the positive offset on the SP when branching to the target block. If NEGATED is non null, negate the tested condition. Return value is the fall-through block name." (cl-destructuring-bind (label-num . label-sp) lap-label - (let* ((bb (comp-block-name (comp-bb-maybe-add + (let* ((bb (comp-block-name (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp)))) ; Fall through block. - (target-sp (+ target-offset (comp-sp))) - (target-addr (comp-label-to-addr label-num)) - (target (comp-bb-maybe-add target-addr target-sp)) + (comp--sp)))) ; Fall through block. + (target-sp (+ target-offset (comp--sp))) + (target-addr (comp--label-to-addr label-num)) + (target (comp--bb-maybe-add target-addr target-sp)) (latch (when (< target-addr (comp-limplify-pc comp-pass)) - (comp-latch-make-fill target))) + (comp--latch-make-fill target))) (eff-target-name (comp-block-name (or latch target)))) (when label-sp - (cl-assert (= (1- label-sp) (+ target-offset (comp-sp))))) - (comp-emit (if negated + (cl-assert (= (1- label-sp) (+ target-offset (comp--sp))))) + (comp--emit (if negated (list 'cond-jump a b bb eff-target-name) (list 'cond-jump a b eff-target-name bb))) - (comp-mark-curr-bb-closed) + (comp--mark-curr-bb-closed) bb))) -(defun comp-emit-handler (lap-label handler-type) +(defun comp--emit-handler (lap-label handler-type) "Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE." (cl-destructuring-bind (label-num . label-sp) lap-label - (cl-assert (= (- label-sp 2) (comp-sp))) + (cl-assert (= (- label-sp 2) (comp--sp))) (setf (comp-func-has-non-local comp-func) t) - (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp))) - (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num) - (1+ (comp-sp)))) - (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym)))) - (comp-emit (list 'push-handler + (let* ((guarded-bb (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) + (comp--sp))) + (handler-bb (comp--bb-maybe-add (comp--label-to-addr label-num) + (1+ (comp--sp)))) + (pop-bb (make--comp-block-lap nil (comp--sp) (comp--new-block-sym)))) + (comp--emit (list 'push-handler handler-type - (comp-slot+1) + (comp--slot+1) (comp-block-name pop-bb) (comp-block-name guarded-bb))) - (comp-mark-curr-bb-closed) + (comp--mark-curr-bb-closed) ;; Emit the basic block to pop the handler if we got the non local. (puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func)) (setf (comp-limplify-curr-block comp-pass) pop-bb) - (comp-emit `(fetch-handler ,(comp-slot+1))) - (comp-emit `(jump ,(comp-block-name handler-bb))) - (comp-mark-curr-bb-closed)))) + (comp--emit `(fetch-handler ,(comp--slot+1))) + (comp--emit `(jump ,(comp-block-name handler-bb))) + (comp--mark-curr-bb-closed)))) -(defun comp-limplify-listn (n) +(defun comp--limplify-listn (n) "Limplify list N." - (comp-with-sp (+ (comp-sp) n -1) - (comp-emit-set-call (comp-call 'cons - (comp-slot) - (make-comp-mvar :constant nil)))) - (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp) - do (comp-with-sp sp - (comp-emit-set-call (comp-call 'cons - (comp-slot) - (comp-slot+1)))))) + (comp--with-sp (+ (comp--sp) n -1) + (comp--emit-set-call (comp--call 'cons + (comp--slot) + (make--comp-mvar :constant nil)))) + (cl-loop for sp from (+ (comp--sp) n -2) downto (comp--sp) + do (comp--with-sp sp + (comp--emit-set-call (comp--call 'cons + (comp--slot) + (comp--slot+1)))))) -(defun comp-new-block-sym (&optional postfix) +(defun comp--new-block-sym (&optional postfix) "Return a unique symbol postfixing POSTFIX naming the next new basic block." (intern (format (if postfix "bb_%s_%s" "bb_%s") (funcall (comp-func-block-cnt-gen comp-func)) postfix))) -(defun comp-fill-label-h () +(defun comp--fill-label-h () "Fill label-to-addr hash table for the current function." (setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql)) (cl-loop for insn in (comp-func-lap comp-func) @@ -1130,7 +1131,7 @@ Return value is the fall-through block name." (`(TAG ,label . ,_) (puthash label addr (comp-limplify-label-to-addr comp-pass)))))) -(defun comp-jump-table-optimizable (jmp-table) +(defun comp--jump-table-optimizable (jmp-table) "Return t if JMP-TABLE can be optimized out." ;; Identify LAP sequences like: ;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24) @@ -1142,13 +1143,13 @@ Return value is the fall-through block name." (`(TAG ,target . ,_label-sp) (= target (car targets))))))) -(defun comp-emit-switch (var last-insn) +(defun comp--emit-switch (var last-insn) "Emit a Limple for a lap jump table given VAR and LAST-INSN." ;; FIXME this not efficient for big jump tables. We should have a second ;; strategy for this case. (pcase last-insn (`(setimm ,_ ,jmp-table) - (unless (comp-jump-table-optimizable jmp-table) + (unless (comp--jump-table-optimizable jmp-table) (cl-loop for test being each hash-keys of jmp-table using (hash-value target-label) @@ -1156,27 +1157,27 @@ Return value is the fall-through block name." with test-func = (hash-table-test jmp-table) for n from 1 for last = (= n len) - for m-test = (make-comp-mvar :constant test) - for target-name = (comp-block-name (comp-bb-maybe-add - (comp-label-to-addr target-label) - (comp-sp))) + for m-test = (make--comp-mvar :constant test) + for target-name = (comp-block-name (comp--bb-maybe-add + (comp--label-to-addr target-label) + (comp--sp))) for ff-bb = (if last - (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) - (comp-sp)) + (comp--bb-maybe-add (1+ (comp-limplify-pc comp-pass)) + (comp--sp)) (make--comp-block-lap nil - (comp-sp) - (comp-new-block-sym))) + (comp--sp) + (comp--new-block-sym))) for ff-bb-name = (comp-block-name ff-bb) if (eq test-func 'eq) - do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name)) + do (comp--emit (list 'cond-jump var m-test target-name ff-bb-name)) else ;; Store the result of the comparison into the scratch slot before ;; emitting the conditional jump. - do (comp-emit (list 'set (make-comp-mvar :slot 'scratch) - (comp-call test-func var m-test))) - (comp-emit (list 'cond-jump - (make-comp-mvar :slot 'scratch) - (make-comp-mvar :constant nil) + do (comp--emit (list 'set (make--comp-mvar :slot 'scratch) + (comp--call test-func var m-test))) + (comp--emit (list 'cond-jump + (make--comp-mvar :slot 'scratch) + (make--comp-mvar :constant nil) ff-bb-name target-name)) unless last ;; All fall through are artificially created here except the last one. @@ -1191,7 +1192,7 @@ SUBR-NAME is the name of function." (or (gethash subr-name comp-subr-arities-h) (func-arity subr-name))) -(defun comp-emit-set-call-subr (subr-name sp-delta) +(defun comp--emit-set-call-subr (subr-name sp-delta) "Emit a call for SUBR-NAME. SP-DELTA is the stack adjustment." (let* ((nargs (1+ (- sp-delta))) @@ -1202,39 +1203,39 @@ SP-DELTA is the stack adjustment." (signal 'native-ice (list "subr contains unevalled args" subr-name))) (if (eq maxarg 'many) ;; callref case. - (comp-emit-set-call (comp-callref subr-name nargs (comp-sp))) + (comp--emit-set-call (comp--callref subr-name nargs (comp--sp))) ;; Normal call. (unless (and (>= maxarg nargs) (<= minarg nargs)) (signal 'native-ice (list "incoherent stack adjustment" nargs maxarg minarg))) (let* ((subr-name subr-name) (slots (cl-loop for i from 0 below maxarg - collect (comp-slot-n (+ i (comp-sp)))))) - (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))) + collect (comp--slot-n (+ i (comp--sp)))))) + (comp--emit-set-call (apply #'comp--call (cons subr-name slots))))))) (eval-when-compile - (defun comp-op-to-fun (x) + (defun comp--op-to-fun (x) "Given the LAP op strip \"byte-\" to have the subr name." (intern (string-replace "byte-" "" x))) - (defun comp-body-eff (body op-name sp-delta) + (defun comp--body-eff (body op-name sp-delta) "Given the original BODY, compute the effective one. When BODY is `auto', guess function name from the LAP byte-code name. Otherwise expect lname fnname." (pcase (car body) ('auto - `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta))) + `((comp--emit-set-call-subr ',(comp--op-to-fun op-name) ,sp-delta))) ((pred symbolp) - `((comp-emit-set-call-subr ',(car body) ,sp-delta))) + `((comp--emit-set-call-subr ',(car body) ,sp-delta))) (_ body)))) -(defmacro comp-op-case (&rest cases) +(defmacro comp--op-case (&rest cases) "Expand CASES into the corresponding `pcase' expansion. This is responsible for generating the proper stack adjustment, when known, and the annotation emission." (declare (debug (body)) (indent defun)) - (declare-function comp-body-eff nil (body op-name sp-delta)) + (declare-function comp--body-eff nil (body op-name sp-delta)) `(pcase op ,@(cl-loop for (op . body) in cases for sp-delta = (gethash op comp-op-stack-info) @@ -1243,55 +1244,55 @@ and the annotation emission." collect `(',op ;; Log all LAP ops except the TAG one. ;; ,(unless (eq op 'TAG) - ;; `(comp-emit-annotation + ;; `(comp--emit-annotation ;; ,(concat "LAP op " op-name))) ;; Emit the stack adjustment if present. ,(when (and sp-delta (not (eq 0 sp-delta))) - `(cl-incf (comp-sp) ,sp-delta)) - ,@(comp-body-eff body op-name sp-delta)) + `(cl-incf (comp--sp) ,sp-delta)) + ,@(comp--body-eff body op-name sp-delta)) else collect `(',op (signal 'native-ice (list "unsupported LAP op" ',op-name)))) (_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op)))))) -(defun comp-limplify-lap-inst (insn) +(defun comp--limplify-lap-inst (insn) "Limplify LAP instruction INSN pushing it in the proper basic block." (let ((op (car insn)) (arg (if (consp (cdr insn)) (cadr insn) (cdr insn)))) - (comp-op-case + (comp--op-case (TAG (cl-destructuring-bind (_TAG label-num . label-sp) insn ;; Paranoid? (when label-sp (cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass)))) - (comp-emit-annotation (format "LAP TAG %d" label-num)))) + (comp--emit-annotation (format "LAP TAG %d" label-num)))) (byte-stack-ref - (comp-copy-slot (- (comp-sp) arg 1))) + (comp--copy-slot (- (comp--sp) arg 1))) (byte-varref - (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar + (comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar :constant arg)))) (byte-varset - (comp-emit (comp-call 'set_internal - (make-comp-mvar :constant arg) - (comp-slot+1)))) + (comp--emit (comp--call 'set_internal + (make--comp-mvar :constant arg) + (comp--slot+1)))) (byte-varbind ;; Verify - (comp-emit (comp-call 'specbind - (make-comp-mvar :constant arg) - (comp-slot+1)))) + (comp--emit (comp--call 'specbind + (make--comp-mvar :constant arg) + (comp--slot+1)))) (byte-call - (cl-incf (comp-sp) (- arg)) - (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp)))) + (cl-incf (comp--sp) (- arg)) + (comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp)))) (byte-unbind - (comp-emit (comp-call 'helper_unbind_n - (make-comp-mvar :constant arg)))) + (comp--emit (comp--call 'helper_unbind_n + (make--comp-mvar :constant arg)))) (byte-pophandler - (comp-emit '(pop-handler))) + (comp--emit '(pop-handler))) (byte-pushconditioncase - (comp-emit-handler (cddr insn) 'condition-case)) + (comp--emit-handler (cddr insn) 'condition-case)) (byte-pushcatch - (comp-emit-handler (cddr insn) 'catcher)) + (comp--emit-handler (cddr insn) 'catcher)) (byte-nth auto) (byte-symbolp auto) (byte-consp auto) @@ -1300,19 +1301,19 @@ and the annotation emission." (byte-eq auto) (byte-memq auto) (byte-not - (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) - (make-comp-mvar :constant nil)))) + (comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp)) + (make--comp-mvar :constant nil)))) (byte-car auto) (byte-cdr auto) (byte-cons auto) (byte-list1 - (comp-limplify-listn 1)) + (comp--limplify-listn 1)) (byte-list2 - (comp-limplify-listn 2)) + (comp--limplify-listn 2)) (byte-list3 - (comp-limplify-listn 3)) + (comp--limplify-listn 3)) (byte-list4 - (comp-limplify-listn 4)) + (comp--limplify-listn 4)) (byte-length auto) (byte-aref auto) (byte-aset auto) @@ -1323,11 +1324,11 @@ and the annotation emission." (byte-get auto) (byte-substring auto) (byte-concat2 - (comp-emit-set-call (comp-callref 'concat 2 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 2 (comp--sp)))) (byte-concat3 - (comp-emit-set-call (comp-callref 'concat 3 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 3 (comp--sp)))) (byte-concat4 - (comp-emit-set-call (comp-callref 'concat 4 (comp-sp)))) + (comp--emit-set-call (comp--callref 'concat 4 (comp--sp)))) (byte-sub1 1-) (byte-add1 1+) (byte-eqlsign =) @@ -1337,7 +1338,7 @@ and the annotation emission." (byte-geq >=) (byte-diff -) (byte-negate - (comp-emit-set-call (comp-call 'negate (comp-slot)))) + (comp--emit-set-call (comp--call 'negate (comp--slot)))) (byte-plus +) (byte-max auto) (byte-min auto) @@ -1352,9 +1353,9 @@ and the annotation emission." (byte-preceding-char preceding-char) (byte-current-column auto) (byte-indent-to - (comp-emit-set-call (comp-call 'indent-to - (comp-slot) - (make-comp-mvar :constant nil)))) + (comp--emit-set-call (comp--call 'indent-to + (comp--slot) + (make--comp-mvar :constant nil)))) (byte-scan-buffer-OBSOLETE) (byte-eolp auto) (byte-eobp auto) @@ -1363,7 +1364,7 @@ and the annotation emission." (byte-current-buffer auto) (byte-set-buffer auto) (byte-save-current-buffer - (comp-emit (comp-call 'record_unwind_current_buffer))) + (comp--emit (comp--call 'record_unwind_current_buffer))) (byte-set-mark-OBSOLETE) (byte-interactive-p-OBSOLETE) (byte-forward-char auto) @@ -1375,41 +1376,41 @@ and the annotation emission." (byte-buffer-substring auto) (byte-delete-region auto) (byte-narrow-to-region - (comp-emit-set-call (comp-call 'narrow-to-region - (comp-slot) - (comp-slot+1)))) + (comp--emit-set-call (comp--call 'narrow-to-region + (comp--slot) + (comp--slot+1)))) (byte-widen - (comp-emit-set-call (comp-call 'widen))) + (comp--emit-set-call (comp--call 'widen))) (byte-end-of-line auto) (byte-constant2) ; TODO ;; Branches. (byte-goto - (comp-emit-uncond-jump (cddr insn))) + (comp--emit-uncond-jump (cddr insn))) (byte-goto-if-nil - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 (cddr insn) nil)) (byte-goto-if-not-nil - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0 (cddr insn) t)) (byte-goto-if-nil-else-pop - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 (cddr insn) nil)) (byte-goto-if-not-nil-else-pop - (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1 + (comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1 (cddr insn) t)) (byte-return - (comp-emit `(return ,(comp-slot+1)))) + (comp--emit `(return ,(comp--slot+1)))) (byte-discard 'pass) (byte-dup - (comp-copy-slot (1- (comp-sp)))) + (comp--copy-slot (1- (comp--sp)))) (byte-save-excursion - (comp-emit (comp-call 'record_unwind_protect_excursion))) + (comp--emit (comp--call 'record_unwind_protect_excursion))) (byte-save-window-excursion-OBSOLETE) (byte-save-restriction - (comp-emit (comp-call 'helper_save_restriction))) + (comp--emit (comp--call 'helper_save_restriction))) (byte-catch) ;; Obsolete (byte-unwind-protect - (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1)))) + (comp--emit (comp--call 'helper_unwind_protect (comp--slot+1)))) (byte-condition-case) ;; Obsolete (byte-temp-output-buffer-setup-OBSOLETE) (byte-temp-output-buffer-show-OBSOLETE) @@ -1436,61 +1437,61 @@ and the annotation emission." (byte-numberp auto) (byte-integerp auto) (byte-listN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'list arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'list arg (comp--sp)))) (byte-concatN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'concat arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'concat arg (comp--sp)))) (byte-insertN - (cl-incf (comp-sp) (- 1 arg)) - (comp-emit-set-call (comp-callref 'insert arg (comp-sp)))) + (cl-incf (comp--sp) (- 1 arg)) + (comp--emit-set-call (comp--callref 'insert arg (comp--sp)))) (byte-stack-set - (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1))) + (comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1))) (byte-stack-set2 (cl-assert nil)) ;; TODO (byte-discardN - (cl-incf (comp-sp) (- arg))) + (cl-incf (comp--sp) (- arg))) (byte-switch ;; Assume to follow the emission of a setimm. - ;; This is checked into comp-emit-switch. - (comp-emit-switch (comp-slot+1) + ;; This is checked into comp--emit-switch. + (comp--emit-switch (comp--slot+1) (cl-first (comp-block-insns (comp-limplify-curr-block comp-pass))))) (byte-constant - (comp-emit-setimm arg)) + (comp--emit-setimm arg)) (byte-discardN-preserve-tos - (cl-incf (comp-sp) (- arg)) - (comp-copy-slot (+ arg (comp-sp))))))) + (cl-incf (comp--sp) (- arg)) + (comp--copy-slot (+ arg (comp--sp))))))) -(defun comp-emit-narg-prologue (minarg nonrest rest) +(defun comp--emit-narg-prologue (minarg nonrest rest) "Emit the prologue for a narg function." (cl-loop for i below minarg - do (comp-emit `(set-args-to-local ,(comp-slot-n i))) - (comp-emit '(inc-args))) + do (comp--emit `(set-args-to-local ,(comp--slot-n i))) + (comp--emit '(inc-args))) (cl-loop for i from minarg below nonrest for bb = (intern (format "entry_%s" i)) for fallback = (intern (format "entry_fallback_%s" i)) - do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb)) - (comp-make-curr-block bb (comp-sp)) - (comp-emit `(set-args-to-local ,(comp-slot-n i))) - (comp-emit '(inc-args)) - finally (comp-emit '(jump entry_rest_args))) + do (comp--emit `(cond-jump-narg-leq ,i ,fallback ,bb)) + (comp--make-curr-block bb (comp--sp)) + (comp--emit `(set-args-to-local ,(comp--slot-n i))) + (comp--emit '(inc-args)) + finally (comp--emit '(jump entry_rest_args))) (when (/= minarg nonrest) (cl-loop for i from minarg below nonrest for bb = (intern (format "entry_fallback_%s" i)) for next-bb = (if (= (1+ i) nonrest) 'entry_rest_args (intern (format "entry_fallback_%s" (1+ i)))) - do (comp-with-sp i - (comp-make-curr-block bb (comp-sp)) - (comp-emit-setimm nil) - (comp-emit `(jump ,next-bb))))) - (comp-make-curr-block 'entry_rest_args (comp-sp)) - (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest))) - (setf (comp-sp) nonrest) + do (comp--with-sp i + (comp--make-curr-block bb (comp--sp)) + (comp--emit-setimm nil) + (comp--emit `(jump ,next-bb))))) + (comp--make-curr-block 'entry_rest_args (comp--sp)) + (comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest))) + (setf (comp--sp) nonrest) (when (and (> nonrest 8) (null rest)) - (cl-decf (comp-sp)))) + (cl-decf (comp--sp)))) -(defun comp-limplify-finalize-function (func) +(defun comp--limplify-finalize-function (func) "Reverse insns into all basic blocks of FUNC." (cl-loop for bb being the hash-value in (comp-func-blocks func) do (setf (comp-block-insns bb) @@ -1498,49 +1499,49 @@ and the annotation emission." (comp--log-func func 2) func) -(cl-defgeneric comp-prepare-args-for-top-level (function) +(cl-defgeneric comp--prepare-args-for-top-level (function) "Given FUNCTION, return the two arguments for comp--register-...") -(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l)) +(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-l)) "Lexically-scoped FUNCTION." (let ((args (comp-func-l-args function))) - (cons (make-comp-mvar :constant (comp-args-base-min args)) - (make-comp-mvar :constant (cond + (cons (make--comp-mvar :constant (comp-args-base-min args)) + (make--comp-mvar :constant (cond ((comp-args-p args) (comp-args-max args)) ((comp-nargs-rest args) 'many) (t (comp-nargs-nonrest args))))))) -(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) +(cl-defmethod comp--prepare-args-for-top-level ((function comp-func-d)) "Dynamically scoped FUNCTION." - (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function))) + (cons (make--comp-mvar :constant (func-arity (comp-func-byte-func function))) (let ((comp-curr-allocation-class 'd-default)) ;; Lambda-lists must stay in the same relocation class of ;; the object referenced by code to respect uninterned ;; symbols. - (make-comp-mvar :constant (comp-func-d-lambda-list function))))) + (make--comp-mvar :constant (comp-func-d-lambda-list function))))) -(cl-defgeneric comp-emit-for-top-level (form for-late-load) +(cl-defgeneric comp--emit-for-top-level (form for-late-load) "Emit the Limple code for top level FORM.") -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def) +(cl-defmethod comp--emit-for-top-level ((form byte-to-native-func-def) for-late-load) (let* ((name (byte-to-native-func-def-name form)) (c-name (byte-to-native-func-def-c-name form)) (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) - (args (comp-prepare-args-for-top-level f))) + (args (comp--prepare-args-for-top-level f))) (cl-assert (and name f)) - (comp-emit - `(set ,(make-comp-mvar :slot 1) - ,(comp-call (if for-late-load + (comp--emit + `(set ,(make--comp-mvar :slot 1) + ,(comp--call (if for-late-load 'comp--late-register-subr 'comp--register-subr) - (make-comp-mvar :constant name) - (make-comp-mvar :constant c-name) + (make--comp-mvar :constant name) + (make--comp-mvar :constant c-name) (car args) (cdr args) (setf (comp-func-type f) - (make-comp-mvar :constant nil)) - (make-comp-mvar + (make--comp-mvar :constant nil)) + (make--comp-mvar :constant (list (let* ((h (comp-ctxt-function-docs comp-ctxt)) @@ -1551,40 +1552,40 @@ and the annotation emission." (comp-func-command-modes f))) ;; This is the compilation unit it-self passed as ;; parameter. - (make-comp-mvar :slot 0)))))) + (make--comp-mvar :slot 0)))))) -(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) +(cl-defmethod comp--emit-for-top-level ((form byte-to-native-top-level) for-late-load) (unless for-late-load - (comp-emit - (comp-call 'eval + (comp--emit + (comp--call 'eval (let ((comp-curr-allocation-class 'd-impure)) - (make-comp-mvar :constant + (make--comp-mvar :constant (byte-to-native-top-level-form form))) - (make-comp-mvar :constant + (make--comp-mvar :constant (byte-to-native-top-level-lexical form)))))) -(defun comp-emit-lambda-for-top-level (func) +(defun comp--emit-lambda-for-top-level (func) "Emit the creation of subrs for lambda FUNC. These are stored in the reloc data array." - (let ((args (comp-prepare-args-for-top-level func))) + (let ((args (comp--prepare-args-for-top-level func))) (let ((comp-curr-allocation-class 'd-impure)) (comp--add-const-to-relocs (comp-func-byte-func func))) - (comp-emit - (comp-call 'comp--register-lambda + (comp--emit + (comp--call 'comp--register-lambda ;; mvar to be fixed-up when containers are ;; finalized. (or (gethash (comp-func-byte-func func) (comp-ctxt-lambda-fixups-h comp-ctxt)) (puthash (comp-func-byte-func func) - (make-comp-mvar :constant nil) + (make--comp-mvar :constant nil) (comp-ctxt-lambda-fixups-h comp-ctxt))) - (make-comp-mvar :constant (comp-func-c-name func)) + (make--comp-mvar :constant (comp-func-c-name func)) (car args) (cdr args) (setf (comp-func-type func) - (make-comp-mvar :constant nil)) - (make-comp-mvar + (make--comp-mvar :constant nil)) + (make--comp-mvar :constant (list (let* ((h (comp-ctxt-function-docs comp-ctxt)) @@ -1595,9 +1596,9 @@ These are stored in the reloc data array." (comp-func-command-modes func))) ;; This is the compilation unit it-self passed as ;; parameter. - (make-comp-mvar :slot 0))))) + (make--comp-mvar :slot 0))))) -(defun comp-limplify-top-level (for-late-load) +(defun comp--limplify-top-level (for-late-load) "Create a Limple function to modify the global environment at load. When FOR-LATE-LOAD is non-nil, the emitted function modifies only function definition. @@ -1627,22 +1628,22 @@ into the C code forwarding the compilation unit." (comp-func func) (comp-pass (make-comp-limplify :curr-block (make--comp-block-lap -1 0 'top-level) - :frame (comp-new-frame 1 0)))) - (comp-make-curr-block 'entry (comp-sp)) - (comp-emit-annotation (if for-late-load + :frame (comp--new-frame 1 0)))) + (comp--make-curr-block 'entry (comp--sp)) + (comp--emit-annotation (if for-late-load "Late top level" "Top level")) ;; Assign the compilation unit incoming as parameter to the slot frame 0. - (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0)) + (comp--emit `(set-par-to-local ,(comp--slot-n 0) 0)) (maphash (lambda (_ func) - (comp-emit-lambda-for-top-level func)) + (comp--emit-lambda-for-top-level func)) (comp-ctxt-byte-func-to-func-h comp-ctxt)) - (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) + (mapc (lambda (x) (comp--emit-for-top-level x for-late-load)) (comp-ctxt-top-level-forms comp-ctxt)) - (comp-emit `(return ,(make-comp-mvar :slot 1))) - (comp-limplify-finalize-function func))) + (comp--emit `(return ,(make--comp-mvar :slot 1))) + (comp--limplify-finalize-function func))) -(defun comp-addr-to-bb-name (addr) +(defun comp--addr-to-bb-name (addr) "Search for a block starting at ADDR into pending or limplified blocks." ;; FIXME Actually we could have another hash for this. (cl-flet ((pred (bb) @@ -1654,7 +1655,7 @@ into the C code forwarding the compilation unit." when (pred bb) return (comp-block-name bb))))) -(defun comp-limplify-block (bb) +(defun comp--limplify-block (bb) "Limplify basic-block BB and add it to the current function." (setf (comp-limplify-curr-block comp-pass) bb (comp-limplify-sp comp-pass) (comp-block-lap-sp bb) @@ -1665,51 +1666,51 @@ into the C code forwarding the compilation unit." (comp-func-lap comp-func)) for inst = (car inst-cell) for next-inst = (car-safe (cdr inst-cell)) - do (comp-limplify-lap-inst inst) + do (comp--limplify-lap-inst inst) (cl-incf (comp-limplify-pc comp-pass)) - when (comp-lap-fall-through-p inst) + when (comp--lap-fall-through-p inst) do (pcase next-inst (`(TAG ,_label . ,label-sp) (when label-sp - (cl-assert (= (1- label-sp) (comp-sp)))) + (cl-assert (= (1- label-sp) (comp--sp)))) (let* ((stack-depth (if label-sp (1- label-sp) - (comp-sp))) - (next-bb (comp-block-name (comp-bb-maybe-add + (comp--sp))) + (next-bb (comp-block-name (comp--bb-maybe-add (comp-limplify-pc comp-pass) stack-depth)))) (unless (comp-block-closed bb) - (comp-emit `(jump ,next-bb)))) + (comp--emit `(jump ,next-bb)))) (cl-return))) - until (comp-lap-eob-p inst))) + until (comp--lap-eob-p inst))) -(defun comp-limplify-function (func) +(defun comp--limplify-function (func) "Limplify a single function FUNC." (let* ((frame-size (comp-func-frame-size func)) (comp-func func) (comp-pass (make-comp-limplify - :frame (comp-new-frame frame-size 0)))) - (comp-fill-label-h) + :frame (comp--new-frame frame-size 0)))) + (comp--fill-label-h) ;; Prologue - (comp-make-curr-block 'entry (comp-sp)) - (comp-emit-annotation (concat "Lisp function: " + (comp--make-curr-block 'entry (comp--sp)) + (comp--emit-annotation (concat "Lisp function: " (symbol-name (comp-func-name func)))) ;; Dynamic functions have parameters bound by the trampoline. (when (comp-func-l-p func) (let ((args (comp-func-l-args func))) (if (comp-args-p args) (cl-loop for i below (comp-args-max args) - do (cl-incf (comp-sp)) - (comp-emit `(set-par-to-local ,(comp-slot) ,i))) - (comp-emit-narg-prologue (comp-args-base-min args) + do (cl-incf (comp--sp)) + (comp--emit `(set-par-to-local ,(comp--slot) ,i))) + (comp--emit-narg-prologue (comp-args-base-min args) (comp-nargs-nonrest args) (comp-nargs-rest args))))) - (comp-emit '(jump bb_0)) + (comp--emit '(jump bb_0)) ;; Body - (comp-bb-maybe-add 0 (comp-sp)) + (comp--bb-maybe-add 0 (comp--sp)) (cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass)) while next-bb - do (comp-limplify-block next-bb)) + do (comp--limplify-block next-bb)) ;; Sanity check against block duplication. (cl-loop with addr-h = (make-hash-table) for bb being the hash-value in (comp-func-blocks func) @@ -1718,15 +1719,15 @@ into the C code forwarding the compilation unit." when addr do (cl-assert (null (gethash addr addr-h))) (puthash addr t addr-h)) - (comp-limplify-finalize-function func))) + (comp--limplify-finalize-function func))) -(defun comp-limplify (_) +(defun comp--limplify (_) "Compute LIMPLE IR for forms in `comp-ctxt'." - (maphash (lambda (_ f) (comp-limplify-function f)) + (maphash (lambda (_ f) (comp--limplify-function f)) (comp-ctxt-funcs-h comp-ctxt)) - (comp-add-func-to-ctxt (comp-limplify-top-level nil)) + (comp--add-func-to-ctxt (comp--limplify-top-level nil)) (when (comp-ctxt-with-late-load comp-ctxt) - (comp-add-func-to-ctxt (comp-limplify-top-level t)))) + (comp--add-func-to-ctxt (comp--limplify-top-level t)))) ;;; add-cstrs pass specific code. @@ -1750,22 +1751,22 @@ into the C code forwarding the compilation unit." ;; type specifier. -(defsubst comp-mvar-used-p (mvar) +(defsubst comp--mvar-used-p (mvar) "Non-nil when MVAR is used as lhs in the current function." (declare (gv-setter (lambda (val) `(puthash ,mvar ,val comp-pass)))) (gethash mvar comp-pass)) -(defun comp-collect-mvars (form) +(defun comp--collect-mvars (form) "Add rhs m-var present in FORM into `comp-pass'." (cl-loop for x in form if (consp x) - do (comp-collect-mvars x) + do (comp--collect-mvars x) else when (comp-mvar-p x) - do (setf (comp-mvar-used-p x) t))) + do (setf (comp--mvar-used-p x) t))) -(defun comp-collect-rhs () +(defun comp--collect-rhs () "Collect all lhs mvars into `comp-pass'." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) @@ -1773,11 +1774,11 @@ into the C code forwarding the compilation unit." for insn in (comp-block-insns b) for (op . args) = insn if (comp--assign-op-p op) - do (comp-collect-mvars (cdr args)) + do (comp--collect-mvars (cdr args)) else - do (comp-collect-mvars args)))) + do (comp--collect-mvars args)))) -(defun comp-negate-arithm-cmp-fun (function) +(defun comp--negate-arithm-cmp-fun (function) "Negate FUNCTION. Return nil if we don't want to emit constraints for its negation." (cl-ecase function @@ -1787,7 +1788,7 @@ Return nil if we don't want to emit constraints for its negation." (>= '<) (<= '>))) -(defun comp-reverse-arithm-fun (function) +(defun comp--reverse-arithm-fun (function) "Reverse FUNCTION." (cl-case function (= '=) @@ -1797,7 +1798,7 @@ Return nil if we don't want to emit constraints for its negation." (<= '>=) (t function))) -(defun comp-emit-assume (kind lhs rhs bb negated) +(defun comp--emit-assume (kind lhs rhs bb negated) "Emit an assume of kind KIND for mvar LHS being RHS. When NEGATED is non-nil, the assumption is negated. The assume is emitted at the beginning of the block BB." @@ -1807,41 +1808,41 @@ The assume is emitted at the beginning of the block BB." ((or 'and 'and-nhc) (if (comp-mvar-p rhs) (let ((tmp-mvar (if negated - (make-comp-mvar :slot (comp-mvar-slot rhs)) + (make--comp-mvar :slot (comp-mvar-slot rhs)) rhs))) - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,tmp-mvar)) (comp-block-insns bb)) (if negated (push `(assume ,tmp-mvar (not ,rhs)) (comp-block-insns bb)))) ;; If is only a constraint we can negate it directly. - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if negated (comp-cstr-negation-make rhs) rhs))) (comp-block-insns bb)))) ((pred comp--arithm-cmp-fun-p) (when-let ((kind (if negated - (comp-negate-arithm-cmp-fun kind) + (comp--negate-arithm-cmp-fun kind) kind))) - (push `(assume ,(make-comp-mvar :slot lhs-slot) + (push `(assume ,(make--comp-mvar :slot lhs-slot) (,kind ,lhs ,(if-let* ((vld (comp-cstr-imm-vld-p rhs)) (val (comp-cstr-imm rhs)) (ok (and (integerp val) (not (memq kind '(= !=)))))) val - (make-comp-mvar :slot (comp-mvar-slot rhs))))) + (make--comp-mvar :slot (comp-mvar-slot rhs))))) (comp-block-insns bb)))) (_ (cl-assert nil))) (setf (comp-func-ssa-status comp-func) 'dirty))) -(defun comp-maybe-add-vmvar (op cmp-res insns-seq) +(defun comp--maybe-add-vmvar (op cmp-res insns-seq) "If CMP-RES is clobbering OP emit a new constrained mvar and return it. Return OP otherwise." (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res))) - (new-mvar (make-comp-mvar + (new-mvar (make--comp-mvar :slot (- (cl-incf (comp-func-vframe-size comp-func)))))) (progn @@ -1849,7 +1850,7 @@ Return OP otherwise." new-mvar) op)) -(defun comp-add-new-block-between (bb-symbol bb-a bb-b) +(defun comp--add-new-block-between (bb-symbol bb-a bb-b) "Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B." (cl-loop with new-bb = (make-comp-block-cstr :name bb-symbol @@ -1872,7 +1873,7 @@ Return OP otherwise." finally (cl-assert nil))) ;; Cheap substitute to a copy propagation pass... -(defun comp-cond-cstrs-target-mvar (mvar exit-insn bb) +(defun comp--cond-cstrs-target-mvar (mvar exit-insn bb) "Given MVAR, search in BB the original mvar MVAR got assigned from. Keep on searching till EXIT-INSN is encountered." (cl-flet ((targetp (x) @@ -1889,7 +1890,7 @@ Keep on searching till EXIT-INSN is encountered." (setf res rhs))) finally (cl-assert nil)))) -(defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym) +(defun comp--add-cond-cstrs-target-block (curr-bb target-bb-sym) "Return the appropriate basic block to add constraint assumptions into. CURR-BB is the current basic block. TARGET-BB-SYM is the symbol name of the target block." @@ -1909,10 +1910,10 @@ TARGET-BB-SYM is the symbol name of the target block." until (null (gethash new-name (comp-func-blocks comp-func))) finally ;; Add it. - (cl-return (comp-add-new-block-between new-name curr-bb target-bb)))))) + (cl-return (comp--add-new-block-between new-name curr-bb target-bb)))))) -(defun comp-add-cond-cstrs-simple () - "`comp-add-cstrs' worker function for each selected function." +(defun comp--add-cond-cstrs-simple () + "`comp--add-cstrs' worker function for each selected function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do @@ -1928,26 +1929,26 @@ TARGET-BB-SYM is the symbol name of the target block." for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p tmp-mvar) + when (comp--mvar-used-p tmp-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and tmp-mvar obj2 block-target negated)) + (comp--emit-assume 'and tmp-mvar obj2 block-target negated)) finally (cl-return-from in-the-basic-block))) (`((cond-jump ,obj1 ,obj2 . ,blocks)) (cl-loop for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p obj1) + when (comp--mvar-used-p obj1) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and obj1 obj2 block-target negated)) + (comp--emit-assume 'and obj1 obj2 block-target negated)) finally (cl-return-from in-the-basic-block))))))) -(defun comp-add-cond-cstrs () - "`comp-add-cstrs' worker function for each selected function." +(defun comp--add-cond-cstrs () + "`comp--add-cstrs' worker function for each selected function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do @@ -1966,13 +1967,13 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,(and (pred comp-mvar-p) mvar-3) (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) - (comp-emit-assume 'and mvar-tested - (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) - (comp-add-cond-cstrs-target-block b bb2) + (comp--emit-assume 'and mvar-tested + (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp--add-cond-cstrs-target-block b bb2) nil) - (comp-emit-assume 'and mvar-tested - (make-comp-mvar :type (comp-cstr-cl-tag mvar-tag)) - (comp-add-cond-cstrs-target-block b bb1) + (comp--emit-assume 'and mvar-tested + (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag)) + (comp--add-cond-cstrs-target-block b bb1) t)) (`((set ,(and (pred comp-mvar-p) cmp-res) (,(pred comp--call-op-p) @@ -1983,8 +1984,8 @@ TARGET-BB-SYM is the symbol name of the target block." ;; (comment ,_comment-str) (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b) - with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b) + with target-mvar1 = (comp--cond-cstrs-target-mvar op1 (car insns-seq) b) + with target-mvar2 = (comp--cond-cstrs-target-mvar op2 (car insns-seq) b) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) @@ -1993,19 +1994,19 @@ TARGET-BB-SYM is the symbol name of the target block." (eql 'and-nhc) (eq 'and) (t fun)) - when (or (comp-mvar-used-p target-mvar1) - (comp-mvar-used-p target-mvar2)) + when (or (comp--mvar-used-p target-mvar1) + (comp--mvar-used-p target-mvar2)) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (when (comp-mvar-used-p target-mvar1) - (comp-emit-assume kind target-mvar1 - (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq) + (when (comp--mvar-used-p target-mvar1) + (comp--emit-assume kind target-mvar1 + (comp--maybe-add-vmvar op2 cmp-res prev-insns-seq) block-target negated)) - (when (comp-mvar-used-p target-mvar2) - (comp-emit-assume (comp-reverse-arithm-fun kind) + (when (comp--mvar-used-p target-mvar2) + (comp--emit-assume (comp--reverse-arithm-fun kind) target-mvar2 - (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq) + (comp--maybe-add-vmvar op1 cmp-res prev-insns-seq) block-target negated))) finally (cl-return-from in-the-basic-block))) (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2015,16 +2016,16 @@ TARGET-BB-SYM is the symbol name of the target block." ;; (comment ,_comment-str) (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) + with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(t nil) - when (comp-mvar-used-p target-mvar) + when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar cstr block-target negated)) finally (cl-return-from in-the-basic-block))) ;; Match predicate on the negated branch (unless). (`((set ,(and (pred comp-mvar-p) cmp-res) @@ -2034,20 +2035,20 @@ TARGET-BB-SYM is the symbol name of the target block." (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p))) (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks)) (cl-loop - with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b) + with target-mvar = (comp--cond-cstrs-target-mvar op (car insns-seq) b) with cstr = (comp--pred-to-cstr fun) for branch-target-cell on blocks for branch-target = (car branch-target-cell) for negated in '(nil t) - when (comp-mvar-used-p target-mvar) + when (comp--mvar-used-p target-mvar) do - (let ((block-target (comp-add-cond-cstrs-target-block b branch-target))) + (let ((block-target (comp--add-cond-cstrs-target-block b branch-target))) (setf (car branch-target-cell) (comp-block-name block-target)) - (comp-emit-assume 'and target-mvar cstr block-target negated)) + (comp--emit-assume 'and target-mvar cstr block-target negated)) finally (cl-return-from in-the-basic-block)))) (setf prev-insns-seq insns-seq)))) -(defsubst comp-insert-insn (insn insn-cell) +(defsubst comp--insert-insn (insn insn-cell) "Insert INSN as second insn of INSN-CELL." (let ((next-cell (cdr insn-cell)) (new-cell `(,insn))) @@ -2055,15 +2056,15 @@ TARGET-BB-SYM is the symbol name of the target block." (cdr new-cell) next-cell (comp-func-ssa-status comp-func) 'dirty))) -(defun comp-emit-call-cstr (mvar call-cell cstr) +(defun comp--emit-call-cstr (mvar call-cell cstr) "Emit a constraint CSTR for MVAR after CALL-CELL." - (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar))) + (let* ((new-mvar (make--comp-mvar :slot (comp-mvar-slot mvar))) ;; Have new-mvar as LHS *and* RHS to ensure monotonicity and ;; fwprop convergence!! (insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr)))) - (comp-insert-insn insn call-cell))) + (comp--insert-insn insn call-cell))) -(defun comp-lambda-list-gen (lambda-list) +(defun comp--lambda-list-gen (lambda-list) "Return a generator to iterate over LAMBDA-LIST." (lambda () (cl-case (car lambda-list) @@ -2079,12 +2080,12 @@ TARGET-BB-SYM is the symbol name of the target block." (car lambda-list) (setf lambda-list (cdr lambda-list))))))) -(defun comp-add-call-cstr () +(defun comp--add-call-cstr () "Add args assumptions for each function of which the type specifier is known." (cl-loop for bb being each hash-value of (comp-func-blocks comp-func) do - (comp-loop-insn-in-block bb + (comp--loop-insn-in-block bb (when-let ((match (pcase insn (`(set ,lhs (,(pred comp--call-op-p) ,f . ,args)) @@ -2095,10 +2096,10 @@ TARGET-BB-SYM is the symbol name of the target block." (cl-values f cstr-f nil args)))))) (cl-multiple-value-bind (f cstr-f lhs args) match (cl-loop - with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f)) + with gen = (comp--lambda-list-gen (comp-cstr-f-args cstr-f)) for arg in args for cstr = (funcall gen) - for target = (comp-cond-cstrs-target-mvar arg insn bb) + for target = (comp--cond-cstrs-target-mvar arg insn bb) unless (comp-cstr-p cstr) do (signal 'native-ice (list "Incoherent type specifier for function" f)) @@ -2109,9 +2110,9 @@ TARGET-BB-SYM is the symbol name of the target block." (or (null lhs) (not (eql (comp-mvar-slot lhs) (comp-mvar-slot target))))) - do (comp-emit-call-cstr target insn-cell cstr))))))) + do (comp--emit-call-cstr target insn-cell cstr))))))) -(defun comp-add-cstrs (_) +(defun comp--add-cstrs (_) "Rewrite conditional branches adding appropriate `assume' insns. This is introducing and placing `assume' insns in use by fwprop to propagate conditional branch test information on target basic @@ -2125,10 +2126,10 @@ blocks." (not (comp-func-has-non-local f))) (let ((comp-func f) (comp-pass (make-hash-table :test #'eq))) - (comp-collect-rhs) - (comp-add-cond-cstrs-simple) - (comp-add-cond-cstrs) - (comp-add-call-cstr) + (comp--collect-rhs) + (comp--add-cond-cstrs-simple) + (comp--add-cond-cstrs) + (comp--add-call-cstr) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2140,7 +2141,7 @@ blocks." ;; avoid optimizing-out functions and preventing their redefinition ;; being effective. -(defun comp-collect-calls (f) +(defun comp--collect-calls (f) "Return a list with all the functions called by F." (cl-loop with h = (make-hash-table :test #'eq) @@ -2160,17 +2161,17 @@ blocks." (comp-ctxt-funcs-h comp-ctxt))) f)))) -(defun comp-pure-infer-func (f) +(defun comp--pure-infer-func (f) "If all functions called by F are pure then F is pure too." (when (and (cl-every (lambda (x) (or (comp--function-pure-p x) (eq x (comp-func-name f)))) - (comp-collect-calls f)) + (comp--collect-calls f)) (not (eq (comp-func-pure f) t))) (comp-log (format "%s inferred to be pure" (comp-func-name f))) (setf (comp-func-pure f) t))) -(defun comp-ipa-pure (_) +(defun comp--ipa-pure (_) "Infer function purity." (cl-loop with pure-n = 0 @@ -2183,7 +2184,7 @@ blocks." when (and (>= (comp-func-speed f) 3) (comp-func-l-p f) (not (comp-func-pure f))) - do (comp-pure-infer-func f) + do (comp--pure-infer-func f) count (comp-func-pure f)))) finally (comp-log (format "ipa-pure iterated %d times" n)))) @@ -2197,13 +2198,13 @@ blocks." ;; this form is called 'minimal SSA form'. ;; This pass should be run every time basic blocks or m-var are shuffled. -(cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type) - "Same as `make-comp-mvar' but set the `id' slot." - (let ((mvar (apply #'make-comp-mvar rest))) +(cl-defun make--comp--ssa-mvar (&rest rest &key _slot _constant _type) + "Same as `make--comp-mvar' but set the `id' slot." + (let ((mvar (apply #'make--comp-mvar rest))) (setf (comp-mvar-id mvar) (sxhash-eq mvar)) mvar)) -(defun comp-clean-ssa (f) +(defun comp--clean-ssa (f) "Clean-up SSA for function F." (setf (comp-func-edges-h f) (make-hash-table)) (cl-loop @@ -2219,7 +2220,7 @@ blocks." unless (eq 'phi (car insn)) collect insn)))) -(defun comp-compute-edges () +(defun comp--compute-edges () "Compute the basic block edges for the current function." (cl-loop with blocks = (comp-func-blocks comp-func) for bb being each hash-value of blocks @@ -2255,7 +2256,7 @@ blocks." (comp-block-in-edges (comp-edge-dst edge)))) (comp--log-edges comp-func))) -(defun comp-collect-rev-post-order (basic-block) +(defun comp--collect-rev-post-order (basic-block) "Walk BASIC-BLOCK children and return their name in reversed post-order." (let ((visited (make-hash-table)) (acc ())) @@ -2270,7 +2271,7 @@ blocks." (collect-rec basic-block) acc))) -(defun comp-compute-dominator-tree () +(defun comp--compute-dominator-tree () "Compute immediate dominators for each basic block in current function." ;; Originally based on: "A Simple, Fast Dominance Algorithm" ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). @@ -2295,7 +2296,7 @@ blocks." ;; No point to go on if the only bb is 'entry'. (bb0 (gethash 'bb_0 blocks))) (cl-loop - with rev-bb-list = (comp-collect-rev-post-order entry) + with rev-bb-list = (comp--collect-rev-post-order entry) with changed = t while changed initially (progn @@ -2322,7 +2323,7 @@ blocks." new-idom) changed t)))))) -(defun comp-compute-dominator-frontiers () +(defun comp--compute-dominator-frontiers () "Compute the dominator frontier for each basic block in `comp-func'." ;; Originally based on: "A Simple, Fast Dominance Algorithm" ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001). @@ -2337,7 +2338,7 @@ blocks." (puthash b-name b (comp-block-df runner)) (setf runner (comp-block-idom runner)))))) -(defun comp-log-block-info () +(defun comp--log-block-info () "Log basic blocks info for the current function." (maphash (lambda (name bb) (let ((dom (comp-block-idom bb)) @@ -2350,7 +2351,7 @@ blocks." 3))) (comp-func-blocks comp-func))) -(defun comp-place-phis () +(defun comp--place-phis () "Place phi insns into the current function." ;; Originally based on: Static Single Assignment Book ;; Algorithm 3.1: Standard algorithm for inserting phi-functions @@ -2391,7 +2392,7 @@ blocks." (unless (cl-find y defs-v) (push y w)))))))) -(defun comp-dom-tree-walker (bb pre-lambda post-lambda) +(defun comp--dom-tree-walker (bb pre-lambda post-lambda) "Dominator tree walker function starting from basic block BB. PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (when pre-lambda @@ -2401,18 +2402,18 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." for child = (comp-edge-dst ed) when (eq bb (comp-block-idom child)) ;; Current block is the immediate dominator then recur. - do (comp-dom-tree-walker child pre-lambda post-lambda))) + do (comp--dom-tree-walker child pre-lambda post-lambda))) (when post-lambda (funcall post-lambda bb))) -(cl-defstruct (comp-ssa (:copier nil)) +(cl-defstruct (comp--ssa (:copier nil)) "Support structure used while SSA renaming." - (frame (comp-new-frame (comp-func-frame-size comp-func) + (frame (comp--new-frame (comp-func-frame-size comp-func) (comp-func-vframe-size comp-func) t) :type comp-vec :documentation "`comp-vec' of m-vars.")) -(defun comp-ssa-rename-insn (insn frame) +(defun comp--ssa-rename-insn (insn frame) (cl-loop for slot-n from (- (comp-func-vframe-size comp-func)) below (comp-func-frame-size comp-func) @@ -2423,7 +2424,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (eql slot-n (comp-mvar-slot x)))) (new-lvalue () ;; If is an assignment make a new mvar and put it as l-value. - (let ((mvar (make-comp-ssa-mvar :slot slot-n))) + (let ((mvar (make--comp--ssa-mvar :slot slot-n))) (setf (comp-vec-aref frame slot-n) mvar (cadr insn) mvar)))) (pcase insn @@ -2433,7 +2434,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (new-lvalue)) (`(fetch-handler . ,_) ;; Clobber all no matter what! - (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n))) + (setf (comp-vec-aref frame slot-n) (make--comp--ssa-mvar :slot slot-n))) (`(phi ,n) (when (equal n slot-n) (new-lvalue))) @@ -2441,7 +2442,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (let ((mvar (comp-vec-aref frame slot-n))) (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn))))))))) -(defun comp-ssa-rename () +(defun comp--ssa-rename () "Entry point to rename into SSA within the current function." (comp-log "Renaming\n" 2) (let ((visited (make-hash-table))) @@ -2449,7 +2450,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." (unless (gethash bb visited) (puthash bb t visited) (cl-loop for insn in (comp-block-insns bb) - do (comp-ssa-rename-insn insn in-frame)) + do (comp--ssa-rename-insn insn in-frame)) (setf (comp-block-final-frame bb) (copy-sequence in-frame)) (when-let ((out-edges (comp-block-out-edges bb))) @@ -2460,11 +2461,11 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." do (ssa-rename-rec child (comp-vec-copy in-frame))))))) (ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func)) - (comp-new-frame (comp-func-frame-size comp-func) + (comp--new-frame (comp-func-frame-size comp-func) (comp-func-vframe-size comp-func) t))))) -(defun comp-finalize-phis () +(defun comp--finalize-phis () "Fixup r-values into phis in all basic blocks." (cl-flet ((finalize-phi (args b) ;; Concatenate into args all incoming m-vars for this phi. @@ -2481,7 +2482,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." when (eq op 'phi) do (finalize-phi args b))))) -(defun comp-remove-unreachable-blocks () +(defun comp--remove-unreachable-blocks () "Remove unreachable basic blocks. Return t when one or more block was removed, nil otherwise." (cl-loop @@ -2497,7 +2498,7 @@ Return t when one or more block was removed, nil otherwise." ret t) finally return ret)) -(defun comp-ssa () +(defun comp--ssa () "Port all functions into minimal SSA form." (maphash (lambda (_ f) (let* ((comp-func f) @@ -2505,15 +2506,15 @@ Return t when one or more block was removed, nil otherwise." (unless (eq ssa-status t) (cl-loop when (eq ssa-status 'dirty) - do (comp-clean-ssa f) - do (comp-compute-edges) - (comp-compute-dominator-tree) - until (null (comp-remove-unreachable-blocks))) - (comp-compute-dominator-frontiers) - (comp-log-block-info) - (comp-place-phis) - (comp-ssa-rename) - (comp-finalize-phis) + do (comp--clean-ssa f) + do (comp--compute-edges) + (comp--compute-dominator-tree) + until (null (comp--remove-unreachable-blocks))) + (comp--compute-dominator-frontiers) + (comp--log-block-info) + (comp--place-phis) + (comp--ssa-rename) + (comp--finalize-phis) (comp--log-func comp-func 3) (setf (comp-func-ssa-status f) t)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2525,12 +2526,12 @@ Return t when one or more block was removed, nil otherwise." ;; This is also responsible for removing function calls to pure functions if ;; possible. -(defconst comp-fwprop-max-insns-scan 4500 +(defconst comp--fwprop-max-insns-scan 4500 ;; Chosen as ~ the greatest required value for full convergence ;; native compiling all Emacs code-base. "Max number of scanned insn before giving-up.") -(defun comp-copy-insn (insn) +(defun comp--copy-insn (insn) "Deep copy INSN." ;; Adapted from `copy-tree'. (if (consp insn) @@ -2538,16 +2539,16 @@ Return t when one or more block was removed, nil otherwise." (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) -(defmacro comp-apply-in-env (func &rest args) +(defmacro comp--apply-in-env (func &rest args) "Apply FUNC to ARGS in the current compilation environment." `(let ((env (cl-loop for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt) @@ -2563,7 +2564,7 @@ Return t when one or more block was removed, nil otherwise." for (func-name . def) in env do (setf (symbol-function func-name) def))))) -(defun comp-fwprop-prologue () +(defun comp--fwprop-prologue () "Prologue for the propagate pass. Here goes everything that can be done not iteratively (read once). Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked? @@ -2575,16 +2576,16 @@ Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or (`(setimm ,lval ,v) (setf (comp-cstr-imm lval) v)))))) -(defun comp-function-foldable-p (f args) +(defun comp--function-foldable-p (f args) "Given function F called with ARGS, return non-nil when optimizable." (and (comp--function-pure-p f) (cl-every #'comp-cstr-imm-vld-p args))) -(defun comp-function-call-maybe-fold (insn f args) +(defun comp--function-call-maybe-fold (insn f args) "Given INSN, when F is pure if all ARGS are known, remove the function call. Return non-nil if the function is folded successfully." (cl-flet ((rewrite-insn-as-setimm (insn value) - ;; See `comp-emit-setimm'. + ;; See `comp--emit-setimm'. (comp--add-const-to-relocs value) (setf (car insn) 'setimm (cddr insn) `(,value)))) @@ -2596,7 +2597,7 @@ Return non-nil if the function is folded successfully." comp-symbol-values-optimizable))) (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm (car args)))))) - ((comp-function-foldable-p f args) + ((comp--function-foldable-p f args) (ignore-errors ;; No point to complain here in case of error because we ;; should do basic block pruning in order to be sure that this @@ -2607,14 +2608,14 @@ Return non-nil if the function is folded successfully." ;; and know to be pure. (comp-func-byte-func f-in-ctxt) f)) - (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args)))) + (value (comp--apply-in-env f (mapcar #'comp-cstr-imm args)))) (rewrite-insn-as-setimm insn value))))))) -(defun comp-fwprop-call (insn lval f args) +(defun comp--fwprop-call (insn lval f args) "Propagate on a call INSN into LVAL. F is the function being called with arguments ARGS. Fold the call in case." - (unless (comp-function-call-maybe-fold insn f args) + (unless (comp--function-call-maybe-fold insn f args) (when (and (eq 'funcall f) (comp-cstr-imm-vld-p (car args))) (setf f (comp-cstr-imm (car args)) @@ -2635,16 +2636,16 @@ Fold the call in case." (comp-type-spec-to-cstr (comp-cstr-imm (car args))))))))) -(defun comp-fwprop-insn (insn) +(defun comp--fwprop-insn (insn) "Propagate within INSN." (pcase insn (`(set ,lval ,rval) (pcase rval (`(,(or 'call 'callref) ,f . ,args) - (comp-fwprop-call insn lval f args)) + (comp--fwprop-call insn lval f args)) (`(,(or 'direct-call 'direct-callref) ,f . ,args) (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt))))) - (comp-fwprop-call insn lval f args))) + (comp--fwprop-call insn lval f args))) (_ (comp-cstr-shallow-copy lval rval)))) (`(assume ,lval ,(and (pred comp-mvar-p) rval)) @@ -2689,7 +2690,7 @@ Fold the call in case." (rvals (mapcar #'car rest))) (apply prop-fn lval rvals))))) -(defun comp-fwprop* () +(defun comp--fwprop* () "Propagate for set* and phi operands. Return t if something was changed." (cl-loop named outer @@ -2701,17 +2702,17 @@ Return t if something was changed." for insn in (comp-block-insns b) for orig-insn = (unless modified ;; Save consing after 1st change. - (comp-copy-insn insn)) + (comp--copy-insn insn)) do - (comp-fwprop-insn insn) + (comp--fwprop-insn insn) (cl-incf i) when (and (null modified) (not (equal insn orig-insn))) do (setf modified t)) - when (> i comp-fwprop-max-insns-scan) + when (> i comp--fwprop-max-insns-scan) do (cl-return-from outer nil) finally return modified)) -(defun comp-rewrite-non-locals () +(defun comp--rewrite-non-locals () "Make explicit in LIMPLE non-local exits if identified." (cl-loop for bb being each hash-value of (comp-func-blocks comp-func) @@ -2728,26 +2729,26 @@ Return t if something was changed." (cdr insn-seq) '((unreachable)) (comp-func-ssa-status comp-func) 'dirty)))) -(defun comp-fwprop (_) +(defun comp--fwprop (_) "Forward propagate types and consts within the lattice." - (comp-ssa) - (comp-dead-code) + (comp--ssa) + (comp--dead-code) (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) ;; FIXME remove the following condition when tested. (not (comp-func-has-non-local f))) (let ((comp-func f)) - (comp-fwprop-prologue) + (comp--fwprop-prologue) (cl-loop for i from 1 to 100 - while (comp-fwprop*) + while (comp--fwprop*) finally (when (= i 100) (display-warning 'comp (format "fwprop pass jammed into %s?" (comp-func-name f)))) (comp-log (format "Propagation run %d times\n" i) 2)) - (comp-rewrite-non-locals) + (comp--rewrite-non-locals) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2767,7 +2768,7 @@ Return t if something was changed." ;; the full compilation unit. ;; For this reason this is triggered only at native-comp-speed == 3. -(defun comp-func-in-unit (func) +(defun comp--func-in-unit (func) "Given FUNC return the `comp-fun' definition in the current context. FUNCTION can be a function-name or byte compiled function." (if (symbolp func) @@ -2775,11 +2776,11 @@ FUNCTION can be a function-name or byte compiled function." (cl-assert (byte-code-function-p func)) (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt)))) -(defun comp-call-optim-form-call (callee args) +(defun comp--call-optim-form-call (callee args) (cl-flet ((fill-args (args total) ;; Fill missing args to reach TOTAL (append args (cl-loop repeat (- total (length args)) - collect (make-comp-mvar :constant nil))))) + collect (make--comp-mvar :constant nil))))) (when (and callee (or (symbolp callee) (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt))) @@ -2797,7 +2798,7 @@ FUNCTION can be a function-name or byte compiled function." ;; actually cheaper since it avoids the call to the ;; intermediate native trampoline (bug#67005). (subrp (subrp f)) - (comp-func-callee (comp-func-in-unit callee))) + (comp-func-callee (comp--func-in-unit callee))) (cond ((and subrp (not (subr-native-elisp-p f))) ;; Trampoline removal. @@ -2832,30 +2833,30 @@ FUNCTION can be a function-name or byte compiled function." ((comp--type-hint-p callee) `(call ,callee ,@args))))))) -(defun comp-call-optim-func () +(defun comp--call-optim-func () "Perform the trampoline call optimization for the current function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (pcase insn (`(set ,lval (callref funcall ,f . ,rest)) (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp-call-optim-form-call + (new-form (comp--call-optim-form-call (comp-cstr-imm f) rest))) (setf insn `(set ,lval ,new-form)))) (`(callref funcall ,f . ,rest) (when-let ((ok (comp-cstr-imm-vld-p f)) - (new-form (comp-call-optim-form-call + (new-form (comp--call-optim-form-call (comp-cstr-imm f) rest))) (setf insn new-form))))))) -(defun comp-call-optim (_) +(defun comp--call-optim (_) "Try to optimize out funcall trampoline usage when possible." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) (comp-func-l-p f)) (let ((comp-func f)) - (comp-call-optim-func)))) + (comp--call-optim-func)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2866,16 +2867,16 @@ FUNCTION can be a function-name or byte compiled function." ;; ;; This pass can be run as last optim. -(defun comp-collect-mvar-ids (insn) +(defun comp--collect-mvar-ids (insn) "Collect the m-var unique identifiers into INSN." (cl-loop for x in insn if (consp x) - append (comp-collect-mvar-ids x) + append (comp--collect-mvar-ids x) else when (comp-mvar-p x) collect (comp-mvar-id x))) -(defun comp-dead-assignments-func () +(defun comp--dead-assignments-func () "Clean-up dead assignments into current function. Return the list of m-var ids nuked." (let ((l-vals ()) @@ -2888,9 +2889,9 @@ Return the list of m-var ids nuked." for (op arg0 . rest) = insn if (comp--assign-op-p op) do (push (comp-mvar-id arg0) l-vals) - (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals)) + (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)) else - do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals)))) + do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals)))) ;; Every l-value appearing that does not appear as r-value has no right to ;; exist and gets nuked. (let ((nuke-list (cl-set-difference l-vals r-vals))) @@ -2902,7 +2903,7 @@ Return the list of m-var ids nuked." 3) (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn (when (and (comp--assign-op-p op) (memq (comp-mvar-id arg0) nuke-list)) @@ -2913,7 +2914,7 @@ Return the list of m-var ids nuked." insn)))))))) nuke-list))) -(defun comp-dead-code () +(defun comp--dead-code () "Dead code elimination." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 2) @@ -2922,7 +2923,7 @@ Return the list of m-var ids nuked." (cl-loop for comp-func = f for i from 1 - while (comp-dead-assignments-func) + while (comp--dead-assignments-func) finally (comp-log (format "dead code rm run %d times\n" i) 2) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2930,14 +2931,14 @@ Return the list of m-var ids nuked." ;;; Tail Call Optimization pass specific code. -(defun comp-form-tco-call-seq (args) +(defun comp--form-tco-call-seq (args) "Generate a TCO sequence for ARGS." `(,@(cl-loop for arg in args for i from 0 - collect `(set ,(make-comp-mvar :slot i) ,arg)) + collect `(set ,(make--comp-mvar :slot i) ,arg)) (jump bb_0))) -(defun comp-tco-func () +(defun comp--tco-func () "Try to pattern match and perform TCO within the current function." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) @@ -2950,20 +2951,20 @@ Return the list of m-var ids nuked." (return ,ret-val)) (when (and (string= func (comp-func-c-name comp-func)) (eq l-val ret-val)) - (let ((tco-seq (comp-form-tco-call-seq args))) + (let ((tco-seq (comp--form-tco-call-seq args))) (setf (car insns-seq) (car tco-seq) (cdr insns-seq) (cdr tco-seq) (comp-func-ssa-status comp-func) 'dirty) (cl-return-from in-the-basic-block)))))))) -(defun comp-tco (_) +(defun comp--tco (_) "Simple peephole pass performing self TCO." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 3) (comp-func-l-p f) (not (comp-func-has-non-local f))) (let ((comp-func f)) - (comp-tco-func) + (comp--tco-func) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) @@ -2973,29 +2974,29 @@ Return the list of m-var ids nuked." ;; This must run after all SSA prop not to have the type hint ;; information overwritten. -(defun comp-remove-type-hints-func () +(defun comp--remove-type-hints-func () "Remove type hints from the current function. These are substituted with a normal `set' op." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) - do (comp-loop-insn-in-block b + do (comp--loop-insn-in-block b (pcase insn (`(set ,l-val (call ,(pred comp--type-hint-p) ,r-val)) (setf insn `(set ,l-val ,r-val))))))) -(defun comp-remove-type-hints (_) +(defun comp--remove-type-hints (_) "Dead code elimination." (maphash (lambda (_ f) (when (>= (comp-func-speed f) 2) (let ((comp-func f)) - (comp-remove-type-hints-func) + (comp--remove-type-hints-func) (comp--log-func comp-func 3)))) (comp-ctxt-funcs-h comp-ctxt))) ;;; Final pass specific code. -(defun comp-args-to-lambda-list (args) +(defun comp--args-to-lambda-list (args) "Return a lambda list for ARGS." (cl-loop with res @@ -3020,7 +3021,7 @@ These are substituted with a normal `set' op." (push 't res)))) (cl-return (reverse res)))) -(defun comp-compute-function-type (_ func) +(defun comp--compute-function-type (_ func) "Compute type specifier for `comp-func' FUNC. Set it into the `type' slot." (when (and (comp-func-l-p func) @@ -3040,13 +3041,13 @@ Set it into the `type' slot." (`(return ,mvar) (push mvar res)))) finally return res))) - (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func)) + (type `(function ,(comp--args-to-lambda-list (comp-func-l-args func)) ,(comp-cstr-to-type-spec res-mvar)))) (comp--add-const-to-relocs type) ;; Fix it up. (setf (comp-cstr-imm (comp-func-type func)) type)))) -(defun comp-finalize-container (cont) +(defun comp--finalize-container (cont) "Finalize data container CONT." (setf (comp-data-container-l cont) (cl-loop with h = (comp-data-container-idx cont) @@ -3064,7 +3065,7 @@ Set it into the `type' slot." 'lambda-fixup obj)))) -(defun comp-finalize-relocs () +(defun comp--finalize-relocs () "Finalize data containers for each relocation class. Remove immediate duplicates within relocation classes. Update all insn accordingly." @@ -3080,7 +3081,7 @@ Update all insn accordingly." (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) ;; We never want compiled lambdas ending up in pure space. A copy must - ;; be already present in impure (see `comp-emit-lambda-for-top-level'). + ;; be already present in impure (see `comp--emit-lambda-for-top-level'). (cl-loop for obj being each hash-keys of d-default-idx when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) do (cl-assert (gethash obj d-impure-idx)) @@ -3096,7 +3097,7 @@ Update all insn accordingly." do (remhash obj d-ephemeral-idx)) ;; Fix-up indexes in each relocation class and fill corresponding ;; reloc lists. - (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral)) + (mapc #'comp--finalize-container (list d-default d-impure d-ephemeral)) ;; Make a vector from the function documentation hash table. (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) with v = (make-vector (hash-table-count h) nil) @@ -3120,11 +3121,11 @@ Update all insn accordingly." (comp-mvar-range mvar) (list (cons idx idx))) (puthash idx t reverse-h)))) -(defun comp-compile-ctxt-to-file (name) +(defun comp--compile-ctxt-to-file (name) "Compile as native code the current context naming it NAME. Prepare every function for final compilation and drive the C back-end." (let ((dir (file-name-directory name))) - (comp-finalize-relocs) + (comp--finalize-relocs) (maphash (lambda (_ f) (comp--log-func f 1)) (comp-ctxt-funcs-h comp-ctxt)) @@ -3132,12 +3133,12 @@ Prepare every function for final compilation and drive the C back-end." ;; In case it's created in the meanwhile. (ignore-error file-already-exists (make-directory dir t))) - (comp--compile-ctxt-to-file name))) + (comp--compile-ctxt-to-file0 name))) -(defun comp-final1 () +(defun comp--final1 () (comp--init-ctxt) (unwind-protect - (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) + (comp--compile-ctxt-to-file (comp-ctxt-output comp-ctxt)) (comp--release-ctxt))) (defvar comp-async-compilation nil @@ -3146,17 +3147,17 @@ Prepare every function for final compilation and drive the C back-end." (defvar comp-running-batch-compilation nil "Non-nil when compilation is driven by any `batch-*-compile' function.") -(defun comp-final (_) +(defun comp--final (_) "Final pass driving the C back-end for code emission." - (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt)) + (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)) (unless comp-dry-run ;; Always run the C side of the compilation as a sub-process ;; unless during bootstrap or async compilation (bug#45056). GCC ;; leaks memory but also interfere with the ability of Emacs to ;; detect when a sub-process completes (TODO understand why). (if (or comp-running-batch-compilation comp-async-compilation) - (comp-final1) - ;; Call comp-final1 in a child process. + (comp--final1) + ;; Call comp--final1 in a child process. (let* ((output (comp-ctxt-output comp-ctxt)) (print-escape-newlines t) (print-length nil) @@ -3178,7 +3179,7 @@ Prepare every function for final compilation and drive the C back-end." load-path ',load-path) ,native-comp-async-env-modifier-form (message "Compiling %s..." ',output) - (comp-final1))) + (comp--final1))) (temp-file (make-temp-file (concat "emacs-int-comp-" (file-name-base output) "-") @@ -3222,7 +3223,7 @@ Prepare every function for final compilation and drive the C back-end." ;; Primitive function advice machinery -(defun comp-make-lambda-list-from-subr (subr) +(defun comp--make-lambda-list-from-subr (subr) "Given SUBR return the equivalent lambda-list." (pcase-let ((`(,min . ,max) (subr-arity subr)) (lambda-list '())) @@ -3266,7 +3267,7 @@ Prepare every function for final compilation and drive the C back-end." ;;;###autoload (defun comp-trampoline-compile (subr-name) "Synthesize compile and return a trampoline for SUBR-NAME." - (let* ((lambda-list (comp-make-lambda-list-from-subr + (let* ((lambda-list (comp--make-lambda-list-from-subr (symbol-function subr-name))) ;; The synthesized trampoline must expose the exact same ABI of ;; the primitive we are replacing in the function reloc table. @@ -3310,6 +3311,7 @@ filename (including FILE)." do (ignore-error file-error (comp-delete-or-replace-file f)))))) +;; In use by comp.c. (defun comp-delete-or-replace-file (oldfile &optional newfile) "Replace OLDFILE with NEWFILE. When NEWFILE is nil just delete OLDFILE. @@ -3493,7 +3495,7 @@ last directory in `native-comp-eln-load-path')." else collect (byte-compile-file file)))) -(defun comp-write-bytecode-file (eln-file) +(defun comp--write-bytecode-file (eln-file) "After native compilation write the bytecode file for ELN-FILE. Make sure that eln file is younger than byte-compiled one and return the filename of this last. @@ -3530,7 +3532,7 @@ variable \"NATIVE_DISABLED\" is set, only byte compile." (car (last native-comp-eln-load-path))) (byte-to-native-output-buffer-file nil) (eln-file (car (batch-native-compile)))) - (comp-write-bytecode-file eln-file) + (comp--write-bytecode-file eln-file) (setq command-line-args-left (cdr command-line-args-left))))) (defun native-compile-prune-cache () diff --git a/src/comp.c b/src/comp.c index 853757f6162..3f989c722d4 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4859,8 +4859,8 @@ add_compiler_options (void) #endif } -DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, - Scomp__compile_ctxt_to_file, +DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, + Scomp__compile_ctxt_to_file0, 1, 1, 0, doc: /* Compile the current context as native code to file FILENAME. */) (Lisp_Object filename) @@ -5789,7 +5789,7 @@ natively-compiled one. */); defsubr (&Scomp__install_trampoline); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); - defsubr (&Scomp__compile_ctxt_to_file); + defsubr (&Scomp__compile_ctxt_to_file0); defsubr (&Scomp_libgccjit_version); defsubr (&Scomp__register_lambda); defsubr (&Scomp__register_subr); diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 4cee084e211..dc4abf50767 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -367,11 +367,11 @@ (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) From c0f656617d6848b94413b79b390788565d338fcd Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 11 Feb 2024 22:32:44 +0200 Subject: [PATCH 178/385] Make sure the binding shown by echo-keystrokes-help is not shadowed And choose just one binding to display rather than two together. (https://lists.gnu.org/archive/html/emacs-devel/2024-02/msg00311.html) * lisp/help.el (help--append-keystrokes-help): New function. * src/keyboard.c (syms_of_keyboard): Add a symbol for it. (echo_dash): Use them here. --- lisp/help.el | 21 +++++++++++++++++++++ src/keyboard.c | 13 +++++-------- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index 72a4f8a800d..07eed2861c2 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -2253,6 +2253,27 @@ The `temp-buffer-window-setup-hook' hook is called." (with-output-to-temp-buffer " *Char Help*" (princ msg))))) +(defun help--append-keystrokes-help (str) + (let* ((keys (this-single-command-keys)) + (bindings (delete nil + (mapcar (lambda (map) (lookup-key map keys t)) + (current-active-maps t))))) + (catch 'res + (dolist (val help-event-list) + (let ((key (vector (if (eql val 'help) + help-char + val)))) + (unless (seq-find (lambda (map) (and (keymapp map) (lookup-key map key))) + bindings) + (throw 'res + (concat + str + (substitute-command-keys + (format + " (\\`%s' for help)" + (key-description key)))))))) + str))) + (defun help--docstring-quote (string) "Return a doc string that represents STRING. diff --git a/src/keyboard.c b/src/keyboard.c index 10cdef67348..4b5e20fb24c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -594,14 +594,9 @@ echo_dash (void) concat2 (KVAR (current_kboard, echo_string), dash)); if (echo_keystrokes_help) - { - Lisp_Object help; - - help = build_string (" (\\`C-h' or \\`' for help)"); - kset_echo_string (current_kboard, - concat2 (KVAR (current_kboard, echo_string), - calln (Qsubstitute_command_keys, help))); - } + kset_echo_string (current_kboard, + calln (Qhelp__append_keystrokes_help, + KVAR (current_kboard, echo_string))); echo_now (); } @@ -12962,6 +12957,8 @@ syms_of_keyboard (void) DEFSYM (Qhelp_key_binding, "help-key-binding"); + DEFSYM (Qhelp__append_keystrokes_help, "help--append-keystrokes-help"); + DEFSYM (Qecho_keystrokes, "echo-keystrokes"); Fset (Qinput_method_exit_on_first_char, Qnil); From db195116a4279521e9cf03c52b7026032461e3e1 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 13 Sep 2023 12:26:22 +0200 Subject: [PATCH 179/385] Add the public API of Compat to the core * lisp/emacs-lisp/compat.el: Add stub file with minimal definitions, so that core packages, that haven't been installed from ELPA, can make use of the public API and use more recent function signatures. * lisp/progmodes/python.el (compat): Remove 'noerror flag, because Compat can now be required without the real package being available. * doc/lispref/package.texi (Forwards-Compatibility): Mention Compat and link to the manual. * etc/NEWS: Document change. (Bug#66554) --- doc/lispref/package.texi | 48 ++++++++++++++++++++ etc/NEWS | 7 +++ lisp/emacs-lisp/compat.el | 92 +++++++++++++++++++++++++++++++++++++++ lisp/progmodes/python.el | 2 +- 4 files changed, 148 insertions(+), 1 deletion(-) create mode 100644 lisp/emacs-lisp/compat.el diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index f75023d4039..421e64dd5d1 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -28,6 +28,7 @@ these archives). * Multi-file Packages:: How to package multiple files. * Package Archives:: Maintaining package archives. * Archive Web Server:: Interfacing to an archive web server. +* Forwards-Compatibility:: Supporting older versions of Emacs. @end menu @node Packaging Basics @@ -399,3 +400,50 @@ Return the file. This will be the tarball for a multi-file package, or the single file for a simple package. @end table + +@node Forwards-Compatibility +@section Supporting older versions of Emacs +@cindex compatibility compat + +Packages that wish to support older releases of Emacs, without giving +up on newer functionality from recent Emacs releases, one can make use +of the Compat package on GNU ELPA. By depending on the package, Emacs +can provide compatibility definitions for missing functionality. + +The versioning of Compat follows that of Emacs, so next to the oldest +version that a package relies on (via the @code{emacs}-package), one +can also indicate what the newest version of Emacs is, that a package +wishes to use definitions from: + +@example +;; Package-Requires: ((emacs "27.2") (compat "29.1")) +@end example + +Note that Compat provides replacement functions with extended +functionality for functions that are already defined (@code{sort}, +@code{assoc}, @dots{}). These functions may have changed their +calling convention (additional optional arguments) or may have changed +their behavior. These functions must be looked up explicitly with +@code{compat-function} or called explicitly with @code{compat-call}. +We call them @dfn{Extended Definitions}. In contrast, newly @dfn{Added +Definitions} can be called as usual. + +@defmac compat-call fun &rest args +This macro calls the compatibility function @var{fun} with @var{args}. +Many functions provided by Compat can be called directly without this +macro. However in the case where Compat provides an alternative +version of an existing function, the function call has to go through +@code{compat-call}. +@end defmac + +@defmac compat-function fun +This macro returns the compatibility function symbol for @var{fun}. +See @code{compat-call} for a more convenient macro to directly call +compatibility functions. +@end defmac + +For further details on how to make use of the package, see +@ref{Usage,, Usage, compat, "Compat" Manual}. In case you don't have +the manual installed, you can also read the +@url{https://elpa.gnu.org/packages/doc/compat.html#Usage, Online +Compat manual}. diff --git a/etc/NEWS b/etc/NEWS index 5ee1509859b..de1f2fd9d2a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1396,6 +1396,13 @@ This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the files and save the changes. ++++ +** New package Compat +Emacs now comes with a stub implementation of the +forwards-compatibility Compat package from GNU ELPA. This allows +built-in packages to use the library more effectively, and helps +preventing the installation of Compat if unnecessary. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/emacs-lisp/compat.el b/lisp/emacs-lisp/compat.el new file mode 100644 index 00000000000..f7037dc4101 --- /dev/null +++ b/lisp/emacs-lisp/compat.el @@ -0,0 +1,92 @@ +;;; compat.el --- Stub of the Compatibility Library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2024 Free Software Foundation, Inc. + +;; Author: \ +;; Philip Kaludercic , \ +;; Daniel Mendler +;; Maintainer: \ +;; Daniel Mendler , \ +;; Compat Development <~pkal/compat-devel@lists.sr.ht>, +;; emacs-devel@gnu.org +;; URL: https://github.com/emacs-compat/compat +;; Keywords: lisp, maint + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The Compat package on ELPA provides forward-compatibility +;; definitions for other packages. While mostly transparent, a +;; minimal API is necessary whenever core definitions change calling +;; conventions (e.g. `plist-get' can be invoked with a predicate from +;; Emacs 29.1 onward). For core packages on ELPA to be able to take +;; advantage of this functionality, the macros `compat-function' and +;; `compat-call' have to be available in the core, usable even if +;; users do not have the Compat package installed, which this file +;; ensures. + +;; A basic introduction to Compat is given in the Info node `(elisp) +;; Forwards Compatibility'. Further details on Compat are documented +;; in the Info node `(compat) Top' (installed along with the Compat +;; package) or read the same manual online: +;; https://elpa.gnu.org/packages/doc/compat.html. + +;;; Code: + +(defmacro compat-function (fun) + "Return compatibility function symbol for FUN. +This is a pseudo-compatibility stub for core packages on ELPA, +that depend on the Compat package, whenever the user doesn't have +the package installed on their current system." + `#',fun) + +(defmacro compat-call (fun &rest args) + "Call compatibility function or macro FUN with ARGS. +This is a pseudo-compatibility stub for core packages on ELPA, +that depend on the Compat package, whenever the user doesn't have +the package installed on their current system." + (cons fun args)) + +;;;; Clever trick to avoid installing Compat if not necessary + +;; The versioning scheme of the Compat package follows that of Emacs, +;; to indicate the version of Emacs, that functionality is being +;; provided for. For example, the Compat version number 29.2.3.9 +;; would attempt to provide compatibility definitions up to Emacs +;; 29.2, while also designating that this is the third major release +;; and ninth minor release of Compat, for the specific Emacs release. + +;; The package version of this file is specified programmatically, +;; instead of giving a fixed version in the header of this file. This +;; is done to ensure that the version of compat.el provided by Emacs +;; always corresponds to the current version of Emacs. In addition to +;; the major-minor version, a large "major release" makes sure that +;; the built-in version of Compat is always preferred over an external +;; installation. This means that if a package specifies a dependency +;; on Compat which matches the current or an older version of Emacs +;; that is being used, no additional dependencies have to be +;; downloaded. +;; +;; Further details and background on this file can be found in the +;; bug#66554 discussion. + +;;;###autoload (push (list 'compat +;;;###autoload emacs-major-version +;;;###autoload emacs-minor-version +;;;###autoload 9999) +;;;###autoload package--builtin-versions) + +(provide 'compat) +;;; compat.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b1654b6a5aa..b7e43f3fc68 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -273,7 +273,7 @@ (eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. (require 'treesit) (require 'pcase) -(require 'compat nil 'noerror) +(require 'compat) (require 'project nil 'noerror) (require 'seq) From 998f9d98c3b0611b472f4be963d24a96c0a9e197 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 6 Feb 2024 20:12:15 +0100 Subject: [PATCH 180/385] Tolerate errors while recompiling all packages * lisp/emacs-lisp/package.el (package-recompile-all): Demote errors raised by 'package-recompile'. (Bug#68678) --- lisp/emacs-lisp/package.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 868373f46c2..fe7b10f569a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2610,7 +2610,8 @@ This is meant to be used only in the case the byte-compiled files are invalid due to changed byte-code, macros or the like." (interactive) (pcase-dolist (`(_ ,pkg-desc) package-alist) - (package-recompile pkg-desc))) + (with-demoted-errors "Error while recompiling: %S" + (package-recompile pkg-desc)))) ;;;###autoload (defun package-autoremove () From 052c2ce0284c5193c9d6768a45a9b3508af51230 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 17:43:37 -0500 Subject: [PATCH 181/385] (pcase): Add buttons to the macros' defs in the docstring of `pcase` * lisp/emacs-lisp/pcase.el (pcase--find-macro-def-regexp): New var. (find-function-regexp-alist): Add entry for `pcase-macro`s. (help-fns--signature): Move declaration to where we know it is valid. (pcase--make-docstring): Add buttons to jump to the definition of Pcase macros. --- lisp/emacs-lisp/pcase.el | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4754d4e720d..880a1829265 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -163,8 +163,12 @@ Emacs Lisp manual for more information and examples." ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) expansion)))) -(declare-function help-fns--signature "help-fns" - (function doc real-def real-function buffer)) +(defconst pcase--find-macro-def-regexp "(pcase-defmacro[\s\t\n]+%s[\s\t\n]*(") + +(with-eval-after-load 'find-func + (defvar find-function-regexp-alist) + (add-to-list 'find-function-regexp-alist + `(pcase-macro . pcase--find-macro-def-regexp))) ;; FIXME: Obviously, this will collide with nadvice's use of ;; function-documentation if we happen to advise `pcase'. @@ -174,9 +178,10 @@ Emacs Lisp manual for more information and examples." (defun pcase--make-docstring () (let* ((main (documentation (symbol-function 'pcase) 'raw)) (ud (help-split-fundoc main 'pcase))) - ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works, - ;; where cl-lib is anything using pcase-defmacro. (require 'help-fns) + (declare-function help-fns-short-filename "help-fns" (filename)) + (declare-function help-fns--signature "help-fns" + (function doc real-def real-function buffer)) (with-temp-buffer (insert (or (cdr ud) main)) ;; Presentation Note: For conceptual continuity, we guarantee @@ -197,11 +202,20 @@ Emacs Lisp manual for more information and examples." (let* ((pair (pop more)) (symbol (car pair)) (me (cdr pair)) - (doc (documentation me 'raw))) + (doc (documentation me 'raw)) + (filename (find-lisp-object-file-name me 'defun))) (insert "\n\n-- ") (setq doc (help-fns--signature symbol doc me (indirect-function me) nil)) + (when filename + (save-excursion + (forward-char -1) + (insert (format-message " in `")) + (help-insert-xref-button (help-fns-short-filename filename) + 'help-function-def symbol filename + 'pcase-macro) + (insert (format-message "'.")))) (insert "\n" (or doc "Not documented."))))) (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) From 9a1522197fb16986c2f641f777d6bef41c348567 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 18:13:27 -0500 Subject: [PATCH 182/385] (cl--generic-describe): Fix regression introduced by fix to bug#54628 Since that fix, we made other changes (put arg names in allcaps) which also happen to fix bug#54628, so we can remove the original fix which was suboptimal when the type includes quotes. * lisp/emacs-lisp/cl-generic.el (cl--generic-describe): Don't rebind `print-quoted` to nil. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-generic-tests--print-quoted): New test. --- lisp/emacs-lisp/cl-generic.el | 5 ++--- test/lisp/emacs-lisp/cl-generic-tests.el | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index bdccdcc48ce..d1bd45120f1 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1145,7 +1145,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (declare-function help-fns-short-filename "help-fns" (filename)) (let ((generic (if (symbolp function) (cl--generic function)))) (when generic - (require 'help-mode) ;Needed for `help-function-def' button! + (require 'help-mode) ;Needed for `help-function-def' button! (save-excursion ;; Ensure that we have two blank lines (but not more). (unless (looking-back "\n\n" (- (point) 2)) @@ -1157,8 +1157,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (pcase-let* ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. - (let ((print-quoted nil) - (quals (if (length> qualifiers 0) + (let ((quals (if (length> qualifiers 0) (concat (substring qualifiers 0 (string-match " *\\'" qualifiers)) diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 086ac399352..990fa580c54 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -319,5 +319,19 @@ Edebug symbols (Bug#42672)." (and (eq 'error (car err)) (string-match "Stray.*declare" (cadr err))))))) +(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4))) + (+ function 1)) + +(ert-deftest cl-generic-tests--print-quoted () + (with-temp-buffer + (cl--generic-describe 'cl-generic-tests--print-quoted-method) + (goto-char (point-min)) + ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4) + (should-not (re-search-forward "#'" nil t)) + (goto-char (point-min)) + ;; But we don't want (eql '4) to turn into (eql (quote 4)) either. + (should (re-search-forward "(eql '4)" nil t)))) + + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here From 9ebc91795f22ca52ea019b8ce7fb1f6e4c8df826 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 12 Feb 2024 02:38:30 +0100 Subject: [PATCH 183/385] Remove redundant `apply` with `derived-mode-p` * lisp/cedet/mode-local.el (mode-local-map-mode-buffers): * lisp/progmodes/which-func.el (which-func-try-to-enable): (which-func-ff-hook): Remove redundant 'apply' with 'derived-mode-p'. Suggested by Philip Kaludercic . --- lisp/cedet/mode-local.el | 4 ++-- lisp/progmodes/which-func.el | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 28f14232704..9f11b9707bd 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -1,6 +1,6 @@ ;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*- ;; -;; Copyright (C) 2004-2005, 2007-2024 Free Software Foundation, Inc. +;; Copyright (C) 2004-2024 Free Software Foundation, Inc. ;; ;; Author: David Ponce ;; Created: 27 Apr 2004 @@ -84,7 +84,7 @@ MODES can be a symbol or a list of symbols. FUNCTION does not have arguments." (setq modes (ensure-list modes)) (mode-local-map-file-buffers - function (lambda () (apply #'derived-mode-p modes)))) + function (lambda () (derived-mode-p modes)))) ;;; Hook machinery ;; diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 631cb3b0aef..b36e13104e3 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (apply #'derived-mode-p which-func-modes))) + (derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (apply #'derived-mode-p which-func-non-auto-modes)) + (not (derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) From 806759dc0a6a3b049ce35d0497011464e5fc4dcb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 22:00:44 -0500 Subject: [PATCH 184/385] (pcase): New `_` syntax in pred/app functions The current syntax for functions in `app` and `pred` patterns allows a shorthand (F ARGS) where the object being matched is added as an extra last argument. This is nice for things like (pred (< 5)) but sometimes the object needs to be at another position. Until now you had to use (pred (lambda (x) (memq x my-list))) or (pred (pcase--flip memq my-list)) in those cases. So, introduce a new shorthand where `_` can be used to indicate where the object should be passed: (pred (memq _ my-list)) * lisp/emacs-lisp/pcase.el (pcase--split-pred): Document new syntax for pred/app functions. (pcase--funcall): Support new syntax. (pcase--flip): Declare obsolete. (pcase--u1, \`): Use `_` instead. (pcase--split-pred): Adjust accordingly. * doc/lispref/control.texi (pcase Macro): Document new syntax for pred/app functions. * lisp/progmodes/opascal.el (pcase-defmacro): * lisp/emacs-lisp/seq.el (seq--make-pcase-bindings): * lisp/emacs-lisp/eieio.el (eieio): * lisp/emacs-lisp/cl-macs.el (cl-struct, cl-type): Use _ instead of `pcase--flip`. (cl--pcase-mutually-exclusive-p): Adjust accordingly. * lisp/emacs-lisp/map.el (map--pcase-map-elt): Declare obsolete. (map--make-pcase-bindings): Use `_` instead. --- doc/lispref/control.texi | 10 ++++++++++ etc/NEWS | 4 ++++ lisp/emacs-lisp/cl-macs.el | 15 ++++++++------- lisp/emacs-lisp/eieio.el | 4 ++-- lisp/emacs-lisp/map.el | 7 ++++--- lisp/emacs-lisp/pcase.el | 25 ++++++++++++++++--------- lisp/emacs-lisp/seq.el | 4 ++-- lisp/progmodes/opascal.el | 2 +- 8 files changed, 47 insertions(+), 24 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 0c6895332a0..78ad5b68a51 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -638,6 +638,16 @@ with @var{n} arguments (the other elements) and an additional Example: @code{(= 42)}@* In this example, the function is @code{=}, @var{n} is one, and the actual function call becomes: @w{@code{(= 42 @var{expval})}}. + +@item function call with an @code{_} arg +Call the function (the first element of the function call) +with the specified arguments (the other elements) and replacing +@code{_} with @var{expval}. + +Example: @code{(gethash _ memo-table)} +In this example, the function is @code{gethash}, and +the actual function call becomes: @w{@code{(gethash @var{expval} +memo-table)}}. @end table @item (app @var{function} @var{pattern}) diff --git a/etc/NEWS b/etc/NEWS index de1f2fd9d2a..afc2c22e68b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1526,6 +1526,10 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** Pcase's functions (in 'pred' and 'app') can specify the argument position. +For example, instead of (pred (< 5)) you can write (pred (> _ 5)). + +++ ** 'define-advice' now sets the new advice's 'name' property to NAME. Named advices defined with 'define-advice' can now be removed with diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 88447203a64..06a09885c88 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3344,14 +3344,14 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the contents of field NAME is matched against PAT, or they can be of the form NAME which is a shorthand for (NAME NAME)." (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp]))) - `(and (pred (pcase--flip cl-typep ',type)) + `(and (pred (cl-typep _ ',type)) ,@(mapcar (lambda (field) (let* ((name (if (consp field) (car field) field)) (pat (if (consp field) (cadr field) field))) `(app ,(if (eq (cl-struct-sequence-type type) 'list) `(nth ,(cl-struct-slot-offset type name)) - `(pcase--flip aref ,(cl-struct-slot-offset type name))) + `(aref _ ,(cl-struct-slot-offset type name))) ,pat))) fields))) @@ -3368,13 +3368,13 @@ the form NAME which is a shorthand for (NAME NAME)." "Extra special cases for `cl-typep' predicates." (let* ((x1 pred1) (x2 pred2) (t1 - (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1)) - (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) + (and (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1)) + (eq '_ (car-safe x1)) (setq x1 (cdr x1)) (null (cdr-safe x1)) (setq x1 (car x1)) (eq 'quote (car-safe x1)) (cadr x1))) (t2 - (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2)) - (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) + (and (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2)) + (eq '_ (car-safe x2)) (setq x2 (cdr x2)) (null (cdr-safe x2)) (setq x2 (car x2)) (eq 'quote (car-safe x2)) (cadr x2)))) (or @@ -3818,7 +3818,8 @@ STRUCT-TYPE and SLOT-NAME are symbols. INST is a structure instance." (pcase-defmacro cl-type (type) "Pcase pattern that matches objects of TYPE. TYPE is a type descriptor as accepted by `cl-typep', which see." - `(pred (pcase--flip cl-typep ',type))) + `(pred (cl-typep _ ',type))) + ;; Local variables: ;; generated-autoload-file: "cl-loaddefs.el" diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index df85a64baf3..fba69a36a97 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -387,9 +387,9 @@ contents of field NAME is matched against PAT, or they can be of ,@(mapcar (lambda (field) (pcase-exhaustive field (`(,name ,pat) - `(app (pcase--flip eieio-oref ',name) ,pat)) + `(app (eieio-oref _ ',name) ,pat)) ((pred symbolp) - `(app (pcase--flip eieio-oref ',field) ,field)))) + `(app (eieio-oref _ ',field) ,field)))) fields))) ;;; Simple generators, and query functions. None of these would do diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index ffbb29615da..95a25978d1c 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -608,18 +608,19 @@ This allows using default values for `map-elt', which can't be done using `pcase--flip'. KEY is the key sought in the map. DEFAULT is the default value." + (declare (obsolete _ "30.1")) `(map-elt ,map ,key ,default)) (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." (mapcar (lambda (elt) (cond ((consp elt) - `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) + `(app (map-elt _ ,(car elt) ,(caddr elt)) ,(cadr elt))) ((keywordp elt) (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (pcase--flip map-elt ,elt) ,var))) - (t `(app (pcase--flip map-elt ',elt) ,elt)))) + `(app (map-elt _ ,elt) ,var))) + (t `(app (map-elt _ ',elt) ,elt)))) args)) (defun map--make-pcase-patterns (args) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 880a1829265..ae9bd87997c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -131,6 +131,8 @@ FUN in `pred' and `app' can take one of the forms: call it with one argument (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument + (F ARG1 .. _ .. ARGn) + call F, passing EXPVAL at the _ position. FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. @@ -814,10 +816,10 @@ A and B can be one of: #'compiled-function-p)))) (pcase--mutually-exclusive-p (cadr upat) otherpred)) '(:pcase--fail . nil)) - ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c)))) + ;; Since we turn (or 'a 'b 'c) into (pred (memq _ '(a b c))) ;; try and preserve the info we get from that memq test. - ((and (eq 'pcase--flip (car-safe (cadr upat))) - (memq (cadr (cadr upat)) '(memq member memql)) + ((and (memq (car-safe (cadr upat)) '(memq member memql)) + (eq (cadr (cadr upat)) '_) (eq 'quote (car-safe (nth 2 (cadr upat)))) (eq 'quote (car-safe pat))) (let ((set (cadr (nth 2 (cadr upat))))) @@ -865,7 +867,7 @@ A and B can be one of: (defmacro pcase--flip (fun arg1 arg2) "Helper function, used internally to avoid (funcall (lambda ...) ...)." - (declare (debug (sexp body))) + (declare (debug (sexp body)) (obsolete _ "30.1")) `(,fun ,arg2 ,arg1)) (defun pcase--funcall (fun arg vars) @@ -886,9 +888,13 @@ A and B can be one of: (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) - (if (or (functionp fun) (not (consp fun))) - `(funcall #',fun ,arg) - `(,@fun ,arg))))) + (cond + ((or (functionp fun) (not (consp fun))) + `(funcall #',fun ,arg)) + ((memq '_ fun) + (mapcar (lambda (x) (if (eq '_ x) arg x)) fun)) + (t + `(,@fun ,arg)))))) (if (null env) call ;; Let's not replace `vars' in `fun' since it's @@ -949,7 +955,7 @@ Otherwise, it defers to REST which is a list of branches of the form ;; Yes, we can use `memql' (or `member')! ((> (length simples) 1) (pcase--u1 (cons `(match ,var - . (pred (pcase--flip ,mem-fun ',simples))) + . (pred (,mem-fun _ ',simples))) (cdr matches)) code vars (if (null others) rest @@ -1096,12 +1102,13 @@ The predicate is the logical-AND of: (declare (debug (pcase-QPAT))) (cond ((eq (car-safe qpat) '\,) (cadr qpat)) + ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat)) ((vectorp qpat) `(and (pred vectorp) (app length ,(length qpat)) ,@(let ((upats nil)) (dotimes (i (length qpat)) - (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i))) + (push `(app (aref _ ,i) ,(list '\` (aref qpat i))) upats)) (nreverse upats)))) ((consp qpat) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4c6553972c2..20077db9e60 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -619,12 +619,12 @@ SEQUENCE must be a sequence of numbers or markers." (unless rest-marker (pcase name (`&rest - (progn (push `(app (pcase--flip seq-drop ,index) + (progn (push `(app (seq-drop _ ,index) ,(seq--elt-safe args (1+ index))) bindings) (setq rest-marker t))) (_ - (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings)))) + (push `(app (seq--elt-safe _ ,index) ,name) bindings)))) (setq index (1+ index))) bindings)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5e8263cb646..a80e12b8129 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -281,7 +281,7 @@ nested routine.") (eval-when-compile (pcase-defmacro opascal--in (set) - `(pred (pcase--flip memq ,set)))) + `(pred (memq _ ,set)))) (defun opascal-string-of (start end) ;; Returns the buffer string from start to end. From 57544fa2a2e1f2d04aa6b6bdf49bde71141b945d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Feb 2024 22:19:49 -0500 Subject: [PATCH 185/385] loaddefs-gen.el: Generate an autoload for `pcase-defmacro` Autoload cookies on uses of `pcase-defmacro` used to copy the definition wholesale instead of generating the expected autoload. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Look inside `eval-and-compile` as well. --- lisp/emacs-lisp/loaddefs-gen.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 1e91e84157d..238ec9d179b 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -183,7 +183,9 @@ expression, in which case we want to handle forms differently." (loaddefs-generate--shorten-autoload `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))) - ((and expansion (memq car '(progn prog1))) + ;; Look inside `progn', and `eval-and-compile', since these + ;; are often used in the expansion of things like `pcase-defmacro'. + ((and expansion (memq car '(progn prog1 eval-and-compile))) (let ((end (memq :autoload-end form))) (when end ;Cut-off anything after the :autoload-end marker. (setq form (copy-sequence form)) From bc6c55c5cf3fc5bd248232c6332ea7cca19ffe91 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 12 Feb 2024 11:16:47 +0800 Subject: [PATCH 186/385] Disable exec loader when Emacs is running under an existing instance * src/androidfns.c (syms_of_androidfns_for_pdumper): Check if Emacs is running under process tracing, and if so, disable android_use_exec_loader. --- src/androidfns.c | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/androidfns.c b/src/androidfns.c index 48c3f3046d6..ea3d5f71c7c 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -3216,6 +3216,10 @@ syms_of_androidfns_for_pdumper (void) jstring string; Lisp_Object language, country, script, variant; const char *data; + FILE *fd; + char *line; + size_t size; + long pid; /* Find the Locale class. */ @@ -3386,6 +3390,35 @@ syms_of_androidfns_for_pdumper (void) /* Set Vandroid_os_language. */ Vandroid_os_language = list4 (language, country, script, variant); + + /* Detect whether Emacs is running under libloader.so or another + process tracing mechanism, and disable `android_use_exec_loader' if + so, leaving subprocesses started by Emacs to the care of that + loader instance. */ + + if (android_get_current_api_level () >= 29) /* Q */ + { + fd = fopen ("/proc/self/status", "r"); + if (!fd) + return; + + line = NULL; + while (getline (&line, &size, fd) != -1) + { + if (strncmp (line, "TracerPid:", sizeof "TracerPid:" - 1)) + continue; + + pid = atol (line + sizeof "TracerPid:" - 1); + + if (pid) + android_use_exec_loader = false; + + break; + } + + free (line); + fclose (fd); + } } #endif /* ANDROID_STUBIFY */ From 2f7d662dd4636a84e157a2af8f843c0589bc5dda Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 12 Feb 2024 12:07:37 +0100 Subject: [PATCH 187/385] ; Update Lisp_Hash_Table hash for CHECK_STRUCTS This follows commit 05e3183ede of 2024-02-06 "Rearrange and pack hash table fields to reduce space". --- src/pdumper.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index b8006b035ea..5c488d8e90f 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2719,7 +2719,7 @@ dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_313A489F0A +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_0360833954 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); From 17a395e04c62d6c6c3f3ff4c4889f03e427e00d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Mart=C3=ADn?= Date: Mon, 12 Feb 2024 13:21:08 +0100 Subject: [PATCH 188/385] ;; Fix typo in the Tramp documentation --- doc/misc/tramp.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d6031d96d6b..db9cefbf966 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -522,7 +522,7 @@ is used as the group to change to. The default host name is the same. @cindex @option{doas} method If the @option{su}, @option{sudo} or @option{doas} option should be -performed on another host, it can be comnbined with a leading +performed on another host, it can be combined with a leading @option{ssh} or @option{plink} option. That means that @value{tramp} connects first to the other host with non-administrative credentials, and changes to administrative credentials on that host afterwards. In From 6aeeae68885e09a7253a0076d0f81cc46b37f20d Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 12 Feb 2024 17:37:16 +0100 Subject: [PATCH 189/385] Allow using 'vc-prepare-patch' in non-VC buffers * lisp/vc/vc.el (vc-prepare-patch): Remove 'vc-ensure-vc-buffer', as it is not necessary to verify this for the command to work. --- lisp/vc/vc.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f612daaa569..ca6efeabac2 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3639,7 +3639,6 @@ marked revisions, use those." (read-string "Subject: " "[PATCH] " nil nil t)) revs))) (save-current-buffer - (vc-ensure-vc-buffer) (let ((patches (mapcar (lambda (rev) (vc-call-backend (vc-responsible-backend default-directory) From 79cfc1eaa0b93f49559d74b6f7a76bf97e70ad2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 7 Feb 2024 21:50:03 +0100 Subject: [PATCH 190/385] Internal function for obarray performance analysis (bug#68244) * src/lread.c (Finternal__obarray_buckets): New function. --- src/lread.c | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/src/lread.c b/src/lread.c index 5aa7466cc12..8f355547268 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5296,6 +5296,32 @@ OBARRAY defaults to the value of `obarray'. */) return Qnil; } +DEFUN ("internal--obarray-buckets", + Finternal__obarray_buckets, Sinternal__obarray_buckets, 1, 1, 0, + doc: /* Symbols in each bucket of OBARRAY. Internal use only. */) + (Lisp_Object obarray) +{ + obarray = check_obarray (obarray); + ptrdiff_t size = ASIZE (obarray); + Lisp_Object ret = Qnil; + for (ptrdiff_t i = 0; i < size; i++) + { + Lisp_Object bucket = Qnil; + Lisp_Object sym = AREF (obarray, i); + if (BARE_SYMBOL_P (sym)) + while (1) + { + bucket = Fcons (sym, bucket); + struct Lisp_Symbol *s = XBARE_SYMBOL(sym)->u.s.next; + if (!s) + break; + sym = make_lisp_symbol (s); + } + ret = Fcons (Fnreverse (bucket), ret); + } + return Fnreverse (ret); +} + #define OBARRAY_SIZE 15121 void @@ -5693,6 +5719,7 @@ syms_of_lread (void) defsubr (&Sget_file_char); defsubr (&Smapatoms); defsubr (&Slocate_file_internal); + defsubr (&Sinternal__obarray_buckets); DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'. From bb77944306d3fbbbdf61ba4f3c9ef1bcb9b4b989 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 8 Feb 2024 19:04:23 +0100 Subject: [PATCH 191/385] Make minibuf-tests independent of obarray hash order * test/src/minibuf-tests.el (minibuf-tests--set-equal): New. (minibuf-tests--all-completions) (minibuf-tests--all-completions-pred) (minibuf-tests--all-completions-regexp): Use it. --- test/src/minibuf-tests.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 14d160df25c..cb305ca0e55 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -61,6 +61,9 @@ ;;; Testing functions that are agnostic to type of COLLECTION. +(defun minibuf-tests--set-equal (a b) + (null (cl-set-exclusive-or a b :test #'equal))) + (defun minibuf-tests--try-completion (xform-collection) (let* ((abcdef (funcall xform-collection '("abc" "def"))) (+abba (funcall xform-collection '("abc" "abba" "def")))) @@ -101,7 +104,8 @@ (let* ((abcdef (funcall xform-collection '("abc" "def"))) (+abba (funcall xform-collection '("abc" "abba" "def")))) (should (equal (all-completions "a" abcdef) '("abc"))) - (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba) '("abc"))) (should (equal (all-completions "abcd" +abba) nil)))) @@ -111,7 +115,8 @@ (+abba (funcall xform-collection '("abc" "abba" "def"))) (+abba-member (funcall collection-member +abba))) (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) - (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba +abba-member) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) (should (equal (all-completions "abcd" +abba +abba-member) nil)) (should-not (all-completions "a" abcdef #'ignore)) @@ -124,7 +129,8 @@ (+abba (funcall xform-collection '("abc" "abba" "def")))) (let ((completion-regexp-list '("."))) (should (equal (all-completions "a" abcdef) '("abc"))) - (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba) '("abc"))) (should (equal (all-completions "abcd" +abba) nil))) (let ((completion-regexp-list '("X"))) From 39cce137ba83713c960c201d8c3d8cf5079eee3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 8 Feb 2024 14:11:02 +0100 Subject: [PATCH 192/385] lread.c: Use bare symbol operations * src/lread.c (read0, intern_sym, intern_driver, intern_1) (intern_c_string_1, Fintern, Fintern_soft, Funintern, oblookup) (map_obarray, init_obarray_once, defvar_int, defvar_bool) (defvar_lisp_nopro, defvar_kboard, syms_of_lread): Use the faster bare-symbol operations where provably correct to do so. --- src/lread.c | 124 +++++++++++++++++++++++++--------------------------- 1 file changed, 59 insertions(+), 65 deletions(-) diff --git a/src/lread.c b/src/lread.c index 8f355547268..db8c4813426 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4480,7 +4480,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) &longhand_chars, &longhand_bytes); - if (SYMBOLP (found)) + if (BARE_SYMBOL_P (found)) result = found; else if (longhand) { @@ -4910,24 +4910,23 @@ check_obarray (Lisp_Object obarray) static Lisp_Object intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { - Lisp_Object *ptr; + struct Lisp_Symbol *s = XBARE_SYMBOL (sym); + s->u.s.interned = (BASE_EQ (obarray, initial_obarray) + ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY + : SYMBOL_INTERNED); - XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray) - ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY - : SYMBOL_INTERNED); - - if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) + if (SREF (s->u.s.name, 0) == ':' && BASE_EQ (obarray, initial_obarray)) { - make_symbol_constant (sym); - XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; + s->u.s.trapped_write = SYMBOL_NOWRITE; + s->u.s.redirect = SYMBOL_PLAINVAL; /* Mark keywords as special. This makes (let ((:key 'foo)) ...) in lexically bound elisp signal an error, as documented. */ - XSYMBOL (sym)->u.s.declared_special = true; - SET_SYMBOL_VAL (XSYMBOL (sym), sym); + s->u.s.declared_special = true; + SET_SYMBOL_VAL (s, sym); } - ptr = aref_addr (obarray, XFIXNUM (index)); - set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); + Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index)); + s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL; *ptr = sym; return sym; } @@ -4937,7 +4936,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) Lisp_Object intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) { - SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil); + SET_SYMBOL_VAL (XBARE_SYMBOL (Qobarray_cache), Qnil); return intern_sym (Fmake_symbol (string), obarray, index); } @@ -4950,7 +4949,7 @@ intern_1 (const char *str, ptrdiff_t len) Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - return (SYMBOLP (tem) ? tem + return (BARE_SYMBOL_P (tem) ? tem /* The above `oblookup' was done on the basis of nchars==nbytes, so the string has to be unibyte. */ : intern_driver (make_unibyte_string (str, len), @@ -4963,7 +4962,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len) Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) { Lisp_Object string; @@ -5015,7 +5014,7 @@ it defaults to the value of `obarray'. */) &longhand, &longhand_chars, &longhand_bytes); - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) { if (longhand) { @@ -5064,10 +5063,10 @@ it defaults to the value of `obarray'. */) { /* If already a symbol, we don't do shorthand-longhand translation, as promised in the docstring. */ - string = SYMBOL_NAME (name); + string = XSYMBOL (name)->u.s.name; tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - return EQ (name, tem) ? name : Qnil; + return BASE2_EQ (name, tem) ? name : Qnil; } } @@ -5088,7 +5087,11 @@ usage: (unintern NAME OBARRAY) */) obarray = check_obarray (obarray); if (SYMBOLP (name)) - string = SYMBOL_NAME (name); + { + if (!BARE_SYMBOL_P (name)) + name = XSYMBOL_WITH_POS (name)->sym; + string = SYMBOL_NAME (name); + } else { CHECK_STRING (name); @@ -5108,7 +5111,7 @@ usage: (unintern NAME OBARRAY) */) if (FIXNUMP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ - if (SYMBOLP (name) && !EQ (name, tem)) + if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem)) return Qnil; /* There are plenty of other symbols which will screw up the Emacs @@ -5118,16 +5121,16 @@ usage: (unintern NAME OBARRAY) */) /* if (NILP (tem) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ - XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; + XBARE_SYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; hash = oblookup_last_bucket_number; - if (EQ (AREF (obarray, hash), tem)) + if (BASE_EQ (AREF (obarray, hash), tem)) { - if (XSYMBOL (tem)->u.s.next) + if (XBARE_SYMBOL (tem)->u.s.next) { Lisp_Object sym; - XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next); + XSETSYMBOL (sym, XBARE_SYMBOL (tem)->u.s.next); ASET (obarray, hash, sym); } else @@ -5138,13 +5141,13 @@ usage: (unintern NAME OBARRAY) */) Lisp_Object tail, following; for (tail = AREF (obarray, hash); - XSYMBOL (tail)->u.s.next; + XBARE_SYMBOL (tail)->u.s.next; tail = following) { - XSETSYMBOL (following, XSYMBOL (tail)->u.s.next); - if (EQ (following, tem)) + XSETSYMBOL (following, XBARE_SYMBOL (tail)->u.s.next); + if (BASE_EQ (following, tem)) { - set_symbol_next (tail, XSYMBOL (following)->u.s.next); + set_symbol_next (tail, XBARE_SYMBOL (following)->u.s.next); break; } } @@ -5176,18 +5179,19 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff oblookup_last_bucket_number = hash; if (BASE_EQ (bucket, make_fixnum (0))) ; - else if (!SYMBOLP (bucket)) + else if (!BARE_SYMBOL_P (bucket)) /* Like CADR error message. */ xsignal2 (Qwrong_type_argument, Qobarrayp, build_string ("Bad data in guts of obarray")); else - for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next)) + for (tail = bucket; ; XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next)) { - if (SBYTES (SYMBOL_NAME (tail)) == size_byte - && SCHARS (SYMBOL_NAME (tail)) == size - && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) + Lisp_Object name = XBARE_SYMBOL (tail)->u.s.name; + if (SBYTES (name) == size_byte + && SCHARS (name) == size + && !memcmp (SDATA (name), ptr, size_byte)) return tail; - else if (XSYMBOL (tail)->u.s.next == 0) + else if (XBARE_SYMBOL (tail)->u.s.next == 0) break; } XSETINT (tem, hash); @@ -5267,13 +5271,13 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob for (i = ASIZE (obarray) - 1; i >= 0; i--) { tail = AREF (obarray, i); - if (SYMBOLP (tail)) + if (BARE_SYMBOL_P (tail)) while (1) { (*fn) (tail, arg); - if (XSYMBOL (tail)->u.s.next == 0) + if (XBARE_SYMBOL (tail)->u.s.next == 0) break; - XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); + XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next); } } } @@ -5337,14 +5341,14 @@ init_obarray_once (void) DEFSYM (Qunbound, "unbound"); DEFSYM (Qnil, "nil"); - SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); + SET_SYMBOL_VAL (XBARE_SYMBOL (Qnil), Qnil); make_symbol_constant (Qnil); - XSYMBOL (Qnil)->u.s.declared_special = true; + XBARE_SYMBOL (Qnil)->u.s.declared_special = true; DEFSYM (Qt, "t"); - SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); + SET_SYMBOL_VAL (XBARE_SYMBOL (Qt), Qt); make_symbol_constant (Qt); - XSYMBOL (Qt)->u.s.declared_special = true; + XBARE_SYMBOL (Qt)->u.s.declared_special = true; /* Qt is correct even if not dumping. loadup.el will set to nil at end. */ Vpurify_flag = Qt; @@ -5368,16 +5372,6 @@ defsubr (union Aligned_Lisp_Subr *aname) #endif } -#ifdef NOTDEF /* Use fset in subr.el now! */ -void -defalias (struct Lisp_Subr *sname, char *string) -{ - Lisp_Object sym; - sym = intern (string); - XSETSUBR (XSYMBOL (sym)->u.s.function, sname); -} -#endif /* NOTDEF */ - /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type intmax_t. Sample call (with "xx" to fool make-docfile): DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ @@ -5385,9 +5379,9 @@ void defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), i_fwd); } /* Similar but define a variable whose value is t if 1, nil if 0. */ @@ -5395,9 +5389,9 @@ void defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -5410,9 +5404,9 @@ void defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), o_fwd); } void @@ -5429,9 +5423,9 @@ void defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring) { Lisp_Object sym = intern_c_string (namestring); - XSYMBOL (sym)->u.s.declared_special = true; - XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; - SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd); + XBARE_SYMBOL (sym)->u.s.declared_special = true; + XBARE_SYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XBARE_SYMBOL (sym), ko_fwd); } /* Check that the elements of lpath exist. */ @@ -5731,7 +5725,7 @@ to find all the symbols in an obarray, use `mapatoms'. */); doc: /* List of values of all expressions which were read, evaluated and printed. Order is reverse chronological. This variable is obsolete as of Emacs 28.1 and should not be used. */); - XSYMBOL (intern ("values"))->u.s.declared_special = false; + XBARE_SYMBOL (intern ("values"))->u.s.declared_special = false; DEFVAR_LISP ("standard-input", Vstandard_input, doc: /* Stream for read to get input from. From 3b90e5052ce1eea47430c85c0c35741e25269ce2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 12 Feb 2024 20:16:35 +0200 Subject: [PATCH 193/385] Tree-sitter support for outline-minor-mode (bug#68824) * doc/emacs/text.texi (Outline Format): Add 'outline-search-function'. * doc/lispref/elisp.texi (Top): Add new menu item "Outline Minor Mode" after "Imenu". * doc/lispref/modes.texi (Modes): Add new menu item "Outline Minor Mode" after "Imenu". (Major Mode Conventions): Mention "Outline Minor Mode" with @pxref. (Outline Minor Mode): New node. * doc/lispref/parsing.texi (Tree-sitter Major Modes): Mention 'treesit-outline-predicate' with @pxref. * lisp/treesit.el (treesit-outline-predicate): New buffer-local variable. (treesit-outline-predicate--from-imenu): New internal function. (treesit-outline-search, treesit-outline-level): New functions. (treesit-major-mode-setup): Set up treesit-outline-predicate, outline-search-function and outline-level. * lisp/progmodes/c-ts-mode.el (c-ts-mode--outline-predicate): New internal function. (c-ts-base-mode): Set 'treesit-outline-predicate' to 'c-ts-mode--outline-predicate'. * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): Kill inherited local variables 'outline-heading-end-regexp', 'outline-regexp', 'outline-level'. * lisp/progmodes/lua-ts-mode.el (lua-ts-mode): Remove 'outline-regexp'. Suggested by john muhl . * lisp/textmodes/html-ts-mode.el (html-ts-mode): Kill inherited local variables 'outline-heading-end-regexp', 'outline-regexp', 'outline-level'. --- doc/emacs/text.texi | 6 +++ doc/lispref/elisp.texi | 1 + doc/lispref/modes.texi | 62 +++++++++++++++++++++++++++ doc/lispref/parsing.texi | 4 ++ etc/NEWS | 7 ++++ lisp/progmodes/c-ts-mode.el | 15 +++++++ lisp/progmodes/heex-ts-mode.el | 10 +++++ lisp/progmodes/lua-ts-mode.el | 12 +----- lisp/textmodes/html-ts-mode.el | 11 +++++ lisp/treesit.el | 76 ++++++++++++++++++++++++++++++++++ 10 files changed, 193 insertions(+), 11 deletions(-) diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 338bf014208..cb347d59948 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1097,6 +1097,12 @@ so that Outline mode will know that sections are contained in chapters. This works as long as no other command starts with @samp{@@chap}. +@vindex outline-search-function + Instead of setting the variable @code{outline-regexp}, you can set +the variable @code{outline-search-function} to a function that +matches the current heading and searches for the next one +(@pxref{Outline Minor Mode,,,elisp, the Emacs Lisp Reference Manual}). + @vindex outline-level You can explicitly specify a rule for calculating the level of a heading line by setting the variable @code{outline-level}. The value diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index cab1622337e..ed254795d90 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -883,6 +883,7 @@ Major and Minor Modes * Minor Modes:: Defining minor modes. * Mode Line Format:: Customizing the text that appears in the mode line. * Imenu:: Providing a menu of definitions made in a buffer. +* Outline Minor Mode:: Outline mode to use with other major modes. * Font Lock Mode:: How modes can highlight text according to syntax. * Auto-Indentation:: How to teach Emacs to indent for a major mode. * Desktop Save Mode:: How modes can have buffer state saved between diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 1d961249633..70d1a40f836 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -25,6 +25,7 @@ user. For related topics such as keymaps and syntax tables, see * Minor Modes:: Defining minor modes. * Mode Line Format:: Customizing the text that appears in the mode line. * Imenu:: Providing a menu of definitions made in a buffer. +* Outline Minor Mode:: Outline mode to use with other major modes. * Font Lock Mode:: How modes can highlight text according to syntax. * Auto-Indentation:: How to teach Emacs to indent for a major mode. * Desktop Save Mode:: How modes can have buffer state saved between @@ -507,6 +508,12 @@ variable @code{imenu-generic-expression}, for the two variables @code{imenu-extract-index-name-function}, or for the variable @code{imenu-create-index-function} (@pxref{Imenu}). +@item +The mode should specify how Outline minor mode should find the +heading lines, by setting up a buffer-local value for the variables +@code{outline-regexp} or @code{outline-search-function}, and also +for the variable @code{outline-level} (@pxref{Outline Minor Mode}). + @item The mode can tell ElDoc mode how to retrieve different types of documentation for whatever is at point, by adding one or more @@ -2994,6 +3001,61 @@ instead. automatically sets up Imenu if this variable is non-@code{nil}. @end defvar +@node Outline Minor Mode +@section Outline Minor Mode + +@cindex Outline minor mode + @dfn{Outline minor mode} is a buffer-local minor mode that hides +parts of the buffer and leaves only heading lines visible. +This minor mode can be used in conjunction with other major modes +(@pxref{Outline Minor Mode,, Outline Minor Mode, emacs, the Emacs Manual}). + + There are two ways to define which lines are headings: with the +variable @code{outline-regexp} or @code{outline-search-function}. + +@defvar outline-regexp +This variable is a regular expression. +Any line whose beginning has a match for this regexp is considered a +heading line. Matches that start within a line (not at the left +margin) do not count. +@end defvar + +@defvar outline-search-function +Alternatively, when it's impossible to create a regexp that +matches heading lines, you can define a function that helps +Outline minor mode to find heading lines. + +The variable @code{outline-search-function} specifies the function with +four arguments: @var{bound}, @var{move}, @var{backward}, and +@var{looking-at}. The function completes two tasks: to match the +current heading line, and to find the next or the previous heading line. +If the argument @var{looking-at} is non-@code{nil}, it should return +non-@code{nil} when point is at the beginning of the outline header line. +If the argument @var{looking-at} is @code{nil}, the first three arguments +are used. The argument @var{bound} is a buffer position that bounds +the search. The match found must not end after that position. A +value of nil means search to the end of the accessible portion of +the buffer. If the argument @var{move} is non-@code{nil}, the +failed search should move to the limit of search and return nil. +If the argument @var{backward} is non-@code{nil}, this function +should search for the previous heading backward. +@end defvar + +@defvar outline-level +This variable is a function that takes no arguments +and should return the level of the current heading. +It's required in both cases: whether you define +@code{outline-regexp} or @code{outline-search-function}. +@end defvar + +If built with tree-sitter, Emacs can automatically use +Outline minor mode if the major mode sets the following variable. + +@defvar treesit-outline-predicate +This variable instructs Emacs how to find lines with outline headings. +It should be a predicate that matches the node on the heading line. +@end defvar + @node Font Lock Mode @section Font Lock Mode @cindex Font Lock mode diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index d685b7f32dc..3d2192ace64 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1897,6 +1897,10 @@ add-log functions used by @code{add-log-current-defun}. @item If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is non-@code{nil}, it sets up Imenu. + +@item +If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is +non-@code{nil}, it sets up Outline minor mode. @end itemize @c TODO: Add treesit-thing-settings stuff once we finalize it. diff --git a/etc/NEWS b/etc/NEWS index afc2c22e68b..f89c8ce1d8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,13 @@ the signature) the automatically inferred function type as well. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. +** Outline Mode + ++++ +*** 'outline-minor-mode' is supported in tree-sitter major modes. +It can be used in all tree-sitter major modes that set either the +variable 'treesit-simple-imenu-settings' or 'treesit-outline-predicate'. + ** X selection requests are now handled much faster and asynchronously. This means it should be less necessary to disable the likes of 'select-active-regions' when Emacs is running over a slow network diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e5835bdb62d..c4b48f03d12 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -922,6 +922,17 @@ Return nil if NODE is not a defun node or doesn't have a name." name))) t)) +;;; Outline minor mode + +(defun c-ts-mode--outline-predicate (node) + "Match outlines on lines with function names." + (and (treesit-node-match-p + node "\\`function_declarator\\'" t) + (when-let ((parent (treesit-node-parent node))) + (treesit-node-match-p + parent + "\\`function_definition\\'" t)))) + ;;; Defun navigation (defun c-ts-mode--defun-valid-p (node) @@ -1259,6 +1270,10 @@ BEG and END are described in `treesit-range-rules'." eos) c-ts-mode--defun-for-class-in-imenu-p nil)))) + ;; Outline minor mode + (setq-local treesit-outline-predicate + #'c-ts-mode--outline-predicate) + (setq-local treesit-font-lock-feature-list c-ts-mode--feature-list)) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 7b53a44deb2..22e8956661d 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move backward." ("Slot" "\\`slot\\'" nil nil) ("Tag" "\\`tag\\'" nil nil))) + ;; Outline minor mode + ;; `heex-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' derived + ;; from `treesit-simple-imenu-settings' above. + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) (setq-local treesit-simple-indent-rules heex-ts--indent-rules) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 05a3ff6d7c6..dc2a8fcec1e 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -774,7 +774,7 @@ Calls REPORT-FN directly." "vararg_expression")))) (text "comment")))) - ;; Imenu. + ;; Imenu/Outline. (setq-local treesit-simple-imenu-settings `(("Requires" "\\`function_call\\'" @@ -789,16 +789,6 @@ Calls REPORT-FN directly." ;; Which-function. (setq-local which-func-functions (treesit-defun-at-point)) - ;; Outline. - (setq-local outline-regexp - (rx (seq (0+ space) - (or (seq "--[[" (0+ space) eol) - (seq symbol-start - (or "do" "for" "if" "repeat" "while" - (seq (? (seq "local" (1+ space))) - "function")) - symbol-end))))) - ;; Align. (setq-local align-indent-before-aligning t) diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 301f3e8791c..9af2aa6748f 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -121,6 +121,17 @@ Return nil if there is no name or if NODE is not a defun node." ;; Imenu. (setq-local treesit-simple-imenu-settings '(("Element" "\\`tag_name\\'" nil nil))) + + ;; Outline minor mode. + (setq-local treesit-outline-predicate "\\`element\\'") + ;; `html-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' above. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-level) + (treesit-major-mode-setup)) (if (treesit-ready-p 'html) diff --git a/lisp/treesit.el b/lisp/treesit.el index 6a485ae591a..25ac582276b 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2860,6 +2860,71 @@ ENTRY. MARKER marks the start of each tree-sitter node." index)))) treesit-simple-imenu-settings))) +;;; Outline minor mode + +(defvar-local treesit-outline-predicate nil + "Predicate used to find outline headings in the syntax tree. +The predicate can be a function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. +It matches the nodes located on lines with outline headings. +Intended to be set by a major mode. When nil, the predicate +is constructed from the value of `treesit-simple-imenu-settings' +when a major mode sets it.") + +(defun treesit-outline-predicate--from-imenu (node) + ;; Return an outline searching predicate created from Imenu. + ;; Return the value suitable to set `treesit-outline-predicate'. + ;; Create this predicate from the value `treesit-simple-imenu-settings' + ;; that major modes set to find Imenu entries. The assumption here + ;; is that the positions of Imenu entries most of the time coincide + ;; with the lines of outline headings. When this assumption fails, + ;; you can directly set a proper value to `treesit-outline-predicate'. + (seq-some + (lambda (setting) + (and (string-match-p (nth 1 setting) (treesit-node-type node)) + (or (null (nth 2 setting)) + (funcall (nth 2 setting) node)))) + treesit-simple-imenu-settings)) + +(defun treesit-outline-search (&optional bound move backward looking-at) + "Search for the next outline heading in the syntax tree. +See the descriptions of arguments in `outline-search-function'." + (if looking-at + (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate) + (treesit--thing-at (pos-bol) treesit-outline-predicate))) + (start (treesit-node-start node))) + (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) + + (let* ((pos + ;; When function wants to find the current outline, point + ;; is at the beginning of the current line. When it wants + ;; to find the next outline, point is at the second column. + (if (eq (point) (pos-bol)) + (if (bobp) (point) (1- (point))) + (pos-eol))) + (found (treesit--navigate-thing pos (if backward -1 1) 'beg + treesit-outline-predicate))) + (if found + (if (or (not bound) (if backward (>= found bound) (<= found bound))) + (progn + (goto-char found) + (goto-char (pos-bol)) + (set-match-data (list (point) (pos-eol))) + t) + (when move (goto-char bound)) + nil) + (when move (goto-char (or bound (if backward (point-min) (point-max))))) + nil)))) + +(defun treesit-outline-level () + "Return the depth of the current outline heading." + (let* ((node (treesit-node-at (point))) + (level (if (treesit-node-match-p node treesit-outline-predicate t) + 1 0))) + (while (setq node (treesit-parent-until node treesit-outline-predicate)) + (setq level (1+ level))) + (if (zerop level) 1 level))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) @@ -2990,6 +3055,17 @@ before calling this function." (setq-local imenu-create-index-function #'treesit-simple-imenu)) + ;; Outline minor mode. + (when (and (or treesit-outline-predicate treesit-simple-imenu-settings) + (not (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)))) + (unless treesit-outline-predicate + (setq treesit-outline-predicate + #'treesit-outline-predicate--from-imenu)) + (setq-local outline-search-function #'treesit-outline-search + outline-level #'treesit-outline-level)) + ;; Remove existing local parsers. (dolist (ov (overlays-in (point-min) (point-max))) (when-let ((parser (overlay-get ov 'treesit-parser))) From 40994d2bafafa53464d3678b06f391fd13c884ec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Feb 2024 17:42:28 -0500 Subject: [PATCH 194/385] (cl--generic-describe): Refactor to ease reuse * lisp/emacs-lisp/cl-generic.el (cl--map-methods-documentation): New function, extrated from `cl--generic-describe`. (cl--generic-describe): Use it. --- lisp/emacs-lisp/cl-generic.el | 73 +++++++++++++++++++++-------------- 1 file changed, 43 insertions(+), 30 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index d1bd45120f1..f439a97f88c 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1140,12 +1140,8 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) (defun cl--generic-describe (function) - ;; Supposedly this is called from help-fns, so help-fns should be loaded at - ;; this point. - (declare-function help-fns-short-filename "help-fns" (filename)) (let ((generic (if (symbolp function) (cl--generic function)))) (when generic - (require 'help-mode) ;Needed for `help-function-def' button! (save-excursion ;; Ensure that we have two blank lines (but not more). (unless (looking-back "\n\n" (- (point) 2)) @@ -1153,32 +1149,49 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (insert "This is a generic function.\n\n") (insert (propertize "Implementations:\n\n" 'face 'bold)) ;; Loop over fanciful generics - (dolist (method (cl--generic-method-table generic)) - (pcase-let* - ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) - ;; FIXME: Add hyperlinks for the types as well. - (let ((quals (if (length> qualifiers 0) - (concat (substring qualifiers - 0 (string-match " *\\'" - qualifiers)) - "\n") - ""))) - (insert (format "%s%S" - quals - (cons function - (cl--generic-upcase-formal-args args))))) - (let* ((met-name (cl--generic-load-hist-format - function - (cl--generic-method-qualifiers method) - (cl--generic-method-specializers method))) - (file (find-lisp-object-file-name met-name 'cl-defmethod))) - (when file - (insert (substitute-command-keys " in `")) - (help-insert-xref-button (help-fns-short-filename file) - 'help-function-def met-name file - 'cl-defmethod) - (insert (substitute-command-keys "'.\n")))) - (insert "\n" (or doc "Undocumented") "\n\n"))))))) + (cl--map-methods-documentation + function + (lambda (quals signature file doc) + (insert (format "%s%S%s\n\n%s\n\n" + quals signature + (if file (format-message " in `%s'." file) "") + (or doc "Undocumented"))))))))) + +(defun cl--map-methods-documentation (funname metname-printer) + "Iterate on FUNNAME's methods documentation at point." + ;; Supposedly this is called from help-fns, so help-fns should be loaded at + ;; this point. + (require 'help-fns) + (declare-function help-fns-short-filename "help-fns" (filename)) + (let ((generic (if (symbolp funname) (cl--generic funname)))) + (when generic + (require 'help-mode) ;Needed for `help-function-def' button! + ;; Loop over fanciful generics + (dolist (method (cl--generic-method-table generic)) + (pcase-let* + ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)) + ;; FIXME: Add hyperlinks for the types as well. + (quals (if (length> qualifiers 0) + (concat (substring qualifiers + 0 (string-match " *\\'" + qualifiers)) + "\n") + "")) + (met-name (cl--generic-load-hist-format + funname + (cl--generic-method-qualifiers method) + (cl--generic-method-specializers method))) + (file (find-lisp-object-file-name met-name 'cl-defmethod))) + (funcall metname-printer + quals + (cons funname + (cl--generic-upcase-formal-args args)) + (when file + (make-text-button (help-fns-short-filename file) nil + 'type 'help-function-def + 'help-args + (list met-name file 'cl-defmethod))) + doc)))))) (defun cl--generic-specializers-apply-to-type-p (specializers type) "Return non-nil if a method with SPECIALIZERS applies to TYPE." From 6a18da80c2a3ff4bdede91bd3c28ecd41703ff98 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 13 Feb 2024 09:47:24 +0800 Subject: [PATCH 195/385] ; * src/lread.c (Finternal__obarray_buckets): Fix coding style. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index db8c4813426..d339b2f15ae 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5316,7 +5316,7 @@ DEFUN ("internal--obarray-buckets", while (1) { bucket = Fcons (sym, bucket); - struct Lisp_Symbol *s = XBARE_SYMBOL(sym)->u.s.next; + struct Lisp_Symbol *s = XBARE_SYMBOL (sym)->u.s.next; if (!s) break; sym = make_lisp_symbol (s); From d570864bebf9f038f696768f2da571ed272f0058 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Thu, 1 Feb 2024 13:58:20 -0800 Subject: [PATCH 196/385] Make outline.el ignore field properties in text * lisp/outline.el (outline-back-to-heading, outline-on-heading-p) (outline-next-visible-heading, outline-mark-subtree) (outline-hide-sublevels, outline--insert-button) (outline--fix-up-all-buttons): Inhibit field text motion (bug#68881). --- lisp/outline.el | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/lisp/outline.el b/lisp/outline.el index b50708c1a7b..5ac0f0707f1 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -686,7 +686,7 @@ If POS is nil, use `point' instead." (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (beginning-of-line) + (forward-line 0) (or (outline-on-heading-p invisible-ok) (let (found) (save-excursion @@ -705,7 +705,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." "Return t if point is on a (visible) heading line. If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (save-excursion - (beginning-of-line) + (forward-line 0) (and (bolp) (or invisible-ok (not (outline-invisible-p))) (if outline-search-function (funcall outline-search-function nil nil nil t) @@ -725,7 +725,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (not (string-match (concat "\\`\\(?:" outline-regexp "\\)") (concat head " ")))) (setq head (concat head " "))) - (unless (bolp) (end-of-line) (newline)) + (unless (bolp) (goto-char (pos-eol)) (newline)) (insert head) (unless (eolp) (save-excursion (newline-and-indent))) @@ -941,9 +941,7 @@ With ARG, repeats or can move backward if negative. A heading line is one that starts with a `*' (or that `outline-regexp' matches)." (interactive "p") - (if (< arg 0) - (beginning-of-line) - (end-of-line)) + (goto-char (if (< arg 0) (pos-bol) (pos-eol))) (let ((regexp (unless outline-search-function (concat "^\\(?:" outline-regexp "\\)"))) found-heading-p) @@ -963,7 +961,7 @@ A heading line is one that starts with a `*' (or that (re-search-forward regexp nil 'move))) (outline-invisible-p (match-beginning 0)))) (setq arg (1- arg))) - (if found-heading-p (beginning-of-line)))) + (if found-heading-p (forward-line 0)))) (defun outline-previous-visible-heading (arg) "Move to the previous heading line. @@ -980,7 +978,7 @@ This puts point at the start of the current subtree, and mark at the end." (let ((beg)) (if (outline-on-heading-p) ;; we are already looking at a heading - (beginning-of-line) + (forward-line 0) ;; else go back to previous heading (outline-previous-visible-heading 1)) (setq beg (point)) @@ -1183,7 +1181,7 @@ of the current heading, or to 1 if the current line is not a heading." (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) ((save-excursion - (beginning-of-line) + (forward-line 0) (if outline-search-function (funcall outline-search-function nil nil nil t) (looking-at outline-regexp))) @@ -1243,7 +1241,7 @@ This also unhides the top heading-less body, if any." (interactive) (save-excursion (outline-back-to-heading) - (if (not (outline-invisible-p (line-end-position))) + (if (not (outline-invisible-p (pos-eol))) (outline-hide-subtree) (outline-show-children) (outline-show-entry)))) @@ -1834,7 +1832,7 @@ With a prefix argument, show headings up to that LEVEL." (defun outline--insert-button (type) (with-silent-modifications (save-excursion - (beginning-of-line) + (forward-line 0) (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons)) (o (seq-find (lambda (o) (overlay-get o 'outline-button)) (overlays-at (point))))) @@ -1842,7 +1840,7 @@ With a prefix argument, show headings up to that LEVEL." (when (eq outline-minor-mode-use-buttons 'insert) (let ((inhibit-read-only t)) (insert (apply #'propertize " " (text-properties-at (point)))) - (beginning-of-line))) + (forward-line 0))) (setq o (make-overlay (point) (1+ (point)))) (overlay-put o 'outline-button t) (overlay-put o 'evaporate t)) @@ -1866,7 +1864,7 @@ With a prefix argument, show headings up to that LEVEL." (when from (save-excursion (goto-char from) - (setq from (line-beginning-position)))) + (setq from (pos-bol)))) (outline-map-region (lambda () (let ((close-p (save-excursion From acc6732ca1d39352f1aae3074ad04564178c0954 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 13 Feb 2024 11:18:16 +0100 Subject: [PATCH 197/385] Reuse commit message when preparing a single patch * lisp/vc/vc.el (vc-prepare-patch): Check commit message if only a single revision was selected. --- lisp/vc/vc.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index ca6efeabac2..619b469bebb 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3623,7 +3623,15 @@ revisions. When invoked interactively in a Log View buffer with marked revisions, use those." (interactive - (let ((revs (vc-prepare-patch-prompt-revisions)) to) + (let* ((revs (vc-prepare-patch-prompt-revisions)) + (subject + (and (length= revs 1) + (plist-get + (vc-call-backend + (vc-responsible-backend default-directory) + 'prepare-patch (car revs)) + :subject))) + to) (require 'message) (while (null (setq to (completing-read-multiple (format-prompt @@ -3636,7 +3644,7 @@ marked revisions, use those." (sit-for blink-matching-delay)) (list (string-join to ", ") (and (not vc-prepare-patches-separately) - (read-string "Subject: " "[PATCH] " nil nil t)) + (read-string "Subject: " (or subject "[PATCH] ") nil nil t)) revs))) (save-current-buffer (let ((patches (mapcar (lambda (rev) From 6ef8d29f221e010705184092600ac124bd0a14fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20Bornemann?= Date: Mon, 12 Feb 2024 21:56:42 +0100 Subject: [PATCH 198/385] ; Resolve a FIXME in rst.el * lisp/textmodes/rst.el (rst-define-key): Use :documentation for the dynamically created docstrings of deprecated bindings. (Bug#69087) Copyright-paperwork-exempt: yes --- lisp/textmodes/rst.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 2cd78943883..5fbff4ba888 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1147,14 +1147,14 @@ as well but give an additional message." (unless (fboundp forwarder-function) (defalias forwarder-function (lambda () + (:documentation + (format "Deprecated binding for %s, use \\[%s] instead." + def def)) (interactive) (call-interactively def) (message "[Deprecated use of key %s; use key %s instead]" (key-description (this-command-keys)) - (key-description key))) - ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. - (format "Deprecated binding for %s, use \\[%s] instead." - def def))) + (key-description key))))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) From 07bd7a0150eab1084a41f230cf59e620811e1778 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 13 Feb 2024 17:12:34 +0100 Subject: [PATCH 199/385] Add docstring for Tramp test macros * test/lisp/net/tramp-tests.el (tramp--test-set-ert-test-documentation): New defun. (tramp--test-deftest-with-stat, tramp--test-deftest-with-perl) (tramp--test-deftest-with-ls): Use it to define docstring. --- test/lisp/net/tramp-tests.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4a964f0daf0..623e0860a01 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3815,15 +3815,24 @@ This tests also `access-file', `file-readable-p', (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) +(defun tramp--test-set-ert-test-documentation (test command) + "Set the documentation string for a derived test. +The test is derived from TEST and COMMAND." + (let ((test-doc + (string-split (ert-test-documentation (get test 'ert--test)) "\n"))) + ;; The first line must be extended. + (setcar + test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) + (setf (ert-test-documentation + (get (intern (format "%s-with-%s" test command)) 'ert--test)) + (string-join test-doc "\n")))) + (defmacro tramp--test-deftest-with-stat (test) "Define ert `TEST-with-stat'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"stat\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "stat") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-stat tramp-test-vec)) @@ -3842,11 +3851,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-perl'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"perl\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "perl") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-perl tramp-test-vec)) @@ -3870,11 +3876,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-ls'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"ls\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "ls") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (if-let ((default-directory ert-remote-temporary-file-directory) From d61145cc8cfb31ca170cd1b5deab59f0a5cbea63 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 13 Feb 2024 19:02:21 +0200 Subject: [PATCH 200/385] More changes for treesitter support of outline-minor-mode (bug#68824) * lisp/treesit.el (treesit-outline-level): Set NAMED arg of 'treesit-node-at' to t. Don't set IGNORE-MISSING arg of 'treesit-node-match-p' to t. * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): Add "singleton_method" to 'treesit-thing-settings'. Set 'treesit-outline-predicate'. Kill local variables 'outline-regexp' and 'outline-level'. --- lisp/progmodes/ruby-ts-mode.el | 14 ++++++++++++++ lisp/treesit.el | 4 ++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 598eaa461ff..426ae248cac 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1133,6 +1133,7 @@ leading double colon is not added." "singleton_class" "module" "method" + "singleton_method" "array" "hash" "parenthesized_statements" @@ -1178,6 +1179,19 @@ leading double colon is not added." ;; Imenu. (setq-local imenu-create-index-function #'ruby-ts--imenu) + ;; Outline minor mode. + (setq-local treesit-outline-predicate + (rx bos (or "singleton_method" + "method" + "alias" + "class" + "module") + eos)) + ;; Restore default values of outline variables + ;; to use `treesit-outline-predicate'. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-simple-indent-rules (ruby-ts--indent-rules)) ;; Font-lock. diff --git a/lisp/treesit.el b/lisp/treesit.el index 25ac582276b..f811b8090bc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2918,8 +2918,8 @@ See the descriptions of arguments in `outline-search-function'." (defun treesit-outline-level () "Return the depth of the current outline heading." - (let* ((node (treesit-node-at (point))) - (level (if (treesit-node-match-p node treesit-outline-predicate t) + (let* ((node (treesit-node-at (point) nil t)) + (level (if (treesit-node-match-p node treesit-outline-predicate) 1 0))) (while (setq node (treesit-parent-until node treesit-outline-predicate)) (setq level (1+ level))) From d2a5d7534c7dcdc4432bf5456cb8a76680f7aa14 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:50 -0800 Subject: [PATCH 201/385] Simplify and speed up EQ * src/lisp.h (lisp_h_BASE2_EQ, lisp_h_EQ): Simplify by testing symbols_with_pos_enabled first. On x86-64 with GCC 13.2 this shrinks temacs text by 1.5% and after removing all *.elc files speeds up 'make' by 1.2%. --- src/lisp.h | 26 +++++++++----------------- 1 file changed, 9 insertions(+), 17 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 5326824bf38..f6133669ac1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -384,27 +384,19 @@ typedef EMACS_INT Lisp_Word; ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_BASE2_EQ(x, y) \ - (BASE_EQ (x, y) \ - || (symbols_with_pos_enabled \ - && SYMBOL_WITH_POS_P (x) \ - && BASE_EQ (XSYMBOL_WITH_POS (x)->sym, y))) +#define lisp_h_BASE2_EQ(x, y) \ + (symbols_with_pos_enabled \ + ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), y) \ + : BASE_EQ (x, y)) /* FIXME: Do we really need to inline the whole thing? * What about keeping the part after `symbols_with_pos_enabled` in * a separate function? */ -#define lisp_h_EQ(x, y) \ - (XLI (x) == XLI (y) \ - || (symbols_with_pos_enabled \ - && (SYMBOL_WITH_POS_P (x) \ - ? (BARE_SYMBOL_P (y) \ - ? XLI (XSYMBOL_WITH_POS (x)->sym) == XLI (y) \ - : (SYMBOL_WITH_POS_P (y) \ - && (XLI (XSYMBOL_WITH_POS (x)->sym) \ - == XLI (XSYMBOL_WITH_POS (y)->sym)))) \ - : (SYMBOL_WITH_POS_P (y) \ - && BARE_SYMBOL_P (x) \ - && (XLI (x) == XLI (XSYMBOL_WITH_POS (y)->sym)))))) +#define lisp_h_EQ(x, y) \ + (symbols_with_pos_enabled \ + ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), \ + SYMBOL_WITH_POS_P (y) ? XSYMBOL_WITH_POS (y)->sym : (y)) \ + : BASE_EQ (x, y)) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ From 08c1863257469b4cb85e97a276ba635d44b22666 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 202/385] Simplify and speed up EQ again * src/lisp.h (lisp_h_BASE2_EQ, lisp_h_EQ): Simplify and refactor. On x86-64 with GCC 3.2 this shrinks temacs text by 0.055% and after removing all *.elc files speeds up 'make' by 1.0%. --- src/lisp.h | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index f6133669ac1..b609bef990c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -385,18 +385,13 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_BASE2_EQ(x, y) \ - (symbols_with_pos_enabled \ - ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), y) \ - : BASE_EQ (x, y)) - -/* FIXME: Do we really need to inline the whole thing? - * What about keeping the part after `symbols_with_pos_enabled` in - * a separate function? */ + BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) \ + ? XSYMBOL_WITH_POS (x)->sym : (x)), \ + y) #define lisp_h_EQ(x, y) \ - (symbols_with_pos_enabled \ - ? BASE_EQ (SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS (x)->sym : (x), \ - SYMBOL_WITH_POS_P (y) ? XSYMBOL_WITH_POS (y)->sym : (y)) \ - : BASE_EQ (x, y)) + BASE2_EQ (x, \ + (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ + ? XSYMBOL_WITH_POS (y)->sym : (y))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ From efdcd7b8f78ef22c0213ea770a552fb69b789381 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 203/385] Remove BASE2_EQ MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (lisp_h_BASE2_EQ, BASE2_EQ): Remove. All uses removed. BASE2_EQ was present only for minor optimization and with current gcc -O2, BASE2_EQ does not affect performance, so it’s not worth the hassle. --- src/lisp.h | 18 +++--------------- src/lread.c | 4 +++- src/timefns.c | 6 +++--- 3 files changed, 9 insertions(+), 19 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index b609bef990c..0b676a027eb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -384,14 +384,11 @@ typedef EMACS_INT Lisp_Word; ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_BASE2_EQ(x, y) \ +#define lisp_h_EQ(x, y) \ BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) \ ? XSYMBOL_WITH_POS (x)->sym : (x)), \ - y) -#define lisp_h_EQ(x, y) \ - BASE2_EQ (x, \ - (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ - ? XSYMBOL_WITH_POS (y)->sym : (y))) + (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ + ? XSYMBOL_WITH_POS (y)->sym : (y))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ @@ -461,7 +458,6 @@ typedef EMACS_INT Lisp_Word; # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) # define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y) -# define BASE2_EQ(x, y) lisp_h_BASE2_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) @@ -1339,14 +1335,6 @@ INLINE bool return lisp_h_BASE_EQ (x, y); } -/* Return true if X and Y are the same object, reckoning X to be the - same as a bare symbol Y if X is Y with position. */ -INLINE bool -(BASE2_EQ) (Lisp_Object x, Lisp_Object y) -{ - return lisp_h_BASE2_EQ (x, y); -} - /* Return true if X and Y are the same object, reckoning a symbol with position as being the same as the bare symbol. */ INLINE bool diff --git a/src/lread.c b/src/lread.c index d339b2f15ae..551bfd735a2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5063,10 +5063,12 @@ it defaults to the value of `obarray'. */) { /* If already a symbol, we don't do shorthand-longhand translation, as promised in the docstring. */ + Lisp_Object sym = (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (name) + ? XSYMBOL_WITH_POS (name)->sym : name); string = XSYMBOL (name)->u.s.name; tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - return BASE2_EQ (name, tem) ? name : Qnil; + return BASE_EQ (sym, tem) ? name : Qnil; } } diff --git a/src/timefns.c b/src/timefns.c index 1541583b485..fc1edf136cb 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -225,7 +225,7 @@ tzlookup (Lisp_Object zone, bool settz) if (NILP (zone)) return local_tz; - else if (BASE_EQ (zone, make_fixnum (0)) || BASE2_EQ (zone, Qt)) + else if (BASE_EQ (zone, make_fixnum (0)) || EQ (zone, Qt)) { zone_string = "UTC0"; new_tz = utc_tz; @@ -234,7 +234,7 @@ tzlookup (Lisp_Object zone, bool settz) { bool plain_integer = FIXNUMP (zone); - if (BASE2_EQ (zone, Qwall)) + if (EQ (zone, Qwall)) zone_string = 0; else if (STRINGP (zone)) zone_string = SSDATA (ENCODE_SYSTEM (zone)); @@ -1548,7 +1548,7 @@ usage: (decode-time &optional TIME ZONE FORM) */) /* Compute SEC from LOCAL_TM.tm_sec and HZ. */ Lisp_Object hz = lt.hz, sec; - if (BASE_EQ (hz, make_fixnum (1)) || !BASE2_EQ (form, Qt)) + if (BASE_EQ (hz, make_fixnum (1)) || !EQ (form, Qt)) sec = make_fixnum (local_tm.tm_sec); else { From 231af322b07447d87b4c250aa601219a4005d9a5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 204/385] Remove lisp_h_PSEUDOVECTORP etc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (lisp_h_PSEUDOVECTORP, lisp_h_EQ, lisp_h_SYMBOLP): Refactor by removing these macros, moving each definiens to its only use. Now that we have symbols with position so that there is no longer a non-lisp_h_* macro counterpart if DEFINE_KEY_OPS_AS_MACROS, there’s no need to separate these definiens from their inline function bodies. --- src/lisp.h | 31 ++++++++++++------------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 0b676a027eb..d1dcddcfb89 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -372,23 +372,12 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_Qnil {0} #endif -#define lisp_h_PSEUDOVECTORP(a,code) \ - (lisp_h_VECTORLIKEP (a) \ - && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size \ - & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ - == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) - #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_EQ(x, y) \ - BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) \ - ? XSYMBOL_WITH_POS (x)->sym : (x)), \ - (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) \ - ? XSYMBOL_WITH_POS (y)->sym : (y))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ @@ -406,8 +395,6 @@ typedef EMACS_INT Lisp_Word; (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) #define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) -#define lisp_h_SYMBOLP(x) \ - (BARE_SYMBOL_P (x) || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ @@ -465,7 +452,6 @@ typedef EMACS_INT Lisp_Word; # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */ # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) @@ -1104,7 +1090,10 @@ enum More_Lisp_Bits INLINE bool PSEUDOVECTORP (Lisp_Object a, int code) { - return lisp_h_PSEUDOVECTORP (a, code); + return (lisp_h_VECTORLIKEP (a) + && ((XUNTAG (a, Lisp_Vectorlike, union vectorlike_header)->size + & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)))); } INLINE bool @@ -1120,9 +1109,10 @@ INLINE bool } INLINE bool -(SYMBOLP) (Lisp_Object x) +SYMBOLP (Lisp_Object x) { - return lisp_h_SYMBOLP (x); + return (BARE_SYMBOL_P (x) + || (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x))); } INLINE struct Lisp_Symbol_With_Pos * @@ -1338,9 +1328,12 @@ INLINE bool /* Return true if X and Y are the same object, reckoning a symbol with position as being the same as the bare symbol. */ INLINE bool -(EQ) (Lisp_Object x, Lisp_Object y) +EQ (Lisp_Object x, Lisp_Object y) { - return lisp_h_EQ (x, y); + return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) + ? XSYMBOL_WITH_POS (x)->sym : x), + (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) + ? XSYMBOL_WITH_POS (y)->sym : y)); } INLINE intmax_t From 473dac880105cf6055a185eb3b9764243f27697c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 205/385] Remove lisp_h_XCONS etc MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When configured with --enable-checking and compiled with gcc -O0, these macros evaluated arguments multiple times, which made it too easy to mistakenly write code that behaves differently when debugging. This patch does not affect performance in normal builds. In --enable-checking builds with gcc -O0 it slows down my usual benchmark (remove all '*.elc’ files and then 'make') by 4.4%. I hope that’s good enough; if not I can complicate the macros to tune better for debugging builds. * src/lisp.h (lisp_h_SET_SYMBOL_VAL, lisp_h_SYMBOL_VAL) (lisp_h_XCONS): Remove, moving each definiens to the corresponding inline function. All uses removed. --- src/lisp.h | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index d1dcddcfb89..796c7867b4c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -330,7 +330,8 @@ typedef EMACS_INT Lisp_Word; without worrying about the implementations diverging, since lisp_h_OP defines the actual implementation. The lisp_h_OP macros are intended to be private to this include file, and should not be - used elsewhere. + used elsewhere. They should evaluate each argument exactly once, + so that they behave like their functional counterparts. FIXME: Remove the lisp_h_OP macros, and define just the inline OP functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well @@ -385,14 +386,9 @@ typedef EMACS_INT Lisp_Word; & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) #define lisp_h_NILP(x) BASE_EQ (x, Qnil) -#define lisp_h_SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ - (sym)->u.s.val.value = (v)) #define lisp_h_SYMBOL_CONSTANT_P(sym) \ (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE) #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) -#define lisp_h_SYMBOL_VAL(sym) \ - (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) #define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP (x, PVEC_SYMBOL_WITH_POS) #define lisp_h_BARE_SYMBOL_P(x) TAGGEDP (x, Lisp_Symbol) #define lisp_h_TAGGEDP(a, tag) \ @@ -402,8 +398,6 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) #define lisp_h_XCAR(c) XCONS (c)->u.s.car #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr -#define lisp_h_XCONS(a) \ - (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons)) #define lisp_h_XHASH(a) XUFIXNUM_RAW (a) #if USE_LSB_TAG # define lisp_h_make_fixnum_wrap(n) \ @@ -448,15 +442,12 @@ typedef EMACS_INT Lisp_Word; # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) -# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) -# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) # define XCDR(c) lisp_h_XCDR (c) -# define XCONS(a) lisp_h_XCONS (a) # define XHASH(a) lisp_h_XHASH (a) # if USE_LSB_TAG # define make_fixnum(n) lisp_h_make_fixnum (n) @@ -1478,9 +1469,10 @@ CHECK_CONS (Lisp_Object x) } INLINE struct Lisp_Cons * -(XCONS) (Lisp_Object a) +XCONS (Lisp_Object a) { - return lisp_h_XCONS (a); + eassert (CONSP (a)); + return XUNTAG (a, Lisp_Cons, struct Lisp_Cons); } /* Take the car or cdr of something known to be a cons cell. */ @@ -2265,9 +2257,10 @@ typedef jmp_buf sys_jmp_buf; /* Value is name of symbol. */ INLINE Lisp_Object -(SYMBOL_VAL) (struct Lisp_Symbol *sym) +SYMBOL_VAL (struct Lisp_Symbol *sym) { - return lisp_h_SYMBOL_VAL (sym); + eassert (sym->u.s.redirect == SYMBOL_PLAINVAL); + return sym->u.s.val.value; } INLINE struct Lisp_Symbol * @@ -2290,9 +2283,10 @@ SYMBOL_FWD (struct Lisp_Symbol *sym) } INLINE void -(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v) +SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v) { - lisp_h_SET_SYMBOL_VAL (sym, v); + eassert (sym->u.s.redirect == SYMBOL_PLAINVAL); + sym->u.s.val.value = v; } INLINE void From 10c6aea4434b1c9ccea30a1f87f301ab2c9bade6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 206/385] Remove SYMBOL_WITH_POS_{POS,SYM} * src/fns.c (internal_equal): Turn comment into eassert that !symbols_with_pos_enabled. (sxhash_obj): Simplify case of symbol with pos (when enabled). * src/lisp.h (XSYMBOL_WITH_POS_SYM, XSYMBOL_WITH_POS_POS) (maybe_remove_pos_from_symbol): New inline functions. (SYMBOL_WITH_POS_SYM, SYMBOL_WITH_POS_POS): Remove. All uses replaced by the new functions. This avoids some double-checking in the source code, simplifies the code overall, and avoids the need for "Type checking is done in the following macro" comments to explain unusual code. --- src/data.c | 16 +++++++--------- src/fns.c | 44 +++++++++++++++++++++----------------------- src/lisp.h | 43 ++++++++++++++++++++++++------------------- src/lread.c | 3 +-- src/timefns.c | 6 ++---- 5 files changed, 55 insertions(+), 57 deletions(-) diff --git a/src/data.c b/src/data.c index 0c47750cb75..530bb774171 100644 --- a/src/data.c +++ b/src/data.c @@ -791,18 +791,16 @@ DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0, doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) (register Lisp_Object sym) { - if (BARE_SYMBOL_P (sym)) - return sym; - /* Type checking is done in the following macro. */ - return SYMBOL_WITH_POS_SYM (sym); + CHECK_SYMBOL (sym); + return BARE_SYMBOL_P (sym) ? sym : XSYMBOL_WITH_POS_SYM (sym); } DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, doc: /* Extract the position from a symbol with position. */) (register Lisp_Object ls) { - /* Type checking is done in the following macro. */ - return SYMBOL_WITH_POS_POS (ls); + CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls); + return XSYMBOL_WITH_POS_POS (ls); } DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, @@ -812,7 +810,7 @@ Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) (register Lisp_Object arg) { if (SYMBOL_WITH_POS_P (arg)) - return (SYMBOL_WITH_POS_SYM (arg)); + return XSYMBOL_WITH_POS_SYM (arg); return arg; } @@ -829,14 +827,14 @@ the position will be taken. */) if (BARE_SYMBOL_P (sym)) bare = sym; else if (SYMBOL_WITH_POS_P (sym)) - bare = XSYMBOL_WITH_POS (sym)->sym; + bare = XSYMBOL_WITH_POS_SYM (sym); else wrong_type_argument (Qsymbolp, sym); if (FIXNUMP (pos)) position = pos; else if (SYMBOL_WITH_POS_P (pos)) - position = XSYMBOL_WITH_POS (pos)->pos; + position = XSYMBOL_WITH_POS_POS (pos); else wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); diff --git a/src/fns.c b/src/fns.c index 61d87752777..918ba0370e8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2782,13 +2782,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, /* A symbol with position compares the contained symbol, and is `equal' to the corresponding ordinary symbol. */ - if (symbols_with_pos_enabled) - { - if (SYMBOL_WITH_POS_P (o1)) - o1 = SYMBOL_WITH_POS_SYM (o1); - if (SYMBOL_WITH_POS_P (o2)) - o2 = SYMBOL_WITH_POS_SYM (o2); - } + o1 = maybe_remove_pos_from_symbol (o1); + o2 = maybe_remove_pos_from_symbol (o2); if (BASE_EQ (o1, o2)) return true; @@ -2869,11 +2864,14 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, if (TS_NODEP (o1)) return treesit_node_eq (o1, o2); #endif - if (SYMBOL_WITH_POS_P(o1)) /* symbols_with_pos_enabled is false. */ - return (BASE_EQ (XSYMBOL_WITH_POS (o1)->sym, - XSYMBOL_WITH_POS (o2)->sym) - && BASE_EQ (XSYMBOL_WITH_POS (o1)->pos, - XSYMBOL_WITH_POS (o2)->pos)); + if (SYMBOL_WITH_POS_P (o1)) + { + eassert (!symbols_with_pos_enabled); + return (BASE_EQ (XSYMBOL_WITH_POS_SYM (o1), + XSYMBOL_WITH_POS_SYM (o2)) + && BASE_EQ (XSYMBOL_WITH_POS_POS (o1), + XSYMBOL_WITH_POS_POS (o2))); + } /* Aside from them, only true vectors, char-tables, compiled functions, and fonts (font-spec, font-entity, font-object) @@ -4465,9 +4463,8 @@ reduce_emacs_uint_to_hash_hash (EMACS_UINT x) static EMACS_INT sxhash_eq (Lisp_Object key) { - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) - key = SYMBOL_WITH_POS_SYM (key); - return XHASH (key) ^ XTYPE (key); + Lisp_Object k = maybe_remove_pos_from_symbol (key); + return XHASH (k) ^ XTYPE (k); } static EMACS_INT @@ -5247,12 +5244,15 @@ sxhash_obj (Lisp_Object obj, int depth) hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); return hash; } - else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) - return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); else - /* Others are 'equal' if they are 'eq', so take their - address as hash. */ - return XHASH (obj); + { + if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) + obj = XSYMBOL_WITH_POS_SYM (obj); + + /* Others are 'equal' if they are 'eq', so take their + address as hash. */ + return XHASH (obj); + } } case Lisp_Cons: @@ -5447,9 +5447,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* See if there's a `:test TEST' among the arguments. */ ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); - Lisp_Object test = i ? args[i] : Qeql; - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test)) - test = SYMBOL_WITH_POS_SYM (test); + Lisp_Object test = i ? maybe_remove_pos_from_symbol (args[i]) : Qeql; const struct hash_table_test *testdesc; if (BASE_EQ (test, Qeq)) testdesc = &hashtest_eq; diff --git a/src/lisp.h b/src/lisp.h index 796c7867b4c..e9b0bd522af 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1113,6 +1113,27 @@ XSYMBOL_WITH_POS (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); } +INLINE Lisp_Object +XSYMBOL_WITH_POS_SYM (Lisp_Object a) +{ + Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym; + eassert (BARE_SYMBOL_P (sym)); + return sym; +} + +INLINE Lisp_Object +XSYMBOL_WITH_POS_POS (Lisp_Object a) +{ + return XSYMBOL_WITH_POS (a)->pos; +} + +INLINE Lisp_Object +maybe_remove_pos_from_symbol (Lisp_Object x) +{ + return (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) + ? XSYMBOL_WITH_POS_SYM (x) : x); +} + INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED XBARE_SYMBOL (Lisp_Object a) { @@ -1128,7 +1149,7 @@ XSYMBOL (Lisp_Object a) if (!BARE_SYMBOL_P (a)) { eassert (symbols_with_pos_enabled); - a = XSYMBOL_WITH_POS (a)->sym; + a = XSYMBOL_WITH_POS_SYM (a); } return XBARE_SYMBOL (a); } @@ -1322,9 +1343,9 @@ INLINE bool EQ (Lisp_Object x, Lisp_Object y) { return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) - ? XSYMBOL_WITH_POS (x)->sym : x), + ? XSYMBOL_WITH_POS_SYM (x) : x), (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) - ? XSYMBOL_WITH_POS (y)->sym : y)); + ? XSYMBOL_WITH_POS_SYM (y) : y)); } INLINE intmax_t @@ -2809,22 +2830,6 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } -INLINE Lisp_Object -SYMBOL_WITH_POS_SYM (Lisp_Object a) -{ - if (!SYMBOL_WITH_POS_P (a)) - wrong_type_argument (Qsymbol_with_pos_p, a); - return XSYMBOL_WITH_POS (a)->sym; -} - -INLINE Lisp_Object -SYMBOL_WITH_POS_POS (Lisp_Object a) -{ - if (!SYMBOL_WITH_POS_P (a)) - wrong_type_argument (Qsymbol_with_pos_p, a); - return XSYMBOL_WITH_POS (a)->pos; -} - INLINE bool USER_PTRP (Lisp_Object x) { diff --git a/src/lread.c b/src/lread.c index 551bfd735a2..c11c641440d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5063,8 +5063,7 @@ it defaults to the value of `obarray'. */) { /* If already a symbol, we don't do shorthand-longhand translation, as promised in the docstring. */ - Lisp_Object sym = (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (name) - ? XSYMBOL_WITH_POS (name)->sym : name); + Lisp_Object sym = maybe_remove_pos_from_symbol (name); string = XSYMBOL (name)->u.s.name; tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); diff --git a/src/timefns.c b/src/timefns.c index fc1edf136cb..0ecbb6e6793 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1765,10 +1765,8 @@ but new code should not rely on it. */) well, since we accept it as input? */ struct lisp_time t; enum timeform input_form = decode_lisp_time (time, false, &t, 0); - if (NILP (form)) - form = current_time_list ? Qlist : Qt; - if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (form)) - form = SYMBOL_WITH_POS_SYM (form); + form = (!NILP (form) ? maybe_remove_pos_from_symbol (form) + : current_time_list ? Qlist : Qt); if (BASE_EQ (form, Qlist)) return ticks_hz_list4 (t.ticks, t.hz); if (BASE_EQ (form, Qinteger)) From d202f1b9e74107c0e51c5d2fdbe094cbe1baaadb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 207/385] XSYMBOL eassume speedups MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lisp.h (XSYMBOL_WITH_POS_SYM, XSYMBOL): Help the compiler by using eassume instead of eassert for XSYMBOL postconditions likely to be useful for optimization later. With gcc 13.2 -O2 x86-64 this improved speed on my usual “compile all .el files” benchmark by 0.7% and shrank the text size of Emacs by 0.09%. --- src/lisp.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index e9b0bd522af..bf96bfd39f7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1117,7 +1117,7 @@ INLINE Lisp_Object XSYMBOL_WITH_POS_SYM (Lisp_Object a) { Lisp_Object sym = XSYMBOL_WITH_POS (a)->sym; - eassert (BARE_SYMBOL_P (sym)); + eassume (BARE_SYMBOL_P (sym)); return sym; } @@ -1148,7 +1148,7 @@ XSYMBOL (Lisp_Object a) { if (!BARE_SYMBOL_P (a)) { - eassert (symbols_with_pos_enabled); + eassume (symbols_with_pos_enabled); a = XSYMBOL_WITH_POS_SYM (a); } return XBARE_SYMBOL (a); From a4a99405d00b98aeb86040117402ed0e1f954833 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Feb 2024 09:54:51 -0800 Subject: [PATCH 208/385] Simplify position-symbol * src/data.c (Fposition_symbol): Simplify by calling Fbare_symbol rather than open-coding it. --- src/data.c | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/data.c b/src/data.c index 530bb774171..f2f35fb355a 100644 --- a/src/data.c +++ b/src/data.c @@ -821,16 +821,9 @@ POS, the position, is either a fixnum or a symbol with position from which the position will be taken. */) (register Lisp_Object sym, register Lisp_Object pos) { - Lisp_Object bare; + Lisp_Object bare = Fbare_symbol (sym); Lisp_Object position; - if (BARE_SYMBOL_P (sym)) - bare = sym; - else if (SYMBOL_WITH_POS_P (sym)) - bare = XSYMBOL_WITH_POS_SYM (sym); - else - wrong_type_argument (Qsymbolp, sym); - if (FIXNUMP (pos)) position = pos; else if (SYMBOL_WITH_POS_P (pos)) From 10bf810e845061a83d466cd7367ab7d220653296 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 13 Feb 2024 21:59:03 +0200 Subject: [PATCH 209/385] Fix left-over from renaming 'comp-*' functions * lisp/progmodes/elisp-mode.el (comp--write-bytecode-file): Call this instead of 'comp-write-bytecode-file', its old name. Reported by Arthur Miller . --- lisp/progmodes/elisp-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index da0cb96e1cf..4e0e7552f8e 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." (load (byte-compile-dest-file buffer-file-name))) (declare-function native-compile "comp") -(declare-function comp-write-bytecode-file "comp") +(declare-function comp--write-bytecode-file "comp") (defun emacs-lisp-native-compile () "Native-compile the current buffer's file (if it has changed). @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write-bytecode-file eln)))) + (comp-write--bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. From 371ccf09fea26892a2fada028d27fb4b596636df Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 12 Feb 2024 18:29:50 +0100 Subject: [PATCH 210/385] Add 'custom-variable' command * lisp/cus-edit.el (customize-toggle-option): Add command. (toggle-option): Add shorter alias for 'customize-toggle-option'. * etc/NEWS: Document it. (Bug#69079) --- etc/NEWS | 4 ++++ lisp/cus-edit.el | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index f89c8ce1d8d..e6b1d424499 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1336,6 +1336,10 @@ in Buffer menu mode. *** New command 'customize-dirlocals'. This command pops up a buffer to edit the settings in ".dir-locals.el". +--- +** New command 'customize-toggle-option'. +This command can toggle boolean options for the duration of a session. + ** Calc +++ diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 38b6ec984ab..8fad51dc116 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1227,6 +1227,41 @@ If OTHER-WINDOW is non-nil, display in another window." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) +;;;###autoload +(defun customize-toggle-option (symbol) + "Toggle the value of boolean option SYMBOL for this session." + (interactive (let ((prompt "Toggle boolean option: ") opts) + (mapatoms + (lambda (sym) + (when (eq (get sym 'custom-type) 'boolean) + (push sym opts)))) + (list (intern (completing-read prompt opts nil nil nil nil + (symbol-at-point)))))) + (let* ((setter (or (get symbol 'custom-set) #'set-default)) + (getter (or (get symbol 'custom-get) #'symbol-value)) + (value (condition-case nil + (funcall getter symbol) + (void-variable (error "`%s' is not bound" symbol)))) + (type (get symbol 'custom-type))) + (cond + ((eq type 'boolean)) + ((and (null type) + (yes-or-no-p + (format "`%s' doesn't have a type, and has the value %S. \ +Proceed to toggle?" symbol value)))) + ((yes-or-no-p + (format "`%s' is of type %s, and has the value %S. \ +Proceed to toggle?" + symbol type value))) + ((error "Abort toggling of option `%s'" symbol))) + (message "%s user options `%s'." + (if (funcall setter symbol (not value)) + "Enabled" "Disabled") + symbol))) + +;;;###autoload +(defalias 'toggle-option #'customize-toggle-option) + ;;;###autoload (defalias 'customize-variable-other-window 'customize-option-other-window) From 160165e8a97cfa3f3ffd803be373a3b34ed87597 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 13 Feb 2024 12:27:38 -0800 Subject: [PATCH 211/385] ; Compute the list of symbols for 'eshell-eval-using-options' once * lisp/eshell/esh-opt.el (eshell--get-option-symbols): New function... (eshell-eval-using-options): ... use it. (eshell--do-opts, eshell--process-args): Take OPTION-SYMS. * test/lisp/eshell/esh-opt-tests.el (esh-opt-test/process-args): (esh-opt-test/process-args-parse-leading-options-only): (esh-opt-test/process-args-external): Pass OPTION-SYMS in. --- lisp/eshell/esh-opt.el | 62 +++++++++++++++++-------------- test/lisp/eshell/esh-opt-tests.el | 24 ++++++++---- 2 files changed, 50 insertions(+), 36 deletions(-) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d01e3569d57..e6f5fc9629a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -100,29 +100,37 @@ the new process for its value. Lastly, any remaining arguments will be available in the locally let-bound variable `args'." (declare (debug (form form sexp body))) - `(let* ((temp-args - ,(if (memq ':preserve-args (cadr options)) - (list 'copy-tree macro-args) - (list 'eshell-stringify-list - (list 'flatten-tree macro-args)))) - (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args)) - ,@(delete-dups - (delq nil (mapcar (lambda (opt) - (and (listp opt) (nth 3 opt) - `(,(nth 3 opt) (pop processed-args)))) - ;; `options' is of the form (quote OPTS). - (cadr options)))) - (args processed-args)) - ;; Silence unused lexical variable warning if body does not use `args'. - (ignore args) - ,@body-forms)) + (let ((option-syms (eshell--get-option-symbols + ;; `options' is of the form (quote OPTS). + (cadr options)))) + `(let* ((temp-args + ,(if (memq ':preserve-args (cadr options)) + (list 'copy-tree macro-args) + (list 'eshell-stringify-list + (list 'flatten-tree macro-args)))) + (args (eshell--do-opts ,name temp-args ,macro-args + ,options ',option-syms)) + ;; Bind all the option variables. When done, `args' will + ;; contain any remaining positional arguments. + ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms)) + ;; Silence unused lexical variable warning if body does not use `args'. + (ignore args) + ,@body-forms))) ;;; Internal Functions: ;; Documented part of the interface; see eshell-eval-using-options. (defvar eshell--args) -(defun eshell--do-opts (name options args orig-args) +(defun eshell--get-option-symbols (options) + "Get a list of symbols for the specified OPTIONS. +OPTIONS is a list of command-line options from +`eshell-eval-using-options' (which see)." + (delete-dups + (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt))) + options)))) + +(defun eshell--do-opts (name args orig-args options option-syms) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." (require 'esh-ext) @@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere." (if (and (= (length args) 0) (memq ':show-usage options)) (eshell-show-usage name options) - (setq args (eshell--process-args name args options)) + (setq args (eshell--process-args name args options + option-syms)) nil)))) (when usage-msg (user-error "%s" usage-msg)))))) @@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized." "%s: unrecognized option --%s") name (car switch))))))) -(defun eshell--process-args (name args options) - "Process the given ARGS using OPTIONS." - (let* ((seen ()) - (opt-vals (delq nil (mapcar (lambda (opt) - (when (listp opt) - (let ((sym (nth 3 opt))) - (when (and sym (not (memq sym seen))) - (push sym seen) - (list sym))))) - options))) +(defun eshell--process-args (name args options option-syms) + "Process the given ARGS for the command NAME using OPTIONS. +OPTION-SYMS is a list of symbols that will hold the processed arguments. + +Return a list of values corresponding to each element in OPTION-SYMS, +followed by any additional positional arguments." + (let* ((opt-vals (mapcar #'list option-syms)) (ai 0) arg (eshell--args args) (pos-argument-found nil)) diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el index 8d6e0c1e426..4e5373e53cd 100644 --- a/test/lisp/eshell/esh-opt-tests.el +++ b/test/lisp/eshell/esh-opt-tests.el @@ -29,13 +29,15 @@ (eshell--process-args "sudo" '("-a") '((?a "all" nil show-all - "do not ignore entries starting with ."))))) + "do not ignore entries starting with .")) + '(show-all)))) (should (equal '("root" "world") (eshell--process-args "sudo" '("-u" "root" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-parse-leading-options-only () "Test behavior of :parse-leading-options-only in `eshell--process-args'." @@ -45,20 +47,23 @@ "sudo" '("emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("root" "emerge" "-uDN" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("DN" "emerge" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-external () "Test behavior of :external in `eshell--process-args'." @@ -69,7 +74,8 @@ "ls" '("/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls"))))) + :external "ls") + '(show-all))))) (cl-letf (((symbol-function 'eshell-search-path) #'identity)) (should (equal '(no-catch eshell-ext-command "ls") @@ -78,7 +84,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'no-catch)))) (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) (should-error @@ -86,7 +93,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'error))) (ert-deftest esh-opt-test/eval-using-options-short () From 7c23234b4ea43a033e06eb466008e0dc8485920b Mon Sep 17 00:00:00 2001 From: Steven Allen Date: Sat, 10 Feb 2024 10:05:11 -0800 Subject: [PATCH 212/385] Respect :lisp-dir whilst scanning for VC package dependencies * lisp/emacs-lisp/package-vc.el (package-vc--unpack-1): Scan 'lisp-dir', if set, for lisp files instead of scanning the root package directory. (Bug#69019) --- lisp/emacs-lisp/package-vc.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index fc402716dab..37980c28b02 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -501,8 +501,10 @@ This includes downloading missing dependencies, generating autoloads, generating a package description file (used to identify a package as a VC package later on), building documentation and marking the package as installed." - (let ((pkg-spec (package-vc--desc->spec pkg-desc)) - missing) + (let* ((pkg-spec (package-vc--desc->spec pkg-desc)) + (lisp-dir (plist-get pkg-spec :lisp-dir)) + (lisp-path (file-name-concat pkg-dir lisp-dir)) + missing) ;; In case the package was installed directly from source, the ;; dependency list wasn't know beforehand, and they might have @@ -519,7 +521,7 @@ documentation and marking the package as installed." "\\|") regexp-unmatchable)) (deps '())) - (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) + (dolist (file (directory-files lisp-path t "\\.el\\'" t)) (unless (string-match-p ignored-files file) (with-temp-buffer (insert-file-contents file) @@ -542,10 +544,8 @@ documentation and marking the package as installed." (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) ;; Generate autoloads (let* ((name (package-desc-name pkg-desc)) - (auto-name (format "%s-autoloads.el" name)) - (lisp-dir (plist-get pkg-spec :lisp-dir))) - (package-generate-autoloads - name (file-name-concat pkg-dir lisp-dir)) + (auto-name (format "%s-autoloads.el" name))) + (package-generate-autoloads name lisp-path) (when lisp-dir (write-region (with-temp-buffer From 70d6f6c41c9b1985e0ec70b45aeeac6982a050bb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Feb 2024 20:35:05 -0500 Subject: [PATCH 213/385] hideif.el: Minor cleanup * lisp/progmodes/hideif.el: Prefer #' to quote function names. (hif-eval): Use `lexical-binding`. (hif-ifx-regexp): Don't use `defconst` since `bovine/c.el` let-binds it. (hif--intern-safe): Rename from `intern-safe` to fix this namespace violation. (hif-strtok): Adjust accordingly. --- lisp/progmodes/hideif.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 71f55379d96..98e567299a1 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows the symbols within." (defun hif-after-revert-function () (and hide-ifdef-mode hide-ifdef-hiding (hide-ifdefs nil nil t))) -(add-hook 'after-revert-hook 'hif-after-revert-function) +(add-hook 'after-revert-hook #'hif-after-revert-function) (defun hif-end-of-line () "Find the end-point of line concatenation." @@ -474,7 +474,7 @@ Everything including these lines is made invisible." (defun hif-eval (form) "Evaluate hideif internal representation." - (let ((val (eval form))) + (let ((val (eval form t))) (if (stringp val) (or (get-text-property 0 'hif-value val) val) @@ -542,7 +542,7 @@ that form should be displayed.") (defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) +(defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) @@ -679,7 +679,7 @@ that form should be displayed.") ("..." . hif-etc) ("defined" . hif-defined))) -(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) +(defconst hif-valid-token-list (mapcar #'cdr hif-token-alist)) (defconst hif-token-regexp ;; The ordering of regexp grouping is crucial to `hif-strtok' @@ -690,7 +690,7 @@ that form should be displayed.") ;; decimal/octal: "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" hif-numtype-suffix-regexp "?\\)" - "\\|" (regexp-opt (mapcar 'car hif-token-alist) t) + "\\|" (regexp-opt (mapcar #'car hif-token-alist) t) "\\|\\(\\w+\\)")) ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") @@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." (t (setq hif-simple-token-only nil) - (intern-safe string))))) + (hif--intern-safe string))))) (defun hif-backward-comment (&optional start end) "If we're currently within a C(++) comment, skip them backwards." @@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters input." (t (error "Invalid token to stringify")))) -(defun intern-safe (str) +(defun hif--intern-safe (str) (if (stringp str) (intern str))) From b54db9c9ac7599fc84f108eb6f469e2af4834bed Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 14 Feb 2024 05:24:36 +0200 Subject: [PATCH 214/385] ; * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile): Fix typo. --- lisp/progmodes/elisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4e0e7552f8e..e0c18214ef7 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write--bytecode-file eln)))) + (comp--write-bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. From fa74c7f88a8f3216665ea386c5b6355e3660fb79 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 14 Feb 2024 09:20:48 +0200 Subject: [PATCH 215/385] Detect DEFUNs as outline-minor-mode headings in Emacs sources in c-ts-mode. * lisp/progmodes/c-ts-mode.el (c-ts-mode--outline-predicate): When c-ts-mode-emacs-sources-support is t, use c-ts-mode--emacs-defun-p (bug#68824). --- lisp/progmodes/c-ts-mode.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index c4b48f03d12..4ef17daf876 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -926,12 +926,12 @@ Return nil if NODE is not a defun node or doesn't have a name." (defun c-ts-mode--outline-predicate (node) "Match outlines on lines with function names." - (and (treesit-node-match-p - node "\\`function_declarator\\'" t) - (when-let ((parent (treesit-node-parent node))) - (treesit-node-match-p - parent - "\\`function_definition\\'" t)))) + (or (and (equal (treesit-node-type node) "function_declarator") + (equal (treesit-node-type (treesit-node-parent node)) + "function_definition")) + ;; DEFUNs in Emacs sources. + (and c-ts-mode-emacs-sources-support + (c-ts-mode--emacs-defun-p node)))) ;;; Defun navigation From decfdd4f1a1e3b1539eafdaaf11191e8477f0636 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= Date: Wed, 14 Feb 2024 08:54:04 +0100 Subject: [PATCH 216/385] Take file-local variables into account in elint-file (bug#69076) * lisp/emacs-lisp/elint.el (elint-file): Use hack-local-variables. --- lisp/emacs-lisp/elint.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index a8bc4bdd1e0..27c169cc657 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -266,6 +266,7 @@ This environment can be passed to `macroexpand'." (insert-file-contents file) (let ((buffer-file-name file) (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))) + (hack-local-variables) (with-syntax-table emacs-lisp-mode-syntax-table (mapc 'elint-top-form (elint-update-env))))) (elint-set-mode-line) From 3a93e301ddc913758abe05c876aa3016e8b23af8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 13 Feb 2024 14:52:39 +0100 Subject: [PATCH 217/385] String hashing improvements (spread and performance) Fix gaps in hashing coverage in the middle and end of even fairly short strings. E.g., `outline-1`, `outline-2` etc all hashed to the exact same value but with the patch, there are no collisions among the ~160000 symbols in the Emacs tree. This change also improves average hashing speed by using fewer mixing operations. * src/fns.c (hash_string): Use unit stride for fairly short strings, while retaining the cap of 8 samples for long ones. Always hash the last word to ensure that the end of the string is covered. For strings shorter than a word, use fewer loads and a single reduction step. --- src/fns.c | 49 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 37 insertions(+), 12 deletions(-) diff --git a/src/fns.c b/src/fns.c index 918ba0370e8..f94e8519957 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5069,24 +5069,49 @@ hash_string (char const *ptr, ptrdiff_t len) EMACS_UINT hash = len; /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, * but dividing by 8 is cheaper. */ - ptrdiff_t step = sizeof hash + ((end - p) >> 3); + ptrdiff_t step = max (sizeof hash, ((end - p) >> 3)); - while (p + sizeof hash <= end) + if (p + sizeof hash <= end) { + do + { + EMACS_UINT c; + /* We presume that the compiler will replace this `memcpy` with + a single load/move instruction when applicable. */ + memcpy (&c, p, sizeof hash); + p += step; + hash = sxhash_combine (hash, c); + } + while (p + sizeof hash <= end); + /* Hash the last wordful of bytes in the string, because that is + is often the part where strings differ. This may cause some + bytes to be hashed twice but we assume that's not a big problem. */ EMACS_UINT c; - /* We presume that the compiler will replace this `memcpy` with - a single load/move instruction when applicable. */ - memcpy (&c, p, sizeof hash); - p += step; + memcpy (&c, end - sizeof c, sizeof c); hash = sxhash_combine (hash, c); } - /* A few last bytes may remain (smaller than an EMACS_UINT). */ - /* FIXME: We could do this without a loop, but it'd require - endian-dependent code :-( */ - while (p < end) + else { - unsigned char c = *p++; - hash = sxhash_combine (hash, c); + /* String is shorter than an EMACS_UINT. Use smaller loads. */ + eassume (p <= end && end - p < sizeof (EMACS_UINT)); + EMACS_UINT tail = 0; + if (end - p >= 4) + { + uint32_t c; + memcpy (&c, p, sizeof c); + tail = (tail << (8 * sizeof c)) + c; + p += sizeof c; + } + if (end - p >= 2) + { + uint16_t c; + memcpy (&c, p, sizeof c); + tail = (tail << (8 * sizeof c)) + c; + p += sizeof c; + } + if (p < end) + tail = (tail << 8) + (unsigned char)*p; + hash = sxhash_combine (hash, tail); } return hash; From 0c7c8210cb6a87a06b61451d19f3601975569946 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 14 Feb 2024 17:27:43 +0100 Subject: [PATCH 218/385] Minor Tramp doc adaption * doc/misc/tramp.texi (Frequently Asked Questions): Be more precise with FIDO2 keys. * lisp/net/tramp.el: Adapt comments. --- doc/misc/tramp.texi | 4 ++-- lisp/net/tramp.el | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index db9cefbf966..0bed7dbe215 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5075,8 +5075,8 @@ the additional handshaking messages for them. This requires at least nitrokey, or titankey. @c @uref{https://docs.fedoraproject.org/en-US/quick-docs/using-yubikeys/} -@strong{Note} that there are reports on problems of handling yubikey -residential keys by @command{ssh-agent}. As workaround, you might +@strong{Note} that there are reports on problems of handling FIDO2 +(residential) keys by @command{ssh-agent}. As workaround, you might disable @command{ssh-agent} for such keys. @item diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f3da56e7a4f..9d883c96252 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -763,9 +763,8 @@ The regexp should match at end of buffer." ;; A security key requires the user physically to touch the device ;; with their finger. We must tell it to the user. -;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and -;; Titankey, which have also passed the tests, do not show such a -;; message. +;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and +;; Yubikey. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -788,6 +787,7 @@ The regexp should match at end of buffer." :version "28.1" :type 'regexp) +;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey. (defcustom tramp-security-key-pin-regexp (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n"))) "Regular expression matching security key PIN prompt. From 61a145076275a9da79d0372d50def4aaf5117587 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Tue, 30 Jan 2024 00:52:39 -0800 Subject: [PATCH 219/385] Improve directory prompt used by package-vc-checkout * lisp/emacs-lisp/package-vc.el (package-vc--read-package-name): Use read-directory-name instead of read-file-name. (Bug#66114) --- lisp/emacs-lisp/package-vc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index e89ead89d4b..5c5486de290 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -825,8 +825,8 @@ for the last released version of the package." (interactive (let* ((name (package-vc--read-package-name "Fetch package source: "))) (list (cadr (assoc name package-archive-contents #'string=)) - (read-file-name "Clone into new or empty directory: " nil nil t nil - (lambda (dir) (or (not (file-exists-p dir)) + (read-directory-name "Clone into new or empty directory: " nil nil + (lambda (dir) (or (not (file-exists-p dir)) (directory-empty-p dir)))) (and current-prefix-arg :last-release)))) (setf directory (expand-file-name directory)) From fbef8ff2a4106ff7f0f3d026071fb8096280cc61 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Feb 2024 17:18:50 -0500 Subject: [PATCH 220/385] titdic-cnv.el: Bring all definitions under the `tit-` namespace Add a `tit-` or `tit--` prefix where necessary. Adjust all callers. I kept the old names via obsolete aliases for now, although it's probably not worth the trouble. * lisp/international/titdic-cnv.el: Bring all definitions under the `tit-` namespace. (tit-quail-cxterm-package-ext-info): Rename var from `quail-cxterm-package-ext-info`. Adjust value to new names. (tit-dic-convert): Rename from `titdic-convert`. (batch-tit-dic-convert): Rename from `batch-titdic-convert`. (tit-quail-misc-package-ext-info): Rename var from `quail-misc-package-ext-info`. Adjust value to new names. (tit--tsang-quick-converter): Rename from `tsang-quick-converter`. (tit--tsang-b5-converter): Rename from `tsang-b5-converter`. (tit--quick-b5-converter): Rename from `quick-b5-converter`. (tit--tsang-cns-converter): Rename from `tsang-cns-converter`. (tit--quick-cns-converter): Rename from `quick-cns-converter`. (tit--py-converter): Rename from `py-converter`. (tit--ziranma-converter): Rename from `ziranma-converter`. (tit--ctlau-converter): Rename from `ctlau-converter`. (tit--ctlau-gb-converter): Rename from `ctlau-gb-converter`. (tit--ctlau-b5-converter): Rename from `ctlau-b5-converter`. (tit-miscdic-convert): Rename from `miscdic-convert`. (batch-tit-miscdic-convert): Rename from `batch-miscdic-convert`. (tit-pinyin-convert): Rename from `pinyin-convert`. * leim/Makefile.in (${leimdir}/quail/%.el, misc_convert) (${srcdir}/../lisp/language/pinyin.el): Use the new names. --- etc/NEWS | 5 ++ leim/Makefile.in | 6 +- lisp/international/titdic-cnv.el | 119 ++++++++++++++++++------------- 3 files changed, 79 insertions(+), 51 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index e6b1d424499..dc24d775bb1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -430,6 +430,11 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 +--- +** Titdic-cnv +Most of the variables and functions in the file have been renamed to +make sure they all use a 'tit-' namespace prefix. + --- ** Trace In batch mode, tracing now sends the trace to stdout. diff --git a/leim/Makefile.in b/leim/Makefile.in index f7a23178919..bc1eeb5e634 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -101,11 +101,11 @@ ${leimdir}/quail ${leimdir}/ja-dic: ## All of TIT_GB and TIT_BIG5. ${leimdir}/quail/%.el: ${srcdir}/CXTERM-DIC/%.tit $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv \ - -f batch-titdic-convert -dir ${leimdir}/quail $< + -f batch-tit-dic-convert -dir ${leimdir}/quail $< misc_convert = $(AM_V_GEN)${RUN_EMACS} \ - -l titdic-cnv -f batch-miscdic-convert -dir ${leimdir}/quail + -l titdic-cnv -f batch-tit-miscdic-convert -dir ${leimdir}/quail ## CTLau.el, CTLau-b5.el. ${leimdir}/quail/CT%.el: ${srcdir}/MISC-DIC/CT%.html @@ -148,7 +148,7 @@ ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L small-ja-dic-option -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map - $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@ + $(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f tit-pinyin-convert $< $@ .PHONY: bootstrap-clean distclean maintainer-clean gen-clean diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index c4706e061e3..42584f6548c 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -31,12 +31,12 @@ ;; Convert cxterm dictionary (of TIT format) to quail-package. ;; ;; Usage (within Emacs): -;; M-x titdic-convertCXTERM-DICTIONARY-NAME +;; M-x tit-dic-convertCXTERM-DICTIONARY-NAME ;; Usage (from shell): -;; % emacs -batch -l titdic-cnv -f batch-titdic-convert\ +;; % emacs -batch -l titdic-cnv -f batch-tit-dic-convert\ ;; [-dir DIR] [DIR | FILE] ... ;; -;; When you run titdic-convert within Emacs, you have a chance to +;; When you run `tit-dic-convert' within Emacs, you have a chance to ;; modify arguments of `quail-define-package' before saving the ;; converted file. For instance, you are likely to modify TITLE, ;; DOCSTRING, and KEY-BINDINGS. @@ -90,7 +90,8 @@ ;; \ is replaced by a description about ;; how to select a translation from a list of candidates. -(defvar quail-cxterm-package-ext-info +(define-obsolete-variable-alias 'quail-cxterm-package-ext-info 'tit-quail-cxterm-package-ext-info "30.1") +(defvar tit-quail-cxterm-package-ext-info '(("chinese-4corner" "四角") ("chinese-array30" "３０") ("chinese-ccdospy" "缩拼" @@ -277,7 +278,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (tit-moveleft ",<") (tit-keyprompt nil)) - (generate-lisp-file-heading filename 'titdic-convert :code nil) + (generate-lisp-file-heading filename 'tit-dic-convert :code nil) (princ ";; Quail package `") (princ package) (princ "\n") @@ -354,7 +355,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (princ "(quail-define-package ") ;; Args NAME, LANGUAGE, TITLE - (let ((title (nth 1 (assoc package quail-cxterm-package-ext-info)))) + (let ((title (nth 1 (assoc package tit-quail-cxterm-package-ext-info)))) (princ "\"") (princ package) (princ "\" \"") @@ -383,7 +384,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (let ((doc (concat tit-prompt "\n")) (comments (if tit-comments (mapconcat #'identity (nreverse tit-comments) "\n"))) - (doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info)))) + (doc-ext (nth 2 (assoc package tit-quail-cxterm-package-ext-info)))) (if comments (setq doc (concat doc "\n" comments "\n"))) (if doc-ext @@ -476,6 +477,9 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, ;;;###autoload (defun titdic-convert (filename &optional dirname) + (declare (obsolete tit-dic-convert "30.1")) + (tit-dic-convert filename dirname)) +(defun tit-dic-convert (filename &optional dirname) "Convert a TIT dictionary of FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." @@ -531,21 +535,24 @@ the generated Quail package is saved." ;;;###autoload (defun batch-titdic-convert (&optional force) - "Run `titdic-convert' on the files remaining on the command line. + (declare (obsolete batch-tit-dic-convert "30.1")) + (batch-tit-dic-convert force)) +(defun batch-tit-dic-convert (&optional force) + "Run `tit-dic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. -For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to +For example, invoke \"emacs -batch -f batch-tit-dic-convert XXX.tit\" to generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\". -To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." +To get complete usage, invoke \"emacs -batch -f batch-tit-dic-convert -h\"." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) - (error "`batch-titdic-convert' should be used only with -batch")) + (error "`batch-tit-dic-convert' should be used only with -batch")) (if (string= (car command-line-args-left) "-h") (progn (message "To convert XXX.tit and YYY.tit into xxx.el and yyy.el:") - (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert XXX.tit YYY.tit") + (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert XXX.tit YYY.tit") (message "To convert XXX.tit into DIR/xxx.el:") - (message " %% emacs -batch -l titdic-cnv -f batch-titdic-convert -dir DIR XXX.tit")) + (message " %% emacs -batch -l titdic-cnv -f batch-tit-dic-convert -dir DIR XXX.tit")) (let (targetdir filename files file) (if (string= (car command-line-args-left) "-dir") (progn @@ -564,7 +571,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (when (or force (file-newer-than-file-p file (tit-make-quail-package-file-name file targetdir))) - (titdic-convert file targetdir)) + (tit-dic-convert file targetdir)) (setq files (cdr files))) (setq command-line-args-left (cdr command-line-args-left))))) (kill-emacs 0)) @@ -583,10 +590,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; COPYRIGHT-NOTICE ;; Copyright notice of the source dictionary. ;; ) -(defvar quail-misc-package-ext-info +(define-obsolete-variable-alias 'quail-misc-package-ext-info 'tit-quail-misc-package-ext-info "30.1") +(defvar tit-quail-misc-package-ext-info '(("chinese-b5-tsangchi" "倉B" "cangjie-table.b5" big5 "tsang-b5.el" - tsang-b5-converter + tit--tsang-b5-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -596,7 +604,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-b5-quick" "簡B" "cangjie-table.b5" big5 "quick-b5.el" - quick-b5-converter + tit--quick-b5-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -606,7 +614,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-cns-tsangchi" "倉C" "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" - tsang-cns-converter + tit--tsang-cns-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -616,7 +624,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-cns-quick" "簡C" "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" - quick-cns-converter + tit--quick-cns-converter "\ ;; # Copyright 2001 Christian Wittern ;; # @@ -626,7 +634,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-py" "拼G" "pinyin.map" cn-gb-2312 "PY.el" - py-converter + tit--py-converter "\ ;; \"pinyin.map\" is included in a free package called CCE. It is ;; available at: [link needs updating -- SK 2021-09-27] @@ -654,7 +662,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ziranma" "自然" "ziranma.cin" cn-gb-2312 "ZIRANMA.el" - ziranma-converter + tit--ziranma-converter "\ ;; \"ziranma.cin\" is included in a free package called CCE. It is ;; available at: [link needs updating -- SK 2021-09-27] @@ -682,7 +690,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ctlau" "刘粤" "CTLau.html" cn-gb-2312 "CTLau.el" - ctlau-gb-converter + tit--ctlau-gb-converter "\ ;; \"CTLau.html\" is available at: ;; @@ -707,7 +715,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ("chinese-ctlaub" "劉粵" "CTLau-b5.html" big5 "CTLau-b5.el" - ctlau-b5-converter + tit--ctlau-b5-converter "\ ;; \"CTLau-b5.html\" is available at: ;; @@ -740,7 +748,8 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; input method is for inputting Big5 characters. Otherwise the input ;; method is for inputting CNS characters. -(defun tsang-quick-converter (dicbuf tsang-p big5-p) +(define-obsolete-function-alias 'tsang-quick-converter #'tit--tsang-quick-converter "30.1") +(defun tit--tsang-quick-converter (dicbuf tsang-p big5-p) (let ((fulltitle (if tsang-p "倉頡" "簡易")) dic) (goto-char (point-max)) @@ -822,23 +831,28 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (if big5-p (nth 1 elt) (nth 2 elt)))))) (insert ")\n"))) -(defun tsang-b5-converter (dicbuf) - (tsang-quick-converter dicbuf t t)) +(define-obsolete-function-alias 'tsang-b5-converter #'tit--tsang-b5-converter "30.1") +(defun tit--tsang-b5-converter (dicbuf) + (tit--tsang-quick-converter dicbuf t t)) -(defun quick-b5-converter (dicbuf) - (tsang-quick-converter dicbuf nil t)) +(define-obsolete-function-alias 'quick-b5-converter #'tit--quick-b5-converter "30.1") +(defun tit--quick-b5-converter (dicbuf) + (tit--tsang-quick-converter dicbuf nil t)) -(defun tsang-cns-converter (dicbuf) - (tsang-quick-converter dicbuf t nil)) +(define-obsolete-function-alias 'tsang-cns-converter #'tit--tsang-cns-converter "30.1") +(defun tit--tsang-cns-converter (dicbuf) + (tit--tsang-quick-converter dicbuf t nil)) -(defun quick-cns-converter (dicbuf) - (tsang-quick-converter dicbuf nil nil)) +(define-obsolete-function-alias 'quick-cns-converter #'tit--quick-cns-converter "30.1") +(defun tit--quick-cns-converter (dicbuf) + (tit--tsang-quick-converter dicbuf nil nil)) ;; Generate a code of a Quail package in the current buffer from ;; Pinyin dictionary in the buffer DICBUF. The input method name of ;; the Quail package is NAME, and the title string is TITLE. -(defun py-converter (dicbuf) +(define-obsolete-function-alias 'py-converter #'tit--py-converter "30.1") +(defun tit--py-converter (dicbuf) (goto-char (point-max)) (insert (format "%S\n" "汉字输入∷拼音∷ @@ -913,7 +927,8 @@ method `chinese-tonepy' with which you must specify tones by digits ;; Ziranma dictionary in the buffer DICBUF. The input method name of ;; the Quail package is NAME, and the title string is TITLE. -(defun ziranma-converter (dicbuf) +(define-obsolete-function-alias 'ziranma-converter #'tit--ziranma-converter "30.1") +(defun tit--ziranma-converter (dicbuf) (let (dic) (with-current-buffer dicbuf (goto-char (point-min)) @@ -1022,7 +1037,8 @@ To input symbols and punctuation, type `/' followed by one of `a' to ;; method name of the Quail package is NAME, and the title string is ;; TITLE. DESCRIPTION is the string shown by describe-input-method. -(defun ctlau-converter (dicbuf description) +(define-obsolete-function-alias 'ctlau-converter #'tit--ctlau-converter "30.1") +(defun tit--ctlau-converter (dicbuf description) (goto-char (point-max)) (insert (format "%S\n" description)) (insert " '((\"\C-?\" . quail-delete-last-char) @@ -1071,8 +1087,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to (forward-line 1))) (insert ")\n")) -(defun ctlau-gb-converter (dicbuf) - (ctlau-converter dicbuf +(define-obsolete-function-alias 'ctlau-gb-converter #'tit--ctlau-gb-converter "30.1") +(defun tit--ctlau-gb-converter (dicbuf) + (tit--ctlau-converter dicbuf "汉字输入∷刘锡祥式粤音∷ 刘锡祥式粤语注音方案 @@ -1085,8 +1102,9 @@ To input symbols and punctuation, type `/' followed by one of `a' to Some infrequent GB characters are accessed by typing \\, followed by the Cantonese romanization of the respective radical (部首).")) -(defun ctlau-b5-converter (dicbuf) - (ctlau-converter dicbuf +(define-obsolete-function-alias 'ctlau-b5-converter #'tit--ctlau-b5-converter "30.1") +(defun tit--ctlau-b5-converter (dicbuf) + (tit--ctlau-converter dicbuf "漢字輸入：劉錫祥式粵音： 劉錫祥式粵語注音方案 @@ -1101,14 +1119,15 @@ To input symbols and punctuation, type `/' followed by one of `a' to (declare-function dos-8+3-filename "dos-fns.el" (filename)) -(defun miscdic-convert (filename &optional dirname) +(define-obsolete-function-alias 'miscdic-convert #'tit-miscdic-convert "30.1") +(defun tit-miscdic-convert (filename &optional dirname) "Convert a dictionary file FILENAME into a Quail package. Optional argument DIRNAME if specified is the directory name under which the generated Quail package is saved." (interactive "FInput method dictionary file: ") (or (file-readable-p filename) (error "%s does not exist" filename)) - (let ((tail quail-misc-package-ext-info) + (let ((tail tit-quail-misc-package-ext-info) coding-system-for-write slot name title dicfile coding quailfile converter copyright) @@ -1137,7 +1156,7 @@ the generated Quail package is saved." ;; Explicitly set eol format to `unix'. (setq coding-system-for-write 'utf-8-unix) (with-temp-file (expand-file-name quailfile dirname) - (generate-lisp-file-heading quailfile 'miscdic-convert) + (generate-lisp-file-heading quailfile 'tit-miscdic-convert) (insert (format-message ";; Quail package `%s'\n" name)) (insert ";; Source dictionary file: " dicfile "\n") (insert ";; Copyright notice of the source file\n") @@ -1164,15 +1183,17 @@ the generated Quail package is saved." quailfile :inhibit-provide t :compile t :coding nil))) (setq tail (cdr tail))))) -(defun batch-miscdic-convert () - "Run `miscdic-convert' on the files remaining on the command line. +;; Used in `Makefile.in'. +(define-obsolete-function-alias 'batch-miscdic-convert #'batch-tit-miscdic-convert "30.1") +(defun batch-tit-miscdic-convert () + "Run `tit-miscdic-convert' on the files remaining on the command line. Use this from the command line, with `-batch'; it won't work in an interactive Emacs. If there's an argument \"-dir\", the next argument specifies a directory to store generated Quail packages." (defvar command-line-args-left) ; Avoid compiler warning. (if (not noninteractive) - (error "`batch-miscdic-convert' should be used only with -batch")) + (error "`batch-tit-miscdic-convert' should be used only with -batch")) (let ((dir default-directory) filename) (while command-line-args-left @@ -1186,11 +1207,13 @@ to store generated Quail packages." (if (file-directory-p filename) (dolist (file (directory-files filename t nil t)) (or (file-directory-p file) - (miscdic-convert file dir))) - (miscdic-convert filename dir)))) + (tit-miscdic-convert file dir))) + (tit-miscdic-convert filename dir)))) (kill-emacs 0)) -(defun pinyin-convert () +;; Used in `Makefile.in'. +(define-obsolete-function-alias 'pinyin-convert #'tit-pinyin-convert "30.1") +(defun tit-pinyin-convert () "Convert text file pinyin.map into an elisp library. The library is named pinyin.el, and contains the constant `pinyin-character-map'." From 1035669b38b5aa2aa277e7423837c80534332c19 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 15 Feb 2024 00:39:00 +0100 Subject: [PATCH 221/385] Add cross-reference to ELisp manual Caveats * doc/lispref/intro.texi (Caveats): Add cross-reference to Emacs manual. Talking about "contributing code" makes little sense in a section about reporting mistakes in the ELisp manual, so skip that part. --- doc/lispref/intro.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 2062ae64866..486125acb0d 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -89,9 +89,9 @@ you are criticizing. @cindex bugs @cindex suggestions -Please send comments and corrections using @kbd{M-x -report-emacs-bug}. If you wish to contribute new code (or send a -patch to fix a problem), use @kbd{M-x submit-emacs-patch}. +Please send comments and corrections using @kbd{M-x report-emacs-bug}. +For more details, @xref{Bugs,, Reporting Bugs, emacs, The GNU Emacs +Manual}. @node Lisp History @section Lisp History From 7256690a3ca4840e0f682a552d45321a1b710398 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 15 Feb 2024 00:51:05 +0100 Subject: [PATCH 222/385] * BUGS: Note how to report critical security issues. --- BUGS | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/BUGS b/BUGS index ee473213c89..f23faa7c756 100644 --- a/BUGS +++ b/BUGS @@ -21,6 +21,10 @@ If necessary, you can read the manual without an info program: cat info/emacs* | more "+/^File: emacs.*, Node: Bugs," +If you think you may have found a critical security issue that needs +to be communicated privately, please contact the GNU Emacs maintainers +directly. See admin/MAINTAINERS for their contact details. + Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to make sure it isn't a known issue. From 7c32f3bcd6d390510d9463b3100255cecab41e1c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 14 Feb 2024 21:18:25 -0800 Subject: [PATCH 223/385] Adjust to recent Gnulib nstrftime changes * admin/merge-gnulib (AVOIDED_MODULES): Add localename. * configure.ac (REQUIRE_GNUISH_STRFTIME_AM_PM): Define. --- admin/merge-gnulib | 2 +- configure.ac | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 5246fb14e1e..35966852e27 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -53,7 +53,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' access btowc chmod close crypto/af_alg dup fchdir fstat - iswblank iswctype iswdigit iswxdigit langinfo lock + iswblank iswctype iswdigit iswxdigit langinfo localename lock mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir pthread-h raise save-cwd select setenv sigprocmask stat stdarg diff --git a/configure.ac b/configure.ac index 847fdbd54d2..c162f880e48 100644 --- a/configure.ac +++ b/configure.ac @@ -1566,6 +1566,8 @@ AC_DEFUN([gt_TYPE_WINT_T], AC_DEFUN_ONCE([gl_STDLIB_H], [AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) gl_NEXT_HEADERS([stdlib.h])]) +AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], [false], + [Emacs does not need glibc strftime behavior for AM and PM indicators.]) # Initialize gnulib right after choosing the compiler. dnl Amongst other things, this sets AR and ARFLAGS. From 377e4212e9df293ba2021238bae2bdccf5c8b8d3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 14 Feb 2024 21:18:25 -0800 Subject: [PATCH 224/385] Update from Gnulib by running admin/merge-gnulib * lib/strftime.c: New file, copied from Gnulib. --- doc/misc/texinfo.tex | 37 +- lib/gnulib.mk.in | 5 +- lib/limits.in.h | 2 +- lib/nstrftime.c | 1501 +---------------------------- lib/strftime.c | 2051 ++++++++++++++++++++++++++++++++++++++++ lib/strftime.h | 71 +- lib/time.in.h | 6 +- lib/time_r.c | 5 + lib/warn-on-use.h | 4 + lib/xalloc-oversized.h | 3 +- m4/gnulib-common.m4 | 76 +- m4/gnulib-comp.m4 | 3 +- m4/nanosleep.m4 | 6 +- m4/nstrftime.m4 | 5 +- m4/utimens.m4 | 15 +- m4/utimensat.m4 | 5 +- 16 files changed, 2210 insertions(+), 1585 deletions(-) create mode 100644 lib/strftime.c diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index e8c382f5967..93d592193a0 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2023-09-19.19} +\def\texinfoversion{2024-02-10.22} % -% Copyright 1985, 1986, 1988, 1990-2023 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2024 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -5238,14 +5238,14 @@ % the current value of \escapechar. \def\escapeisbackslash{\escapechar=`\\} -% Use \ in index files by default. texi2dvi didn't support @ as the escape -% character (as it checked for "\entry" in the files, and not "@entry"). When -% the new version of texi2dvi has had a chance to become more prevalent, then -% the escape character can change back to @ again. This should be an easy -% change to make now because both @ and \ are only used as escape characters in -% index files, never standing for themselves. +% Uncomment to use \ in index files by default. Old texi2dvi (before 2019) +% didn't support @ as the escape character (as it checked for "\entry" in +% the files, and not "@entry"). +% In the future we can remove this flag and simplify the code for +% index files and backslashes, once the support is no longer likely to be +% useful. % -\set txiindexescapeisbackslash +% \set txiindexescapeisbackslash % Write the entry in \indextext to the index file. % @@ -6137,8 +6137,7 @@ % normally unnmhead0 calls unnumberedzzz: \outer\parseargdef\unnumbered{\unnmhead0{#1}} \def\unnumberedzzz#1{% - \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 - \global\advance\unnumberedno by 1 + \global\advance\unnumberedno by 1 % % Since an unnumbered has no number, no prefix for figures. \global\let\chaplevelprefix = \empty @@ -6194,8 +6193,8 @@ % normally calls unnumberedseczzz: \outer\parseargdef\unnumberedsec{\unnmhead1{#1}} \def\unnumberedseczzz#1{% - \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 - \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}% + \global\advance\unnumberedno by 1 + \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno}% } % Subsections. @@ -6218,9 +6217,8 @@ % normally calls unnumberedsubseczzz: \outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} \def\unnumberedsubseczzz#1{% - \global\subsubsecno=0 \global\advance\subsecno by 1 - \sectionheading{#1}{subsec}{Ynothing}% - {\the\unnumberedno.\the\secno.\the\subsecno}% + \global\advance\unnumberedno by 1 + \sectionheading{#1}{subsec}{Ynothing}{\the\unnumberedno}% } % Subsubsections. @@ -6244,9 +6242,8 @@ % normally unnumberedsubsubseczzz: \outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} \def\unnumberedsubsubseczzz#1{% - \global\advance\subsubsecno by 1 - \sectionheading{#1}{subsubsec}{Ynothing}% - {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}% + \global\advance\unnumberedno by 1 + \sectionheading{#1}{subsubsec}{Ynothing}{\the\unnumberedno}% } % These macros control what the section commands do, according @@ -8205,8 +8202,6 @@ \let\commondummyword\unmacrodo \xdef\macrolist{\macrolist}% \endgroup - \else - \errmessage{Macro #1 not defined}% \fi } diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e10aab5fc8d..9970f7810e2 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -47,6 +47,7 @@ # --avoid=iswdigit \ # --avoid=iswxdigit \ # --avoid=langinfo \ +# --avoid=localename \ # --avoid=lock \ # --avoid=mbrtowc \ # --avoid=mbsinit \ @@ -2745,7 +2746,9 @@ ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) libgnu_a_SOURCES += nstrftime.c -EXTRA_DIST += strftime.h +EXTRA_DIST += strftime.c strftime.h + +EXTRA_libgnu_a_SOURCES += strftime.c endif ## end gnulib module nstrftime diff --git a/lib/limits.in.h b/lib/limits.in.h index 236fc58e525..c65eb4c1cfe 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -130,7 +130,7 @@ # define BOOL_WIDTH 1 # define BOOL_MAX 1 # elif ! defined BOOL_MAX -# define BOOL_MAX ((((1U << (BOOL_WIDTH - 1)) - 1) << 1) + 1) +# define BOOL_MAX 1 # endif #endif diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 69e4164dc0c..88490064297 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -1,5 +1,6 @@ -/* Copyright (C) 1991-2024 Free Software Foundation, Inc. - This file is part of the GNU C Library. +/* Generate time strings. + + Copyright (C) 2024 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as @@ -14,1497 +15,5 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see . */ -#ifdef _LIBC -# define USE_IN_EXTENDED_LOCALE_MODEL 1 -# define HAVE_STRUCT_ERA_ENTRY 1 -# define HAVE_TM_GMTOFF 1 -# define HAVE_STRUCT_TM_TM_ZONE 1 -# define HAVE_TZNAME 1 -# include "../locale/localeinfo.h" -#else -# include -# if FPRINTFTIME -# include "fprintftime.h" -# else -# include "strftime.h" -# endif -# include "time-internal.h" -#endif - -#include -#include -#include - -#if HAVE_TZNAME && !HAVE_DECL_TZNAME -extern char *tzname[]; -#endif - -/* Do multibyte processing if multibyte encodings are supported, unless - multibyte sequences are safe in formats. Multibyte sequences are - safe if they cannot contain byte sequences that look like format - conversion specifications. The multibyte encodings used by the - C library on the various platforms (UTF-8, GB2312, GBK, CP936, - GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949, - SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%' - cannot occur in a multibyte character except in the first byte. - - The DEC-HANYU encoding used on OSF/1 is not safe for formats, but - this encoding has never been seen in real-life use, so we ignore - it. */ -#if !(defined __osf__ && 0) -# define MULTIBYTE_IS_FORMAT_SAFE 1 -#endif -#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE) - -#if DO_MULTIBYTE -# include - static const mbstate_t mbstate_zero; -#endif - -#include -#include -#include -#include -#include - -#include "attribute.h" -#include - -#ifdef COMPILE_WIDE -# include -# define CHAR_T wchar_t -# define UCHAR_T unsigned int -# define L_(Str) L##Str -# define NLW(Sym) _NL_W##Sym - -# define MEMCPY(d, s, n) __wmemcpy (d, s, n) -# define STRLEN(s) __wcslen (s) - -#else -# define CHAR_T char -# define UCHAR_T unsigned char -# define L_(Str) Str -# define NLW(Sym) Sym -# define ABALTMON_1 _NL_ABALTMON_1 - -# define MEMCPY(d, s, n) memcpy (d, s, n) -# define STRLEN(s) strlen (s) - -#endif - -/* Shift A right by B bits portably, by dividing A by 2**B and - truncating towards minus infinity. A and B should be free of side - effects, and B should be in the range 0 <= B <= INT_BITS - 2, where - INT_BITS is the number of useful bits in an int. GNU code can - assume that INT_BITS is at least 32. - - ISO C99 says that A >> B is implementation-defined if A < 0. Some - implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift - right in the usual way when A < 0, so SHR falls back on division if - ordinary A >> B doesn't seem to be the usual signed shift. */ -#define SHR(a, b) \ - (-1 >> 1 == -1 \ - ? (a) >> (b) \ - : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) - -#define TM_YEAR_BASE 1900 - -#ifndef __isleap -/* Nonzero if YEAR is a leap year (every 4 years, - except every 100th isn't, and every 400th is). */ -# define __isleap(year) \ - ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) -#endif - - -#ifdef _LIBC -# define mktime_z(tz, tm) mktime (tm) -# define tzname __tzname -# define tzset __tzset -#endif - -#ifndef FPRINTFTIME -# define FPRINTFTIME 0 -#endif - -#if FPRINTFTIME -# define STREAM_OR_CHAR_T FILE -# define STRFTIME_ARG(x) /* empty */ -#else -# define STREAM_OR_CHAR_T CHAR_T -# define STRFTIME_ARG(x) x, -#endif - -#if FPRINTFTIME -# define memset_byte(P, Len, Byte) \ - do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) -# define memset_space(P, Len) memset_byte (P, Len, ' ') -# define memset_zero(P, Len) memset_byte (P, Len, '0') -#elif defined COMPILE_WIDE -# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) -# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) -#else -# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) -# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) -#endif - -#if FPRINTFTIME -# define advance(P, N) -#else -# define advance(P, N) ((P) += (N)) -#endif - -#define add(n, f) width_add (width, n, f) -#define width_add(width, n, f) \ - do \ - { \ - size_t _n = (n); \ - size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ - size_t _incr = _n < _w ? _w : _n; \ - if (_incr >= maxsize - i) \ - { \ - errno = ERANGE; \ - return 0; \ - } \ - if (p) \ - { \ - if (_n < _w) \ - { \ - size_t _delta = _w - _n; \ - if (pad == L_('0') || pad == L_('+')) \ - memset_zero (p, _delta); \ - else \ - memset_space (p, _delta); \ - } \ - f; \ - advance (p, _n); \ - } \ - i += _incr; \ - } while (0) - -#define add1(c) width_add1 (width, c) -#if FPRINTFTIME -# define width_add1(width, c) width_add (width, 1, fputc (c, p)) -#else -# define width_add1(width, c) width_add (width, 1, *p = c) -#endif - -#define cpy(n, s) width_cpy (width, n, s) -#if FPRINTFTIME -# define width_cpy(width, n, s) \ - width_add (width, n, \ - do \ - { \ - if (to_lowcase) \ - fwrite_lowcase (p, (s), _n); \ - else if (to_uppcase) \ - fwrite_uppcase (p, (s), _n); \ - else \ - { \ - /* Ignore the value of fwrite. The caller can determine whether \ - an error occurred by inspecting ferror (P). All known fwrite \ - implementations set the stream's error indicator when they \ - fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ - not require this. */ \ - fwrite (s, _n, 1, p); \ - } \ - } \ - while (0) \ - ) -#else -# define width_cpy(width, n, s) \ - width_add (width, n, \ - if (to_lowcase) \ - memcpy_lowcase (p, (s), _n LOCALE_ARG); \ - else if (to_uppcase) \ - memcpy_uppcase (p, (s), _n LOCALE_ARG); \ - else \ - MEMCPY ((void *) p, (void const *) (s), _n)) -#endif - -#ifdef COMPILE_WIDE -# ifndef USE_IN_EXTENDED_LOCALE_MODEL -# undef __mbsrtowcs_l -# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) -# endif -#endif - - -#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL -/* We use this code also for the extended locale handling where the - function gets as an additional argument the locale which has to be - used. To access the values we have to redefine the _NL_CURRENT - macro. */ -# define strftime __strftime_l -# define wcsftime __wcsftime_l -# undef _NL_CURRENT -# define _NL_CURRENT(category, item) \ - (current->values[_NL_ITEM_INDEX (item)].string) -# define LOCALE_PARAM , locale_t loc -# define LOCALE_ARG , loc -# define HELPER_LOCALE_ARG , current -#else -# define LOCALE_PARAM -# define LOCALE_ARG -# ifdef _LIBC -# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) -# else -# define HELPER_LOCALE_ARG -# endif -#endif - -#ifdef COMPILE_WIDE -# ifdef USE_IN_EXTENDED_LOCALE_MODEL -# define TOUPPER(Ch, L) __towupper_l (Ch, L) -# define TOLOWER(Ch, L) __towlower_l (Ch, L) -# else -# define TOUPPER(Ch, L) towupper (Ch) -# define TOLOWER(Ch, L) towlower (Ch) -# endif -#else -# ifdef USE_IN_EXTENDED_LOCALE_MODEL -# define TOUPPER(Ch, L) __toupper_l (Ch, L) -# define TOLOWER(Ch, L) __tolower_l (Ch, L) -# else -# define TOUPPER(Ch, L) toupper (Ch) -# define TOLOWER(Ch, L) tolower (Ch) -# endif -#endif -/* We don't use 'isdigit' here since the locale dependent - interpretation is not what we want here. We only need to accept - the arabic digits in the ASCII range. One day there is perhaps a - more reliable way to accept other sets of digits. */ -#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) - -/* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds - maximum object size 9223372036854775807", caused by insufficient data flow - analysis and value propagation of the 'width_add' expansion when GCC is not - optimizing. Cf. . */ -#if __GNUC__ >= 7 && !__OPTIMIZE__ -# pragma GCC diagnostic ignored "-Wstringop-overflow" -#endif - -#if FPRINTFTIME -static void -fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) -{ - while (len-- > 0) - { - fputc (TOLOWER ((UCHAR_T) *src, loc), fp); - ++src; - } -} - -static void -fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) -{ - while (len-- > 0) - { - fputc (TOUPPER ((UCHAR_T) *src, loc), fp); - ++src; - } -} -#else -static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, - size_t len LOCALE_PARAM); - -static CHAR_T * -memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) -{ - while (len-- > 0) - dest[len] = TOLOWER ((UCHAR_T) src[len], loc); - return dest; -} - -static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, - size_t len LOCALE_PARAM); - -static CHAR_T * -memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) -{ - while (len-- > 0) - dest[len] = TOUPPER ((UCHAR_T) src[len], loc); - return dest; -} -#endif - - -#if ! HAVE_TM_GMTOFF -/* Yield the difference between *A and *B, - measured in seconds, ignoring leap seconds. */ -# define tm_diff ftime_tm_diff -static int tm_diff (const struct tm *, const struct tm *); -static int -tm_diff (const struct tm *a, const struct tm *b) -{ - /* Compute intervening leap days correctly even if year is negative. - Take care to avoid int overflow in leap day calculations, - but it's OK to assume that A and B are close to each other. */ - int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); - int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); - int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); - int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); - int a400 = SHR (a100, 2); - int b400 = SHR (b100, 2); - int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); - int years = a->tm_year - b->tm_year; - int days = (365 * years + intervening_leap_days - + (a->tm_yday - b->tm_yday)); - return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) - + (a->tm_min - b->tm_min)) - + (a->tm_sec - b->tm_sec)); -} -#endif /* ! HAVE_TM_GMTOFF */ - - - -/* The number of days from the first day of the first ISO week of this - year to the year day YDAY with week day WDAY. ISO weeks start on - Monday; the first ISO week has the year's first Thursday. YDAY may - be as small as YDAY_MINIMUM. */ -#define ISO_WEEK_START_WDAY 1 /* Monday */ -#define ISO_WEEK1_WDAY 4 /* Thursday */ -#define YDAY_MINIMUM (-366) -static int iso_week_days (int, int); -static __inline int -iso_week_days (int yday, int wday) -{ - /* Add enough to the first operand of % to make it nonnegative. */ - int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; - return (yday - - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 - + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); -} - - -/* When compiling this file, GNU applications can #define my_strftime - to a symbol (typically nstrftime) to get an extended strftime with - extra arguments TZ and NS. */ - -#if FPRINTFTIME -# undef my_strftime -# define my_strftime fprintftime -#endif - -#ifdef my_strftime -# define extra_args , tz, ns -# define extra_args_spec , timezone_t tz, int ns -#else -# if defined COMPILE_WIDE -# define my_strftime wcsftime -# define nl_get_alt_digit _nl_get_walt_digit -# else -# define my_strftime strftime -# define nl_get_alt_digit _nl_get_alt_digit -# endif -# define extra_args -# define extra_args_spec -/* We don't have this information in general. */ -# define tz 1 -# define ns 0 -#endif - -static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) - const CHAR_T *, const struct tm *, - bool, int, int, bool * - extra_args_spec LOCALE_PARAM); - -/* Write information from TP into S according to the format - string FORMAT, writing no more that MAXSIZE characters - (including the terminating '\0') and returning number of - characters written. If S is NULL, nothing will be written - anywhere, so to determine how many characters would be - written, use NULL for S and (size_t) -1 for MAXSIZE. */ -size_t -my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) - const CHAR_T *format, - const struct tm *tp extra_args_spec LOCALE_PARAM) -{ - bool tzset_called = false; - return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false, - 0, -1, &tzset_called extra_args LOCALE_ARG); -} -libc_hidden_def (my_strftime) - -/* Just like my_strftime, above, but with more parameters. - UPCASE indicates that the result should be converted to upper case. - YR_SPEC and WIDTH specify the padding and width for the year. - *TZSET_CALLED indicates whether tzset has been called here. */ -static size_t -__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) - const CHAR_T *format, - const struct tm *tp, bool upcase, - int yr_spec, int width, bool *tzset_called - extra_args_spec LOCALE_PARAM) -{ -#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL - struct __locale_data *const current = loc->__locales[LC_TIME]; -#endif -#if FPRINTFTIME - size_t maxsize = (size_t) -1; -#endif - - int saved_errno = errno; - int hour12 = tp->tm_hour; -#ifdef _NL_CURRENT - /* We cannot make the following values variables since we must delay - the evaluation of these values until really needed since some - expressions might not be valid in every situation. The 'struct tm' - might be generated by a strptime() call that initialized - only a few elements. Dereference the pointers only if the format - requires this. Then it is ok to fail if the pointers are invalid. */ -# define a_wkday \ - ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday))) -# define f_wkday \ - ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday))) -# define a_month \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon))) -# define f_month \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon))) -# define a_altmonth \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon))) -# define f_altmonth \ - ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ - ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon))) -# define ampm \ - ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ - ? NLW(PM_STR) : NLW(AM_STR))) - -# define aw_len STRLEN (a_wkday) -# define am_len STRLEN (a_month) -# define aam_len STRLEN (a_altmonth) -# define ap_len STRLEN (ampm) -#endif -#if HAVE_TZNAME - char **tzname_vec = tzname; -#endif - const char *zone; - size_t i = 0; - STREAM_OR_CHAR_T *p = s; - const CHAR_T *f; -#if DO_MULTIBYTE && !defined COMPILE_WIDE - const char *format_end = NULL; -#endif - - zone = NULL; -#if HAVE_STRUCT_TM_TM_ZONE - /* The POSIX test suite assumes that setting - the environment variable TZ to a new value before calling strftime() - will influence the result (the %Z format) even if the information in - TP is computed with a totally different time zone. - This is bogus: though POSIX allows bad behavior like this, - POSIX does not require it. Do the right thing instead. */ - zone = (const char *) tp->tm_zone; -#endif -#if HAVE_TZNAME - if (!tz) - { - if (! (zone && *zone)) - zone = "GMT"; - } - else - { -# if !HAVE_STRUCT_TM_TM_ZONE - /* Infer the zone name from *TZ instead of from TZNAME. */ - tzname_vec = tz->tzname_copy; -# endif - } - /* The tzset() call might have changed the value. */ - if (!(zone && *zone) && tp->tm_isdst >= 0) - { - /* POSIX.1 requires that local time zone information be used as - though strftime called tzset. */ -# ifndef my_strftime - if (!*tzset_called) - { - tzset (); - *tzset_called = true; - } -# endif - zone = tzname_vec[tp->tm_isdst != 0]; - } -#endif - if (! zone) - zone = ""; - - if (hour12 > 12) - hour12 -= 12; - else - if (hour12 == 0) - hour12 = 12; - - for (f = format; *f != '\0'; width = -1, f++) - { - int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */ - int modifier; /* Field modifier ('E', 'O', or 0). */ - int digits = 0; /* Max digits for numeric format. */ - int number_value; /* Numeric value to be printed. */ - unsigned int u_number_value; /* (unsigned int) number_value. */ - bool negative_number; /* The number is negative. */ - bool always_output_a_sign; /* +/- should always be output. */ - int tz_colon_mask; /* Bitmask of where ':' should appear. */ - const CHAR_T *subfmt; - CHAR_T *bufp; - CHAR_T buf[1 - + 2 /* for the two colons in a %::z or %:::z time zone */ - + (sizeof (int) < sizeof (time_t) - ? INT_STRLEN_BOUND (time_t) - : INT_STRLEN_BOUND (int))]; - bool to_lowcase = false; - bool to_uppcase = upcase; - size_t colons; - bool change_case = false; - int format_char; - int subwidth; - -#if DO_MULTIBYTE && !defined COMPILE_WIDE - switch (*f) - { - case L_('%'): - break; - - case L_('\b'): case L_('\t'): case L_('\n'): - case L_('\v'): case L_('\f'): case L_('\r'): - case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): - case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): - case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): - case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): - case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): - case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): - case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): - case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): - case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): - case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): - case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): - case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): - case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): - case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): - case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): - case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): - case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): - case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): - case L_('~'): - /* The C Standard requires these 98 characters (plus '%') to - be in the basic execution character set. None of these - characters can start a multibyte sequence, so they need - not be analyzed further. */ - add1 (*f); - continue; - - default: - /* Copy this multibyte sequence until we reach its end, find - an error, or come back to the initial shift state. */ - { - mbstate_t mbstate = mbstate_zero; - size_t len = 0; - size_t fsize; - - if (! format_end) - format_end = f + strlen (f) + 1; - fsize = format_end - f; - - do - { - size_t bytes = mbrlen (f + len, fsize - len, &mbstate); - - if (bytes == 0) - break; - - if (bytes == (size_t) -2) - { - len += strlen (f + len); - break; - } - - if (bytes == (size_t) -1) - { - len++; - break; - } - - len += bytes; - } - while (! mbsinit (&mbstate)); - - cpy (len, f); - f += len - 1; - continue; - } - } - -#else /* ! DO_MULTIBYTE */ - - /* Either multibyte encodings are not supported, they are - safe for formats, so any non-'%' byte can be copied through, - or this is the wide character version. */ - if (*f != L_('%')) - { - add1 (*f); - continue; - } - -#endif /* ! DO_MULTIBYTE */ - - char const *percent = f; - - /* Check for flags that can modify a format. */ - while (1) - { - switch (*++f) - { - /* This influences the number formats. */ - case L_('_'): - case L_('-'): - case L_('+'): - case L_('0'): - pad = *f; - continue; - - /* This changes textual output. */ - case L_('^'): - to_uppcase = true; - continue; - case L_('#'): - change_case = true; - continue; - - default: - break; - } - break; - } - - if (ISDIGIT (*f)) - { - width = 0; - do - { - if (ckd_mul (&width, width, 10) - || ckd_add (&width, width, *f - L_('0'))) - width = INT_MAX; - ++f; - } - while (ISDIGIT (*f)); - } - - /* Check for modifiers. */ - switch (*f) - { - case L_('E'): - case L_('O'): - modifier = *f++; - break; - - default: - modifier = 0; - break; - } - - /* Now do the specified format. */ - format_char = *f; - switch (format_char) - { -#define DO_NUMBER(d, v) \ - do \ - { \ - digits = d; \ - number_value = v; \ - goto do_number; \ - } \ - while (0) -#define DO_SIGNED_NUMBER(d, negative, v) \ - DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number) -#define DO_YEARISH(d, negative, v) \ - DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish) -#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \ - do \ - { \ - digits = d; \ - negative_number = negative; \ - u_number_value = v; \ - goto label; \ - } \ - while (0) - - /* The mask is not what you might think. - When the ordinal i'th bit is set, insert a colon - before the i'th digit of the time zone representation. */ -#define DO_TZ_OFFSET(d, mask, v) \ - do \ - { \ - digits = d; \ - tz_colon_mask = mask; \ - u_number_value = v; \ - goto do_tz_offset; \ - } \ - while (0) -#define DO_NUMBER_SPACEPAD(d, v) \ - do \ - { \ - digits = d; \ - number_value = v; \ - goto do_number_spacepad; \ - } \ - while (0) - - case L_('%'): - if (f - 1 != percent) - goto bad_percent; - add1 (*f); - break; - - case L_('a'): - if (modifier != 0) - goto bad_format; - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } -#ifdef _NL_CURRENT - cpy (aw_len, a_wkday); - break; -#else - goto underlying_strftime; -#endif - - case 'A': - if (modifier != 0) - goto bad_format; - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } -#ifdef _NL_CURRENT - cpy (STRLEN (f_wkday), f_wkday); - break; -#else - goto underlying_strftime; -#endif - - case L_('b'): - case L_('h'): - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } - if (modifier == L_('E')) - goto bad_format; -#ifdef _NL_CURRENT - if (modifier == L_('O')) - cpy (aam_len, a_altmonth); - else - cpy (am_len, a_month); - break; -#else - goto underlying_strftime; -#endif - - case L_('B'): - if (modifier == L_('E')) - goto bad_format; - if (change_case) - { - to_uppcase = true; - to_lowcase = false; - } -#ifdef _NL_CURRENT - if (modifier == L_('O')) - cpy (STRLEN (f_altmonth), f_altmonth); - else - cpy (STRLEN (f_month), f_month); - break; -#else - goto underlying_strftime; -#endif - - case L_('c'): - if (modifier == L_('O')) - goto bad_format; -#ifdef _NL_CURRENT - if (! (modifier == L_('E') - && (*(subfmt = - (const CHAR_T *) _NL_CURRENT (LC_TIME, - NLW(ERA_D_T_FMT))) - != '\0'))) - subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); -#else - goto underlying_strftime; -#endif - - subformat: - subwidth = -1; - subformat_width: - { - size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) - subfmt, tp, to_uppcase, - pad, subwidth, tzset_called - extra_args LOCALE_ARG); - add (len, __strftime_internal (p, - STRFTIME_ARG (maxsize - i) - subfmt, tp, to_uppcase, - pad, subwidth, tzset_called - extra_args LOCALE_ARG)); - } - break; - -#if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) - underlying_strftime: - { - /* The relevant information is available only via the - underlying strftime implementation, so use that. */ - char ufmt[5]; - char *u = ufmt; - char ubuf[1024]; /* enough for any single format in practice */ - size_t len; - /* Make sure we're calling the actual underlying strftime. - In some cases, config.h contains something like - "#define strftime rpl_strftime". */ -# ifdef strftime -# undef strftime - size_t strftime (); -# endif - - /* The space helps distinguish strftime failure from empty - output. */ - *u++ = ' '; - *u++ = '%'; - if (modifier != 0) - *u++ = modifier; - *u++ = format_char; - *u = '\0'; - len = strftime (ubuf, sizeof ubuf, ufmt, tp); - if (len != 0) - cpy (len - 1, ubuf + 1); - } - break; -#endif - - case L_('C'): - if (modifier == L_('E')) - { -#if HAVE_STRUCT_ERA_ENTRY - struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); - if (era) - { -# ifdef COMPILE_WIDE - size_t len = __wcslen (era->era_wname); - cpy (len, era->era_wname); -# else - size_t len = strlen (era->era_name); - cpy (len, era->era_name); -# endif - break; - } -#else - goto underlying_strftime; -#endif - } - - { - bool negative_year = tp->tm_year < - TM_YEAR_BASE; - bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); - int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 - + TM_YEAR_BASE / 100); - DO_YEARISH (2, negative_year, century); - } - - case L_('x'): - if (modifier == L_('O')) - goto bad_format; -#ifdef _NL_CURRENT - if (! (modifier == L_('E') - && (*(subfmt = - (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) - != L_('\0')))) - subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); - goto subformat; -#else - goto underlying_strftime; -#endif - case L_('D'): - if (modifier != 0) - goto bad_format; - subfmt = L_("%m/%d/%y"); - goto subformat; - - case L_('d'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_mday); - - case L_('e'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER_SPACEPAD (2, tp->tm_mday); - - /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) - and then jump to one of these labels. */ - - do_tz_offset: - always_output_a_sign = true; - goto do_number_body; - - do_yearish: - if (pad == 0) - pad = yr_spec; - always_output_a_sign - = (pad == L_('+') - && ((digits == 2 ? 99 : 9999) < u_number_value - || digits < width)); - goto do_maybe_signed_number; - - do_number_spacepad: - if (pad == 0) - pad = L_('_'); - - do_number: - /* Format NUMBER_VALUE according to the MODIFIER flag. */ - negative_number = number_value < 0; - u_number_value = number_value; - - do_signed_number: - always_output_a_sign = false; - - do_maybe_signed_number: - tz_colon_mask = 0; - - do_number_body: - /* Format U_NUMBER_VALUE according to the MODIFIER flag. - NEGATIVE_NUMBER is nonzero if the original number was - negative; in this case it was converted directly to - unsigned int (i.e., modulo (UINT_MAX + 1)) without - negating it. */ - if (modifier == L_('O') && !negative_number) - { -#ifdef _NL_CURRENT - /* Get the locale specific alternate representation of - the number. If none exist NULL is returned. */ - const CHAR_T *cp = nl_get_alt_digit (u_number_value - HELPER_LOCALE_ARG); - - if (cp != NULL) - { - size_t digitlen = STRLEN (cp); - if (digitlen != 0) - { - cpy (digitlen, cp); - break; - } - } -#else - goto underlying_strftime; -#endif - } - - bufp = buf + sizeof (buf) / sizeof (buf[0]); - - if (negative_number) - u_number_value = - u_number_value; - - do - { - if (tz_colon_mask & 1) - *--bufp = ':'; - tz_colon_mask >>= 1; - *--bufp = u_number_value % 10 + L_('0'); - u_number_value /= 10; - } - while (u_number_value != 0 || tz_colon_mask != 0); - - do_number_sign_and_padding: - if (pad == 0) - pad = L_('0'); - if (width < 0) - width = digits; - - { - CHAR_T sign_char = (negative_number ? L_('-') - : always_output_a_sign ? L_('+') - : 0); - int numlen = buf + sizeof buf / sizeof buf[0] - bufp; - int shortage = width - !!sign_char - numlen; - int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage; - - if (sign_char) - { - if (pad == L_('_')) - { - if (p) - memset_space (p, padding); - i += padding; - width -= padding; - } - width_add1 (0, sign_char); - width--; - } - - cpy (numlen, bufp); - } - break; - - case L_('F'): - if (modifier != 0) - goto bad_format; - if (pad == 0 && width < 0) - { - pad = L_('+'); - subwidth = 4; - } - else - { - subwidth = width - 6; - if (subwidth < 0) - subwidth = 0; - } - subfmt = L_("%Y-%m-%d"); - goto subformat_width; - - case L_('H'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_hour); - - case L_('I'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, hour12); - - case L_('k'): /* GNU extension. */ - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER_SPACEPAD (2, tp->tm_hour); - - case L_('l'): /* GNU extension. */ - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER_SPACEPAD (2, hour12); - - case L_('j'): - if (modifier == L_('E')) - goto bad_format; - - DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); - - case L_('M'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_min); - - case L_('m'): - if (modifier == L_('E')) - goto bad_format; - - DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); - -#ifndef _LIBC - case L_('N'): /* GNU extension. */ - if (modifier == L_('E')) - goto bad_format; - { - int n = ns, ns_digits = 9; - if (width <= 0) - width = ns_digits; - int ndigs = ns_digits; - while (width < ndigs || (1 < ndigs && n % 10 == 0)) - ndigs--, n /= 10; - for (int j = ndigs; 0 < j; j--) - buf[j - 1] = n % 10 + L_('0'), n /= 10; - if (!pad) - pad = L_('0'); - width_cpy (0, ndigs, buf); - width_add (width - ndigs, 0, (void) 0); - } - break; -#endif - - case L_('n'): - add1 (L_('\n')); - break; - - case L_('P'): - to_lowcase = true; -#ifndef _NL_CURRENT - format_char = L_('p'); -#endif - FALLTHROUGH; - case L_('p'): - if (change_case) - { - to_uppcase = false; - to_lowcase = true; - } -#ifdef _NL_CURRENT - cpy (ap_len, ampm); - break; -#else - goto underlying_strftime; -#endif - - case L_('q'): /* GNU extension. */ - DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); - - case L_('R'): - subfmt = L_("%H:%M"); - goto subformat; - - case L_('r'): -#ifdef _NL_CURRENT - if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, - NLW(T_FMT_AMPM))) - == L_('\0')) - subfmt = L_("%I:%M:%S %p"); - goto subformat; -#else - goto underlying_strftime; -#endif - - case L_('S'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, tp->tm_sec); - - case L_('s'): /* GNU extension. */ - { - struct tm ltm; - time_t t; - - ltm = *tp; - ltm.tm_yday = -1; - t = mktime_z (tz, <m); - if (ltm.tm_yday < 0) - { - errno = EOVERFLOW; - return 0; - } - - /* Generate string value for T using time_t arithmetic; - this works even if sizeof (long) < sizeof (time_t). */ - - bufp = buf + sizeof (buf) / sizeof (buf[0]); - negative_number = t < 0; - - do - { - int d = t % 10; - t /= 10; - *--bufp = (negative_number ? -d : d) + L_('0'); - } - while (t != 0); - - digits = 1; - always_output_a_sign = false; - goto do_number_sign_and_padding; - } - - case L_('X'): - if (modifier == L_('O')) - goto bad_format; -#ifdef _NL_CURRENT - if (! (modifier == L_('E') - && (*(subfmt = - (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) - != L_('\0')))) - subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); - goto subformat; -#else - goto underlying_strftime; -#endif - case L_('T'): - subfmt = L_("%H:%M:%S"); - goto subformat; - - case L_('t'): - add1 (L_('\t')); - break; - - case L_('u'): - DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); - - case L_('U'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); - - case L_('V'): - case L_('g'): - case L_('G'): - if (modifier == L_('E')) - goto bad_format; - { - /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) - is a leap year, except that YEAR and YEAR - 1 both work - correctly even when (tp->tm_year + TM_YEAR_BASE) would - overflow. */ - int year = (tp->tm_year - + (tp->tm_year < 0 - ? TM_YEAR_BASE % 400 - : TM_YEAR_BASE % 400 - 400)); - int year_adjust = 0; - int days = iso_week_days (tp->tm_yday, tp->tm_wday); - - if (days < 0) - { - /* This ISO week belongs to the previous year. */ - year_adjust = -1; - days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), - tp->tm_wday); - } - else - { - int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), - tp->tm_wday); - if (0 <= d) - { - /* This ISO week belongs to the next year. */ - year_adjust = 1; - days = d; - } - } - - switch (*f) - { - case L_('g'): - { - int yy = (tp->tm_year % 100 + year_adjust) % 100; - DO_YEARISH (2, false, - (0 <= yy - ? yy - : tp->tm_year < -TM_YEAR_BASE - year_adjust - ? -yy - : yy + 100)); - } - - case L_('G'): - DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, - (tp->tm_year + (unsigned int) TM_YEAR_BASE - + year_adjust)); - - default: - DO_NUMBER (2, days / 7 + 1); - } - } - - case L_('W'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); - - case L_('w'): - if (modifier == L_('E')) - goto bad_format; - - DO_NUMBER (1, tp->tm_wday); - - case L_('Y'): - if (modifier == L_('E')) - { -#if HAVE_STRUCT_ERA_ENTRY - struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); - if (era) - { -# ifdef COMPILE_WIDE - subfmt = era->era_wformat; -# else - subfmt = era->era_format; -# endif - if (pad == 0) - pad = yr_spec; - goto subformat; - } -#else - goto underlying_strftime; -#endif - } - if (modifier == L_('O')) - goto bad_format; - - DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE, - tp->tm_year + (unsigned int) TM_YEAR_BASE); - - case L_('y'): - if (modifier == L_('E')) - { -#if HAVE_STRUCT_ERA_ENTRY - struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); - if (era) - { - int delta = tp->tm_year - era->start_date[0]; - if (pad == 0) - pad = yr_spec; - DO_NUMBER (2, (era->offset - + delta * era->absolute_direction)); - } -#else - goto underlying_strftime; -#endif - } - - { - int yy = tp->tm_year % 100; - if (yy < 0) - yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; - DO_YEARISH (2, false, yy); - } - - case L_('Z'): - if (change_case) - { - to_uppcase = false; - to_lowcase = true; - } - -#ifdef COMPILE_WIDE - { - /* The zone string is always given in multibyte form. We have - to convert it to wide character. */ - size_t w = pad == L_('-') || width < 0 ? 0 : width; - char const *z = zone; - mbstate_t st = {0}; - size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); - if (len == (size_t) -1) - return 0; - size_t incr = len < w ? w : len; - if (incr >= maxsize - i) - { - errno = ERANGE; - return 0; - } - if (p) - { - if (len < w) - { - size_t delta = w - len; - __wmemmove (p + delta, p, len); - wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' '; - wmemset (p, wc, delta); - } - p += incr; - } - i += incr; - } -#else - cpy (strlen (zone), zone); -#endif - break; - - case L_(':'): - /* :, ::, and ::: are valid only just before 'z'. - :::: etc. are rejected later. */ - for (colons = 1; f[colons] == L_(':'); colons++) - continue; - if (f[colons] != L_('z')) - goto bad_format; - f += colons; - goto do_z_conversion; - - case L_('z'): - colons = 0; - - do_z_conversion: - if (tp->tm_isdst < 0) - break; - - { - int diff; - int hour_diff; - int min_diff; - int sec_diff; -#if HAVE_TM_GMTOFF - diff = tp->tm_gmtoff; -#else - if (!tz) - diff = 0; - else - { - struct tm gtm; - struct tm ltm; - time_t lt; - - /* POSIX.1 requires that local time zone information be used as - though strftime called tzset. */ -# ifndef my_strftime - if (!*tzset_called) - { - tzset (); - *tzset_called = true; - } -# endif - - ltm = *tp; - ltm.tm_wday = -1; - lt = mktime_z (tz, <m); - if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) - break; - diff = tm_diff (<m, >m); - } -#endif - - negative_number = diff < 0 || (diff == 0 && *zone == '-'); - hour_diff = diff / 60 / 60; - min_diff = diff / 60 % 60; - sec_diff = diff % 60; - - switch (colons) - { - case 0: /* +hhmm */ - DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); - - case 1: tz_hh_mm: /* +hh:mm */ - DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); - - case 2: tz_hh_mm_ss: /* +hh:mm:ss */ - DO_TZ_OFFSET (9, 024, - hour_diff * 10000 + min_diff * 100 + sec_diff); - - case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ - if (sec_diff != 0) - goto tz_hh_mm_ss; - if (min_diff != 0) - goto tz_hh_mm; - DO_TZ_OFFSET (3, 0, hour_diff); - - default: - goto bad_format; - } - } - - case L_('\0'): /* GNU extension: % at end of format. */ - bad_percent: - --f; - FALLTHROUGH; - default: - /* Unknown format; output the format, including the '%', - since this is most likely the right thing to do if a - multibyte string has been misparsed. */ - bad_format: - cpy (f - percent + 1, percent); - break; - } - } - -#if ! FPRINTFTIME - if (p && maxsize != 0) - *p = L_('\0'); -#endif - - errno = saved_errno; - return i; -} +#define my_strftime nstrftime +#include "strftime.c" diff --git a/lib/strftime.c b/lib/strftime.c new file mode 100644 index 00000000000..c7256c3d354 --- /dev/null +++ b/lib/strftime.c @@ -0,0 +1,2051 @@ +/* Copyright (C) 1991-2024 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This file is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +#ifndef FPRINTFTIME +# define FPRINTFTIME 0 +#endif + +#ifndef USE_C_LOCALE +# define USE_C_LOCALE 0 +#endif + +#ifdef _LIBC +# define USE_IN_EXTENDED_LOCALE_MODEL 1 +# define HAVE_STRUCT_ERA_ENTRY 1 +# define HAVE_TM_GMTOFF 1 +# define HAVE_STRUCT_TM_TM_ZONE 1 +# define HAVE_TZNAME 1 +# include "../locale/localeinfo.h" +#else +# include +# if FPRINTFTIME +# include "fprintftime.h" +# else +# include "strftime.h" +# endif +# include "time-internal.h" +#endif + +/* Whether to require GNU behavior for AM and PM indicators, even on + other platforms. This matters only in non-C locales. + The default is to require it; you can override this via + AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], 1) and if you do that + you may be able to omit Gnulib's localename module and its dependencies. */ +#ifndef REQUIRE_GNUISH_STRFTIME_AM_PM +# define REQUIRE_GNUISH_STRFTIME_AM_PM true +#endif +#if USE_C_LOCALE +# undef REQUIRE_GNUISH_STRFTIME_AM_PM +# define REQUIRE_GNUISH_STRFTIME_AM_PM false +#endif + +#if USE_C_LOCALE +# include "c-ctype.h" +#else +# include +#endif +#include +#include + +#if HAVE_TZNAME && !HAVE_DECL_TZNAME +extern char *tzname[]; +#endif + +/* Do multibyte processing if multibyte encodings are supported, unless + multibyte sequences are safe in formats. Multibyte sequences are + safe if they cannot contain byte sequences that look like format + conversion specifications. The multibyte encodings used by the + C library on the various platforms (UTF-8, GB2312, GBK, CP936, + GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949, + SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%' + cannot occur in a multibyte character except in the first byte. + + The DEC-HANYU encoding used on OSF/1 is not safe for formats, but + this encoding has never been seen in real-life use, so we ignore + it. */ +#if !(defined __osf__ && 0) +# define MULTIBYTE_IS_FORMAT_SAFE 1 +#endif +#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE) + +#if DO_MULTIBYTE +# include + static const mbstate_t mbstate_zero; +#endif + +#include +#include +#include +#include +#include + +#if USE_C_LOCALE && HAVE_STRFTIME_L +# include +#endif + +#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM +# include +# include "localename.h" +#endif + +#include "attribute.h" +#include + +#ifdef COMPILE_WIDE +# include +# define CHAR_T wchar_t +# define UCHAR_T unsigned int +# define L_(Str) L##Str +# define NLW(Sym) _NL_W##Sym + +# define MEMCPY(d, s, n) __wmemcpy (d, s, n) +# define STRLEN(s) __wcslen (s) + +#else +# define CHAR_T char +# define UCHAR_T unsigned char +# define L_(Str) Str +# define NLW(Sym) Sym +# define ABALTMON_1 _NL_ABALTMON_1 + +# define MEMCPY(d, s, n) memcpy (d, s, n) +# define STRLEN(s) strlen (s) + +#endif + +/* Shift A right by B bits portably, by dividing A by 2**B and + truncating towards minus infinity. A and B should be free of side + effects, and B should be in the range 0 <= B <= INT_BITS - 2, where + INT_BITS is the number of useful bits in an int. GNU code can + assume that INT_BITS is at least 32. + + ISO C99 says that A >> B is implementation-defined if A < 0. Some + implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift + right in the usual way when A < 0, so SHR falls back on division if + ordinary A >> B doesn't seem to be the usual signed shift. */ +#define SHR(a, b) \ + (-1 >> 1 == -1 \ + ? (a) >> (b) \ + : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) + +#define TM_YEAR_BASE 1900 + +#ifndef __isleap +/* Nonzero if YEAR is a leap year (every 4 years, + except every 100th isn't, and every 400th is). */ +# define __isleap(year) \ + ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) +#endif + + +#ifdef _LIBC +# define mktime_z(tz, tm) mktime (tm) +# define tzname __tzname +# define tzset __tzset + +# define time_t __time64_t +# define __gmtime_r(t, tp) __gmtime64_r (t, tp) +# define mktime(tp) __mktime64 (tp) +#endif + +#if FPRINTFTIME +# define STREAM_OR_CHAR_T FILE +# define STRFTIME_ARG(x) /* empty */ +#else +# define STREAM_OR_CHAR_T CHAR_T +# define STRFTIME_ARG(x) x, +#endif + +#if FPRINTFTIME +# define memset_byte(P, Len, Byte) \ + do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) +# define memset_space(P, Len) memset_byte (P, Len, ' ') +# define memset_zero(P, Len) memset_byte (P, Len, '0') +#elif defined COMPILE_WIDE +# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) +# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) +#else +# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) +# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) +#endif + +#if FPRINTFTIME +# define advance(P, N) +#else +# define advance(P, N) ((P) += (N)) +#endif + +#define add(n, f) width_add (width, n, f) +#define width_add(width, n, f) \ + do \ + { \ + size_t _n = (n); \ + size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ + size_t _incr = _n < _w ? _w : _n; \ + if (_incr >= maxsize - i) \ + { \ + errno = ERANGE; \ + return 0; \ + } \ + if (p) \ + { \ + if (_n < _w) \ + { \ + size_t _delta = _w - _n; \ + if (pad == L_('0') || pad == L_('+')) \ + memset_zero (p, _delta); \ + else \ + memset_space (p, _delta); \ + } \ + f; \ + advance (p, _n); \ + } \ + i += _incr; \ + } while (0) + +#define add1(c) width_add1 (width, c) +#if FPRINTFTIME +# define width_add1(width, c) width_add (width, 1, fputc (c, p)) +#else +# define width_add1(width, c) width_add (width, 1, *p = c) +#endif + +#define cpy(n, s) width_cpy (width, n, s) +#if FPRINTFTIME +# define width_cpy(width, n, s) \ + width_add (width, n, \ + do \ + { \ + if (to_lowcase) \ + fwrite_lowcase (p, (s), _n); \ + else if (to_uppcase) \ + fwrite_uppcase (p, (s), _n); \ + else \ + { \ + /* Ignore the value of fwrite. The caller can determine whether \ + an error occurred by inspecting ferror (P). All known fwrite \ + implementations set the stream's error indicator when they \ + fail due to ENOMEM etc., even though C11 and POSIX.1-2008 do \ + not require this. */ \ + fwrite (s, _n, 1, p); \ + } \ + } \ + while (0) \ + ) +#else +# define width_cpy(width, n, s) \ + width_add (width, n, \ + if (to_lowcase) \ + memcpy_lowcase (p, (s), _n LOCALE_ARG); \ + else if (to_uppcase) \ + memcpy_uppcase (p, (s), _n LOCALE_ARG); \ + else \ + MEMCPY ((void *) p, (void const *) (s), _n)) +#endif + +#ifdef COMPILE_WIDE +# ifndef USE_IN_EXTENDED_LOCALE_MODEL +# undef __mbsrtowcs_l +# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) +# endif +#endif + + +#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL +/* We use this code also for the extended locale handling where the + function gets as an additional argument the locale which has to be + used. To access the values we have to redefine the _NL_CURRENT + macro. */ +# define strftime __strftime_l +# define wcsftime __wcsftime_l +# undef _NL_CURRENT +# define _NL_CURRENT(category, item) \ + (current->values[_NL_ITEM_INDEX (item)].string) +# define LOCALE_PARAM , locale_t loc +# define LOCALE_ARG , loc +# define HELPER_LOCALE_ARG , current +#else +# define LOCALE_PARAM +# define LOCALE_ARG +# ifdef _LIBC +# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) +# else +# define HELPER_LOCALE_ARG +# endif +#endif + +#ifdef COMPILE_WIDE +# ifdef USE_IN_EXTENDED_LOCALE_MODEL +# define TOUPPER(Ch, L) __towupper_l (Ch, L) +# define TOLOWER(Ch, L) __towlower_l (Ch, L) +# else +# define TOUPPER(Ch, L) towupper (Ch) +# define TOLOWER(Ch, L) towlower (Ch) +# endif +#else +# ifdef USE_IN_EXTENDED_LOCALE_MODEL +# define TOUPPER(Ch, L) __toupper_l (Ch, L) +# define TOLOWER(Ch, L) __tolower_l (Ch, L) +# else +# if USE_C_LOCALE +# define TOUPPER(Ch, L) c_toupper (Ch) +# define TOLOWER(Ch, L) c_tolower (Ch) +# else +# define TOUPPER(Ch, L) toupper (Ch) +# define TOLOWER(Ch, L) tolower (Ch) +# endif +# endif +#endif +/* We don't use 'isdigit' here since the locale dependent + interpretation is not what we want here. We only need to accept + the arabic digits in the ASCII range. One day there is perhaps a + more reliable way to accept other sets of digits. */ +#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) + +/* Avoid false GCC warning "'memset' specified size 18446744073709551615 exceeds + maximum object size 9223372036854775807", caused by insufficient data flow + analysis and value propagation of the 'width_add' expansion when GCC is not + optimizing. Cf. . */ +#if __GNUC__ >= 7 && !__OPTIMIZE__ +# pragma GCC diagnostic ignored "-Wstringop-overflow" +#endif + +#if FPRINTFTIME +static void +fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) +{ + while (len-- > 0) + { + fputc (TOLOWER ((UCHAR_T) *src, loc), fp); + ++src; + } +} + +static void +fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) +{ + while (len-- > 0) + { + fputc (TOUPPER ((UCHAR_T) *src, loc), fp); + ++src; + } +} +#else +static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, + size_t len LOCALE_PARAM); + +static CHAR_T * +memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) +{ + while (len-- > 0) + dest[len] = TOLOWER ((UCHAR_T) src[len], loc); + return dest; +} + +static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, + size_t len LOCALE_PARAM); + +static CHAR_T * +memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM) +{ + while (len-- > 0) + dest[len] = TOUPPER ((UCHAR_T) src[len], loc); + return dest; +} +#endif + + +#if USE_C_LOCALE && HAVE_STRFTIME_L + +/* Cache for the C locale object. + Marked volatile so that different threads see the same value + (avoids locking). */ +static volatile locale_t c_locale_cache; + +/* Return the C locale object, or (locale_t) 0 with errno set + if it cannot be created. */ +static locale_t +c_locale (void) +{ + if (!c_locale_cache) + c_locale_cache = newlocale (LC_ALL_MASK, "C", (locale_t) 0); + return c_locale_cache; +} + +#endif + + +#if (defined __NetBSD__ || defined __sun) && REQUIRE_GNUISH_STRFTIME_AM_PM + +/* Return true if an AM/PM indicator should be removed. */ +static bool +should_remove_ampm (void) +{ + /* According to glibc's 'am_pm' attribute in the locale database, an AM/PM + indicator should be absent in the locales for the following languages: + ab an ast az be ber bg br bs ce cs csb cv da de dsb eo et eu fa fi fo fr + fur fy ga gl gv hr hsb ht hu hy it ka kk kl ku kv kw ky lb lg li lij ln + lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro + ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm + uz ve wae wo xh zu */ + const char *loc = gl_locale_name (LC_TIME, "LC_TIME"); + bool remove_ampm = false; + switch (loc[0]) + { + case 'a': + switch (loc[1]) + { + case 'b': case 'n': case 'z': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == 't' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'b': + switch (loc[1]) + { + case 'e': + if (loc[2] == '\0' || loc[2] == '_' + || (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_'))) + remove_ampm = true; + break; + case 'g': case 'r': case 's': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'c': + switch (loc[1]) + { + case 'e': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == '\0' || loc[2] == '_' + || (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_'))) + remove_ampm = true; + break; + default: + break; + } + break; + case 'd': + switch (loc[1]) + { + case 'a': case 'e': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'e': + switch (loc[1]) + { + case 'o': case 't': case 'u': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'f': + switch (loc[1]) + { + case 'a': case 'i': case 'o': case 'r': case 'y': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'u': + if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'g': + switch (loc[1]) + { + case 'a': case 'l': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'h': + switch (loc[1]) + { + case 'r': case 't': case 'u': case 'y': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 's': + if (loc[2] == 'b' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'i': + switch (loc[1]) + { + case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'k': + switch (loc[1]) + { + case 'a': case 'k': case 'l': case 'u': case 'v': case 'w': case 'y': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'l': + switch (loc[1]) + { + case 'b': case 'g': case 'n': case 't': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'i': + if (loc[2] == 'j' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'm': + switch (loc[1]) + { + case 'g': case 'i': case 'k': case 'n': case 's': case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'h': + if (loc[2] == 'r' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'n': + switch (loc[1]) + { + case 'b': case 'l': case 'n': case 'r': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'd': + if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'h': + if (loc[2] == 'n' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 's': + if (loc[2] == 'o' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'o': + switch (loc[1]) + { + case 'c': case 's': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'p': + switch (loc[1]) + { + case 'l': case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'a': + if (loc[2] == 'p' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'r': + switch (loc[1]) + { + case 'o': case 'u': case 'w': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 's': + switch (loc[1]) + { + case 'c': case 'e': case 'k': case 'l': case 'm': case 'r': case 's': + case 't': case 'u': case 'v': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'a': + if (loc[2] == 'h' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'g': + if (loc[2] == 's' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'z': + if (loc[2] == 'l' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 't': + switch (loc[1]) + { + case 'g': case 'k': case 'n': case 's': case 't': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'u': + switch (loc[1]) + { + case 'g': case 'k': case 'z': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + case 'n': + if (loc[2] == 'm'&& (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + default: + break; + } + break; + case 'v': + switch (loc[1]) + { + case 'e': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'w': + switch (loc[1]) + { + case 'a': + if (loc[2] == 'e' && (loc[3] == '\0' || loc[3] == '_')) + remove_ampm = true; + break; + case 'o': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'x': + switch (loc[1]) + { + case 'h': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + case 'z': + switch (loc[1]) + { + case 'u': + if (loc[2] == '\0' || loc[2] == '_') + remove_ampm = true; + break; + default: + break; + } + break; + default: + break; + } + return remove_ampm; +} + +#endif + + +#if ! HAVE_TM_GMTOFF +/* Yield the difference between *A and *B, + measured in seconds, ignoring leap seconds. */ +# define tm_diff ftime_tm_diff +static int tm_diff (const struct tm *, const struct tm *); +static int +tm_diff (const struct tm *a, const struct tm *b) +{ + /* Compute intervening leap days correctly even if year is negative. + Take care to avoid int overflow in leap day calculations, + but it's OK to assume that A and B are close to each other. */ + int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); + int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); + int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); + int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); + int a400 = SHR (a100, 2); + int b400 = SHR (b100, 2); + int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); + int years = a->tm_year - b->tm_year; + int days = (365 * years + intervening_leap_days + + (a->tm_yday - b->tm_yday)); + return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) + + (a->tm_min - b->tm_min)) + + (a->tm_sec - b->tm_sec)); +} +#endif /* ! HAVE_TM_GMTOFF */ + + + +/* The number of days from the first day of the first ISO week of this + year to the year day YDAY with week day WDAY. ISO weeks start on + Monday; the first ISO week has the year's first Thursday. YDAY may + be as small as YDAY_MINIMUM. */ +#define ISO_WEEK_START_WDAY 1 /* Monday */ +#define ISO_WEEK1_WDAY 4 /* Thursday */ +#define YDAY_MINIMUM (-366) +static int iso_week_days (int, int); +static __inline int +iso_week_days (int yday, int wday) +{ + /* Add enough to the first operand of % to make it nonnegative. */ + int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; + return (yday + - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 + + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); +} + + +#if !defined _NL_CURRENT && (USE_C_LOCALE && !HAVE_STRFTIME_L) +static CHAR_T const c_weekday_names[][sizeof "Wednesday"] = + { + L_("Sunday"), L_("Monday"), L_("Tuesday"), L_("Wednesday"), + L_("Thursday"), L_("Friday"), L_("Saturday") + }; +static CHAR_T const c_month_names[][sizeof "September"] = + { + L_("January"), L_("February"), L_("March"), L_("April"), L_("May"), + L_("June"), L_("July"), L_("August"), L_("September"), L_("October"), + L_("November"), L_("December") + }; +#endif + + +/* When compiling this file, GNU applications can #define my_strftime + to a symbol (typically nstrftime) to get an extended strftime with + extra arguments TZ and NS. */ + +#ifdef my_strftime +# define extra_args , tz, ns +# define extra_args_spec , timezone_t tz, int ns +#else +# if defined COMPILE_WIDE +# define my_strftime wcsftime +# define nl_get_alt_digit _nl_get_walt_digit +# else +# define my_strftime strftime +# define nl_get_alt_digit _nl_get_alt_digit +# endif +# define extra_args +# define extra_args_spec +/* We don't have this information in general. */ +# define tz 1 +# define ns 0 +#endif + +static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t) + const CHAR_T *, const struct tm *, + bool, int, int, bool * + extra_args_spec LOCALE_PARAM); + +/* Write information from TP into S according to the format + string FORMAT, writing no more that MAXSIZE characters + (including the terminating '\0') and returning number of + characters written. If S is NULL, nothing will be written + anywhere, so to determine how many characters would be + written, use NULL for S and (size_t) -1 for MAXSIZE. */ +size_t +my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) + const CHAR_T *format, + const struct tm *tp extra_args_spec LOCALE_PARAM) +{ + bool tzset_called = false; + return __strftime_internal (s, STRFTIME_ARG (maxsize) format, tp, false, + 0, -1, &tzset_called extra_args LOCALE_ARG); +} +libc_hidden_def (my_strftime) + +/* Just like my_strftime, above, but with more parameters. + UPCASE indicates that the result should be converted to upper case. + YR_SPEC and WIDTH specify the padding and width for the year. + *TZSET_CALLED indicates whether tzset has been called here. */ +static size_t +__strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) + const CHAR_T *format, + const struct tm *tp, bool upcase, + int yr_spec, int width, bool *tzset_called + extra_args_spec LOCALE_PARAM) +{ +#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL + struct __locale_data *const current = loc->__locales[LC_TIME]; +#endif +#if FPRINTFTIME + size_t maxsize = (size_t) -1; +#endif + + int saved_errno = errno; + int hour12 = tp->tm_hour; +#ifdef _NL_CURRENT + /* We cannot make the following values variables since we must delay + the evaluation of these values until really needed since some + expressions might not be valid in every situation. The 'struct tm' + might be generated by a strptime() call that initialized + only a few elements. Dereference the pointers only if the format + requires this. Then it is ok to fail if the pointers are invalid. */ +# define a_wkday \ + ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday))) +# define f_wkday \ + ((const CHAR_T *) (tp->tm_wday < 0 || tp->tm_wday > 6 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday))) +# define a_month \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon))) +# define f_month \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon))) +# define a_altmonth \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ABALTMON_1) + tp->tm_mon))) +# define f_altmonth \ + ((const CHAR_T *) (tp->tm_mon < 0 || tp->tm_mon > 11 \ + ? "?" : _NL_CURRENT (LC_TIME, NLW(ALTMON_1) + tp->tm_mon))) +# define ampm \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ + ? NLW(PM_STR) : NLW(AM_STR))) + +# define aw_len STRLEN (a_wkday) +# define am_len STRLEN (a_month) +# define aam_len STRLEN (a_altmonth) +# define ap_len STRLEN (ampm) +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +/* The English abbreviated weekday names are just the first 3 characters of the + English full weekday names. */ +# define a_wkday \ + (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday]) +# define aw_len 3 +# define f_wkday \ + (tp->tm_wday < 0 || tp->tm_wday > 6 ? L_("?") : c_weekday_names[tp->tm_wday]) +/* The English abbreviated month names are just the first 3 characters of the + English full month names. */ +# define a_month \ + (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon]) +# define am_len 3 +# define f_month \ + (tp->tm_mon < 0 || tp->tm_mon > 11 ? L_("?") : c_month_names[tp->tm_mon]) +/* The English AM/PM strings happen to have the same length, namely 2. */ +# define ampm (L_("AMPM") + 2 * (tp->tm_hour > 11)) +# define ap_len 2 +#endif +#if HAVE_TZNAME + char **tzname_vec = tzname; +#endif + const char *zone; + size_t i = 0; + STREAM_OR_CHAR_T *p = s; + const CHAR_T *f; +#if DO_MULTIBYTE && !defined COMPILE_WIDE + const char *format_end = NULL; +#endif + + zone = NULL; +#if HAVE_STRUCT_TM_TM_ZONE + /* The POSIX test suite assumes that setting + the environment variable TZ to a new value before calling strftime() + will influence the result (the %Z format) even if the information in + TP is computed with a totally different time zone. + This is bogus: though POSIX allows bad behavior like this, + POSIX does not require it. Do the right thing instead. */ + zone = (const char *) tp->tm_zone; +#endif +#if HAVE_TZNAME + if (!tz) + { + if (! (zone && *zone)) + zone = "GMT"; + } + else + { +# if !HAVE_STRUCT_TM_TM_ZONE + /* Infer the zone name from *TZ instead of from TZNAME. */ + tzname_vec = tz->tzname_copy; +# endif + } + /* The tzset() call might have changed the value. */ + if (!(zone && *zone) && tp->tm_isdst >= 0) + { + /* POSIX.1 requires that local time zone information be used as + though strftime called tzset. */ +# ifndef my_strftime + if (!*tzset_called) + { + tzset (); + *tzset_called = true; + } +# endif + zone = tzname_vec[tp->tm_isdst != 0]; + } +#endif + if (! zone) + zone = ""; + + if (hour12 > 12) + hour12 -= 12; + else + if (hour12 == 0) + hour12 = 12; + + for (f = format; *f != '\0'; width = -1, f++) + { + int pad = 0; /* Padding for number ('_', '-', '+', '0', or 0). */ + int modifier; /* Field modifier ('E', 'O', or 0). */ + int digits = 0; /* Max digits for numeric format. */ + int number_value; /* Numeric value to be printed. */ + unsigned int u_number_value; /* (unsigned int) number_value. */ + bool negative_number; /* The number is negative. */ + bool always_output_a_sign; /* +/- should always be output. */ + int tz_colon_mask; /* Bitmask of where ':' should appear. */ + const CHAR_T *subfmt; + CHAR_T *bufp; + CHAR_T buf[1 + + 2 /* for the two colons in a %::z or %:::z time zone */ + + (sizeof (int) < sizeof (time_t) + ? INT_STRLEN_BOUND (time_t) + : INT_STRLEN_BOUND (int))]; + bool to_lowcase = false; + bool to_uppcase = upcase; + size_t colons; + bool change_case = false; + int format_char; + int subwidth; + +#if DO_MULTIBYTE && !defined COMPILE_WIDE + switch (*f) + { + case L_('%'): + break; + + case L_('\b'): case L_('\t'): case L_('\n'): + case L_('\v'): case L_('\f'): case L_('\r'): + case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): + case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): + case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): + case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): + case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): + case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): + case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): + case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): + case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): + case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): + case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): + case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): + case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): + case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): + case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): + case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): + case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): + case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): + case L_('~'): + /* The C Standard requires these 98 characters (plus '%') to + be in the basic execution character set. None of these + characters can start a multibyte sequence, so they need + not be analyzed further. */ + add1 (*f); + continue; + + default: + /* Copy this multibyte sequence until we reach its end, find + an error, or come back to the initial shift state. */ + { + mbstate_t mbstate = mbstate_zero; + size_t len = 0; + size_t fsize; + + if (! format_end) + format_end = f + strlen (f) + 1; + fsize = format_end - f; + + do + { + size_t bytes = mbrlen (f + len, fsize - len, &mbstate); + + if (bytes == 0) + break; + + if (bytes == (size_t) -2) + { + len += strlen (f + len); + break; + } + + if (bytes == (size_t) -1) + { + len++; + break; + } + + len += bytes; + } + while (! mbsinit (&mbstate)); + + cpy (len, f); + f += len - 1; + continue; + } + } + +#else /* ! DO_MULTIBYTE */ + + /* Either multibyte encodings are not supported, they are + safe for formats, so any non-'%' byte can be copied through, + or this is the wide character version. */ + if (*f != L_('%')) + { + add1 (*f); + continue; + } + +#endif /* ! DO_MULTIBYTE */ + + char const *percent = f; + + /* Check for flags that can modify a format. */ + while (1) + { + switch (*++f) + { + /* This influences the number formats. */ + case L_('_'): + case L_('-'): + case L_('+'): + case L_('0'): + pad = *f; + continue; + + /* This changes textual output. */ + case L_('^'): + to_uppcase = true; + continue; + case L_('#'): + change_case = true; + continue; + + default: + break; + } + break; + } + + if (ISDIGIT (*f)) + { + width = 0; + do + { + if (ckd_mul (&width, width, 10) + || ckd_add (&width, width, *f - L_('0'))) + width = INT_MAX; + ++f; + } + while (ISDIGIT (*f)); + } + + /* Check for modifiers. */ + switch (*f) + { + case L_('E'): + case L_('O'): + modifier = *f++; + break; + + default: + modifier = 0; + break; + } + + /* Now do the specified format. */ + format_char = *f; + switch (format_char) + { +#define DO_NUMBER(d, v) \ + do \ + { \ + digits = d; \ + number_value = v; \ + goto do_number; \ + } \ + while (0) +#define DO_SIGNED_NUMBER(d, negative, v) \ + DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_signed_number) +#define DO_YEARISH(d, negative, v) \ + DO_MAYBE_SIGNED_NUMBER (d, negative, v, do_yearish) +#define DO_MAYBE_SIGNED_NUMBER(d, negative, v, label) \ + do \ + { \ + digits = d; \ + negative_number = negative; \ + u_number_value = v; \ + goto label; \ + } \ + while (0) + + /* The mask is not what you might think. + When the ordinal i'th bit is set, insert a colon + before the i'th digit of the time zone representation. */ +#define DO_TZ_OFFSET(d, mask, v) \ + do \ + { \ + digits = d; \ + tz_colon_mask = mask; \ + u_number_value = v; \ + goto do_tz_offset; \ + } \ + while (0) +#define DO_NUMBER_SPACEPAD(d, v) \ + do \ + { \ + digits = d; \ + number_value = v; \ + goto do_number_spacepad; \ + } \ + while (0) + + case L_('%'): + if (f - 1 != percent) + goto bad_percent; + add1 (*f); + break; + + case L_('a'): + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) + cpy (aw_len, a_wkday); + break; +#else + goto underlying_strftime; +#endif + + case 'A': + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) + cpy (STRLEN (f_wkday), f_wkday); + break; +#else + goto underlying_strftime; +#endif + + case L_('b'): + case L_('h'): + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } + if (modifier == L_('E')) + goto bad_format; +#ifdef _NL_CURRENT + if (modifier == L_('O')) + cpy (aam_len, a_altmonth); + else + cpy (am_len, a_month); + break; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + cpy (am_len, a_month); + break; +#else + goto underlying_strftime; +#endif + + case L_('B'): + if (modifier == L_('E')) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#ifdef _NL_CURRENT + if (modifier == L_('O')) + cpy (STRLEN (f_altmonth), f_altmonth); + else + cpy (STRLEN (f_month), f_month); + break; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + cpy (STRLEN (f_month), f_month); + break; +#else + goto underlying_strftime; +#endif + + case L_('c'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, + NLW(ERA_D_T_FMT))) + != '\0'))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%a %b %e %H:%M:%S %Y"); +#else + goto underlying_strftime; +#endif + + subformat: + subwidth = -1; + subformat_width: + { + size_t len = __strftime_internal (NULL, STRFTIME_ARG ((size_t) -1) + subfmt, tp, to_uppcase, + pad, subwidth, tzset_called + extra_args LOCALE_ARG); + add (len, __strftime_internal (p, + STRFTIME_ARG (maxsize - i) + subfmt, tp, to_uppcase, + pad, subwidth, tzset_called + extra_args LOCALE_ARG)); + } + break; + +#if !((defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) || (USE_C_LOCALE && !HAVE_STRFTIME_L)) + underlying_strftime: + { + /* The relevant information is available only via the + underlying strftime implementation, so use that. */ + char ufmt[5]; + char *u = ufmt; + char ubuf[1024]; /* enough for any single format in practice */ + size_t len; + /* Make sure we're calling the actual underlying strftime. + In some cases, config.h contains something like + "#define strftime rpl_strftime". */ +# ifdef strftime +# undef strftime + size_t strftime (char *, size_t, const char *, struct tm const *); +# endif + + /* The space helps distinguish strftime failure from empty + output. */ + *u++ = ' '; + *u++ = '%'; + if (modifier != 0) + *u++ = modifier; + *u++ = format_char; + *u = '\0'; + +# if USE_C_LOCALE /* implies HAVE_STRFTIME_L */ + locale_t locale = c_locale (); + if (!locale) + return 0; /* errno is set here */ + len = strftime_l (ubuf, sizeof ubuf, ufmt, tp, locale); +# else + len = strftime (ubuf, sizeof ubuf, ufmt, tp); +# endif + if (len != 0) + { +# if defined __NetBSD__ || defined __sun /* NetBSD, Solaris */ + if (format_char == L_('c')) + { + /* The output of the strftime %c directive consists of the + date, the time, and the time zone. But the time zone is + wrong, since neither TZ nor ZONE was passed as argument. + Therefore, remove the the last space-delimited word. + In order not to accidentally remove a date or a year + (that contains no letter) or an AM/PM indicator (that has + length 2), remove that last word only if it contains a + letter and has length >= 3. */ + char *space; + for (space = ubuf + len - 1; *space != ' '; space--) + ; + if (space > ubuf) + { + /* Found a space. */ + if (strlen (space + 1) >= 3) + { + /* The last word has length >= 3. */ + bool found_letter = false; + const char *p; + for (p = space + 1; *p != '\0'; p++) + if ((*p >= 'A' && *p <= 'Z') + || (*p >= 'a' && *p <= 'z')) + { + found_letter = true; + break; + } + if (found_letter) + { + /* The last word contains a letter. */ + *space = '\0'; + len = space - ubuf; + } + } + } + } +# if REQUIRE_GNUISH_STRFTIME_AM_PM + /* The output of the strftime %p and %r directives contains + an AM/PM indicator even for locales where it is not + suitable, such as French. Remove this indicator. */ + else if (format_char == L_('p')) + { + bool found_ampm = (len > 1); + if (found_ampm && should_remove_ampm ()) + { + ubuf[1] = '\0'; + len = 1; + } + } + else if (format_char == L_('r')) + { + char last_char = ubuf[len - 1]; + bool found_ampm = !(last_char >= '0' && last_char <= '9'); + if (found_ampm && should_remove_ampm ()) + { + char *space; + for (space = ubuf + len - 1; *space != ' '; space--) + ; + if (space > ubuf) + { + *space = '\0'; + len = space - ubuf; + } + } + } +# endif +# endif + cpy (len - 1, ubuf + 1); + } + } + break; +#endif + + case L_('C'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { +# ifdef COMPILE_WIDE + size_t len = __wcslen (era->era_wname); + cpy (len, era->era_wname); +# else + size_t len = strlen (era->era_name); + cpy (len, era->era_name); +# endif + break; + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + + { + bool negative_year = tp->tm_year < - TM_YEAR_BASE; + bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); + int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 + + TM_YEAR_BASE / 100); + DO_YEARISH (2, negative_year, century); + } + + case L_('x'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) + != L_('\0')))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); + goto subformat; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%m/%d/%y"); + goto subformat; +#else + goto underlying_strftime; +#endif + case L_('D'): + if (modifier != 0) + goto bad_format; + subfmt = L_("%m/%d/%y"); + goto subformat; + + case L_('d'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_mday); + + case L_('e'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, tp->tm_mday); + + /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) + and then jump to one of these labels. */ + + do_tz_offset: + always_output_a_sign = true; + goto do_number_body; + + do_yearish: + if (pad == 0) + pad = yr_spec; + always_output_a_sign + = (pad == L_('+') + && ((digits == 2 ? 99 : 9999) < u_number_value + || digits < width)); + goto do_maybe_signed_number; + + do_number_spacepad: + if (pad == 0) + pad = L_('_'); + + do_number: + /* Format NUMBER_VALUE according to the MODIFIER flag. */ + negative_number = number_value < 0; + u_number_value = number_value; + + do_signed_number: + always_output_a_sign = false; + + do_maybe_signed_number: + tz_colon_mask = 0; + + do_number_body: + /* Format U_NUMBER_VALUE according to the MODIFIER flag. + NEGATIVE_NUMBER is nonzero if the original number was + negative; in this case it was converted directly to + unsigned int (i.e., modulo (UINT_MAX + 1)) without + negating it. */ + if (modifier == L_('O') && !negative_number) + { +#ifdef _NL_CURRENT + /* Get the locale specific alternate representation of + the number. If none exist NULL is returned. */ + const CHAR_T *cp = nl_get_alt_digit (u_number_value + HELPER_LOCALE_ARG); + + if (cp != NULL) + { + size_t digitlen = STRLEN (cp); + if (digitlen != 0) + { + cpy (digitlen, cp); + break; + } + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + + bufp = buf + sizeof (buf) / sizeof (buf[0]); + + if (negative_number) + u_number_value = - u_number_value; + + do + { + if (tz_colon_mask & 1) + *--bufp = ':'; + tz_colon_mask >>= 1; + *--bufp = u_number_value % 10 + L_('0'); + u_number_value /= 10; + } + while (u_number_value != 0 || tz_colon_mask != 0); + + do_number_sign_and_padding: + if (pad == 0) + pad = L_('0'); + if (width < 0) + width = digits; + + { + CHAR_T sign_char = (negative_number ? L_('-') + : always_output_a_sign ? L_('+') + : 0); + int numlen = buf + sizeof buf / sizeof buf[0] - bufp; + int shortage = width - !!sign_char - numlen; + int padding = pad == L_('-') || shortage <= 0 ? 0 : shortage; + + if (sign_char) + { + if (pad == L_('_')) + { + if (p) + memset_space (p, padding); + i += padding; + width -= padding; + } + width_add1 (0, sign_char); + width--; + } + + cpy (numlen, bufp); + } + break; + + case L_('F'): + if (modifier != 0) + goto bad_format; + if (pad == 0 && width < 0) + { + pad = L_('+'); + subwidth = 4; + } + else + { + subwidth = width - 6; + if (subwidth < 0) + subwidth = 0; + } + subfmt = L_("%Y-%m-%d"); + goto subformat_width; + + case L_('H'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_hour); + + case L_('I'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, hour12); + + case L_('k'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, tp->tm_hour); + + case L_('l'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, hour12); + + case L_('j'): + if (modifier == L_('E')) + goto bad_format; + + DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); + + case L_('M'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_min); + + case L_('m'): + if (modifier == L_('E')) + goto bad_format; + + DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); + +#ifndef _LIBC + case L_('N'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + { + int n = ns, ns_digits = 9; + if (width <= 0) + width = ns_digits; + int ndigs = ns_digits; + while (width < ndigs || (1 < ndigs && n % 10 == 0)) + ndigs--, n /= 10; + for (int j = ndigs; 0 < j; j--) + buf[j - 1] = n % 10 + L_('0'), n /= 10; + if (!pad) + pad = L_('0'); + width_cpy (0, ndigs, buf); + width_add (width - ndigs, 0, (void) 0); + } + break; +#endif + + case L_('n'): + add1 (L_('\n')); + break; + + case L_('P'): + to_lowcase = true; +#ifndef _NL_CURRENT + format_char = L_('p'); +#endif + FALLTHROUGH; + case L_('p'): + if (change_case) + { + to_uppcase = false; + to_lowcase = true; + } +#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L) + cpy (ap_len, ampm); + break; +#else + goto underlying_strftime; +#endif + + case L_('q'): /* GNU extension. */ + DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); + + case L_('R'): + subfmt = L_("%H:%M"); + goto subformat; + + case L_('r'): +#ifdef _NL_CURRENT + if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, + NLW(T_FMT_AMPM))) + == L_('\0')) + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#elif (defined __APPLE__ && defined __MACH__) || defined __FreeBSD__ + /* macOS, FreeBSD strftime() may produce empty output for "%r". */ + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#else + goto underlying_strftime; +#endif + + case L_('S'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_sec); + + case L_('s'): /* GNU extension. */ + { + struct tm ltm; + time_t t; + + ltm = *tp; + ltm.tm_yday = -1; + t = mktime_z (tz, <m); + if (ltm.tm_yday < 0) + { + errno = EOVERFLOW; + return 0; + } + + /* Generate string value for T using time_t arithmetic; + this works even if sizeof (long) < sizeof (time_t). */ + + bufp = buf + sizeof (buf) / sizeof (buf[0]); + negative_number = t < 0; + + do + { + int d = t % 10; + t /= 10; + *--bufp = (negative_number ? -d : d) + L_('0'); + } + while (t != 0); + + digits = 1; + always_output_a_sign = false; + goto do_number_sign_and_padding; + } + + case L_('X'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) + != L_('\0')))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); + goto subformat; +#elif USE_C_LOCALE && !HAVE_STRFTIME_L + subfmt = L_("%H:%M:%S"); + goto subformat; +#else + goto underlying_strftime; +#endif + case L_('T'): + subfmt = L_("%H:%M:%S"); + goto subformat; + + case L_('t'): + add1 (L_('\t')); + break; + + case L_('u'): + DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); + + case L_('U'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); + + case L_('V'): + case L_('g'): + case L_('G'): + if (modifier == L_('E')) + goto bad_format; + { + /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) + is a leap year, except that YEAR and YEAR - 1 both work + correctly even when (tp->tm_year + TM_YEAR_BASE) would + overflow. */ + int year = (tp->tm_year + + (tp->tm_year < 0 + ? TM_YEAR_BASE % 400 + : TM_YEAR_BASE % 400 - 400)); + int year_adjust = 0; + int days = iso_week_days (tp->tm_yday, tp->tm_wday); + + if (days < 0) + { + /* This ISO week belongs to the previous year. */ + year_adjust = -1; + days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), + tp->tm_wday); + } + else + { + int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), + tp->tm_wday); + if (0 <= d) + { + /* This ISO week belongs to the next year. */ + year_adjust = 1; + days = d; + } + } + + switch (*f) + { + case L_('g'): + { + int yy = (tp->tm_year % 100 + year_adjust) % 100; + DO_YEARISH (2, false, + (0 <= yy + ? yy + : tp->tm_year < -TM_YEAR_BASE - year_adjust + ? -yy + : yy + 100)); + } + + case L_('G'): + DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, + (tp->tm_year + (unsigned int) TM_YEAR_BASE + + year_adjust)); + + default: + DO_NUMBER (2, days / 7 + 1); + } + } + + case L_('W'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); + + case L_('w'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (1, tp->tm_wday); + + case L_('Y'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { +# ifdef COMPILE_WIDE + subfmt = era->era_wformat; +# else + subfmt = era->era_format; +# endif + if (pad == 0) + pad = yr_spec; + goto subformat; + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + if (modifier == L_('O')) + goto bad_format; + + DO_YEARISH (4, tp->tm_year < -TM_YEAR_BASE, + tp->tm_year + (unsigned int) TM_YEAR_BASE); + + case L_('y'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { + int delta = tp->tm_year - era->start_date[0]; + if (pad == 0) + pad = yr_spec; + DO_NUMBER (2, (era->offset + + delta * era->absolute_direction)); + } +#elif USE_C_LOCALE && !HAVE_STRFTIME_L +#else + goto underlying_strftime; +#endif + } + + { + int yy = tp->tm_year % 100; + if (yy < 0) + yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; + DO_YEARISH (2, false, yy); + } + + case L_('Z'): + if (change_case) + { + to_uppcase = false; + to_lowcase = true; + } + +#ifdef COMPILE_WIDE + { + /* The zone string is always given in multibyte form. We have + to convert it to wide character. */ + size_t w = pad == L_('-') || width < 0 ? 0 : width; + char const *z = zone; + mbstate_t st = {0}; + size_t len = __mbsrtowcs_l (p, &z, maxsize - i, &st, loc); + if (len == (size_t) -1) + return 0; + size_t incr = len < w ? w : len; + if (incr >= maxsize - i) + { + errno = ERANGE; + return 0; + } + if (p) + { + if (len < w) + { + size_t delta = w - len; + __wmemmove (p + delta, p, len); + wchar_t wc = pad == L_('0') || pad == L_('+') ? L'0' : L' '; + wmemset (p, wc, delta); + } + p += incr; + } + i += incr; + } +#else + cpy (strlen (zone), zone); +#endif + break; + + case L_(':'): + /* :, ::, and ::: are valid only just before 'z'. + :::: etc. are rejected later. */ + for (colons = 1; f[colons] == L_(':'); colons++) + continue; + if (f[colons] != L_('z')) + goto bad_format; + f += colons; + goto do_z_conversion; + + case L_('z'): + colons = 0; + + do_z_conversion: + if (tp->tm_isdst < 0) + break; + + { + int diff; + int hour_diff; + int min_diff; + int sec_diff; +#if HAVE_TM_GMTOFF + diff = tp->tm_gmtoff; +#else + if (!tz) + diff = 0; + else + { + struct tm gtm; + struct tm ltm; + time_t lt; + + /* POSIX.1 requires that local time zone information be used as + though strftime called tzset. */ +# ifndef my_strftime + if (!*tzset_called) + { + tzset (); + *tzset_called = true; + } +# endif + + ltm = *tp; + ltm.tm_wday = -1; + lt = mktime_z (tz, <m); + if (ltm.tm_wday < 0 || ! localtime_rz (0, <, >m)) + break; + diff = tm_diff (<m, >m); + } +#endif + + negative_number = diff < 0 || (diff == 0 && *zone == '-'); + hour_diff = diff / 60 / 60; + min_diff = diff / 60 % 60; + sec_diff = diff % 60; + + switch (colons) + { + case 0: /* +hhmm */ + DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); + + case 1: tz_hh_mm: /* +hh:mm */ + DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); + + case 2: tz_hh_mm_ss: /* +hh:mm:ss */ + DO_TZ_OFFSET (9, 024, + hour_diff * 10000 + min_diff * 100 + sec_diff); + + case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ + if (sec_diff != 0) + goto tz_hh_mm_ss; + if (min_diff != 0) + goto tz_hh_mm; + DO_TZ_OFFSET (3, 0, hour_diff); + + default: + goto bad_format; + } + } + + case L_('\0'): /* GNU extension: % at end of format. */ + bad_percent: + --f; + FALLTHROUGH; + default: + /* Unknown format; output the format, including the '%', + since this is most likely the right thing to do if a + multibyte string has been misparsed. */ + bad_format: + cpy (f - percent + 1, percent); + break; + } + } + +#if ! FPRINTFTIME + if (p && maxsize != 0) + *p = L_('\0'); +#endif + + errno = saved_errno; + return i; +} diff --git a/lib/strftime.h b/lib/strftime.h index d6efdb848a3..8ce62cdb6d7 100644 --- a/lib/strftime.h +++ b/lib/strftime.h @@ -21,17 +21,68 @@ extern "C" { #endif -/* Just like strftime, but with two more arguments: - POSIX requires that strftime use the local timezone information. - Use the timezone __TZ instead. Use __NS as the number of - nanoseconds in the %N directive. +/* Formats the broken-down time *__TP, with additional __NS nanoseconds, + into the buffer __S of size __MAXSIZE, according to the rules of the + LC_TIME category of the current locale. - On error, set errno and return 0. Otherwise, return the number of - bytes generated (not counting the trailing NUL), preserving errno - if the number is 0. This errno behavior is in draft POSIX 202x - plus some requested changes to POSIX. */ -size_t nstrftime (char *restrict, size_t, char const *, struct tm const *, - timezone_t __tz, int __ns); + Uses the time zone __TZ. + If *__TP represents local time, __TZ should be set to + tzalloc (getenv ("TZ")). + If *__TP represents universal time (a.k.a. GMT), __TZ should be set to + (timezone_t) 0. + + The format string __FORMAT, including GNU extensions, is described in + the GNU libc's strftime() documentation: + + Additionally, the following conversion is supported: + %N The number of nanoseconds, passed as __NS argument. + Here's a summary of the available conversions (= format directives): + literal characters %n %t %% + date: + century %C + year %Y %y + week-based year %G %g + month (in year) %m %B %b %h + week in year %U %W %V + day in year %j + day (in month) %d %e + day in week %u %w %A %a + year, month, day %x %F %D + time: + half-day %p %P + hour %H %k %I %l + minute (in hour) %M + hour, minute %R + second (in minute) %S + hour, minute, second %r %T %X + second (since epoch) %s + date and time: %c + time zone: %z %Z + nanosecond %N + + Stores the result, as a string with a trailing NUL character, at the + beginning of the array __S[0..__MAXSIZE-1], if it fits, and returns + the length of that string, not counting the trailing NUL. In this case, + errno is preserved if the return value is 0. + If it does not fit, this function sets errno to ERANGE and returns 0. + Upon other errors, this function sets errno and returns 0 as well. + + Note: The errno behavior is in draft POSIX 202x plus some requested + changes to POSIX. + + This function is like strftime, but with two more arguments: + * __TZ instead of the local timezone information, + * __NS as the number of nanoseconds in the %N directive. + */ +size_t nstrftime (char *restrict __s, size_t __maxsize, + char const *__format, + struct tm const *__tp, timezone_t __tz, int __ns); + +/* Like nstrftime, except that it uses the "C" locale instead of the + current locale. */ +size_t c_nstrftime (char *restrict __s, size_t __maxsize, + char const *__format, + struct tm const *__tp, timezone_t __tz, int __ns); #ifdef __cplusplus } diff --git a/lib/time.in.h b/lib/time.in.h index ce28f1af25d..df99c8abca9 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -438,11 +438,7 @@ _GL_CXXALIAS_SYS (ctime, char *, (time_t const *__tp)); _GL_CXXALIASWARN (ctime); # endif # elif defined GNULIB_POSIXCHECK -# undef ctime -# if HAVE_RAW_DECL_CTIME -_GL_WARN_ON_USE (ctime, "ctime has portability problems - " - "use gnulib module ctime for portability"); -# endif +/* No need to warn about portability, as a more serious warning is below. */ # endif /* Convert *TP to a date and time string. See diff --git a/lib/time_r.c b/lib/time_r.c index 3ef0b36802c..b724f3b38de 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -21,6 +21,11 @@ #include +/* The replacement functions in this file are only used on native Windows. + They are multithread-safe, because the gmtime() and localtime() functions + on native Windows — both in the ucrt and in the older MSVCRT — return a + pointer to a 'struct tm' in thread-local memory. */ + static struct tm * copy_tm_result (struct tm *dest, struct tm const *src) { diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index 8f4d40dcbeb..701013a07f4 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h @@ -32,6 +32,10 @@ _GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline' linkage. + _GL_WARN_ON_USE should not be used more than once for a given function + in a given compilation unit (because this may generate a warning even + if the function is never called). + However, one of the reasons that a function is a portability trap is if it has the wrong signature. Declaring FUNCTION with a different signature in C is a compilation error, so this macro must use the diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 0b7bb2cee85..7f30f83e769 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -29,8 +29,7 @@ is SIZE_MAX - 1. */ #define __xalloc_oversized(n, s) \ ((s) != 0 \ - && ((size_t) (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) \ - < (n))) + && (PTRDIFF_MAX < SIZE_MAX ? PTRDIFF_MAX : SIZE_MAX - 1) / (s) < (n)) /* Return 1 if and only if an array of N objects, each of size S, cannot exist reliably because its total size in bytes would exceed diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 00691c0d6c3..d8d0904f787 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 91 +# gnulib-common.m4 serial 92 dnl Copyright (C) 2007-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -76,42 +76,48 @@ AC_DEFUN([gl_COMMON_BODY], [ #endif]) AH_VERBATIM([attribute], [/* Attributes. */ -#if (defined __has_attribute \ - && (!defined __clang_minor__ \ - || (defined __apple_build_version__ \ - ? 7000000 <= __apple_build_version__ \ - : 5 <= __clang_major__))) -# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) -#else -# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr -# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2) -# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) -# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) -# define _GL_ATTR_diagnose_if 0 -# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) -# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) -# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) -# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7) -# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6) -# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0) -# ifdef _ICC -# define _GL_ATTR_may_alias 0 +/* Define _GL_HAS_ATTRIBUTE only once, because on FreeBSD, with gcc < 5, if + gets included once again after , __has_attribute(x) + expands to 0 always, and redefining _GL_HAS_ATTRIBUTE would turn off all + attributes. */ +#ifndef _GL_HAS_ATTRIBUTE +# if (defined __has_attribute \ + && (!defined __clang_minor__ \ + || (defined __apple_build_version__ \ + ? 7000000 <= __apple_build_version__ \ + : 5 <= __clang_major__))) +# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) # else -# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3) +# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr +# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2) +# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) +# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) +# define _GL_ATTR_diagnose_if 0 +# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) +# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) +# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) +# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7) +# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6) +# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0) +# ifdef _ICC +# define _GL_ATTR_may_alias 0 +# else +# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3) +# endif +# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1) +# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3) +# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0) +# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3) +# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7) +# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96) +# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9) +# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0) +# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7) +# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) # endif -# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1) -# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3) -# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0) -# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3) -# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7) -# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96) -# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9) -# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0) -# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7) -# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4) #endif /* Use __has_c_attribute if available. However, do not use with diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 7a7ebb0f34e..d8b92e7b122 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -1024,7 +1024,7 @@ AC_DEFUN([gl_INIT], if test $ac_use_included_regex = yes; then func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c fi - if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then + if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then func_gl_gnulib_m4code_strtoll fi if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then @@ -1422,6 +1422,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stdlib.in.h lib/stpcpy.c lib/str-two-way.h + lib/strftime.c lib/strftime.h lib/string.in.h lib/strnlen.c diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 index c51f590402f..ff730b676cd 100644 --- a/m4/nanosleep.m4 +++ b/m4/nanosleep.m4 @@ -1,4 +1,4 @@ -# serial 46 +# serial 47 dnl From Jim Meyering. dnl Check for the nanosleep function. @@ -119,6 +119,10 @@ AC_DEFUN([gl_FUNC_NANOSLEEP], # Guess it halfway works when the kernel is Linux. linux*) gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; + # Midipix generally emulates the Linux system calls, + # but here it handles large arguments correctly. + midipix*) + gl_cv_func_nanosleep='guessing yes' ;; # Guess no on native Windows. mingw* | windows*) gl_cv_func_nanosleep='guessing no' ;; diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 67250dc9455..aa5d63a54b5 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,4 +1,4 @@ -# serial 37 +# serial 38 # Copyright (C) 1996-1997, 1999-2007, 2009-2024 Free Software Foundation, Inc. # @@ -16,7 +16,4 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME], AC_REQUIRE([AC_STRUCT_TIMEZONE]) AC_REQUIRE([gl_TM_GMTOFF]) - - AC_DEFINE([my_strftime], [nstrftime], - [Define to the name of the strftime replacement function.]) ]) diff --git a/m4/utimens.m4 b/m4/utimens.m4 index af03e6b52be..0f5bfd4c843 100644 --- a/m4/utimens.m4 +++ b/m4/utimens.m4 @@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. -dnl serial 15 +dnl serial 16 AC_DEFUN([gl_UTIMENS], [ @@ -36,12 +36,13 @@ AC_DEFUN([gl_UTIMENS], [gl_cv_func_futimesat_works=yes], [gl_cv_func_futimesat_works=no], [case "$host_os" in - # Guess yes on Linux systems. - linux-* | linux) gl_cv_func_futimesat_works="guessing yes" ;; - # Guess yes on glibc systems. - *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; - # If we don't know, obey --enable-cross-guesses. - *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;; + # Guess yes on Linux systems + # and on systems that emulate the Linux system calls. + linux* | midipix*) gl_cv_func_futimesat_works="guessing yes" ;; + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_futimesat_works="guessing yes" ;; + # If we don't know, obey --enable-cross-guesses. + *) gl_cv_func_futimesat_works="$gl_cross_guess_normal" ;; esac ]) rm -f conftest.file]) diff --git a/m4/utimensat.m4 b/m4/utimensat.m4 index e595b333d17..4af7f6f81c8 100644 --- a/m4/utimensat.m4 +++ b/m4/utimensat.m4 @@ -1,4 +1,4 @@ -# serial 11 +# serial 12 # See if we need to provide utimensat replacement. dnl Copyright (C) 2009-2024 Free Software Foundation, Inc. @@ -83,6 +83,9 @@ AC_DEFUN([gl_FUNC_UTIMENSAT], # Guess yes on Linux or glibc systems. linux-* | linux | *-gnu* | gnu*) gl_cv_func_utimensat_works="guessing yes" ;; + # Guess yes on systems that emulate the Linux system calls. + midipix*) + gl_cv_func_utimensat_works="guessing yes" ;; # Guess 'nearly' on AIX. aix*) gl_cv_func_utimensat_works="guessing nearly" ;; From 783a511d1e31b5c9e5f9cb8ec27fd91d1b9078c9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 15 Feb 2024 14:23:43 +0800 Subject: [PATCH 225/385] Handle /assets and /content file names in `android-browse-url' * lisp/net/browse-url.el (android-browse-url): New function. * lisp/term/android-win.el (android-browse-url-internal): Update function declaration. * src/androidselect.c (Fandroid_browse_url): Rename to... (Fandroid_browse_url_internal): ... this. (syms_of_androidselect): Adjust to match. --- lisp/net/browse-url.el | 2 +- lisp/term/android-win.el | 44 ++++++++++++++++++++++++++++++++++++++++ src/androidselect.c | 20 +++++++++++------- 3 files changed, 58 insertions(+), 8 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index bc2a7db9a8b..ddc57724343 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1324,7 +1324,7 @@ and instant messengers instead of opening it in a web browser." :type 'boolean :version "30.1") -(declare-function android-browse-url "androidselect.c") +(declare-function android-browse-url "../term/android-win") ;;;###autoload (defun browse-url-default-android-browser (url &optional _new-window) diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el index e0d252f17e0..b7b0920626e 100644 --- a/lisp/term/android-win.el +++ b/lisp/term/android-win.el @@ -479,6 +479,50 @@ the UTF-8 coding system." ;; Return the concatenation of both these values. (concat locale-base locale-modifier))) + +;; Miscellaneous functions. + +(declare-function android-browse-url-internal "androidselect.c") + +(defun android-browse-url (url &optional send) + "Open URL in an external application. + +URL should be a URL-encoded URL with a scheme specified unless +SEND is non-nil. Signal an error upon failure. + +If SEND is nil, start a program that is able to display the URL, +such as a web browser. Otherwise, try to share URL using +programs such as email clients. + +If URL is a file URI, convert it into a `content' address +accessible to other programs." + (when-let* ((uri (url-generic-parse-url url)) + (filename (url-filename uri)) + ;; If `uri' is a file URI and the file resides in /content + ;; or /assets, copy it to a temporary file before + ;; providing it to other programs. + (replacement-url (and (string-match-p + "/\\(content\\|assets\\)[/$]" + filename) + (prog1 t + (copy-file + filename + (setq filename + (make-temp-file + "local" + nil + (let ((extension + (file-name-extension + filename))) + (if extension + (concat "." + extension) + nil)))) + t)) + (concat "file://" filename)))) + (setq url replacement-url)) + (android-browse-url-internal url send)) + (provide 'android-win) ;; android-win.el ends here. diff --git a/src/androidselect.c b/src/androidselect.c index 5b23c559d2c..61f1c6045db 100644 --- a/src/androidselect.c +++ b/src/androidselect.c @@ -237,15 +237,21 @@ DEFUN ("android-clipboard-exists-p", Fandroid_clipboard_exists_p, return rc ? Qt : Qnil; } -DEFUN ("android-browse-url", Fandroid_browse_url, - Sandroid_browse_url, 1, 2, 0, - doc: /* Open URL in an external application. URL should be a -URL-encoded URL with a scheme specified unless SEND is non-nil. -Signal an error upon failure. +DEFUN ("android-browse-url-internal", Fandroid_browse_url_internal, + Sandroid_browse_url_internal, 1, 2, 0, + doc: /* Open URL in an external application. + +URL should be a URL-encoded URL with a scheme specified unless SEND is +non-nil. Signal an error upon failure. If SEND is nil, start a program that is able to display the URL, such as a web browser. Otherwise, try to share URL using programs such as -email clients. */) +email clients. + +If URL is a file URI, convert it into a `content' address accessible to +other programs. Files inside the /content or /assets directories cannot +be opened through such addresses, which this function does not provide +for. Use `android-browse-url' instead. */) (Lisp_Object url, Lisp_Object send) { Lisp_Object value; @@ -803,7 +809,7 @@ syms_of_androidselect (void) defsubr (&Sandroid_set_clipboard); defsubr (&Sandroid_get_clipboard); defsubr (&Sandroid_clipboard_exists_p); - defsubr (&Sandroid_browse_url); + defsubr (&Sandroid_browse_url_internal); defsubr (&Sandroid_get_clipboard_targets); defsubr (&Sandroid_get_clipboard_data); From 60cff1ac9d216e5abcb350ea5e623ab0b377c131 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Tue, 16 Jan 2024 08:21:41 +0100 Subject: [PATCH 226/385] Add support for reading/writing IELM input history (bug#67000) * lisp/ielm.el (inferior-emacs-lisp-mode): Add support for saving input history to a file. (ielm--history-file-name): New variable indicating IELM input history file. (ielm--exit): Holds a function to call when Emacs is killed to write out the input history. (ielm--input-history-writer): Helper function for writing the IELM input history out to file. * lisp/comint.el (comint-input-ring-file-name): Improve defcustom tag. --- etc/NEWS | 8 ++++++++ lisp/comint.el | 2 +- lisp/ielm.el | 29 +++++++++++++++++++++++++++++ 3 files changed, 38 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index dc24d775bb1..5220a7fb337 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1357,6 +1357,14 @@ characters, such as ½ (U+00BD VULGAR FRACTION ONE HALF), are also recognized as rational fractions. They have been since 2004, but it looks like it was never mentioned in the NEWS, or even the manual. +** IELM + +--- +*** IELM now remembers input history between sessions. +The new user option 'ielm-history-file-name' is the name of the file +where IELM input history will be saved. Customize it to nil to revert +to the old behavior of not remembering input history between sessions. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/comint.el b/lisp/comint.el index 0a9cdb44bef..655ff30469c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -254,7 +254,7 @@ This variable is buffer-local." See also `comint-read-input-ring' and `comint-write-input-ring'. `comint-mode' makes this a buffer-local variable. You probably want to set this in a mode hook, rather than customize the default value." - :type '(choice (const :tag "nil" nil) + :type '(choice (const :tag "Disable input history" nil) file) :group 'comint) diff --git a/lisp/ielm.el b/lisp/ielm.el index 777aebb70cf..e583e0fe32c 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -110,6 +110,13 @@ This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs." :type 'boolean) +(defcustom ielm-history-file-name + (locate-user-emacs-file "ielm-history.eld") + "If non-nil, name of the file to read/write IELM input history." + :type '(choice (const :tag "Disable input history" nil) + file) + :version "30.1") + (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) (defcustom ielm-mode-hook nil "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." @@ -503,6 +510,17 @@ behavior of the indirect buffer." (funcall pp-default-function beg end) end)) +;;; Input history + +(defvar ielm--exit nil + "Function to call when Emacs is killed.") + +(defun ielm--input-history-writer (buf) + "Return a function writing IELM input history to BUF." + (lambda () + (with-current-buffer buf + (comint-write-input-ring)))) + ;;; Major mode (define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM" @@ -605,6 +623,17 @@ Customized bindings may be defined in `ielm-map', which currently contains: #'ielm-indirect-setup-hook 'append t) (setq comint-indirect-setup-function #'emacs-lisp-mode) + ;; Input history + (setq-local comint-input-ring-file-name ielm-history-file-name) + (setq-local ielm--exit (ielm--input-history-writer (current-buffer))) + (setq-local kill-buffer-hook + (lambda () + (funcall ielm--exit) + (remove-hook 'kill-emacs-hook ielm--exit))) + (unless noninteractive + (add-hook 'kill-emacs-hook ielm--exit)) + (comint-read-input-ring t) + ;; A dummy process to keep comint happy. It will never get any input (unless (comint-check-proc (current-buffer)) ;; Was cat, but on non-Unix platforms that might not exist, so From 3d6137116f6be8ee38f9f49c9811b97ef92e0e58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Feb 2024 12:04:07 +0200 Subject: [PATCH 227/385] Allow font-spec in 'face-font-rescale-alist' set at startup * lisp/startup.el (startup--rescale-elt-match-p): New function. (normal-top-level): Use it, instead of the naive 'string-match-p', to match the default font against the elements of 'face-font-rescale-alist'. Reported by Rahguzar . --- lisp/startup.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 773765a4b97..1c21b5de857 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -556,6 +556,17 @@ the updated value." (setq startup--original-eln-load-path (copy-sequence native-comp-eln-load-path)))) +(defun startup--rescale-elt-match-p (font-pattern font-object) + "Test whether FONT-OBJECT matches an element of `face-font-rescale-alist'. +FONT-OBJECT is a font-object that specifies a font to test. +FONT-PATTERN is the car of an element of `face-font-rescale-alist', +which can be either a regexp matching a font name or a font-spec." + (if (stringp font-pattern) + ;; FONT-PATTERN is a regexp, we need the name of FONT-OBJECT to match. + (string-match-p font-pattern (font-xlfd-name font-object)) + ;; FONT-PATTERN is a font-spec. + (font-match-p font-pattern font-object))) + (defvar android-fonts-enumerated nil "Whether or not fonts have been enumerated already. On Android, Emacs uses this variable internally at startup.") @@ -816,8 +827,9 @@ It is the default value of the variable `top-level'." (when (and (display-multi-font-p) (not (eq face-font-rescale-alist old-face-font-rescale-alist)) - (assoc (font-xlfd-name (face-attribute 'default :font)) - face-font-rescale-alist #'string-match-p)) + (assoc (face-attribute 'default :font) + face-font-rescale-alist + #'startup--rescale-elt-match-p)) (set-face-attribute 'default nil :font (font-spec))) ;; Modify the initial frame based on what .emacs puts into From e058380324e462c234bb3407d504807f22d825b0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 15 Feb 2024 22:11:14 +0800 Subject: [PATCH 228/385] Fix the MS-DOS build * configure.ac (REQUIRE_GNUISH_STRFTIME_AM_PM): Move definition to... * src/conf_post.h (REQUIRE_GNUISH_STRFTIME_AM_PM): ...conf_post.h. --- configure.ac | 2 -- src/conf_post.h | 4 ++++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index c162f880e48..847fdbd54d2 100644 --- a/configure.ac +++ b/configure.ac @@ -1566,8 +1566,6 @@ AC_DEFUN([gt_TYPE_WINT_T], AC_DEFUN_ONCE([gl_STDLIB_H], [AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) gl_NEXT_HEADERS([stdlib.h])]) -AC_DEFINE([REQUIRE_GNUISH_STRFTIME_AM_PM], [false], - [Emacs does not need glibc strftime behavior for AM and PM indicators.]) # Initialize gnulib right after choosing the compiler. dnl Amongst other things, this sets AR and ARFLAGS. diff --git a/src/conf_post.h b/src/conf_post.h index 83a0dd1b09b..f2353803074 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -471,3 +471,7 @@ extern int emacs_setenv_TZ (char const *); #undef MB_CUR_MAX #define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX #endif /* REPLACEMENT_MB_CUR_MAX */ + +/* Emacs does not need glibc strftime behavior for AM and PM + indicators. */ +#define REQUIRE_GNUISH_STRFTIME_AM_PM false From 7b34bb5c928798e0d40fce062c1b6d4b2ce06979 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 15 Feb 2024 19:36:05 +0200 Subject: [PATCH 229/385] project-or-external-find-regexp: Fix the docstring * lisp/progmodes/project.el (project-or-external-find-regexp): Fix the docstring (bug#68958). --- lisp/progmodes/project.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 983c0ed2ac2..aa92a73336e 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -992,9 +992,7 @@ requires quoting, e.g. `\\[quoted-insert]'." ;;;###autoload (defun project-or-external-find-regexp (regexp) - "Find all matches for REGEXP in the project roots or external roots. -With \\[universal-argument] prefix, you can specify the file name -pattern to search for." + "Find all matches for REGEXP in the project roots or external roots." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) From 4dbc3bbcc568182380d4646310a652285e210876 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Feb 2024 19:17:07 +0100 Subject: [PATCH 230/385] ; * lisp/emacs-lisp/comp.el (comp--write-bytecode-file): Add comment. --- lisp/emacs-lisp/comp.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6879e6aeeb9..593291a379e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3495,6 +3495,7 @@ last directory in `native-comp-eln-load-path')." else collect (byte-compile-file file)))) +;; In use by elisp-mode.el (defun comp--write-bytecode-file (eln-file) "After native compilation write the bytecode file for ELN-FILE. Make sure that eln file is younger than byte-compiled one and From cea72c1757cc45b42baf3a35fb4d963f3e722b9c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Feb 2024 15:09:13 -0500 Subject: [PATCH 231/385] (tex-font-lock-keywords-1): Fix bug#68827 * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-1): Don't apply `tex-verbatim` in comments. --- lisp/textmodes/tex-mode.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8968d8ec23b..5c5ca573f38 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -514,14 +514,19 @@ An alternative value is \" . \", if you use a font with a narrow period." (inbraces-re (lambda (re) (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) - `( ;; Highlight $$math$$ and $math$. + `(;; Verbatim-like args. + ;; Do it first, because we don't want to highlight them + ;; in comments (bug#68827), but we do want to highlight them + ;; in $math$. + (,(concat slash verbish opt arg) 3 'tex-verbatim keep) + ;; Highlight $$math$$ and $math$. ;; This is done at the very beginning so as to interact with the other ;; keywords in the same way as comments and strings. (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" (funcall inbraces-re (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) "*}\\)+\\$?\\$") - (0 'tex-math)) + (0 'tex-math keep)) ;; Heading args. (,(concat slash headings "\\*?" opt arg) ;; If ARG ends up matching too much (if the {} don't match, e.g.) @@ -543,8 +548,6 @@ An alternative value is \" . \", if you use a font with a narrow period." (,(concat slash variables " *" arg) 2 font-lock-variable-name-face) ;; Include args. (,(concat slash includes opt arg) 3 font-lock-builtin-face) - ;; Verbatim-like args. - (,(concat slash verbish opt arg) 3 'tex-verbatim t) ;; Definitions. I think. ("^[ \t]*\\\\def *\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face)))) From 45f9af61b8ecbe500de915f63de53e9c598184b9 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 8 Jan 2024 19:38:33 +0100 Subject: [PATCH 232/385] Remove references to phst@google.com. I don't work for Google any more, so I'll use my private address going forward. * .mailmap: Remove references to phst@google.com. --- .mailmap | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.mailmap b/.mailmap index 8454eb9154c..5e733728b5a 100644 --- a/.mailmap +++ b/.mailmap @@ -143,8 +143,7 @@ Philip Kaludercic Philip Kaludercic Philip Kaludercic Philip Kaludercic -Philipp Stephani -Philipp Stephani Philipp Stephani +Philipp Stephani Phillip Lord Pierre Lorenzon Pieter van Oostrum From 572d58b5e8d0f1f1244b9ccab8f02c4f50ca8d12 Mon Sep 17 00:00:00 2001 From: Tomas Volf <~@wolfsden.cz> Date: Thu, 15 Feb 2024 18:23:23 -0800 Subject: [PATCH 233/385] When deleting output in Eshell, optionally add it to the kill ring. * lisp/eshell/esh-mode.el (eshell-kill-output): Rename to... (eshell-delete-output): ... this, for consistency with 'comint-mode', and accept KILL argument. Update callers. Copyright-paperwork-exempt: yes --- lisp/eshell/esh-mode.el | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index fd279f61673..b15f99a0359 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -290,7 +290,7 @@ non-interactive sessions, such as when using `eshell-command'.") "C-e" #'eshell-show-maximum-output "C-f" #'eshell-forward-argument "C-m" #'eshell-copy-old-input - "C-o" #'eshell-kill-output + "C-o" #'eshell-delete-output "C-r" #'eshell-show-output "C-t" #'eshell-truncate-buffer "C-u" #'eshell-kill-input @@ -832,15 +832,23 @@ This function should be in the list `eshell-output-filter-functions'." eshell-last-output-start eshell-last-output-end)) -(defun eshell-kill-output () - "Kill all output from interpreter since last input. -Does not delete the prompt." - (interactive) +(defun eshell-delete-output (&optional kill) + "Delete all output from interpreter since last input. +If KILL is non-nil (interactively, the prefix), save the killed text in +the kill ring. + +This command does not delete the prompt." + (interactive "P") (save-excursion (goto-char (eshell-beginning-of-output)) (insert "*** output flushed ***\n") + (when kill + (copy-region-as-kill (point) (eshell-end-of-output))) (delete-region (point) (eshell-end-of-output)))) +(define-obsolete-function-alias 'eshell-kill-output + #'eshell-delete-output "30.1") + (defun eshell-show-output (&optional arg) "Display start of this batch of interpreter output at top of window. Sets mark to the value of point when this command is run. From 44a1721156ec29e5799da94f7918f217f52fd751 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 16 Feb 2024 09:04:46 -0500 Subject: [PATCH 234/385] * lisp/loadup.el (lexical-binding): Add a comment --- lisp/loadup.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/loadup.el b/lisp/loadup.el index c498c0e53af..c6a8dcbb909 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -635,6 +635,8 @@ directory got moved. This is set to be a pair in the form of: (unwind-protect (let ((tmp-dump-mode dump-mode) (dump-mode nil) + ;; Set `lexical-binding' to nil by default + ;; in the dumped Emacs. (lexical-binding nil)) (if (member tmp-dump-mode '("pdump" "pbootstrap")) (dump-emacs-portable (expand-file-name output invocation-directory)) From 4b89fb08bdd7d0249698bc0ed578555d6755724d Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 16 Feb 2024 22:17:01 +0800 Subject: [PATCH 235/385] * src/androidvfs.c (android_scan_directory_tree): Get rid of xstrdup. --- src/androidvfs.c | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/src/androidvfs.c b/src/androidvfs.c index 78f6b6da6a8..3030bd56cdc 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -1018,8 +1018,8 @@ android_extract_long (char *pointer) static const char * android_scan_directory_tree (char *file, size_t *limit_return) { - char *token, *saveptr, *copy, *copy1, *start, *max, *limit; - size_t token_length, ntokens, i; + char *token, *saveptr, *copy, *start, *max, *limit; + size_t token_length, ntokens, i, len; char *tokens[10]; USE_SAFE_ALLOCA; @@ -1031,11 +1031,14 @@ android_scan_directory_tree (char *file, size_t *limit_return) limit = (char *) directory_tree + directory_tree_size; /* Now, split `file' into tokens, with the delimiter being the file - name separator. Look for the file and seek past it. */ + name separator. Look for the file and seek past it. Create a copy + of FILE for the enjoyment of `strtok_r'. */ ntokens = 0; saveptr = NULL; - copy = copy1 = xstrdup (file); + len = strlen (file) + 1; + copy = SAFE_ALLOCA (len); + memcpy (copy, file, len); memset (tokens, 0, sizeof tokens); while ((token = strtok_r (copy, "/", &saveptr))) @@ -1044,19 +1047,14 @@ android_scan_directory_tree (char *file, size_t *limit_return) /* Make sure ntokens is within bounds. */ if (ntokens == ARRAYELTS (tokens)) - { - xfree (copy1); - goto fail; - } + goto fail; - tokens[ntokens] = SAFE_ALLOCA (strlen (token) + 1); - memcpy (tokens[ntokens], token, strlen (token) + 1); + len = strlen (token) + 1; + tokens[ntokens] = SAFE_ALLOCA (len); + memcpy (tokens[ntokens], token, len); ntokens++; } - /* Free the copy created for strtok_r. */ - xfree (copy1); - /* If there are no tokens, just return the start of the directory tree. */ From 5b65c2ad7526ec081ac37d32c87e9b58e787d66a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 17 Feb 2024 10:27:26 +0800 Subject: [PATCH 236/385] Properly record mtime after insert-file-contents on Android * src/fileio.c (write_region): Do not verify file identity after retreiving file status for the second time if st_ino is 0. --- src/fileio.c | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/fileio.c b/src/fileio.c index a92da93ae48..483498fd879 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5628,7 +5628,15 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, changed to a call to `stat'. */ if (emacs_fstatat (AT_FDCWD, fn, &st1, 0) == 0 - && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino) + && st.st_dev == st1.st_dev + && (st.st_ino == st1.st_ino +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + /* `st1.st_ino' == 0 indicates that the inode number + cannot be extracted from this document file, despite + `st' potentially being backed by a real file. */ + || st1.st_ino == 0 +#endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */ + )) { /* Use the heuristic if it appears to be valid. With neither O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the From 537914561eb3809e34b9daf8c2b4719ae9b30a6b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 17 Feb 2024 10:33:54 +0800 Subject: [PATCH 237/385] * java/debug.sh: Print errors correctly if device is ambiguous. --- java/debug.sh | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/java/debug.sh b/java/debug.sh index 8fc03d014cf..c5d40141355 100755 --- a/java/debug.sh +++ b/java/debug.sh @@ -104,13 +104,14 @@ if [ -z "$devices" ]; then exit 1 fi -if [ -z $device ]; then - device=$devices +if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z $device ]; then + echo "Multiple devices are available. Please specify one with" + echo "the option --device and try again." + exit 1 fi -if [ `wc -w <<< "$devices"` -gt 1 ] && [ -z device ]; then - echo "Multiple devices are available. Please pick one using" - echo "--device and try again." +if [ -z $device ]; then + device=$devices fi echo "Looking for $package on device $device" @@ -189,6 +190,8 @@ if [ "$attach_existing" != "yes" ]; then package_pids=`awk -f tmp.awk <<< $package_pids` fi +rm tmp.awk + pid=$package_pids num_pids=`wc -w <<< "$package_pids"` From e288e1b2f352952e826727967a406c8675fd5594 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 15 Feb 2024 20:17:20 -0800 Subject: [PATCH 238/385] Remove "erc-" prefixed Compat definitions * lisp/erc/erc-compat.el: Remove NO-ERROR argument from top-level `require' for library `compat' because it's guaranteed to be present. (erc-compat-function, erc-compat-call): Redefine as obsolete aliases for unprefixed namesakes. * lisp/erc/erc-fill.el (erc-fill-wrap-nudge): Use `compat-call' instead of `erc-compat-call'. --- lisp/erc/erc-compat.el | 46 +++--------------------------------------- lisp/erc/erc-fill.el | 2 +- 2 files changed, 4 insertions(+), 44 deletions(-) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 9b8699f6949..b5b8fbaf8ab 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -31,51 +31,11 @@ ;;; Code: -(require 'compat nil 'noerror) +(require 'compat) (eval-when-compile (require 'cl-lib)) -;; Except for the "erc-" namespacing, these two definitions should be -;; continuously updated to match the latest upstream ones verbatim. -;; Although they're pretty simple, it's likely not worth checking for -;; and possibly deferring to the non-prefixed versions. -;; -;; BEGIN Compat macros - -;;;; Macros for extended compatibility function calls - -(defmacro erc-compat-function (fun) - "Return compatibility function symbol for FUN. - -If the Emacs version provides a sufficiently recent version of -FUN, the symbol FUN is returned itself. Otherwise the macro -returns the symbol of a compatibility function which supports the -behavior and calling convention of the current stable Emacs -version. For example Compat 29.1 will provide compatibility -functions which implement the behavior and calling convention of -Emacs 29.1. - -See also `compat-call' to directly call compatibility functions." - (let ((compat (intern (format "compat--%s" fun)))) - `#',(if (fboundp compat) compat fun))) - -(defmacro erc-compat-call (fun &rest args) - "Call compatibility function or macro FUN with ARGS. - -A good example function is `plist-get' which was extended with an -additional predicate argument in Emacs 29.1. The compatibility -function, which supports this additional argument, can be -obtained via (compat-function plist-get) and called -via (compat-call plist-get plist prop predicate). It is not -possible to directly call (plist-get plist prop predicate) on -Emacs older than 29.1, since the original `plist-get' function -does not yet support the predicate argument. Note that the -Compat library never overrides existing functions. - -See also `compat-function' to lookup compatibility functions." - (let ((compat (intern (format "compat--%s" fun)))) - `(,(if (fboundp compat) compat fun) ,@args))) - -;; END Compat macros +(define-obsolete-function-alias 'erc-compat-function #'compat-function "30.1") +(define-obsolete-function-alias 'erc-compat-call #'compat-call "30.1") ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index b91ce007087..547b3a11043 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -832,7 +832,7 @@ decorations applied by third-party modules." (line (count-screen-lines (window-start) (window-point)))) (when (zerop arg) (setq arg 1)) - (erc-compat-call + (compat-call set-transient-map (let ((map (make-sparse-keymap))) (dolist (key '(?= ?- ?0)) From a43b062ee57fd9b7c410e741946e51281db5b92a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 8 Feb 2024 19:19:53 -0800 Subject: [PATCH 239/385] ; Load erc-compat before ert-x in ERC tests Avoid eager macro-expansion error in tests files on Emacs 27 and 28 by ensuring definitions provided by Compat, like `macroexp-file-name', load first. * lisp/erc/erc-speedbar.el (erc-speedbar--reset-last-ran-on-timer): Suppress "`buffer-local-value' is an obsolete generalized variable" warning on Emacs 29 and below. * lisp/erc/erc-stamp.el (erc-stamp--time-as-day): Avoid "unused lexical variable `current-time-list'" warning on 28 and below. * lisp/erc/erc.el (erc-check-text-conversion): Add `defvar' for `text-conversion-style' to avoid "reference to free variable" warning on Emacs 29 and below. * test/lisp/erc/erc-button-tests.el: Load `erc-button' before `ert-x'. * test/lisp/erc/erc-fill-tests.el: Load `erc-fill' before `ert-x'. * test/lisp/erc/erc-goodies-tests.el: Load `erc-goodies' before `ert-x'. * test/lisp/erc/erc-networks-tests.el: Explicitly load `erc-compat' before anything else. * test/lisp/erc/erc-scenarios-base-renick.el: Update timeouts. * test/lisp/erc/erc-stamp-tests.el: Load `erc-stamp' before `ert-x'. * test/lisp/erc/erc-tests.el: Load `erc-ring' before `ert-x'. --- lisp/erc/erc-speedbar.el | 5 +++-- lisp/erc/erc-stamp.el | 1 + lisp/erc/erc.el | 1 + test/lisp/erc/erc-button-tests.el | 3 +-- test/lisp/erc/erc-fill-tests.el | 4 ++-- test/lisp/erc/erc-goodies-tests.el | 4 ++-- test/lisp/erc/erc-networks-tests.el | 1 + test/lisp/erc/erc-scenarios-base-renick.el | 8 ++++---- test/lisp/erc/erc-stamp-tests.el | 6 +++--- test/lisp/erc/erc-tests.el | 2 +- 10 files changed, 19 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index e3d28aa60dd..a81a3869436 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -566,8 +566,9 @@ The INDENT level is ignored." (defun erc-speedbar--reset-last-ran-on-timer () "Reset `erc-speedbar--last-ran'." (when speedbar-buffer - (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) - (current-time)))) + (with-suppressed-warnings ((obsolete buffer-local-value)) ; <=29 + (setf (buffer-local-value 'erc-speedbar--last-ran speedbar-buffer) + (current-time))))) ;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t) (define-erc-module nickbar nil diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index a11739a4195..a8190a2c94a 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -828,6 +828,7 @@ left-sided stamps and date stamps inserted by this function." ;; perform day alignments via this function only when needed. (defun erc-stamp--time-as-day (current-time) "Discard hour, minute, and second info from timestamp CURRENT-TIME." + (defvar current-time-list) ; <=28 (let* ((current-time-list) ; flag (decoded (decode-time current-time erc-stamp--tz))) (setf (decoded-time-second decoded) 0 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 08dfa4b8f1b..88227688064 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9492,6 +9492,7 @@ guarantee that the input method functions properly for the purpose of typing within the ERC prompt." (when (and (eq major-mode 'erc-mode) (fboundp 'set-text-conversion-style)) + (defvar text-conversion-style) ; avoid free variable warning on <=29 (if (>= (point) (erc-beg-of-input-line)) (unless (eq text-conversion-style 'action) (set-text-conversion-style 'action)) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ba6fe9fd8c1..603b3745a27 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -20,14 +20,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-button) (require 'ert-x) ; cl-lib (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-button) - (ert-deftest erc-button-alist--url () (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 0f19b481f37..2c3537676a7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -23,13 +23,13 @@ ;; scenarios. ;;; Code: +(require 'erc-fill) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-fill) - (defvar erc-fill-tests--buffers nil) (defvar erc-fill-tests--current-time-value nil) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 170e28bda96..7013ce0c8fc 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -19,13 +19,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-goodies) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-goodies) - (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 53cff8f489c..90b8aa99741 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -18,6 +18,7 @@ ;; along with GNU Emacs. If not, see . ;;; Code: +(require 'erc-compat) (require 'ert-x) ; cl-lib (eval-and-compile diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index ca22728b152..e0fcb8b9366 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -281,12 +281,12 @@ (should-not (get-buffer "rando@barnet")) (with-current-buffer "frenemy@foonet" - (funcall expect 1 "now known as") - (funcall expect 1 "doubly so")) + (funcall expect 10 "now known as") + (funcall expect 10 "doubly so")) (with-current-buffer "frenemy@barnet" - (funcall expect 1 "now known as") - (funcall expect 1 "reality picture")) + (funcall expect 10 "now known as") + (funcall expect 10 "reality picture")) (when noninteractive (with-current-buffer "frenemy@barnet" (kill-buffer)) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 70ca224ac74..a49173ffa2f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -20,14 +20,14 @@ ;;; Commentary: ;;; Code: +(require 'erc-stamp) +(require 'erc-goodies) ; for `erc-make-read-only' + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-stamp) -(require 'erc-goodies) ; for `erc-make-read-only' - ;; These display-oriented tests are brittle because many factors ;; influence how text properties are applied. We should just ;; rework these into full scenarios. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7d189d37929..dad161a2827 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -20,13 +20,13 @@ ;; along with GNU Emacs. If not, see . ;;; Code: +(require 'erc-ring) (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-ring) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) From 1a36d52413c784750f650ccba95436e4f76ab104 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 3 Feb 2024 17:17:48 -0800 Subject: [PATCH 240/385] Autoload custom-loads for new Custom groups in erc.el * lisp/erc/erc.el: Add `custom-loads' library features for group symbols `erc-spelling' and `erc-imenu' since they aren't defined in all supported Emacs versions. Also add groups `erc-sasl' and `erc-nicks', new libraries recently added to ERC. Note that this is unrelated to prefixes generated for the help system. (Bug#68943) --- lisp/erc/erc.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 88227688064..db5a9baf5c3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -135,6 +135,13 @@ concerning buffers." "Running scripts at startup and with /LOAD." :group 'erc) +;; Add `custom-loads' features for group symbols missing from a +;; supported Emacs version, possibly because they belong to a new ERC +;; library. These groups all share their library's feature name. +;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29 +;;;###autoload erc-imenu erc-nicks)) ; 30 +;;;###autoload (custom-add-load symbol symbol)) + (defvar erc-message-parsed) ; only known to this file (defvar erc--msg-props nil From 9668b4f97c2fc6bfff83258861d455a6d02516a8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Nov 2023 12:07:36 -0800 Subject: [PATCH 241/385] Make erc-fill-wrap depend on scrolltobottom * lisp/erc/erc-fill.el (erc-fill-mode): Add reference to `erc-fill-wrap-mode' in doc string. (erc--fill-wrap-scrolltobottom-exempt-p): New variable to allow tests involving `fill-wrap' to opt out of having to enable `scrolltobottom'. (erc-fill--wrap-ensure-dependencies): Warn and enable `erc-scrolltobottom-mode' if necessary. (erc-fill-wrap-mode): Mention workaround for automatically enabling `scrolltobottom'. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Exempt tests from `scrolltobottom' dependency. * test/lisp/erc/resources/erc-scenarios-common.el: Load `erc-fill' when compiling. (erc-scenarios-common--print-trace): Exempt tests using `fill-wrap' from the `scrolltobottom' dependency by making `erc--fill-wrap-scrolltobottom-exempt-p' non-nil during test runs. (Bug#60936) --- lisp/erc/erc-fill.el | 62 ++++++++++--------- test/lisp/erc/erc-fill-tests.el | 1 + .../erc/resources/erc-scenarios-common.el | 4 +- 3 files changed, 36 insertions(+), 31 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 547b3a11043..aa12b807fbc 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -44,11 +44,7 @@ (define-erc-module fill nil "Manage filling in ERC buffers. ERC fill mode is a global minor mode. When enabled, messages in -the channel buffers are filled." - ;; FIXME ensure a consistent ordering relative to hook members from - ;; other modules. Ideally, this module's processing should happen - ;; after "morphological" modifications to a message's text but - ;; before superficial decorations. +channel buffers are filled. See also `erc-fill-wrap-mode'." ((add-hook 'erc-insert-modify-hook #'erc-fill 60) (add-hook 'erc-send-modify-hook #'erc-fill 60)) ((remove-hook 'erc-insert-modify-hook #'erc-fill) @@ -425,8 +421,11 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." " " #'erc-fill--wrap-beginning-of-line) (defvar erc-button-mode) +(defvar erc-scrolltobottom-mode) (defvar erc-legacy-invisible-bounds-p) +(defvar erc--fill-wrap-scrolltobottom-exempt-p nil) + (defun erc-fill--wrap-ensure-dependencies () (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (when erc-legacy-invisible-bounds-p @@ -439,6 +438,10 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (unless erc-fill-mode (push 'fill missing-deps) (erc-fill-mode +1)) + (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p + (memq 'scrolltobottom erc-modules)) + (push 'scrolltobottom missing-deps) + (erc-scrolltobottom-mode +1)) (when erc-fill-wrap-merge (require 'erc-button) (unless erc-button-mode @@ -459,27 +462,25 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. -This module displays nicks overhanging leftward to a common -offset, as determined by the option `erc-fill-static-center'. -And it \"wraps\" messages at a common margin width, as determined -by the option `erc-fill-wrap-margin-width'. To use it, either -include `fill-wrap' in `erc-modules' or set `erc-fill-function' -to `erc-fill-wrap'. Most users will want to enable the -`scrolltobottom' module as well. -During sessions in which this module is active, use -\\[erc-fill-wrap-nudge] to adjust the width of the indent and the -stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for -cycling between logical- and screen-line oriented command -movement. Similarly, use \\[erc-fill-wrap-refill-buffer] to fix -alignment problems after running certain commands, like -`text-scale-adjust'. Also see related stylistic options -`erc-fill-wrap-merge', and `erc-fill-wrap-merge-indicator'. -\(Hint: in narrow windows, where is space tight, try setting -`erc-fill-static-center' to 1. And if you also use the option -`erc-fill-wrap-merge-indicator', set that to value-menu item -\"Leading MIDDLE DOT sans gap\" or one of the various -\"trailing\" items.) +This module displays nicks overhanging leftward to a common +offset, as determined by the option `erc-fill-static-center'. It +also \"wraps\" messages at a common width, as determined by the +option `erc-fill-wrap-margin-width'. To use it, either include +`fill-wrap' in `erc-modules' or set `erc-fill-function' to +`erc-fill-wrap'. + +Once enabled, use \\[erc-fill-wrap-nudge] to adjust the width of +the indent and the stamp margin. And For cycling between +logical- and screen-line oriented command movement, see +\\[erc-fill-wrap-toggle-truncate-lines]. Similarly, use +\\[erc-fill-wrap-refill-buffer] to fix alignment problems after +running certain commands, like `text-scale-adjust'. Also see +related stylistic options `erc-fill-wrap-merge', and +`erc-fill-wrap-merge-indicator'. (Hint: in narrow windows, try +setting `erc-fill-static-center' to 1, and if you use +`erc-fill-wrap-merge-indicator', choose \"Leading MIDDLE DOT sans +gap\" or one of the \"trailing\" items from the Customize menu.) This module imposes various restrictions on the appearance of timestamps. Most notably, it insists on displaying them in the @@ -497,11 +498,12 @@ a workaround provided by `erc-stamp-prefix-log-filter', which strips trailing stamps from logged messages and instead prepends them to every line. -As a so-called \"local\" module, `fill-wrap' depends on the -global modules `fill', `stamp', and `button'; it activates them -as needed when initializing. Please note that enabling and -disabling this module by invoking one of its minor-mode toggles -is not recommended." +A so-called \"local\" module, `fill-wrap' depends on the global +modules `fill', `stamp', `button', and `scrolltobottom'. It +activates them as needed when initializing and leaves them +enabled when shutting down. To opt out of `scrolltobottom' +specifically, disable its minor mode, `erc-scrolltobottom-mode', +via `erc-fill-wrap-mode-hook'." ((erc-fill--wrap-ensure-dependencies) (erc--restore-initialize-priors erc-fill-wrap-mode erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 2c3537676a7..3c4ad04abd7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -52,6 +52,7 @@ (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 042b3a8c05b..9ad5ce49429 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -94,7 +94,8 @@ (require 'erc) (eval-when-compile (require 'erc-join) - (require 'erc-services)) + (require 'erc-services) + (require 'erc-fill)) (declare-function erc-network "erc-networks") (defvar erc-network) @@ -148,6 +149,7 @@ (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) From d7c18a7b4f218de8c4d2178c9124ea26c7dc5b6b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 20:42:18 -0800 Subject: [PATCH 242/385] Ignore the TGT-LIST parameter in erc-open * etc/ERC-NEWS: Mention `erc-open' now ignores TGT-LIST. * lisp/erc/erc.el (erc-open): Set `erc-default-recipients' to a list containing only the supplied target. Other values may cause ERC to malfunction. Also redo doc string. --- etc/ERC-NEWS | 10 ++++++++++ lisp/erc/erc.el | 37 +++++++++++++++---------------------- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 1e88500d169..b2aceaa9f39 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -502,6 +502,16 @@ encouraged to keep a module's name aligned with its group's as well as the provided feature of its containing library, if only for the usual reasons of namespace hygiene and discoverability. +*** The function 'erc-open' no longer uses the 'TGT-LIST' parameter. +ERC has always used the parameter to initialize the local variable +'erc-default-recipients', which stores a list of routing targets with +the topmost considered "active." However, since at least ERC 5.1, a +buffer and its active target effectively mate for life, making +'TGT-LIST', in practice, a read-only list of a single target. And +because that target must also appear as the 'CHANNEL' parameter, +'TGT-LIST' mainly serves to reinforce 'erc-open's reputation of being +unruly. + *** ERC supports arbitrary CHANTYPES. Specifically, channels can be prefixed with any predesignated character, mainly to afford more flexibility to specialty services, diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index db5a9baf5c3..94e98bd7660 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2486,29 +2486,22 @@ nil." (cl-assert (= (point) (point-max))))) (defun erc-open (&optional server port nick full-name - connect passwd tgt-list channel process + connect passwd _tgt-list channel process client-certificate user id) - "Connect to SERVER on PORT as NICK with USER and FULL-NAME. + "Return a new or reinitialized server or target buffer. +If CONNECT is non-nil, connect to SERVER and return its new or +reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs +to an active session, and return a new or refurbished target buffer for +CHANNEL, which may also be a query target (the parameter name remains +for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and +PASSWD to `erc-determine-parameters' for preserving as session-local +variables. Do something similar for CLIENT-CERTIFICATE and ID, which +should be as described by `erc-tls'. -If CONNECT is non-nil, connect to the server. Otherwise assume -already connected and just create a separate buffer for the new -target given by CHANNEL, meaning these parameters are mutually -exclusive. Note that CHANNEL may also be a query; its name has -been retained for historical reasons. - -Use PASSWD as user password on the server. If TGT-LIST is -non-nil, use it to initialize `erc-default-recipients'. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the file name of the private key corresponding -to a client certificate and the second element is the file name -of the client certificate itself to use when connecting over TLS, -or t, which means that `auth-source' will be queried for the -private key and the certificate. - -When non-nil, ID should be a symbol for identifying the connection. - -Returns the buffer for the given server or channel." +Note that ERC ignores TGT-LIST and initializes `erc-default-recipients' +with CHANNEL as its only member. Note also that this function has the +side effect of setting the current buffer to the one it returns. Use +`with-current-buffer' or `save-excursion' to nullify this effect." (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) @@ -2545,7 +2538,7 @@ Returns the buffer for the given server or channel." ;; connection parameters (setq erc-server-process process) ;; stack of default recipients - (setq erc-default-recipients tgt-list) + (when channel (setq erc-default-recipients (list channel))) (when target (setq erc--target target erc-network (erc-network))) From 25d15391f2683ea95c4d7ee291fb82e0c9858d73 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 17:15:14 -0800 Subject: [PATCH 243/385] Normalize ISUPPORT params with empty values in ERC * lisp/erc/erc-backend.el (erc-server-parameters) (erc--isupport-params): Mention parsing and storage behavior regarding nonstandard "FOO=" tokens. (erc--parse-isupport-value): Move comment closer to code. (erc--get-isupport-entry): Treat the empty string as truly null, as prescribed by the Brocklesby draft cited in the top-level comment. * test/lisp/erc/erc-tests.el (erc--get-isupport-entry): Add case for the empty string appearing as a value for an `erc-server-parameters' item. (erc-server-005): Assert compat-related behavior of retaining the empty string as a valid value from a raw "FOO=" token. (Bug#67220) --- lisp/erc/erc-backend.el | 21 +++++++++++++-------- test/lisp/erc/erc-tests.el | 26 ++++++++++++++++++-------- 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index e379066b08e..2aaedad1b64 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -254,6 +254,11 @@ Entries are of the form: or (PARAMETER) if no value is provided. +where PARAMETER is a string and VALUE is a string or nil. For +compatibility, a raw parameter of the form \"FOO=\" becomes +(\"FOO\" . \"\") even though it's equivalent to the preferred +canonical form \"FOO\" and its lisp representation (\"FOO\"). + Some examples of possible parameters sent by servers: CHANMODES=b,k,l,imnpst - list of supported channel modes CHANNELLEN=50 - maximum length of channel names @@ -273,7 +278,8 @@ WALLCHOPS - supports sending messages to all operators in a channel") (defvar-local erc--isupport-params nil "Hash map of \"ISUPPORT\" params. Keys are symbols. Values are lists of zero or more strings with hex -escapes removed.") +escapes removed. ERC normalizes incoming parameters of the form +\"FOO=\" to (FOO).") ;;; Server and connection state @@ -2150,10 +2156,6 @@ Then display the welcome message." ;; ;; > The server SHOULD send "X", not "X="; this is the normalized form. ;; - ;; Note: for now, assume the server will only send non-empty values, - ;; possibly with printable ASCII escapes. Though in practice, the - ;; only two escapes we're likely to see are backslash and space, - ;; meaning the pattern is too liberal. (let (case-fold-search) (mapcar (lambda (v) @@ -2164,7 +2166,9 @@ Then display the welcome message." (string-match "[\\]x[0-9A-F][0-9A-F]" v start)) (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0)) c (string-to-number m 16)) - (if (<= ?\ c ?~) + ;; In practice, this range is too liberal. The only + ;; escapes we're likely to see are ?\\, ?=, and ?\s. + (if (<= ?\s c ?~) (setq v (concat (substring v 0 (match-beginning 0)) (string c) (substring v (match-end 0))) @@ -2189,8 +2193,9 @@ primitive value." (or erc-server-parameters (erc-with-server-buffer erc-server-parameters))))) - (if (cdr v) - (erc--parse-isupport-value (cdr v)) + (if-let ((val (cdr v)) + ((not (string-empty-p val)))) + (erc--parse-isupport-value val) '--empty--))))) (pcase value ('--empty-- (unless single (list key))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index dad161a2827..4762be468a5 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1054,7 +1054,8 @@ (ert-deftest erc--get-isupport-entry () (let ((erc--isupport-params (make-hash-table)) - (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C"))) + (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C") + ("SPAM" . ""))) (items (lambda () (cl-loop for k being the hash-keys of erc--isupport-params using (hash-values v) collect (cons k v))))) @@ -1075,7 +1076,9 @@ (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1"))) (should (equal (funcall items) - '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))))) + '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))) + (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM))) + (should-not (erc--get-isupport-entry 'SPAM 'single)))) (ert-deftest erc-server-005 () (let* ((hooked 0) @@ -1093,34 +1096,41 @@ (lambda (_ _ _ line) (push line calls)))) (ert-info ("Baseline") - (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...") + (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" + "are supp...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ov)@+") ("EXCEPTS") + ;; Should be ("CHANTYPES") but + ;; retained for compatibility. + ("CHANTYPES" . "") ("BOT" . "B")))) (should (zerop (hash-table-count erc--isupport-params))) (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) - (should (string= (pop calls) - "BOT=B EXCEPTS PREFIX=(ov)@+ are supp...")) + (should (string= + (pop calls) + "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp...")) (should (equal args (erc-response.command-args parsed))))) (erc-call-hooks nil parsed)) (ert-info ("Negated, updated") - (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...") + (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+" + "are su...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) - (should (string= (pop calls) - "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su...")) + (should (string-prefix-p + "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ " + (pop calls))) (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) (should-not (erc--get-isupport-entry 'EXCEPTS)) From 3d87e343276081247102838b827b8a1f5e9e0c54 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Feb 2024 20:01:54 -0800 Subject: [PATCH 244/385] Use modern fallback for channel name detection in ERC * lisp/erc/erc-backend.el (erc-query-buffer-p): Remove forward declaration. * lisp/erc/erc.el (erc-query-buffer-p): Defer to `erc-channel-p'. (erc-channel-p): Refactor and use `erc--fallback-channel-prefixes' for the default CHANTYPES value. Honor an empty CHANTYPES value as valid, e.g., for servers that only support direct messages. (erc--fallback-channel-prefixes): New variable to hold fallback CHANTYPES prefixes recommended by RFC1459 and modern authorities on the matter. * test/lisp/erc/erc-tests.el (erc-channel-p): Revise test. (Bug#67220) --- lisp/erc/erc-backend.el | 1 - lisp/erc/erc.el | 32 ++++++++++++++--------------- test/lisp/erc/erc-tests.el | 42 ++++++++++++++++++++++++-------------- 3 files changed, 42 insertions(+), 33 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2aaedad1b64..7b782d0ef44 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -158,7 +158,6 @@ (declare-function erc-parse-user "erc" (string)) (declare-function erc-process-away "erc" (proc away-p)) (declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) -(declare-function erc-query-buffer-p "erc" (&optional buffer)) (declare-function erc-remove-channel-member "erc" (channel nick)) (declare-function erc-remove-channel-users "erc" nil) (declare-function erc-remove-user "erc" (nick)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 94e98bd7660..f250584e47a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1663,11 +1663,7 @@ If BUFFER is nil, the current buffer is used." (defun erc-query-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC query buffer. If BUFFER is nil, the current buffer is used." - (with-current-buffer (or buffer (current-buffer)) - (let ((target (erc-target))) - (and (eq major-mode 'erc-mode) - target - (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) + (not (erc-channel-p (or buffer (current-buffer))))) (defun erc-ison-p (nick) "Return non-nil if NICK is online." @@ -1882,18 +1878,20 @@ buries those." :group 'erc-buffers :type 'boolean) -(defun erc-channel-p (channel) - "Return non-nil if CHANNEL seems to be an IRC channel name." - (cond ((stringp channel) - (memq (aref channel 0) - (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single))) - (append types nil) - '(?# ?& ?+ ?!)))) - ((and-let* (((bufferp channel)) - ((buffer-live-p channel)) - (target (buffer-local-value 'erc--target channel))) - (erc-channel-p (erc--target-string target)))) - (t nil))) +(defvar erc--fallback-channel-prefixes "#&" + "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.") + +(defun erc-channel-p (target) + "Return non-nil if TARGET is a valid channel name or a channel buffer." + (cond ((stringp target) + (and-let* + (((not (string-empty-p target))) + (value (let ((entry (erc--get-isupport-entry 'CHANTYPES))) + (if entry (cadr entry) erc--fallback-channel-prefixes))) + ((erc--strpos (aref target 0) value))))) + ((and-let* (((buffer-live-p target)) + (target (buffer-local-value 'erc--target target)) + ((erc--target-channel-p target))))))) ;; For the sake of compatibility, a historical quirk concerning this ;; option, when nil, has been preserved: all buffers are suffixed with diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4762be468a5..085b063bdb2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1167,25 +1167,37 @@ (should (equal (erc-downcase "\\O/") "|o/" ))))) (ert-deftest erc-channel-p () - (let ((erc--isupport-params (make-hash-table)) - erc-server-parameters) + (erc-tests-common-make-server-buf) - (should (erc-channel-p "#chan")) - (should (erc-channel-p "##chan")) - (should (erc-channel-p "&chan")) - (should (erc-channel-p "+chan")) - (should (erc-channel-p "!chan")) - (should-not (erc-channel-p "@chan")) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "##chan")) + (should (erc-channel-p "&chan")) + (should-not (erc-channel-p "+chan")) + (should-not (erc-channel-p "!chan")) + (should-not (erc-channel-p "@chan")) - (push '("CHANTYPES" . "#&@+!") erc-server-parameters) + ;; Server sends "CHANTYPES=#&+!" + (should-not erc-server-parameters) + (setq erc-server-parameters '(("CHANTYPES" . "#&+!"))) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "&chan")) + (should (erc-channel-p "+chan")) + (should (erc-channel-p "!chan")) - (should (erc-channel-p "!chan")) - (should (erc-channel-p "#chan")) + (with-current-buffer (erc--open-target "#chan") + (should (erc-channel-p (current-buffer)))) + (with-current-buffer (erc--open-target "+chan") + (should (erc-channel-p (current-buffer)))) + (should (erc-channel-p (get-buffer "#chan"))) + (should (erc-channel-p (get-buffer "+chan"))) - (with-current-buffer (get-buffer-create "#chan") - (setq erc--target (erc--target-from-string "#chan"))) - (should (erc-channel-p (get-buffer "#chan")))) - (kill-buffer "#chan")) + ;; Server sends "CHANTYPES=" because it's query only. + (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params) + (should-not (erc-channel-p "#spam")) + (should-not (erc-channel-p "&spam")) + (should-not (erc-channel-p (save-excursion (erc--open-target "#spam")))) + + (erc-tests-common-kill-buffers)) (ert-deftest erc--valid-local-channel-p () (ert-info ("Local channels not supported") From de6f7f3c86ea0e52e8f9825585c726a7f93fa9cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sat, 10 Feb 2024 16:14:08 +0100 Subject: [PATCH 245/385] Refine shebang tests (bug#64939) * test/lisp/files-tests.el (files-tests--check-shebang): For shell-script modes, verify that the correct shell is set. (files-tests-auto-mode-interpreter): Prefer 'sh-base-mode' to 'sh-mode' to stay tree-sitter-agnostic; re-organize test cases to make future ones easier to add. --- test/lisp/files-tests.el | 45 ++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 718ecd51f8b..23516ff0d7d 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1656,30 +1656,39 @@ The door of all subtleties! (should (equal (file-name-base "foo") "foo")) (should (equal (file-name-base "foo/bar") "bar"))) -(defun files-tests--check-shebang (shebang expected-mode) - "Assert that mode for SHEBANG derives from EXPECTED-MODE." - (let ((actual-mode - (ert-with-temp-file script-file - :text shebang - (find-file script-file) - (if (derived-mode-p expected-mode) - expected-mode - major-mode)))) - ;; Tuck all the information we need in the `should' form: input - ;; shebang, expected mode vs actual. - (should - (equal (list shebang actual-mode) - (list shebang expected-mode))))) +(defvar sh-shell) + +(defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect) + "Assert that mode for SHEBANG derives from EXPECTED-MODE. + +If EXPECTED-MODE is sh-base-mode, DIALECT says what `sh-shell' should be +set to." + (ert-with-temp-file script-file + :text shebang + (find-file script-file) + (let ((actual-mode (if (derived-mode-p expected-mode) + expected-mode + major-mode))) + ;; Tuck all the information we need in the `should' form: input + ;; shebang, expected mode vs actual. + (should + (equal (list shebang actual-mode) + (list shebang expected-mode))) + (when (eq expected-mode 'sh-base-mode) + (should (eq sh-shell expected-dialect)))))) (ert-deftest files-tests-auto-mode-interpreter () "Test that `set-auto-mode' deduces correct modes from shebangs." - (files-tests--check-shebang "#!/bin/bash" 'sh-mode) - (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode) + ;; Straightforward interpreter invocation. + (files-tests--check-shebang "#!/bin/bash" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode) + ;; Invocation through env. + (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) + ;; Invocation through env, with supplementary arguments. (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) - (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) - (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)) + (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" From ecb9641ecb5f42899042ff9c164ec7dbb8e166fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sat, 10 Feb 2024 17:37:35 +0100 Subject: [PATCH 246/385] Support more complex env invocations in shebang lines This is not an exact re-implementation of what env accepts, but hopefully it should be "good enough". Example of known limitation: we assume that arguments for --long-options will be set with '=', but that is not necessarily the case. '--unset' (mandatory argument) can be passed as '--unset=VAR' or '--unset VAR', but '--default-signal' (optional argument) requires an '=' sign. For bug#64939. * lisp/files.el (auto-mode-interpreter-regexp): Account for supplementary arguments passed beside -S/--split-string. * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): Test some of these combinations. --- lisp/files.el | 8 +++++++- test/lisp/files-tests.el | 8 +++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index f67b650cb92..5098d49048e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3274,7 +3274,13 @@ and `inhibit-local-variables-suffixes'. If ;; Optional group 1: env(1) invocation. "\\(" "[^ \t\n]*/bin/env[ \t]*" - "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?" + ;; Within group 1: possible -S/--split-string. + "\\(?:" + ;; -S/--split-string + "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" + ;; More env arguments. + "\\(?:-[^ \t\n]+[ \t]+\\)*" + "\\)?" "\\)?" ;; Group 2: interpreter. "\\([^ \t\n]+\\)")) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 23516ff0d7d..0a5c3b897e4 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1687,8 +1687,14 @@ set to." (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) ;; Invocation through env, with supplementary arguments. + (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv --default-signal bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) - (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)) + (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) + (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" From c64e650fb346d92294703d22f8cd7deb7c47b49e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sat, 10 Feb 2024 17:56:57 +0100 Subject: [PATCH 247/385] Support shebang lines with amended environment For bug#64939. * lisp/files.el (auto-mode-interpreter-regexp): Account for possible VARIABLE=[VALUE] operands. * test/lisp/files-tests.el (files-tests-auto-mode-interpreter): Add an example from the coreutils manual. --- lisp/files.el | 5 ++++- test/lisp/files-tests.el | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 5098d49048e..524385edc84 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3274,12 +3274,15 @@ and `inhibit-local-variables-suffixes'. If ;; Optional group 1: env(1) invocation. "\\(" "[^ \t\n]*/bin/env[ \t]*" - ;; Within group 1: possible -S/--split-string. + ;; Within group 1: possible -S/--split-string and environment + ;; adjustments. "\\(?:" ;; -S/--split-string "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" ;; More env arguments. "\\(?:-[^ \t\n]+[ \t]+\\)*" + ;; Interpreter environment modifications. + "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" "\\)?" "\\)?" ;; Group 2: interpreter. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 0a5c3b897e4..d4c1ef3ba67 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1694,7 +1694,9 @@ set to." (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) - (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash)) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash) + ;; Invocation through env, with modified environment. + (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH} python" 'python-base-mode)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" From 84e4f1259b54442f52183c1ccee72a417e0a2658 Mon Sep 17 00:00:00 2001 From: john muhl Date: Mon, 12 Feb 2024 18:46:51 -0600 Subject: [PATCH 248/385] Eagerly indent first field in tables in 'lua-ts-mode' * lisp/progmodes/lua-ts-mode.el (lua-ts--simple-indent-rules): Properly indent the first field of a table when it appears on a line by itself. (Bug#69088) --- lisp/progmodes/lua-ts-mode.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index dc2a8fcec1e..c7f5ac50b04 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -317,6 +317,8 @@ values of OVERRIDE." (node-is ")") (node-is "}")) standalone-parent 0) + ((match null "table_constructor") + standalone-parent lua-ts-indent-offset) ((or (and (parent-is "arguments") lua-ts--first-child-matcher) (and (parent-is "parameters") lua-ts--first-child-matcher) (and (parent-is "table_constructor") lua-ts--first-child-matcher)) From 6477be93bd8a29cba8ce383f9ea3fba23c45f225 Mon Sep 17 00:00:00 2001 From: Aleksandr Vityazev Date: Thu, 15 Feb 2024 22:51:24 +0300 Subject: [PATCH 249/385] Make key selection method configurable in EPA. * lisp/epa.el (epa-keys-select-method): New defcustom. (epa--select-keys-in-minibuffer): New function. (epa-select-keys): Use new option and function. * etc/NEWS: Announce it. * doc/misc/epa.texi (Key Management): Document it. (Bug#69133) --- doc/misc/epa.texi | 7 +++++++ etc/NEWS | 8 ++++++++ lisp/epa.el | 33 ++++++++++++++++++++++++++++++++- 3 files changed, 47 insertions(+), 1 deletion(-) diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index 27a9e2b0ebb..cd6da1dadba 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -289,6 +289,13 @@ also ask you whether or not to sign the text before encryption and if you answered yes, it will let you select the signing keys. @end deffn +You can change the default method that is used to select keys with the +variable @code{epa-file-select-keys}. + +@defvar epa-keys-select-method +Method used to select keys in @code{epa-select-keys}. +@end defvar + @node Cryptographic operations on files @section Cryptographic Operations on Files @cindex cryptographic operations on files diff --git a/etc/NEWS b/etc/NEWS index 5220a7fb337..4477116248e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1365,6 +1365,14 @@ The new user option 'ielm-history-file-name' is the name of the file where IELM input history will be saved. Customize it to nil to revert to the old behavior of not remembering input history between sessions. +** EasyPG + ++++ +*** New user option 'epa-keys-select-method'. +This allows the user to customize the key selection method, which can be +either by using a pop-up buffer or from the minibuffer. The pop-up +buffer method is the default, which preserves previous behavior. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/epa.el b/lisp/epa.el index 53da3bf6cce..b2593bc62ba 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -73,6 +73,16 @@ The command `epa-mail-encrypt' uses this." :group 'epa :version "24.4") +(defcustom epa-keys-select-method 'buffer + "Method used to select keys in `epa-select-keys'. +If the value is \\='buffer, the default, keys are selected via a +pop-up buffer. If the value is \\='minibuffer, keys are selected +via the minibuffer instead, using `completing-read-multiple'." + :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) + (const :tag "Read keys from minibuffer" minibuffer)) + :group 'epa + :version "30.1") + ;;; Faces (defgroup epa-faces nil @@ -450,6 +460,25 @@ q trust status questionable. - trust status unspecified. (epa--marked-keys)) (kill-buffer epa-keys-buffer))))) +(defun epa--select-keys-in-minibuffer (prompt keys) + (let* ((prompt (pcase-let ((`(,first ,second ,third) + (string-split prompt "\\.")) + (hint "(separated by comma)")) + (if third + (format "%s %s. %s: " first hint second) + (format "%s %s: " first hint)))) + (keys-alist + (seq-map + (lambda (key) + (cons (substring-no-properties + (epa--button-key-text key)) + key)) + keys)) + (selected-keys (completing-read-multiple prompt keys-alist))) + (seq-map + (lambda (key) (cdr (assoc key keys-alist))) + selected-keys))) + ;;;###autoload (defun epa-select-keys (context prompt &optional names secret) "Display a user's keyring and ask him to select keys. @@ -459,7 +488,9 @@ NAMES is a list of strings to be matched with keys. If it is nil, all the keys are listed. If SECRET is non-nil, list secret keys instead of public keys." (let ((keys (epg-list-keys context names secret))) - (epa--select-keys prompt keys))) + (pcase epa-keys-select-method + ('minibuffer (epa--select-keys-in-minibuffer prompt keys)) + (_ (epa--select-keys prompt keys))))) ;;;; Key Details From d85461ac61c5ea99ea194f99c771de1efdabbef4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 11:31:20 +0200 Subject: [PATCH 250/385] ; Fix last change * doc/misc/epa.texi (Cryptographic operations on regions): Fix wording of the 'epa-keys-select-method's documentation. * lisp/epa.el (epa-keys-select-method): Doc fix (bug#69133). --- doc/misc/epa.texi | 10 ++++++---- lisp/epa.el | 3 ++- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index cd6da1dadba..f450b9cbdd9 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -289,11 +289,13 @@ also ask you whether or not to sign the text before encryption and if you answered yes, it will let you select the signing keys. @end deffn -You can change the default method that is used to select keys with the -variable @code{epa-file-select-keys}. - @defvar epa-keys-select-method -Method used to select keys in @code{epa-select-keys}. +This variable controls the method used for key selection in +@code{epa-select-keys}. The default value @code{buffer} pops up a +special buffer where you can select the keys. If the value is +@code{minibuffer}, @code{epa-select-keys} will instead prompt for the +keys in the minibuffer, where you should type the keys separated by +commas. @end defvar @node Cryptographic operations on files diff --git a/lisp/epa.el b/lisp/epa.el index b2593bc62ba..c29df18bb58 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -77,7 +77,8 @@ The command `epa-mail-encrypt' uses this." "Method used to select keys in `epa-select-keys'. If the value is \\='buffer, the default, keys are selected via a pop-up buffer. If the value is \\='minibuffer, keys are selected -via the minibuffer instead, using `completing-read-multiple'." +via the minibuffer instead, using `completing-read-multiple'. +Any other value is treated as \\='buffer." :type '(choice (const :tag "Read keys from a pop-up buffer" buffer) (const :tag "Read keys from minibuffer" minibuffer)) :group 'epa From 77576cd7626e4a99a5c88aa854091d701edd53a8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 12:15:11 +0200 Subject: [PATCH 251/385] ; Don't use non-ASCII characters in C comments in xdisp.c. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 6087a25afcc..4d60915f31c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24774,7 +24774,7 @@ maybe_produce_line_number (struct it *it) /* NOTE: We use `base_line_number` without checking BASE_LINE_NUMBER_VALID_P because we assume that `redisplay_window` has already flushed this cache for us when needed. - NOTE²: Checking BASE_LINE_NUMBER_VALID_P here would be + NOTE2: Checking BASE_LINE_NUMBER_VALID_P here would be overly pessimistic because it might say that the cache was invalid before entering `redisplay_window` yet the value has just been refreshed. */ From 07a392f445eb21c5e4681027eee9d981300a4309 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sat, 17 Feb 2024 10:17:41 -0500 Subject: [PATCH 252/385] Update to Org 9.6.19 --- doc/misc/org.org | 22 +++++++--------------- etc/refcards/orgcard.tex | 2 +- lisp/org/ol-man.el | 14 ++++++++++++++ lisp/org/ol.el | 5 +---- lisp/org/org-compat.el | 2 +- lisp/org/org-id.el | 12 ++++++------ lisp/org/org-lint.el | 7 +++++-- lisp/org/org-table.el | 8 ++++---- lisp/org/org-tempo.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 10 ++++++---- lisp/org/ox-latex.el | 5 +++-- lisp/org/ox-odt.el | 5 +++-- lisp/org/ox.el | 9 ++++----- 14 files changed, 58 insertions(+), 49 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index 9535eccc1e6..441985c905f 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16712,6 +16712,7 @@ to HTML, the following links all point to a dedicated anchor in :END: #+cindex: sitemap, of published pages +#+vindex: org-publish-project-alist The following properties may be used to control publishing of a map of files for a given project. @@ -16729,6 +16730,12 @@ a map of files for a given project. Title of sitemap page. Defaults to name of file. +- ~:sitemap-style~ :: + + Can be ~list~ (site-map is just an itemized list of the titles of + the files involved) or ~tree~ (the directory structure of the + source files is reflected in the site-map). Defaults to ~tree~. + - ~:sitemap-format-entry~ :: #+findex: org-publish-find-date @@ -16774,21 +16781,6 @@ a map of files for a given project. Should sorting be case-sensitive? Default ~nil~. -- ~:sitemap-file-entry-format~ :: - - With this option one can tell how a sitemap's entry is formatted in - the sitemap. This is a format string with some escape sequences: - ~%t~ stands for the title of the file, ~%a~ stands for the author of - the file and ~%d~ stands for the date of the file. The date is - retrieved with the ~org-publish-find-date~ function and formatted - with ~org-publish-sitemap-date-format~. Default ~%t~. - -- ~:sitemap-date-format~ :: - - Format string for the ~format-time-string~ function that tells how - a sitemap entry's date is to be formatted. This property bypasses - ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. - *** Generating an index :PROPERTIES: :DESCRIPTION: An index that reaches across pages. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 705ab62d69d..e1d40d8632f 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.15} +\def\orgversionnumber{9.6.19} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index b6cada1b3c3..d3d7db04700 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -39,13 +39,27 @@ :group 'org-link :type '(choice (const man) (const woman))) +(declare-function Man-translate-references "man" (ref)) (defun org-man-open (path _) "Visit the manpage on PATH. PATH should be a topic that can be thrown at the man command. If PATH contains extra ::STRING which will use `occur' to search matched strings in man buffer." + (require 'man) ; For `Man-translate-references' (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) (let* ((command (match-string 1 path)) + ;; FIXME: Remove after we drop Emacs 29 support. + ;; Working around security bug #66390. + (command (if (not (equal (Man-translate-references ";id") ";id")) + ;; We are on Emacs that escapes man command args + ;; (see Emacs commit 820f0793f0b). + command + ;; Older Emacs without the fix - escape the + ;; arguments ourselves. + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string command "\\s-+")) + " "))) (search (match-string 2 path)) (buffer (funcall org-man-command command))) (when search diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 4c84e62f4c9..c3b03087842 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -291,10 +291,7 @@ or emacs-wiki packages to Org syntax. The function must accept two parameters, a TYPE containing the link protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, which is everything after the link protocol. It should return a cons -with possibly modified values of type and path. -Org contains a function for this, so if you set this variable to -`org-translate-link-from-planner', you should be able follow many -links created by planner." +with possibly modified values of type and path." :group 'org-link-follow :type '(choice (const nil) (function)) :safe #'null) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 33a510cd7f2..c17a100d3c1 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -664,7 +664,7 @@ You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." +%d is the date." :group 'org-export-publish :type 'string) (make-obsolete-variable diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 9561f2de184..fe7d5f4c1a5 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -29,13 +29,13 @@ ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. -;; Identifiers consist of a prefix (default "Org" given by the variable +;; Identifiers consist of a prefix (given by the variable ;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. -;; Org has a builtin method that uses a compact encoding of the creation -;; time of the ID, with microsecond accuracy. This virtually -;; guarantees globally unique identifiers, even if several people are -;; creating IDs at the same time in files that will eventually be used +;; of different methods, see the variable `org-id-method'. Org has a +;; builtin method that uses a compact encoding of the creation time of +;; the ID, with microsecond accuracy. This virtually guarantees +;; globally unique identifiers, even if several people are creating +;; IDs at the same time in files that will eventually be used ;; together. ;; ;; By default Org uses UUIDs as global unique identifiers. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index dc12ec272fa..a503de7d364 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -1209,8 +1209,11 @@ Use \"export %s\" instead" (`(,(and (pred symbolp) name) ,(pred string-or-null-p) ,(pred string-or-null-p)) - (unless (org-cite-get-processor name) - (list source "Unknown cite export processor %S" name))) + (unless (or (org-cite-get-processor name) + (progn + (org-cite-try-load-processor name) + (org-cite-get-processor name))) + (list source (format "Unknown cite export processor %S" name)))) (_ (list source "Invalid cite export processor declaration"))) (error diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 6408f48ccbd..92490f9f6bf 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1922,8 +1922,8 @@ However, when N is 0, do not increment the field at all." (let ((org-table-may-need-update nil)) (org-table-next-row)) (org-table-blank-field)) ;; Insert the new field. NEW-FIELD may be nil if - ;; `org-table-increment' is nil, or N = 0. In that case, copy - ;; FIELD. + ;; `org-table-copy-increment' is nil, or N = 0. In that case, + ;; copy FIELD. (insert (or next-field field)) (org-table-maybe-recalculate-line) (org-table-align))) @@ -4084,8 +4084,8 @@ already hidden." "Read column selection select as a list of numbers. SELECT is a string containing column ranges, separated by white -space characters, see `org-table-hide-column' for details. MAX -is the maximum column number. +space characters, see `org-table-toggle-column-width' for details. +MAX is the maximum column number. Return value is a sorted list of numbers. Ignore any number outside of the [1;MAX] range." diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 44b04a9f4be..afa69867f2a 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; Org Tempo reimplements completions of structure template before -;; point like `org-try-structure-completion' in Org v9.1 and earlier. +;; point in Org v9.1 and earlier. ;; For example, strings like " Date: Sat, 17 Feb 2024 18:53:05 +0200 Subject: [PATCH 253/385] Revert "Update to Org 9.6.19" This reverts commit 07a392f445eb21c5e4681027eee9d981300a4309. It was installed by mistake. --- doc/misc/org.org | 22 +++++++++++++++------- etc/refcards/orgcard.tex | 2 +- lisp/org/ol-man.el | 14 -------------- lisp/org/ol.el | 5 ++++- lisp/org/org-compat.el | 2 +- lisp/org/org-id.el | 12 ++++++------ lisp/org/org-lint.el | 7 ++----- lisp/org/org-table.el | 8 ++++---- lisp/org/org-tempo.el | 2 +- lisp/org/org-version.el | 4 ++-- lisp/org/org.el | 10 ++++------ lisp/org/ox-latex.el | 5 ++--- lisp/org/ox-odt.el | 5 ++--- lisp/org/ox.el | 9 +++++---- 14 files changed, 49 insertions(+), 58 deletions(-) diff --git a/doc/misc/org.org b/doc/misc/org.org index 441985c905f..9535eccc1e6 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16712,7 +16712,6 @@ to HTML, the following links all point to a dedicated anchor in :END: #+cindex: sitemap, of published pages -#+vindex: org-publish-project-alist The following properties may be used to control publishing of a map of files for a given project. @@ -16730,12 +16729,6 @@ a map of files for a given project. Title of sitemap page. Defaults to name of file. -- ~:sitemap-style~ :: - - Can be ~list~ (site-map is just an itemized list of the titles of - the files involved) or ~tree~ (the directory structure of the - source files is reflected in the site-map). Defaults to ~tree~. - - ~:sitemap-format-entry~ :: #+findex: org-publish-find-date @@ -16781,6 +16774,21 @@ a map of files for a given project. Should sorting be case-sensitive? Default ~nil~. +- ~:sitemap-file-entry-format~ :: + + With this option one can tell how a sitemap's entry is formatted in + the sitemap. This is a format string with some escape sequences: + ~%t~ stands for the title of the file, ~%a~ stands for the author of + the file and ~%d~ stands for the date of the file. The date is + retrieved with the ~org-publish-find-date~ function and formatted + with ~org-publish-sitemap-date-format~. Default ~%t~. + +- ~:sitemap-date-format~ :: + + Format string for the ~format-time-string~ function that tells how + a sitemap entry's date is to be formatted. This property bypasses + ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~. + *** Generating an index :PROPERTIES: :DESCRIPTION: An index that reaches across pages. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index e1d40d8632f..705ab62d69d 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.6.19} +\def\orgversionnumber{9.6.15} \def\versionyear{2023} % latest update \input emacsver.tex diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el index d3d7db04700..b6cada1b3c3 100644 --- a/lisp/org/ol-man.el +++ b/lisp/org/ol-man.el @@ -39,27 +39,13 @@ :group 'org-link :type '(choice (const man) (const woman))) -(declare-function Man-translate-references "man" (ref)) (defun org-man-open (path _) "Visit the manpage on PATH. PATH should be a topic that can be thrown at the man command. If PATH contains extra ::STRING which will use `occur' to search matched strings in man buffer." - (require 'man) ; For `Man-translate-references' (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) (let* ((command (match-string 1 path)) - ;; FIXME: Remove after we drop Emacs 29 support. - ;; Working around security bug #66390. - (command (if (not (equal (Man-translate-references ";id") ";id")) - ;; We are on Emacs that escapes man command args - ;; (see Emacs commit 820f0793f0b). - command - ;; Older Emacs without the fix - escape the - ;; arguments ourselves. - (mapconcat 'identity - (mapcar #'shell-quote-argument - (split-string command "\\s-+")) - " "))) (search (match-string 2 path)) (buffer (funcall org-man-command command))) (when search diff --git a/lisp/org/ol.el b/lisp/org/ol.el index c3b03087842..4c84e62f4c9 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -291,7 +291,10 @@ or emacs-wiki packages to Org syntax. The function must accept two parameters, a TYPE containing the link protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, which is everything after the link protocol. It should return a cons -with possibly modified values of type and path." +with possibly modified values of type and path. +Org contains a function for this, so if you set this variable to +`org-translate-link-from-planner', you should be able follow many +links created by planner." :group 'org-link-follow :type '(choice (const nil) (function)) :safe #'null) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index c17a100d3c1..33a510cd7f2 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -664,7 +664,7 @@ You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date." +%d is the date formatted using `org-publish-sitemap-date-format'." :group 'org-export-publish :type 'string) (make-obsolete-variable diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index fe7d5f4c1a5..9561f2de184 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -29,13 +29,13 @@ ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. -;; Identifiers consist of a prefix (given by the variable +;; Identifiers consist of a prefix (default "Org" given by the variable ;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. Org has a -;; builtin method that uses a compact encoding of the creation time of -;; the ID, with microsecond accuracy. This virtually guarantees -;; globally unique identifiers, even if several people are creating -;; IDs at the same time in files that will eventually be used +;; of different methods, see the variable `org-id-method'. +;; Org has a builtin method that uses a compact encoding of the creation +;; time of the ID, with microsecond accuracy. This virtually +;; guarantees globally unique identifiers, even if several people are +;; creating IDs at the same time in files that will eventually be used ;; together. ;; ;; By default Org uses UUIDs as global unique identifiers. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index a503de7d364..dc12ec272fa 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -1209,11 +1209,8 @@ Use \"export %s\" instead" (`(,(and (pred symbolp) name) ,(pred string-or-null-p) ,(pred string-or-null-p)) - (unless (or (org-cite-get-processor name) - (progn - (org-cite-try-load-processor name) - (org-cite-get-processor name))) - (list source (format "Unknown cite export processor %S" name)))) + (unless (org-cite-get-processor name) + (list source "Unknown cite export processor %S" name))) (_ (list source "Invalid cite export processor declaration"))) (error diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 92490f9f6bf..6408f48ccbd 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1922,8 +1922,8 @@ However, when N is 0, do not increment the field at all." (let ((org-table-may-need-update nil)) (org-table-next-row)) (org-table-blank-field)) ;; Insert the new field. NEW-FIELD may be nil if - ;; `org-table-copy-increment' is nil, or N = 0. In that case, - ;; copy FIELD. + ;; `org-table-increment' is nil, or N = 0. In that case, copy + ;; FIELD. (insert (or next-field field)) (org-table-maybe-recalculate-line) (org-table-align))) @@ -4084,8 +4084,8 @@ already hidden." "Read column selection select as a list of numbers. SELECT is a string containing column ranges, separated by white -space characters, see `org-table-toggle-column-width' for details. -MAX is the maximum column number. +space characters, see `org-table-hide-column' for details. MAX +is the maximum column number. Return value is a sorted list of numbers. Ignore any number outside of the [1;MAX] range." diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index afa69867f2a..44b04a9f4be 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -24,7 +24,7 @@ ;;; Commentary: ;; ;; Org Tempo reimplements completions of structure template before -;; point in Org v9.1 and earlier. +;; point like `org-try-structure-completion' in Org v9.1 and earlier. ;; For example, strings like " Date: Sun, 11 Feb 2024 21:26:41 +0000 Subject: [PATCH 254/385] Add manual entries for which-key * doc/emacs/display.texi (Display Custom): Briefly introduce which-key. * doc/emacs/help.texi (Key Help): Briefly mention which-key. --- doc/emacs/display.texi | 3 ++- doc/emacs/help.texi | 5 +++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index d2557d6148e..bda57d2b30e 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2215,7 +2215,8 @@ there is something to echo. @xref{Echo Area}. default), the multi-character key sequence echo shown according to @code{echo-keystrokes} will include a short help text about keys which will invoke @code{describe-prefix-bindings} (@pxref{Misc Help}) to show -the list of commands for the prefix you already typed. +the list of commands for the prefix you already typed. For a related +help facility, see @ref{which-key}. @cindex mouse pointer @cindex hourglass pointer display diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 99a4173ac29..1a76e663657 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -260,6 +260,11 @@ by these buttons, Emacs provides the @code{button-describe} and @code{widget-describe} commands, that should be run with point over the button. +@anchor which-key +@kbd{M-x which-key} is a global minor mode which helps in discovering + keymaps. It displays keybindings following your currently entered + incomplete command (prefix), in a popup. + @node Name Help @section Help by Command or Variable Name From c14a67a80f4263c13db55b6a79fb545b82a8b5b7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Feb 2024 18:57:12 +0200 Subject: [PATCH 255/385] ; Fix markup in last change (bug#68929). --- doc/emacs/help.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 1a76e663657..05457a3f34f 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -260,7 +260,7 @@ by these buttons, Emacs provides the @code{button-describe} and @code{widget-describe} commands, that should be run with point over the button. -@anchor which-key +@anchor{which-key} @kbd{M-x which-key} is a global minor mode which helps in discovering keymaps. It displays keybindings following your currently entered incomplete command (prefix), in a popup. From e56f0ef51bfdd0e03e817670754bc813fb3702a2 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Fri, 2 Feb 2024 20:59:41 +0100 Subject: [PATCH 256/385] org: Fix security prompt for downloading remote resource * lisp/org.el (org--confirm-resource-safe): Do not assume that resource is safe when user replies "n" (do not download). Reported-by: Max Nikulin Link: https://orgmode.org/list/upj6uk$b7o$1@ciao.gmane.io --- lisp/org/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org/org.el b/lisp/org/org.el index 3075729d01d..c75afbf5a67 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -4685,7 +4685,7 @@ returns non-nil if any of them match." (if (and (= char ?f) current-file) (concat "file://" current-file) uri)) "\\'"))))) - (prog1 (memq char '(?y ?n ?! ?d ?\s ?f)) + (prog1 (memq char '(?y ?! ?d ?\s ?f)) (quit-window t))))))) (defun org-extract-log-state-settings (x) From db5e84af202532b138918295ea6dd1b0ea910d78 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 17 Feb 2024 09:31:50 -0800 Subject: [PATCH 257/385] Alias some gnus-specific do-nothing functions Replace with #'always and #'ignore * lisp/gnus/gnus-agent.el: `gnus-agent-true' and `gnus-agent-false' * lisp/gnus/gnus-util.el: `gnus-not-ignore' --- lisp/gnus/gnus-agent.el | 13 +++++-------- lisp/gnus/gnus-util.el | 3 +-- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 3ee93031119..0928b179787 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2910,13 +2910,9 @@ The following commands are available: (car func) (gnus-byte-compile `(lambda () ,func))))) -(defun gnus-agent-true () - "Return t." - t) +(defalias 'gnus-agent-true #'always) -(defun gnus-agent-false () - "Return nil." - nil) +(defalias 'gnus-agent-false #'ignore) (defun gnus-category-make-function-1 (predicate) "Make a function from PREDICATE." @@ -2924,8 +2920,9 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - `(,(or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) + (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + (if (symbolp fun) `(,fun) `(funcall ',fun)))) ;; More complex predicate. ((consp predicate) `(,(cond diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b5aa0b02d34..7218c686a2a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1113,8 +1113,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defun gnus-not-ignore (&rest _args) - t) +(defalias gnus-not-ignore #'always) (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. From 32c5bdfa971220bae37991a298628605c82f866c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Je=C4=8Dm=C3=ADnek?= Date: Sat, 17 Feb 2024 09:34:36 -0800 Subject: [PATCH 258/385] Provide better default value for date in Gnus scoring MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug#61002, thanks to Kamil Jońca for reporting * lisp/gnus/gnus-score.el (gnus-summary-score-entry): When scoring on Date header, the default value for the prompt should be number of days between the date of the article under point, and "now". --- lisp/gnus/gnus-score.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index bd19e7d7cd7..479b7496cf1 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -893,9 +893,14 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (t "permanent")) header (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) + (cond ((numberp match) (int-to-string match)) + ((string= header "date") + (int-to-string + (- + (/ (car (time-convert (current-time) 1)) 86400) + (/ (car (time-convert (gnus-date-get-time match) 1)) + 86400)))) + (t match))))) ;; If this is an integer comparison, we transform from string to int. (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) From 20997aa20728a6fc2a3de736e9fc718b97dcef99 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Feb 2024 19:20:42 +0100 Subject: [PATCH 259/385] ; Fix typo from commit 32c5bdfa971 * lisp/gnus/gnus-util.el (gnus-not-ignore): Quote the argument to defalias. --- lisp/gnus/gnus-util.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 7218c686a2a..0b0a9bbfc1d 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1113,7 +1113,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defalias gnus-not-ignore #'always) +(defalias 'gnus-not-ignore #'always) (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. From 9e56bd5ed8775f53c3025b114525cee7c578e2d0 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 11 Feb 2024 18:38:13 +0100 Subject: [PATCH 260/385] Removed decommissioned PGP keyservers * lisp/epa-ks.el (epa-keyserver): Update the user option type of `epa-keyserver'. See https://mail.gnu.org/archive/html/emacs-devel/2023-11/msg00857.html. --- lisp/epa-ks.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index c3c11bb0b0b..13840da0bd9 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -47,11 +47,8 @@ This is used by `epa-search-keys', for looking up public keys." (repeat :tag "Random pool" (string :tag "Keyserver address")) (const "keyring.debian.org") - (const "keys.gnupg.net") (const "keyserver.ubuntu.com") (const "pgp.mit.edu") - (const "pool.sks-keyservers.net") - (const "zimmermann.mayfirst.org") (string :tag "Custom keyserver")) :version "28.1") From 5a64d2c7595dc393504c6eee9321d74dbd8ae9e2 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 17 Feb 2024 22:34:55 +0200 Subject: [PATCH 261/385] java-ts-mode: Indentation for opening brace on a separate line * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Support putting the opening brace on a separate line (bug#67556). * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add a test. --- lisp/progmodes/java-ts-mode.el | 13 +++++--- .../java-ts-mode-resources/indent.erts | 31 +++++++++++++++++++ 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 52d025e365a..5c4bce340f0 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -74,7 +74,12 @@ ((parent-is "program") column-0 0) ((match "}" "element_value_array_initializer") parent-bol 0) - ((node-is "}") column-0 c-ts-common-statement-offset) + ((node-is + ,(format "\\`%s\\'" + (regexp-opt '("constructor_body" "class_body" "interface_body" + "block" "switch_block" "array_initializer")))) + parent-bol 0) + ((node-is "}") standalone-parent 0) ((node-is ")") parent-bol 0) ((node-is "else") parent-bol 0) ((node-is "]") parent-bol 0) @@ -86,10 +91,10 @@ ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) ((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset) ((parent-is "interface_body") column-0 c-ts-common-statement-offset) - ((parent-is "constructor_body") column-0 c-ts-common-statement-offset) + ((parent-is "constructor_body") standalone-parent java-ts-mode-indent-offset) ((parent-is "enum_body_declarations") parent-bol 0) ((parent-is "enum_body") column-0 c-ts-common-statement-offset) - ((parent-is "switch_block") column-0 c-ts-common-statement-offset) + ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset) ((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset) ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) @@ -125,7 +130,7 @@ ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) - ((parent-is "block") column-0 c-ts-common-statement-offset))) + ((parent-is "block") standalone-parent java-ts-mode-indent-offset))) "Tree-sitter indent rules.") (defvar java-ts-mode--keywords diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 4fca74dd2e1..514d2e08977 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -110,3 +110,34 @@ public class Java { } } =-=-= + +Name: Opening bracket on separate line (bug#67556) + +=-= +public class Java { + void foo( + String foo) + { + for (var f : rs) + return new String[] + { + "foo", + "bar" + }; + if (a == 0) + { + return 0; + } else if (a == 1) + { + return 1; + } + + switch(expr) + { + case x: + // code block + break; + } + } +} +=-=-= From 37bb33dae791e5f59f1d0d27c0221db3b3b4c16d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 15 Feb 2024 18:45:29 -0800 Subject: [PATCH 262/385] =?UTF-8?q?Adjust=20to=20yesterday=E2=80=99s=20Gnu?= =?UTF-8?q?lib=20nstrftime=20changes?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bruno Haible fixed Gnulib so that nstrftime no longer requires locking code, which means we no longer need to avoid localename. However, nstrftime now requires localename-unsafe-limited which pulls in some Gnulib-specific locale code, and it’s likely this needs to be replaced with Emacs-specific locale code. In the meantime let’s continue to finess this by avoiding localename-unsafe-limited. * admin/merge-gnulib (AVOIDED_MODULES): Avoid localename-unsafe-limited instead of localename. --- admin/merge-gnulib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 35966852e27..41531d573b0 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -53,7 +53,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' access btowc chmod close crypto/af_alg dup fchdir fstat - iswblank iswctype iswdigit iswxdigit langinfo localename lock + iswblank iswctype iswdigit iswxdigit langinfo localename-unsafe-limited lock mbrtowc mbsinit memchr mkdir msvc-inval msvc-nothrow nl_langinfo openat-die opendir pthread-h raise save-cwd select setenv sigprocmask stat stdarg From bd0e281a6a27c048b12847811bc0385acbaa1eec Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 15:58:03 -0800 Subject: [PATCH 263/385] Update from Gnulib by running admin/merge-gnulib --- lib/gnulib.mk.in | 2 +- lib/strftime.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 9970f7810e2..711ddcf1260 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -47,7 +47,7 @@ # --avoid=iswdigit \ # --avoid=iswxdigit \ # --avoid=langinfo \ -# --avoid=localename \ +# --avoid=localename-unsafe-limited \ # --avoid=lock \ # --avoid=mbrtowc \ # --avoid=mbsinit \ diff --git a/lib/strftime.c b/lib/strftime.c index c7256c3d354..128176cad40 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -401,7 +401,7 @@ should_remove_ampm (void) lt lv mg mhr mi mk mn ms mt nb nds nhn nl nn nr nso oc os pap pl pt ro ru rw sah sc se sgs sk sl sm sr ss st su sv szl tg tk tn ts tt ug uk unm uz ve wae wo xh zu */ - const char *loc = gl_locale_name (LC_TIME, "LC_TIME"); + const char *loc = gl_locale_name_unsafe (LC_TIME, "LC_TIME"); bool remove_ampm = false; switch (loc[0]) { From c2d714886ef139f601d89463675b0d5b49d18ff9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 18 Feb 2024 12:48:41 +0800 Subject: [PATCH 264/385] Implement tooltip_reuse_hidden_frame for Android * java/org/gnu/emacs/EmacsWindow.java (findSuitableActivityContext): Return Activity rather than Context. (mapWindow): Provide window token manually. * src/androidfns.c (Fx_show_tip, Fx_hide_tip): Respect tooltip_reuse_hidden_frame. --- java/org/gnu/emacs/EmacsWindow.java | 27 ++++++++++++--- src/androidfns.c | 53 ++++++++++++++++++++++++++++- 2 files changed, 74 insertions(+), 6 deletions(-) diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 978891ba619..427a1a92332 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -27,6 +27,8 @@ import java.util.LinkedHashMap; import java.util.Map; +import android.app.Activity; + import android.content.ClipData; import android.content.ClipDescription; import android.content.Context; @@ -362,6 +364,9 @@ private static class Coordinate requestViewLayout (); } + /* Return WM layout parameters for an override redirect window with + the geometry provided here. */ + private WindowManager.LayoutParams getWindowLayoutParams () { @@ -384,15 +389,15 @@ private static class Coordinate return params; } - private Context + private Activity findSuitableActivityContext () { /* Find a recently focused activity. */ if (!EmacsActivity.focusedActivities.isEmpty ()) return EmacsActivity.focusedActivities.get (0); - /* Return the service context, which probably won't work. */ - return EmacsService.SERVICE; + /* Resort to the last activity to be focused. */ + return EmacsActivity.lastFocusedActivity; } public synchronized void @@ -416,7 +421,7 @@ private static class Coordinate { EmacsWindowAttachmentManager manager; WindowManager windowManager; - Context ctx; + Activity ctx; Object tem; WindowManager.LayoutParams params; @@ -447,11 +452,23 @@ private static class Coordinate activity using the system window manager. */ ctx = findSuitableActivityContext (); + + if (ctx == null) + { + Log.w (TAG, "failed to attach override-redirect window" + + " for want of activity"); + return; + } + tem = ctx.getSystemService (Context.WINDOW_SERVICE); windowManager = (WindowManager) tem; - /* Calculate layout parameters. */ + /* Calculate layout parameters and propagate the + activity's token into it. */ + params = getWindowLayoutParams (); + params.token = (ctx.findViewById (android.R.id.content) + .getWindowToken ()); view.setLayoutParams (params); /* Attach the view. */ diff --git a/src/androidfns.c b/src/androidfns.c index ea3d5f71c7c..0675a0a3c98 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -2287,6 +2287,57 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, goto start_timer; } + else if (tooltip_reuse_hidden_frame && BASE_EQ (frame, tip_last_frame)) + { + bool delete = false; + Lisp_Object tail, elt, parm, last; + + /* Check if every parameter in PARMS has the same value in + tip_last_parms. This may destruct tip_last_parms which, + however, will be recreated below. */ + for (tail = parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = CAR (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (CDR (elt), CDR (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms + = call2 (Qassq_delete_all, parm, tip_last_parms); + } + else + tip_last_parms + = call2 (Qassq_delete_all, parm, tip_last_parms); + } + + /* Now check if every parameter in what is left of + tip_last_parms with a non-nil value has an association in + PARMS. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = CAR (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (CDR (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + android_hide_tip (delete); + } else android_hide_tip (true); } @@ -2453,7 +2504,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, #endif /* 0 */ return Qnil; #else /* !ANDROID_STUBIFY */ - return android_hide_tip (true); + return android_hide_tip (!tooltip_reuse_hidden_frame); #endif /* ANDROID_STUBIFY */ } From aa8baf77b47e3de114f5dc5e9aaa987bb96ed248 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Sun, 18 Feb 2024 00:04:18 +0900 Subject: [PATCH 265/385] Add README file about translations of Emacs manuals * doc/README: New file. --- doc/README | 204 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 204 insertions(+) create mode 100644 doc/README diff --git a/doc/README b/doc/README new file mode 100644 index 00000000000..81b54c91a76 --- /dev/null +++ b/doc/README @@ -0,0 +1,204 @@ +* Translating the Emacs manuals + +** Copyright assignment + +People who contribute translated documents should provide a copyright +assignment to the Free Software Foundation. See the 'Copyright +Assignment' section in the Emacs manual. + + +** Translated documents license + +The translated documents are distributed under the same license as the +original documents: the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation. + +See https://www.gnu.org/licenses/fdl-1.3.html for more information. + +If you have questions regarding the use of the FDL license in your +translation work that are not answered in the FAQ, do not hesitate to +contact the GNU project: https://www.gnu.org/contact/ + +** Location + +*** Texinfo source files + +The source files of the translated manuals are located in the doc/ +directory, under the directory whose name corresponds to the translated +language. + + E.g. French manuals sources are found under doc/fr. + +The structure of the language folders should match the structure of the +English manuals (i.e. include misc, man, lispref, lispintro, emacs). + +*** built files + +Translated deliverables in info format are built at release time and are +made available for local installation. + + +** Format + +The manuals and their translations are written in the Texinfo format +(with the exception of the org-mode manual that is written in org-mode +and of illustrations for the Introduction to Emacs Lisp Programming that +are written in eps). + +See https://www.gnu.org/software/Texinfo/ for more information. + +You should install the Texinfo utilities to be able to verify the +translated files, and refer to the Texinfo manual if you do not +understand the meaning of the various Texinfo declarations. + +Emacs has a Texinfo mode that properly highlights the Texinfo code to +make it easier to see which parts are text to be translated and which +parts are not. + + +*** Texinfo specific issues + +Until the Emacs/Texinfo projects provide better solutions, here are a +few rules to follow: + +- Under each @node, add an @anchor that has the same content at the +original English @node. + +- Translate the @node content but leave the @anchor in English. + +- Most Emacs manuals are set to include the docstyle.Texi file. This +file adds the @documentencoding UTF-8 directive to the targeted manual. +There is no need to add this directive in a manual that includes +docstyle.Texi. + +- Add a @documentlanguage directive that includes your language. + + E.g. @documentlanguage zh + +This directive has currently little effect but will be useful in the +future. + +- The @author directive can be used for the translator's name. + + E.g. @author traduit en français par Achile Talon + + +** Fixing the original document + +During the course of the translation, you might find parts of the +original document that need to be updated or otherwise fixed, or even +bugs in Emacs. If you do not intend to provide fixes right away, please +file a bug report promptly so someone can fix it soon. + +See the 'Bugs' section in the Emacs manual. + +** Sending contributions + +Send your contributions (either files or revisions) to +emacs-devel@gnu.org for review. + +Always send contributions in the format of the original document. Most +of the contents in the Emacs manuals are in Texinfo format, so do not +send contributions that are in derivative formats (e.g. info, html, +docbook, plain text, etc.) + +Before sending files for review, ensure that they have been properly +checked for spelling/grammar/typography by at least using the tools that +Emacs provides. + +You should also make sure that the Texinfo files build properly on your +system. + +Send your contributions as patches (git diff -p --stat), and prefer the +git format-patch form because the format allows easier review and easier +installation of the changes by someone with write access to the +repository. + +The Emacs project has a lot of coding, documentation and commenting +conventions. Sending such patches allows the project managers to make +sure that the contributions comply with the various conventions. + + +** Discussing translation issues + +Translation-related discussions are welcome on the emacs-devel list. +Discussions specific to your language do not have to take place in +English. + + +** Translation teams + +The number of words in the Emacs manuals is above 2,000,000 words and +growing. While one individual could theoretically translate all the +files, it is more practical to work in language teams. + +If you have a small group of translators willing to help, make sure that +the files are properly reviewed before sending them to emacs-devel (see +above). + +You are invited to refer to the translation-related documents that the +GNU Project maintains and to get in touch with your language's +translation team to learn from the practices they have developed over +the years. + +See https://www.gnu.org/server/standards/README.translations.html for +more information. + + +** Translation processes + +Emacs does not yet provide tools that significantly help the translation +process. A few useful functions would be + +- automatic lookup of a list of glossary items when starting to work on +a translation "unit" (paragraph or otherwise), such glossary terms +should be easily insertable at point, + +- automatic lookup of past translations to check for similarity and +improve homogeneity over the whole document set, such past translation +matches should be easily insertable at point, + +etc. + + +*** Using the PO format as an intermediate translation format + +Although the PO format has not been developed with documentation in +mind, it is well known among free software translation teams and you can +easily use the po4a utility to convert Texinfo to PO for work in +translation tools that support the PO format. + +See https://po4a.org for more information. + +However, regardless of the intermediate file format that you might use, +you should only send Texinfo files for review to emacs-devel. + + +*** Free tools that you can use in your processes + +A number of free software tools exist, outside the Emacs ecosystem, to +help translators (amateurs and professionals alike) with the translation +process. + +If you find that Emacs should implement some of their features, you are +welcome to provide patches to the Emacs project. + +Such tools include: + +- the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ +- KDE's Lokalize, https://apps.kde.org/lokalize/ +- OmegaT, http://omegat.org +- the Okapi Framework, https://www.okapiframework.org +- pootle, https://pootle.translatehouse.org + +etc. + + +* Licence of this document + +Copyright (C) 2024 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, are +permitted in any medium without royalty provided the copyright notice +and this notice are preserved. This file is offered as-is, without any +warranty. From a58bcb96ac898d218b3169e76db798f192107d52 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Sun, 18 Feb 2024 00:02:09 +0900 Subject: [PATCH 266/385] Move French translations to the top-level doc/ directory. --- doc/{lang => }/fr/misc/ses-fr.texi | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename doc/{lang => }/fr/misc/ses-fr.texi (100%) diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/fr/misc/ses-fr.texi similarity index 100% rename from doc/lang/fr/misc/ses-fr.texi rename to doc/fr/misc/ses-fr.texi From 42179750c5f3f722b1ce2f82d2b2e73bba8e4de8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Feb 2024 09:49:16 +0200 Subject: [PATCH 267/385] Move translations-related files to do/translations/. --- doc/{ => translations}/README | 0 doc/{ => translations}/fr/misc/ses-fr.texi | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename doc/{ => translations}/README (100%) rename doc/{ => translations}/fr/misc/ses-fr.texi (100%) diff --git a/doc/README b/doc/translations/README similarity index 100% rename from doc/README rename to doc/translations/README diff --git a/doc/fr/misc/ses-fr.texi b/doc/translations/fr/misc/ses-fr.texi similarity index 100% rename from doc/fr/misc/ses-fr.texi rename to doc/translations/fr/misc/ses-fr.texi From d80f1352d80938bb4ef61c5d74aa056902abd9b4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Feb 2024 09:56:14 +0200 Subject: [PATCH 268/385] ; Fix punctuation and encoding of doc/translations/README * doc/translations/README: Fix non-ASCII characters and punctuation. Add local variables section. --- doc/translations/README | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/doc/translations/README b/doc/translations/README index 81b54c91a76..c689f0b14b3 100644 --- a/doc/translations/README +++ b/doc/translations/README @@ -3,14 +3,14 @@ ** Copyright assignment People who contribute translated documents should provide a copyright -assignment to the Free Software Foundation. See the 'Copyright -Assignment' section in the Emacs manual. +assignment to the Free Software Foundation. See the "Copyright +Assignment" section in the Emacs manual. ** Translated documents license The translated documents are distributed under the same license as the -original documents: the GNU Free Documentation License, Version 1.3 or +original documents: the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation. See https://www.gnu.org/licenses/fdl-1.3.html for more information. @@ -27,7 +27,7 @@ The source files of the translated manuals are located in the doc/ directory, under the directory whose name corresponds to the translated language. - E.g. French manuals sources are found under doc/fr. + E.g., French manuals sources are found under doc/fr. The structure of the language folders should match the structure of the English manuals (i.e. include misc, man, lispref, lispintro, emacs). @@ -73,14 +73,14 @@ docstyle.Texi. - Add a @documentlanguage directive that includes your language. - E.g. @documentlanguage zh + E.g., @documentlanguage zh This directive has currently little effect but will be useful in the future. - The @author directive can be used for the translator's name. - E.g. @author traduit en français par Achile Talon + E.g., @author traduit en français par Achile Talon ** Fixing the original document @@ -99,7 +99,7 @@ emacs-devel@gnu.org for review. Always send contributions in the format of the original document. Most of the contents in the Emacs manuals are in Texinfo format, so do not -send contributions that are in derivative formats (e.g. info, html, +send contributions that are in derivative formats (e.g., info, html, docbook, plain text, etc.) Before sending files for review, ensure that they have been properly @@ -202,3 +202,10 @@ Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. This file is offered as-is, without any warranty. + + +Local Variables: +mode: outline +paragraph-separate: "[ ]*$" +coding: utf-8 +End: From f8d27a8a1fd5bdc8e25569cc05a9298e186a8c63 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 23:12:18 -0800 Subject: [PATCH 269/385] Ignore fewer GCC -fanalyzer diagnostics in ccl.c * src/ccl.c: Do not ignore -Wanalyzer-use-of-uninitialized-value, as that bug has been fixed in GCC. Ignore -Wanalyzer-out-of-bounds only if GCC 13, as the bug will reportedly be fixed when GCC 14 comes out. --- src/ccl.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/ccl.c b/src/ccl.c index a3a03a5b7b1..8bb8a78fe3d 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -35,11 +35,6 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "keyboard.h" -/* Avoid GCC 12 bug . */ -#if GNUC_PREREQ (12, 0, 0) -# pragma GCC diagnostic ignored "-Wanalyzer-use-of-uninitialized-value" -#endif - /* Table of registered CCL programs. Each element is a vector of NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the name of the program, CCL_PROG (vector) is the compiled code of the @@ -609,7 +604,7 @@ while (0) https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579 which causes GCC to mistakenly complain about popping the mapping stack. */ -#if GNUC_PREREQ (13, 0, 0) +#if __GNUC__ == 13 # pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds" #endif From 42c6cf4e5804312defa9d9caac8882500bd38179 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 23:38:30 -0800 Subject: [PATCH 270/385] Remove no-longer-needed pdumper_load workaround * src/pdumper.c (pdumper_load): Revert my commit "Pacify GCC 12.1.1 in default developer build" dated 2022-06-13 13:21:18 -07, as GCC bug 105961 is fixed, and this workaround is not needed for unfixed GCC as these builds should not use --enable-gcc-warnings. --- src/pdumper.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 5c488d8e90f..509fb079db7 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5593,10 +5593,7 @@ pdumper_load (const char *dump_filename, char *argv0) struct dump_header header_buf = { 0 }; struct dump_header *header = &header_buf; - struct dump_memory_map sections[NUMBER_DUMP_SECTIONS]; - - /* Use memset instead of "= { 0 }" to work around GCC bug 105961. */ - memset (sections, 0, sizeof sections); + struct dump_memory_map sections[NUMBER_DUMP_SECTIONS] = { 0 }; const struct timespec start_time = current_timespec (); char *dump_filename_copy; From 659770fdf535ca683a97d965d2e4ed0f9f321145 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Feb 2024 23:48:20 -0800 Subject: [PATCH 271/385] Do not ignore -Wanalyzer-allocation-size in GCC 14 * src/lisp.h (SAFE_ALLOCA_LISP_EXTRA): Use pragma to ignore the warning only in GCC 13, as the GCC developers say GCC bug 109577 is fixed in GCC 14. --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index bf96bfd39f7..79a6a054b81 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5525,7 +5525,7 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577 which causes GCC to mistakenly complain about the memory allocation in SAFE_ALLOCA_LISP_EXTRA. */ -#if GNUC_PREREQ (13, 0, 0) +#if GNUC_PREREQ (13, 0, 0) && !GNUC_PREREQ (14, 0, 0) # pragma GCC diagnostic ignored "-Wanalyzer-allocation-size" #endif From 4a8d3c5b75b28167300d2df061d053935809d43e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 18 Feb 2024 00:12:28 -0800 Subject: [PATCH 272/385] Use -Wanalyzer-deref-before-check in GCC 14 * src/marker.c: Work around GCC bug 113253 only if GCC 13. The GCC bug reportedly will be fixed in GCC 14. --- src/marker.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/marker.c b/src/marker.c index 0101e144b4d..1559dd52719 100644 --- a/src/marker.c +++ b/src/marker.c @@ -21,7 +21,7 @@ along with GNU Emacs. If not, see . */ #include /* Work around GCC bug 113253. */ -#if 13 <= __GNUC__ +#if __GNUC__ == 13 # pragma GCC diagnostic ignored "-Wanalyzer-deref-before-check" #endif From f6743099cc907f1f2847f028ff8f3712288c559f Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 18 Feb 2024 18:08:51 -0800 Subject: [PATCH 273/385] Back out part of commit db5e84af202 * lisp/gnus/gnus-agent.el (gnus-category-make-function-1): This code is untested and was not meant to be part of the earlier commit. --- lisp/gnus/gnus-agent.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 0928b179787..1726b806913 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -2920,9 +2920,8 @@ The following commands are available: ;; Functions are just returned as is. ((or (symbolp predicate) (functionp predicate)) - (let ((fun (or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) - (if (symbolp fun) `(,fun) `(funcall ',fun)))) + `(,(or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) ;; More complex predicate. ((consp predicate) `(,(cond From 8f260bb93f534b24d9a93d3315804ffe0c1fec4f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 18 Feb 2024 21:39:31 -0800 Subject: [PATCH 274/385] Don't update ranges for the whole buffer in treesit--pre-redisplay * lisp/treesit.el (treesit--pre-redisplay): Only update two screen-full of text around point. --- lisp/treesit.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index f811b8090bc..fa82ad898a9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1382,7 +1382,15 @@ as comment due to incomplete parse tree." ;; `treesit-update-ranges' will force the host language's parser to ;; reparse and set correct ranges for embedded parsers. Then ;; `treesit-parser-root-node' will force those parsers to reparse. - (treesit-update-ranges) + (let ((len (+ (* (window-body-height) (window-body-width)) 800))) + ;; FIXME: As a temporary fix, this prevents Emacs from updating + ;; every single local parsers in the buffer every time there's an + ;; edit. Moving forward, we need some way to properly track the + ;; regions which need update on parser ranges, like what jit-lock + ;; and syntax-ppss does. + (treesit-update-ranges + (max (point-min) (- (point) len)) + (min (point-max) (+ (point) len)))) ;; Force repase on _all_ the parsers might not be necessary, but ;; this is probably the most robust way. (dolist (parser (treesit-parser-list)) From be8f3e68a88a00bc12f1cc405a8a341666c41858 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 2 Jan 2024 12:06:16 +0100 Subject: [PATCH 275/385] * test/src/eval-tests.el (eval-tests/default-value): Add new test case. Bug#66117 --- test/src/eval-tests.el | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e1c90feb09a..187dc2f34d5 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -282,26 +282,39 @@ expressions works for identifiers starting with period." (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) :type 'cyclic-variable-indirection)) -(defvar eval-tests/global-var 'value) -(defvar-local eval-tests/buffer-local-var 'value) +(defvar eval-tests/global-var 'global-value) +(defvar-local eval-tests/buffer-local-var 'default-value) (ert-deftest eval-tests/default-value () ;; `let' overrides the default value for global variables. (should (default-boundp 'eval-tests/global-var)) - (should (eq 'value (default-value 'eval-tests/global-var))) - (should (eq 'value eval-tests/global-var)) - (let ((eval-tests/global-var 'bar)) - (should (eq 'bar (default-value 'eval-tests/global-var))) - (should (eq 'bar eval-tests/global-var))) + (should (eq 'global-value (default-value 'eval-tests/global-var))) + (should (eq 'global-value eval-tests/global-var)) + (let ((eval-tests/global-var 'let-value)) + (should (eq 'let-value (default-value 'eval-tests/global-var))) + (should (eq 'let-value eval-tests/global-var))) ;; `let' overrides the default value everywhere, but leaves ;; buffer-local values unchanged in current buffer and in the ;; buffers where there is no explicitly set buffer-local value. (should (default-boundp 'eval-tests/buffer-local-var)) - (should (eq 'value (default-value 'eval-tests/buffer-local-var))) - (should (eq 'value eval-tests/buffer-local-var)) + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'default-value eval-tests/buffer-local-var)) (with-temp-buffer - (let ((eval-tests/buffer-local-var 'bar)) - (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) - (should (eq 'bar eval-tests/buffer-local-var))))) + (let ((eval-tests/buffer-local-var 'let-value)) + (should (eq 'let-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'let-value eval-tests/buffer-local-var)))) + ;; When current buffer has explicit buffer-local binding, `let' does + ;; not alter the default binding. + (with-temp-buffer + (setq-local eval-tests/buffer-local-var 'local-value) + (let ((eval-tests/buffer-local-var 'let-value)) + ;; Let in a buffer with local binding does not change the + ;; default value for variable. + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'let-value eval-tests/buffer-local-var)) + (with-temp-buffer + ;; We are in a new buffer - `eval-tests/buffer-local-var' has its global default value. + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'default-value eval-tests/buffer-local-var)))))) (ert-deftest eval-tests--handler-bind () ;; A `handler-bind' has no effect if no error is signaled. From 5d3ecd7358252349dd26e6015a83054893af4474 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Mon, 19 Feb 2024 20:05:14 +0900 Subject: [PATCH 276/385] ; Proofreading changes in doc/translations/README. --- doc/translations/README | 135 ++++++++++++++++++++-------------------- 1 file changed, 67 insertions(+), 68 deletions(-) diff --git a/doc/translations/README b/doc/translations/README index c689f0b14b3..35b9b9e9cf9 100644 --- a/doc/translations/README +++ b/doc/translations/README @@ -15,22 +15,23 @@ any later version published by the Free Software Foundation. See https://www.gnu.org/licenses/fdl-1.3.html for more information. -If you have questions regarding the use of the FDL license in your -translation work that are not answered in the FAQ, do not hesitate to -contact the GNU project: https://www.gnu.org/contact/ +If you have any questions regarding the use of the FDL license in your +translation work that do not appear in the FAQ, feel free to contact the +GNU project. -** Location +See https://www.gnu.org/contact/ for more information. + +** Location of the translated files *** Texinfo source files -The source files of the translated manuals are located in the doc/ -directory, under the directory whose name corresponds to the translated -language. +The source files of the translated manuals are located in the +doc/translations directory, under the translated language sub-directory. - E.g., French manuals sources are found under doc/fr. + E.g., French manual sources are found under doc/translations/fr. -The structure of the language folders should match the structure of the -English manuals (i.e. include misc, man, lispref, lispintro, emacs). +The structure of each language folder should match that of the English +manuals (i.e. include misc, man, lispref, lispintro, emacs). *** built files @@ -38,22 +39,21 @@ Translated deliverables in info format are built at release time and are made available for local installation. -** Format +** Source files format The manuals and their translations are written in the Texinfo format -(with the exception of the org-mode manual that is written in org-mode -and of illustrations for the Introduction to Emacs Lisp Programming that -are written in eps). +(with the exception of the org-mode manual, which is written in +org-mode, and illustrations for the Introduction to Emacs Lisp +Programming, which are written in eps). See https://www.gnu.org/software/Texinfo/ for more information. -You should install the Texinfo utilities to be able to verify the -translated files, and refer to the Texinfo manual if you do not -understand the meaning of the various Texinfo declarations. +You must install the Texinfo utilities in order to verify the translated +files, and refer to the Texinfo manual for information on the various +Texinfo declarations. -Emacs has a Texinfo mode that properly highlights the Texinfo code to -make it easier to see which parts are text to be translated and which -parts are not. +Emacs has a Texinfo mode that highlights the parts of the Texinfo code +to be translated for easy reference. *** Texinfo specific issues @@ -61,21 +61,21 @@ parts are not. Until the Emacs/Texinfo projects provide better solutions, here are a few rules to follow: -- Under each @node, add an @anchor that has the same content at the -original English @node. +- Under each @node, add an @anchor that has the same content as the + original English @node. - Translate the @node content but leave the @anchor in English. - Most Emacs manuals are set to include the docstyle.Texi file. This -file adds the @documentencoding UTF-8 directive to the targeted manual. -There is no need to add this directive in a manual that includes -docstyle.Texi. + file adds the @documentencoding UTF-8 directive to the targeted + manual. There is no need to add this directive in a manual that + includes docstyle.texi. - Add a @documentlanguage directive that includes your language. E.g., @documentlanguage zh -This directive has currently little effect but will be useful in the +This directive currently has little effect but will be useful in the future. - The @author directive can be used for the translator's name. @@ -85,34 +85,35 @@ future. ** Fixing the original document -During the course of the translation, you might find parts of the -original document that need to be updated or otherwise fixed, or even -bugs in Emacs. If you do not intend to provide fixes right away, please -file a bug report promptly so someone can fix it soon. +During the course of the translation, you might encounter passages in +the original document that need to be updated or otherwise corrected, or +even run into a bug in Emacs. If you cannot immediately correct the +problem, please file a bug report promptly. See the 'Bugs' section in the Emacs manual. -** Sending contributions +** Sending your contributions -Send your contributions (either files or revisions) to -emacs-devel@gnu.org for review. +Send your contributions (files or revisions) for review to the Emacs +development list at emacs-devel@gnu.org. Subscribing to the list is not +obligatory. Always send contributions in the format of the original document. Most -of the contents in the Emacs manuals are in Texinfo format, so do not -send contributions that are in derivative formats (e.g., info, html, -docbook, plain text, etc.) +of the content in the Emacs manuals is in Texinfo format, so please do +not send contributions in derivative formats (e.g. info, html, docbook, +plain text, etc.) -Before sending files for review, ensure that they have been properly -checked for spelling/grammar/typography by at least using the tools that -Emacs provides. +Before sending files for review, please ensure that they have been +thoroughly checked for spelling/grammar/typography by at least using the +tools provided by Emacs. -You should also make sure that the Texinfo files build properly on your +Please also make sure that the Texinfo files build properly on your system. Send your contributions as patches (git diff -p --stat), and prefer the -git format-patch form because the format allows easier review and easier -installation of the changes by someone with write access to the -repository. +git format-patch form, since the format allows for easier review and +easier installation of the changes by the persons with write access to +the repository. The Emacs project has a lot of coding, documentation and commenting conventions. Sending such patches allows the project managers to make @@ -121,25 +122,24 @@ sure that the contributions comply with the various conventions. ** Discussing translation issues -Translation-related discussions are welcome on the emacs-devel list. -Discussions specific to your language do not have to take place in +Translation-related discussions are welcome on the emacs development +list. Discussions specific to your language do not have to be in English. ** Translation teams -The number of words in the Emacs manuals is above 2,000,000 words and +The number of words in the Emacs manuals is over 2,000,000 words and growing. While one individual could theoretically translate all the files, it is more practical to work in language teams. -If you have a small group of translators willing to help, make sure that -the files are properly reviewed before sending them to emacs-devel (see -above). +If you have a small group of translators willing to help, please make +sure that the files are properly reviewed before sending them to the +Emacs development list (see above). -You are invited to refer to the translation-related documents that the -GNU Project maintains and to get in touch with your language's -translation team to learn from the practices they have developed over -the years. +Please refer to the translation-related documents maintained by the GNU +Project, and contact your language translation team to learn the +practices they have developed over the years. See https://www.gnu.org/server/standards/README.translations.html for more information. @@ -148,46 +148,45 @@ more information. ** Translation processes Emacs does not yet provide tools that significantly help the translation -process. A few useful functions would be +process. A few useful functions would be: - automatic lookup of a list of glossary items when starting to work on -a translation "unit" (paragraph or otherwise), such glossary terms -should be easily insertable at point, + a translation "unit" (paragraph or otherwise); such glossary terms + should be easily insertable at point, - automatic lookup of past translations to check for similarity and -improve homogeneity over the whole document set, such past translation -matches should be easily insertable at point, - -etc. + improve homogeneity over the whole document set; such past translation + matches should be easily insertable at point, etc. *** Using the PO format as an intermediate translation format Although the PO format has not been developed with documentation in -mind, it is well known among free software translation teams and you can -easily use the po4a utility to convert Texinfo to PO for work in +mind, it is well-known among free software translation teams, and you +can easily use the po4a utility to convert Texinfo to PO for work in translation tools that support the PO format. See https://po4a.org for more information. However, regardless of the intermediate file format that you might use, -you should only send Texinfo files for review to emacs-devel. +you should only send files in the original format (Texinfo, org-mode, +eps) for review and installation. *** Free tools that you can use in your processes -A number of free software tools exist, outside the Emacs ecosystem, to -help translators (amateurs and professionals alike) with the translation -process. +A number of free software tools are available outside the Emacs +ecosystem, to help translators (both amateur and professional) in the +translation process. -If you find that Emacs should implement some of their features, you are +If they have any features that you think Emacs should implement, you are welcome to provide patches to the Emacs project. Such tools include: - the GNOME Translation Editor, https://wiki.gnome.org/Apps/Gtranslator/ - KDE's Lokalize, https://apps.kde.org/lokalize/ -- OmegaT, http://omegat.org +- OmegaT, https://omegat.org - the Okapi Framework, https://www.okapiframework.org - pootle, https://pootle.translatehouse.org From 70dc1700562309c2612a71be35f9c71e9e1641b8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Feb 2024 15:19:54 +0200 Subject: [PATCH 277/385] ; Further copyedits of doc/translations/README. --- doc/translations/README | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/doc/translations/README b/doc/translations/README index 35b9b9e9cf9..02edb829dcf 100644 --- a/doc/translations/README +++ b/doc/translations/README @@ -26,31 +26,32 @@ See https://www.gnu.org/contact/ for more information. *** Texinfo source files The source files of the translated manuals are located in the -doc/translations directory, under the translated language sub-directory. +doc/translations directory, under the sub-directory corresponding to the +translated language. E.g., French manual sources are found under doc/translations/fr. -The structure of each language folder should match that of the English +The structure of each language's folder should match that of the English manuals (i.e. include misc, man, lispref, lispintro, emacs). -*** built files +*** Built files -Translated deliverables in info format are built at release time and are +Translated deliverables in Info format are built at release time and are made available for local installation. ** Source files format The manuals and their translations are written in the Texinfo format -(with the exception of the org-mode manual, which is written in -org-mode, and illustrations for the Introduction to Emacs Lisp -Programming, which are written in eps). +(with the exception of the org-mode manual, which is written in Org, and +illustrations for the Introduction to Emacs Lisp Programming, which are +EPS files). See https://www.gnu.org/software/Texinfo/ for more information. -You must install the Texinfo utilities in order to verify the translated +You must install the Texinfo package in order to verify the translated files, and refer to the Texinfo manual for information on the various -Texinfo declarations. +Texinfo features. Emacs has a Texinfo mode that highlights the parts of the Texinfo code to be translated for easy reference. @@ -67,7 +68,7 @@ few rules to follow: - Translate the @node content but leave the @anchor in English. - Most Emacs manuals are set to include the docstyle.Texi file. This - file adds the @documentencoding UTF-8 directive to the targeted + file adds the "@documentencoding UTF-8" directive to the targeted manual. There is no need to add this directive in a manual that includes docstyle.texi. @@ -111,7 +112,7 @@ Please also make sure that the Texinfo files build properly on your system. Send your contributions as patches (git diff -p --stat), and prefer the -git format-patch form, since the format allows for easier review and +git format-patch form, since that format allows for easier review and easier installation of the changes by the persons with write access to the repository. @@ -123,7 +124,7 @@ sure that the contributions comply with the various conventions. ** Discussing translation issues Translation-related discussions are welcome on the emacs development -list. Discussions specific to your language do not have to be in +list. Discussions specific to your language do not have to be in English. @@ -175,9 +176,9 @@ eps) for review and installation. *** Free tools that you can use in your processes -A number of free software tools are available outside the Emacs -ecosystem, to help translators (both amateur and professional) in the -translation process. +A number of free software tools are available outside the Emacs project, +to help translators (both amateur and professional) in the translation +process. If they have any features that you think Emacs should implement, you are welcome to provide patches to the Emacs project. From ddfba511c190e5bb44e44a50aef5ab8c08e3d798 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Feb 2024 10:27:02 +0100 Subject: [PATCH 278/385] Check shortdoc keywords and fix one mistake * lisp/emacs-lisp/shortdoc.el (shortdoc--check) (define-short-documentation-group): Check that used keywords exist. * lisp/emacs-lisp/shortdoc.el (list): Fix a typo. --- lisp/emacs-lisp/shortdoc.el | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index a6a49c72f74..cde28985cd0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -50,6 +50,17 @@ '((t :inherit variable-pitch)) "Face used for a section.") +;;;###autoload +(defun shortdoc--check (group functions) + (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* + :result :result-string :eg-result :eg-result-string :doc))) + (dolist (f functions) + (when (consp f) + (dolist (x f) + (when (and (keywordp x) (not (memq x keywords))) + (error "Shortdoc %s function `%s': bad keyword `%s'" + group (car f) x))))))) + ;;;###autoload (progn (defvar shortdoc--groups nil) @@ -118,6 +129,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), `:no-eval*', `:result', `:result-string', `:eg-result' and `:eg-result-string' properties." (declare (indent defun)) + (shortdoc--check group functions) `(progn (setq shortdoc--groups (delq (assq ',group shortdoc--groups) shortdoc--groups)) @@ -715,7 +727,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (plist-get '(a 1 b 2 c 3) 'b)) (plist-put :no-eval (setq plist (plist-put plist 'd 4)) - :eq-result (a 1 b 2 c 3 d 4)) + :eg-result (a 1 b 2 c 3 d 4)) (plist-member :eval (plist-member '(a 1 b 2 c 3) 'b)) "Data About Lists" From 188fe6bffa69e08b60a7d65709998bd803b7ada5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Feb 2024 11:44:53 +0100 Subject: [PATCH 279/385] Replace XSET_HASH_TABLE with make_lisp_hash_table * src/lisp.h (XSET_HASH_TABLE): Remove, replace with... (make_lisp_hash_table): ...this. All callers adapted. --- src/alloc.c | 3 +-- src/fns.c | 13 ++----------- src/lisp.h | 8 ++++++-- 3 files changed, 9 insertions(+), 15 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 6abe9e28650..8c94c7eb33c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6034,8 +6034,7 @@ purecopy (Lisp_Object obj) return obj; /* Don't hash cons it. */ } - struct Lisp_Hash_Table *h = purecopy_hash_table (table); - XSET_HASH_TABLE (obj, h); + obj = make_lisp_hash_table (purecopy_hash_table (table)); } else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj)) { diff --git a/src/fns.c b/src/fns.c index f94e8519957..0a9692f36e8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4608,13 +4608,7 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, h->next_weak = NULL; h->purecopy = purecopy; h->mutable = true; - - Lisp_Object table; - XSET_HASH_TABLE (table, h); - eassert (HASH_TABLE_P (table)); - eassert (XHASH_TABLE (table) == h); - - return table; + return make_lisp_hash_table (h); } @@ -4624,7 +4618,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, static Lisp_Object copy_hash_table (struct Lisp_Hash_Table *h1) { - Lisp_Object table; struct Lisp_Hash_Table *h2; h2 = allocate_hash_table (); @@ -4649,9 +4642,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2->index = hash_table_alloc_bytes (index_bytes); memcpy (h2->index, h1->index, index_bytes); } - XSET_HASH_TABLE (table, h2); - - return table; + return make_lisp_hash_table (h2); } diff --git a/src/lisp.h b/src/lisp.h index 79a6a054b81..db053ba9f70 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2547,8 +2547,12 @@ XHASH_TABLE (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table); } -#define XSET_HASH_TABLE(VAR, PTR) \ - XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE) +INLINE Lisp_Object +make_lisp_hash_table (struct Lisp_Hash_Table *h) +{ + eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_HASH_TABLE)); + return make_lisp_ptr (h, Lisp_Vectorlike); +} /* Value is the key part of entry IDX in hash table H. */ INLINE Lisp_Object From 23793600778c4efe5615b646f2d3895624c23ef0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Feb 2024 14:42:55 +0100 Subject: [PATCH 280/385] Slight switch byte op speedup * src/bytecode.c (exec_byte_code): Hoist symbols_with_pos_enabled check from fast loop, and eliminate the initial index check. --- src/bytecode.c | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index dd805cbd97a..8d7240b9966 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1737,28 +1737,29 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) emacs_abort (); Lisp_Object v1 = POP; - ptrdiff_t i; struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); - - /* h->count is a faster approximation for HASH_TABLE_SIZE (h) - here. */ - if (h->count <= 5 && !h->test->cmpfn) - { /* Do a linear search if there are not many cases - FIXME: 5 is arbitrarily chosen. */ - for (i = h->count; 0 <= --i; ) - if (EQ (v1, HASH_KEY (h, i))) - break; + /* Do a linear search if there are few cases and the test is `eq'. + (The table is assumed to be sized exactly; all entries are + consecutive at the beginning.) + FIXME: 5 is arbitrarily chosen. */ + if (h->count <= 5 && !h->test->cmpfn && !symbols_with_pos_enabled) + { + eassume (h->count >= 2); + for (ptrdiff_t i = h->count - 1; i >= 0; i--) + if (BASE_EQ (v1, HASH_KEY (h, i))) + { + op = XFIXNUM (HASH_VALUE (h, i)); + goto op_branch; + } } else - i = hash_lookup (h, v1); - - if (i >= 0) { - Lisp_Object val = HASH_VALUE (h, i); - if (BYTE_CODE_SAFE && !FIXNUMP (val)) - emacs_abort (); - op = XFIXNUM (val); - goto op_branch; + ptrdiff_t i = hash_lookup (h, v1); + if (i >= 0) + { + op = XFIXNUM (HASH_VALUE (h, i)); + goto op_branch; + } } } NEXT; From 6893106fe9302b1be68dd04034441799e6d29b68 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 15 Feb 2024 12:10:12 +0100 Subject: [PATCH 281/385] Allow attaching files at point using 'gnus-dired-attach' * lisp/gnus/gnus-dired.el (gnus-dired-attach-at-end): Add option. (gnus-dired-attach): Respect it. * doc/misc/gnus.texi (Other modes): Document it. (Bug#69141) --- doc/misc/gnus.texi | 5 ++++- lisp/gnus/gnus-dired.el | 9 ++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 2f8f97e5845..98196310b5c 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26695,9 +26695,12 @@ buffers. It is enabled with @table @kbd @item C-c C-m C-a @findex gnus-dired-attach +@vindex gnus-dired-attach-at-end @cindex attachments, selection via dired Send dired's marked files as an attachment (@code{gnus-dired-attach}). -You will be prompted for a message buffer. +You will be prompted for a message buffer. By default it will attach +files to the end of the message buffer, but you can modify that +behaviour by customising @code{gnus-dired-attach-at-end}. @item C-c C-m C-l @findex gnus-dired-find-file-mailcap diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 48c1aef968b..f33c5f7f2e5 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -111,6 +111,12 @@ See `mail-user-agent' for more information." (autoload 'gnus-completing-read "gnus-util") +(defcustom gnus-dired-attach-at-end t + "Non-nil means that files should be attached at the end of a buffer." + :group 'mail ;; dired? + :version "30.1" + :type 'boolean) + ;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "Attach dired's marked files to a gnus message composition. @@ -161,7 +167,8 @@ filenames." ;; set buffer to destination buffer, and attach files (set-buffer destination) - (goto-char (point-max)) ;attach at end of buffer + (when gnus-dired-attach-at-end + (goto-char (point-max))) ;attach at end of buffer (while files-to-attach (mml-attach-file (car files-to-attach) (or (mm-default-file-type (car files-to-attach)) From a1cbc4d810bc1b525fa46b23249b414c1ad6b031 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Feb 2024 21:34:43 +0200 Subject: [PATCH 282/385] ; * doc/misc/gnus.texi (Other modes): Fix last change. --- doc/misc/gnus.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 98196310b5c..419a5390374 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26698,9 +26698,9 @@ buffers. It is enabled with @vindex gnus-dired-attach-at-end @cindex attachments, selection via dired Send dired's marked files as an attachment (@code{gnus-dired-attach}). -You will be prompted for a message buffer. By default it will attach -files to the end of the message buffer, but you can modify that -behaviour by customising @code{gnus-dired-attach-at-end}. +The function prompts for a message buffer, and by default attaches files +to the end of that buffer; customize @code{gnus-dired-attach-at-end} to +place the attachments at point instead. @item C-c C-m C-l @findex gnus-dired-find-file-mailcap From 4e9993cada32a866a75b458092de0028db2f5f41 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Feb 2024 12:52:40 +0100 Subject: [PATCH 283/385] Add Tramp methods dockercp and podmancp * doc/misc/tramp.texi (External methods): Add dockercp and podmancp. * etc/NEWS: Add Tramp methods "dockercp" and "podmancp". * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file) (tramp-sshfs-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): Adapt `tramp-expand-args' calls. * lisp/net/tramp-container.el (tramp-dockercp-method) (tramp-podmancp-method): New defconst. (tramp-methods) : Add new methods. (tramp-container--completion-function): Adapt docstring. Use it for "dockercp" and "podmancp" completion. * lisp/net/tramp.el (tramp-get-remote-tmpdir): * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Use a default value with `tramp-get-method-parameter'. * lisp/net/tramp-sh.el (tramp-methods) : Add `tramp-copy-file-name'. (tramp-default-copy-file-name): New defconst. (tramp-make-copy-file-name): Rename from `tramp-make-copy-program-file-name'. Use method parameter `tramp-copy-file-name'. (Bug#69085) (tramp-do-copy-or-rename-file-out-of-band): Adapt callees. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-get-method-parameter, tramp-expand-args): New optional argument DEFAULT. * test/lisp/net/tramp-tests.el (tramp--test-container-p): Adapt. (tramp--test-container-oob-p): New defun. (tramp-test17-dired-with-wildcards, tramp-test35-remote-path) (tramp-test41-special-characters): Use it. (tramp--test-set-ert-test-documentation): Use `split-string'. --- doc/misc/tramp.texi | 14 ++++++ etc/NEWS | 12 +++-- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-container.el | 60 ++++++++++++++++++++++++- lisp/net/tramp-gvfs.el | 4 +- lisp/net/tramp-sh.el | 38 ++++++++-------- lisp/net/tramp-sshfs.el | 4 +- lisp/net/tramp-sudoedit.el | 2 +- lisp/net/tramp.el | 35 ++++++++++----- test/lisp/net/tramp-tests.el | 85 +++++++++++++++++++++--------------- 10 files changed, 182 insertions(+), 74 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index affd760730b..6d4654f1a8a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1059,6 +1059,20 @@ session. These methods support the @samp{-P} argument. +@item @option{dockercp} +@item @option{podmancp} +@cindex method @option{dockercp} +@cindex @option{dockercp} method +@cindex method @option{podmancp} +@cindex @option{podmancp} method + +These methods are similar to @option{docker} or @option{podman}, but +they use the command @command{docker cp} or @command{podman cp} for +transferring large files. + +These copy commands do not support file globs, and they ignore a user +name. + @item @option{fcp} @cindex method @option{fcp} @cindex @option{fcp} method diff --git a/etc/NEWS b/etc/NEWS index 4477116248e..7b248c3fe78 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -884,6 +884,10 @@ mode line. 'header' will display in the header line; ** Tramp ++++ +*** New connection methods "dockercp" and "podmancp". +These are the external methods counterparts of "docker" and "podman". + +++ *** New connection methods "toolbox" and "flatpak". They allow accessing system containers provided by Toolbox or @@ -1121,7 +1125,7 @@ the user option 'nnweb-type' to 'gmane'. *** New user option 'gnus-mode-line-logo'. This allows the user to either disable the display of any logo or specify which logo will be displayed as part of the -buffer-identification in the mode-line of Gnus-buffers. +buffer-identification in the mode-line of Gnus buffers. ** Rmail @@ -1333,7 +1337,7 @@ chat buffers use by default. This command toggles the display of internal buffers in Buffer Menu mode; that is, buffers not visiting a file and whose names start with a space. Previously, such buffers were never shown. This command is bound to 'I' -in Buffer menu mode. +in Buffer Menu mode. ** Customize @@ -1429,7 +1433,7 @@ current project configuration, and later updates it as you edit the files and save the changes. +++ -** New package Compat +** New package Compat. Emacs now comes with a stub implementation of the forwards-compatibility Compat package from GNU ELPA. This allows built-in packages to use the library more effectively, and helps @@ -1560,7 +1564,7 @@ values. +++ ** Pcase's functions (in 'pred' and 'app') can specify the argument position. -For example, instead of (pred (< 5)) you can write (pred (> _ 5)). +For example, instead of '(pred (< 5))' you can write '(pred (> _ 5))'. +++ ** 'define-advice' now sets the new advice's 'name' property to NAME. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2e4ad1cc412..96625fc5680 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1230,7 +1230,7 @@ connection if a previous connection has died for some reason." (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? (process-connection-type tramp-process-connection-type) (args (tramp-expand-args - vec 'tramp-login-args ?d (or device ""))) + vec 'tramp-login-args nil ?d (or device ""))) (p (let ((default-directory tramp-compat-temporary-file-directory)) (apply diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 1f578949e4d..30639cbeb85 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -31,15 +31,20 @@ ;; Open a file on a running Docker container: ;; ;; C-x C-f /docker:USER@CONTAINER:/path/to/file +;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file ;; ;; or Podman: ;; ;; C-x C-f /podman:USER@CONTAINER:/path/to/file +;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file ;; ;; Where: ;; USER is the user on the container to connect as (optional). ;; CONTAINER is the container to connect to. ;; +;; "docker" and "podman" are inline methods, "dockercp" and "podmancp" +;; are out-of-band methods. +;; ;; ;; ;; Open file in a Kubernetes container: @@ -141,10 +146,20 @@ If it is nil, the default context will be used." (defconst tramp-docker-method "docker" "Tramp method name to use to connect to Docker containers.") +;;;###tramp-autoload +(defconst tramp-dockercp-method "dockercp" + "Tramp method name to use to connect to Docker containers. +This is for out-of-band connections.") + ;;;###tramp-autoload (defconst tramp-podman-method "podman" "Tramp method name to use to connect to Podman containers.") +;;;###tramp-autoload +(defconst tramp-podmancp-method "podmancp" + "Tramp method name to use to connect to Podman containers. +This is for out-of-band connections.") + ;;;###tramp-autoload (defconst tramp-kubernetes-method "kubernetes" "Tramp method name to use to connect to Kubernetes containers.") @@ -183,7 +198,8 @@ BODY is the backend specific code." (defun tramp-container--completion-function (method) "List running containers available for connection. METHOD is the Tramp method to be used for \"ps\", either -`tramp-docker-method' or `tramp-podman-method'. +`tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method', +or `tramp-podmancp-method'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." @@ -375,6 +391,23 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-dockercp-method + (tramp-login-program ,tramp-docker-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c")) + (tramp-copy-program ,tramp-docker-program) + (tramp-copy-args (("cp"))) + (tramp-copy-file-name (("%h" ":") ("%f"))) + (tramp-copy-recursive t))) + (add-to-list 'tramp-methods `(,tramp-podman-method (tramp-login-program ,tramp-podman-program) @@ -388,6 +421,23 @@ see its function help for a description of the format." (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods + `(,tramp-podmancp-method + (tramp-login-program ,tramp-podman-program) + (tramp-login-args (("exec") + ("-it") + ("-u" "%u") + ("%h") + ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) + (tramp-remote-shell ,tramp-default-remote-shell) + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-i" "-c")) + (tramp-copy-program ,tramp-podman-program) + (tramp-copy-args (("cp"))) + (tramp-copy-file-name (("%h" ":") ("%f"))) + (tramp-copy-recursive t))) + (add-to-list 'tramp-methods `(,tramp-kubernetes-method (tramp-login-program ,tramp-kubernetes-program) @@ -431,10 +481,18 @@ see its function help for a description of the format." tramp-docker-method `((tramp-container--completion-function ,tramp-docker-method))) + (tramp-set-completion-function + tramp-dockercp-method + `((tramp-container--completion-function ,tramp-dockercp-method))) + (tramp-set-completion-function tramp-podman-method `((tramp-container--completion-function ,tramp-podman-method))) + (tramp-set-completion-function + tramp-podmancp-method + `((tramp-container--completion-function ,tramp-podmancp-method))) + (tramp-set-completion-function tramp-kubernetes-method `((tramp-kubernetes--completion-function ,tramp-kubernetes-method))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 4e949e7e60b..93071ed7350 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2294,8 +2294,8 @@ connection if a previous connection has died for some reason." ;; indicated by the "mounted" signal, i.e. the ;; "fuse-mountpoint" file property. (with-timeout - ((or (tramp-get-method-parameter vec 'tramp-connection-timeout) - tramp-connection-timeout) + ((tramp-get-method-parameter + vec 'tramp-connection-timeout tramp-connection-timeout) (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (tramp-error vec 'file-error diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3557b3a1b64..66e648624b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -282,6 +282,7 @@ The string is used in `tramp-methods'.") (tramp-copy-program "nc") ;; We use "-v" for better error tracking. (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) + (tramp-copy-file-name (("%f"))) (tramp-remote-copy-program "nc") ;; We use "-p" as required for newer busyboxes. For older ;; busybox/nc versions, the value must be (("-l") ("%r")). This @@ -428,6 +429,9 @@ The string is used in `tramp-methods'.") eos) nil ,(user-login-name)))) +(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f")) + "Default `tramp-copy-file-name' entry for out-of-band methods.") + ;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh '((tramp-parse-rhosts "/etc/hosts.equiv") @@ -2399,10 +2403,10 @@ The method used must be an out-of-band method." #'file-name-as-directory #'identity) (if v1 - (tramp-make-copy-program-file-name v1) + (tramp-make-copy-file-name v1) (file-name-unquote filename))) target (if v2 - (tramp-make-copy-program-file-name v2) + (tramp-make-copy-file-name v2) (file-name-unquote newname))) ;; Check for listener port. @@ -2441,7 +2445,7 @@ The method used must be an out-of-band method." ;; " " has either been a replacement of "%k" (when ;; KEEP-DATE argument is non-nil), or a replacement for ;; the whole keep-date sublist. - (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec)) + (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec)) ;; `tramp-ssh-controlmaster-options' is a string instead ;; of a list. Unflatten it. copy-args @@ -2450,11 +2454,11 @@ The method used must be an out-of-band method." (lambda (x) (if (tramp-compat-string-search " " x) (split-string x) x)) copy-args)) - copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) + copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec) remote-copy-program (tramp-get-method-parameter v 'tramp-remote-copy-program) remote-copy-args - (apply #'tramp-expand-args v 'tramp-remote-copy-args spec)) + (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec)) ;; Check for local copy program. (unless (executable-find copy-program) @@ -5290,7 +5294,8 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter hop 'tramp-async-args))) (connection-timeout (tramp-get-method-parameter - hop 'tramp-connection-timeout)) + hop 'tramp-connection-timeout + tramp-connection-timeout)) (command (tramp-get-method-parameter hop 'tramp-login-program)) @@ -5348,7 +5353,7 @@ connection if a previous connection has died for some reason." ;; Add arguments for asynchronous processes. (when process-name async-args) (tramp-expand-args - hop 'tramp-login-args + hop 'tramp-login-args nil ?h (or l-host "") ?u (or l-user "") ?p (or l-port "") ?c (format-spec options (format-spec-make ?t tmpfile)) ?n (concat @@ -5365,8 +5370,7 @@ connection if a previous connection has died for some reason." p vec (min pos (with-current-buffer (process-buffer p) (point-max))) - tramp-actions-before-shell - (or connection-timeout tramp-connection-timeout)) + tramp-actions-before-shell connection-timeout) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host) @@ -5559,8 +5563,8 @@ raises an error." string "")) -(defun tramp-make-copy-program-file-name (vec) - "Create a file name suitable for `scp', `pscp', or `nc' and workalikes." +(defun tramp-make-copy-file-name (vec) + "Create a file name suitable for out-of-band methods." (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-host vec)) @@ -5571,13 +5575,13 @@ raises an error." ;; This does not work for MS Windows scp, if there are characters ;; to be quoted. OpenSSH 8 supports disabling of strict file name ;; checking in scp, we use it when available. - (unless (string-match-p (rx "ftp" eos) method) + (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method) (setq localname (tramp-unquote-shell-quote-argument localname))) - (cond - ((tramp-get-method-parameter vec 'tramp-remote-copy-program) - localname) - ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname)) - (t (format "%s@%s:%s" user host localname))))) + (string-join + (apply #'tramp-expand-args vec + 'tramp-copy-file-name tramp-default-copy-file-name + (list ?h (or host "") ?u (or user "") ?f localname)) + ""))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 8dad599c7e7..d0d56b8967e 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -322,7 +322,7 @@ arguments to pass to the OPERATION." v (tramp-get-method-parameter v 'tramp-login-program) nil outbuf display (tramp-expand-args - v 'tramp-login-args + v 'tramp-login-args nil ?h (or (tramp-file-name-host v) "") ?u (or (tramp-file-name-user v) "") ?p (or (tramp-file-name-port v) "") @@ -424,7 +424,7 @@ connection if a previous connection has died for some reason." (tramp-fuse-mount-spec vec) (tramp-fuse-mount-point vec) (tramp-expand-args - vec 'tramp-mount-args + vec 'tramp-mount-args nil ?p (or (tramp-file-name-port vec) "")))))) (tramp-error vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0c717c4a5aa..7bbfec62753 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -771,7 +771,7 @@ in case of error, t otherwise." (tramp-get-connection-name vec) (current-buffer) (append (tramp-expand-args - vec 'tramp-sudo-login + vec 'tramp-sudo-login nil ?h (or (tramp-file-name-host vec) "") ?u (or (tramp-file-name-user vec) "")) (flatten-tree args)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2efee2344d2..e6d6eb0ee66 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -301,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are defined: This specifies the list of parameters to pass to the above mentioned program, the hints for `tramp-login-args' also apply here. + * `tramp-copy-file-name' + The remote source or destination file name for out-of-band methods. + You can use \"%u\" and \"%h\" like in `tramp-login-args'. + Additionally, \"%f\" denotes the local file name part. This list + will be expanded to a string without spaces between the elements of + the list. + + The default value is `tramp-default-copy-file-name'. + * `tramp-copy-env' A list of environment variables and their values, which will be set when calling `tramp-copy-program'. @@ -1545,21 +1554,23 @@ LOCALNAME and HOP do not count." (equal (tramp-file-name-unify vec1) (tramp-file-name-unify vec2)))) -(defun tramp-get-method-parameter (vec param) +(defun tramp-get-method-parameter (vec param &optional default) "Return the method parameter PARAM. If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' -entry does not exist, return nil." +entry does not exist, return DEFAULT." (let ((hash-entry (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry) ;; Use the static value from `tramp-methods'. - (when-let ((methods-entry + (if-let ((methods-entry (assoc param (assoc (tramp-file-name-method vec) tramp-methods)))) - (cadr methods-entry))))) + (cadr methods-entry) + ;; Return the default value. + default)))) ;; The localname can be quoted with "/:". Extract this. (defun tramp-file-name-unquote-localname (vec) @@ -3943,6 +3954,9 @@ Let-bind it when necessary.") (tramp-get-method-parameter v 'tramp-case-insensitive) ;; There isn't. So we must check, in case there's a connection already. + ;; Note: We cannot use it as DEFAULT value of + ;; `tramp-get-method-parameter', because it would be evalled + ;; during the call. (and (let ((non-essential t)) (tramp-connectable-p v)) (with-tramp-connection-property v "case-insensitive" (ignore-errors @@ -4752,15 +4766,15 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defvar tramp-extra-expand-args nil "Method specific arguments.") -(defun tramp-expand-args (vec parameter &rest spec-list) +(defun tramp-expand-args (vec parameter default &rest spec-list) "Expand login arguments as given by PARAMETER in `tramp-methods'. PARAMETER is a symbol like `tramp-login-args', denoting a list of list of strings from `tramp-methods', containing %-sequences for -substitution. +substitution. DEFAULT is used when PARAMETER is not specified. SPEC-LIST is a list of char/value pairs used for `format-spec-make'. It is appended by `tramp-extra-expand-args', a connection-local variable." - (let ((args (tramp-get-method-parameter vec parameter)) + (let ((args (tramp-get-method-parameter vec parameter default)) (extra-spec-list (mapcar #'eval @@ -4939,7 +4953,7 @@ a connection-local variable." (mapcar (lambda (x) (split-string x " ")) (tramp-expand-args - v 'tramp-login-args + v 'tramp-login-args nil ?h (or host "") ?u (or user "") ?p (or port "") ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) ?d (or device "") ?a (or pta "") ?l "")))) @@ -6326,9 +6340,8 @@ This handles also chrooted environments, which are not regarded as local." (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." (with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir" - (let ((dir - (tramp-make-tramp-file-name - vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) + (let ((dir (tramp-make-tramp-file-name + vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp")))) (or (and (file-directory-p dir) (file-writable-p dir) (tramp-file-local-name dir)) (tramp-error vec 'file-error "Directory %s not accessible" dir)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 623e0860a01..cdd2a1efdb2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (not (tramp--test-rsync-p))) ;; Wildcards are not supported in tramp-crypt.el. (skip-unless (not (tramp--test-crypt-p))) + ;; Wildcards are not supported with "docker cp ..." or "podman cp ...". + (skip-unless (not (tramp--test-container-oob-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 @@ -3819,7 +3821,7 @@ This tests also `access-file', `file-readable-p', "Set the documentation string for a derived test. The test is derived from TEST and COMMAND." (let ((test-doc - (string-split (ert-test-documentation (get test 'ert--test)) "\n"))) + (split-string (ert-test-documentation (get test 'ert--test)) "\n"))) ;; The first line must be extended. (setcar test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) @@ -6379,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process." (setq tramp-remote-path orig-tramp-remote-path) ;; We make a super long `tramp-remote-path'. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) - (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) - (should (file-directory-p dir)) - (setq tramp-remote-path - (append - tramp-remote-path `(,(file-remote-p dir 'localname))) - orig-exec-path - (append - (butlast orig-exec-path) - `(,(file-remote-p dir 'localname)) - (last orig-exec-path))))) - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (equal (exec-path) orig-exec-path)) - ;; Ignore trailing newline. - (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) - ;; The shell doesn't handle such long strings. - (unless (tramp-compat-length> - path - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) - ;; The last element of `exec-path' is `exec-directory'. - (should - (string-equal path (string-join (butlast orig-exec-path) ":")))) - ;; The shell "sh" shall always exist. - (should (executable-find "sh" 'remote))) + (unless (tramp--test-container-oob-p) + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) + (let ((dir (make-temp-file + (file-name-as-directory tmp-name) 'dir))) + (should (file-directory-p dir)) + (setq tramp-remote-path + (append + tramp-remote-path `(,(file-remote-p dir 'localname))) + orig-exec-path + (append + (butlast orig-exec-path) + `(,(file-remote-p dir 'localname)) + (last orig-exec-path))))) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (should (equal (exec-path) orig-exec-path)) + ;; Ignore trailing newline. + (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) + ;; The shell doesn't handle such long strings. + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) + ;; The last element of `exec-path' is `exec-directory'. + (should + (string-equal path (string-join (butlast orig-exec-path) ":")))) + ;; The shell "sh" shall always exist. + (should (executable-find "sh" 'remote)))) ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -7056,17 +7060,24 @@ This is used in tests which we don't want to tag (not (and (tramp--test-adb-p) (string-match-p (rx multibyte) default-directory))))) -(defun tramp--test-crypt-p () - "Check, whether the remote directory is encrypted." - (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) - (defun tramp--test-container-p () "Check, whether a container method is used. This does not support some special file names." (string-match-p - (rx bol (| "docker" "podman") eol) + (rx bol (| "docker" "podman")) (file-remote-p ert-remote-temporary-file-directory 'method))) +(defun tramp--test-container-oob-p () + "Check, whether the dockercp or podmancp method is used. +They does not support wildcard copy." + (string-match-p + (rx bol (| "dockercp" "podmancp") eol) + (file-remote-p ert-remote-temporary-file-directory 'method))) + +(defun tramp--test-crypt-p () + "Check, whether the remote directory is encrypted." + (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) + (defun tramp--test-expensive-test-p () "Whether expensive tests are run. This is used in tests which we don't want to tag `:expensive' @@ -7483,7 +7494,8 @@ This requires restrictions of file name syntax." (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "*foo+bar*baz+") @@ -7503,7 +7515,10 @@ This requires restrictions of file name syntax." (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "bar") "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) + (tramp--test-gvfs-p)) + "[foo]bar[baz]") "{foo}bar{baz}"))) ;; Simplify test in order to speed up. (apply #'tramp--test-check-files From d5775ae4d3ac8a1a4d2625e05307c9296df28d6f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Feb 2024 12:53:15 +0100 Subject: [PATCH 284/385] ; Copyedits --- lisp/net/tramp-compat.el | 2 ++ lisp/net/tramp-integration.el | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 061766090a0..98de0dba7ff 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -337,6 +337,8 @@ Also see `ignore'." ;; ;; * Starting with Emacs 29.1, use `buffer-match-p'. ;; +;; * Starting with Emacs 29.1, use `string-split'. +;; ;; * Starting with Emacs 30.1, there is `handler-bind'. Use it ;; instead of `condition-case' when the origin of an error shall be ;; kept, for example when the HANDLER propagates the error with diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index c0b60f57e40..e1f0b2a3495 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'." (when minibuffer-completing-file-name (setq tramp-rfn-eshadow-overlay (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) - ;; Copy rfn-eshadow-overlay properties. + ;; Copy `rfn-eshadow-overlay' properties. (let ((props (overlay-properties rfn-eshadow-overlay))) (while props ;; The `field' property prevents correct minibuffer From d9afa1f30fdf9d00b447fea0a8343397333e172f Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Mon, 19 Feb 2024 23:36:17 +0100 Subject: [PATCH 285/385] Make find-function-regexp also find transient-define-* * lisp/emacs-lisp/find-func.el (find-function-regexp): Also find transient-define-prefix, transient-define-suffix, transient-define-infix and transient-define-argument. --- lisp/emacs-lisp/find-func.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 63f547ebeb8..411602ef166 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -60,6 +60,7 @@ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\ +transient-define-\\(?:prefix\\|suffix\\|infix\\|argument\\)\\|\ menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" find-function-space-re "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") From 4c6653f23aef097e3a6ed687e21decea6c790b5e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Feb 2024 15:44:13 +0200 Subject: [PATCH 286/385] ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Doc fix. --- lisp/emacs-lisp/pcase.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 47db2b89b9e..692c8f9b3fe 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -261,7 +261,7 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) to its +Each EXP should match (i.e. be of compatible structure) its respective PATTERN; a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) @@ -283,7 +283,7 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) to its +Each EXP should match (i.e. be of compatible structure) its respective PATTERN; a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) From 2eb85a9de1a5068d09b21464601dbd3263e55c85 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Feb 2024 19:15:38 +0200 Subject: [PATCH 287/385] ; * lisp/emacs-lisp/pcase.el (pcase-let*, pcase-let): Another doc fix. --- lisp/emacs-lisp/pcase.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 692c8f9b3fe..ff68203eaea 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -261,8 +261,8 @@ As with `pcase-let', BINDINGS are of the form (PATTERN EXP), but the EXP in each binding in BINDINGS can use the results of the destructuring bindings that precede it in BINDINGS' order. -Each EXP should match (i.e. be of compatible structure) its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug ((&rest (pcase-PAT &optional form)) body))) @@ -283,8 +283,8 @@ All EXPs are evaluated first, and then used to perform destructuring bindings by matching each EXP against its respective PATTERN. Then BODY is evaluated with those bindings in effect. -Each EXP should match (i.e. be of compatible structure) its -respective PATTERN; a mismatch may signal an error or may go +Each EXP should match its respective PATTERN (i.e. be of structure +compatible to PATTERN); a mismatch may signal an error or may go undetected, binding variables to arbitrary values, such as nil." (declare (indent 1) (debug pcase-let*)) (if (null (cdr bindings)) From bbf0b7d0407883ea0a59c09b501c6e550bb8e10c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 20 Feb 2024 19:47:29 +0100 Subject: [PATCH 288/385] * Fix missing entry in 'cl--typeof-types' * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Add 'native-comp-unit'. --- lisp/emacs-lisp/cl-preloaded.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 20e68555578..d533eea9e73 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -81,6 +81,7 @@ (tree-sitter-parser atom) (tree-sitter-node atom) (tree-sitter-compiled-query atom) + (native-comp-unit atom) ;; Plus, really hand made: (null symbol list sequence atom)) "Alist of supertypes. From 167d9b9040333a5bff64325423750243c60edfa1 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 20 Feb 2024 18:49:20 +0100 Subject: [PATCH 289/385] Allow trivially autoloading uses of transient's define macros Since 49e41991b2f transient-define-prefix itself was autoloaded, but that meant that when ever an autoload file was loaded, which contained an autoload for a command defined using that macro, transient itself had to be loaded. That shouldn't be necessary. For commands using these macros, an autoload that is identical to what would have been generated if it had been defined using defun, works just fine. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Allow uses of transient-define-prefix, transient-define-suffix, transient-define-infix and transient-define-argument to be autoloaded using just ";;;autoload". * lisp/transient.el (transient-define-prefix): No longer autoload. --- lisp/emacs-lisp/loaddefs-gen.el | 17 ++++++++++++----- lisp/transient.el | 1 - 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 238ec9d179b..581053f6304 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -201,8 +201,7 @@ expression, in which case we want to handle forms differently." define-globalized-minor-mode defun defmacro easy-mmode-define-minor-mode define-minor-mode define-inline cl-defun cl-defmacro cl-defgeneric - cl-defstruct pcase-defmacro iter-defun cl-iter-defun - transient-define-prefix)) + cl-defstruct pcase-defmacro iter-defun cl-iter-defun)) (macrop car) (setq expand (let ((load-true-file-name file) (load-file-name file)) @@ -218,13 +217,17 @@ expression, in which case we want to handle forms differently." define-globalized-minor-mode easy-mmode-define-minor-mode define-minor-mode cl-defun defun* cl-defmacro defmacro* - define-overloadable-function)) + define-overloadable-function + transient-define-prefix transient-define-suffix + transient-define-infix transient-define-argument)) (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) (name (nth 1 form)) (args (pcase car ((or 'defun 'defmacro 'defun* 'defmacro* 'cl-defun 'cl-defmacro - 'define-overloadable-function) + 'define-overloadable-function + 'transient-define-prefix 'transient-define-suffix + 'transient-define-infix 'transient-define-argument) (nth 2 form)) ('define-skeleton '(&optional str arg)) ((or 'define-generic-mode 'define-derived-mode @@ -246,7 +249,11 @@ expression, in which case we want to handle forms differently." define-global-minor-mode define-globalized-minor-mode easy-mmode-define-minor-mode - define-minor-mode)) + define-minor-mode + transient-define-prefix + transient-define-suffix + transient-define-infix + transient-define-argument)) t) (and (eq (car-safe (car body)) 'interactive) ;; List of modes or just t. diff --git a/lisp/transient.el b/lisp/transient.el index f9060f5ba85..bb35746e186 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -855,7 +855,6 @@ elements themselves.") ;;; Define -;;;###autoload (defmacro transient-define-prefix (name arglist &rest args) "Define NAME as a transient prefix command. From 1acc7cb851417b83ae90fe4d0ee9f01af2e03722 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 20 Feb 2024 22:49:07 +0100 Subject: [PATCH 290/385] Do not attempt to check declarations in lock files * lisp/emacs-lisp/check-declare.el (check-declare-directory): Do not attempt to check declarations in lock files. (Bug#69084) --- lisp/emacs-lisp/check-declare.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index a6d1a330d90..faa7824c8bd 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -328,9 +328,14 @@ Returns non-nil if any false statements are found." (setq root (directory-file-name (file-relative-name root))) (or (file-directory-p root) (error "Directory `%s' not found" root)) - (let ((files (directory-files-recursively root "\\.el\\'"))) - (when files - (apply #'check-declare-files files)))) + (when-let* ((files (directory-files-recursively root "\\.el\\'")) + (files (mapcan (lambda (file) + ;; Filter out lock files. + (and (not (string-prefix-p + ".#" (file-name-nondirectory file))) + (list file))) + files))) + (apply #'check-declare-files files))) (provide 'check-declare) From 7b0d75018885d8d34ff7c4427a83a21a4808282c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 21 Feb 2024 11:49:47 +0800 Subject: [PATCH 291/385] Work around premature dismissals of submenus under Android * java/org/gnu/emacs/EmacsContextMenu.java (display): If between HONEYCOMB and N, set wasSubmenuSelected. --- java/org/gnu/emacs/EmacsContextMenu.java | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/java/org/gnu/emacs/EmacsContextMenu.java b/java/org/gnu/emacs/EmacsContextMenu.java index 17e6033377d..f1d70f05a25 100644 --- a/java/org/gnu/emacs/EmacsContextMenu.java +++ b/java/org/gnu/emacs/EmacsContextMenu.java @@ -361,8 +361,24 @@ private static final class Item implements MenuItem.OnMenuItemClickListener public Boolean call () { + boolean rc; + lastMenuEventSerial = serial; - return display1 (window, xPosition, yPosition); + rc = display1 (window, xPosition, yPosition); + + /* Android 3.0 to Android 7.0 perform duplicate calls to + onContextMenuClosed after a context menu is dismissed for + the second or third time. Since the second call after such + a dismissal is otherwise liable to prematurely cancel any + context menu displayed immediately afterwards, ignore calls + received within 300 milliseconds of this menu's being + displayed. */ + + if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB + && Build.VERSION.SDK_INT < Build.VERSION_CODES.N) + wasSubmenuSelected = System.currentTimeMillis (); + + return rc; } }); From d6131b5902a70339305285f9861bdfd24c567eab Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 21 Feb 2024 09:02:33 +0100 Subject: [PATCH 292/385] * lisp/net/tramp.el (tramp-methods): Fix typo in docstring. (Bug#69294) --- lisp/net/tramp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9d883c96252..2d6db31fee8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -332,8 +332,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: chosen port for the remote listener. * `tramp-copy-keep-date' - This specifies whether the copying program when the preserves the - timestamp of the original file. + This specifies whether the copying program preserves the timestamp + of the original file. * `tramp-copy-keep-tmpfile' This specifies whether a temporary local file shall be kept From 3b34c5e4a583dd88f476570cbd58655a18e9a6b4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 21 Feb 2024 08:49:15 -0500 Subject: [PATCH 293/385] * lisp/emacs-lisp/map.el (map--make-pcase-bindings): Fix use in Emacs<30 --- lisp/emacs-lisp/map.el | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 95a25978d1c..d3d71a36ee4 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -608,19 +608,30 @@ This allows using default values for `map-elt', which can't be done using `pcase--flip'. KEY is the key sought in the map. DEFAULT is the default value." + ;; It's obsolete in Emacs>29, but `map.el' is distributed via GNU ELPA + ;; for earlier Emacsen. (declare (obsolete _ "30.1")) `(map-elt ,map ,key ,default)) (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." - (mapcar (lambda (elt) - (cond ((consp elt) - `(app (map-elt _ ,(car elt) ,(caddr elt)) - ,(cadr elt))) - ((keywordp elt) - (let ((var (intern (substring (symbol-name elt) 1)))) - `(app (map-elt _ ,elt) ,var))) - (t `(app (map-elt _ ',elt) ,elt)))) + (mapcar (if (< emacs-major-version 30) + (lambda (elt) + (cond ((consp elt) + `(app (map--pcase-map-elt ,(car elt) ,(caddr elt)) + ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (pcase--flip map-elt ,elt) ,var))) + (t `(app (pcase--flip map-elt ',elt) ,elt)))) + (lambda (elt) + (cond ((consp elt) + `(app (map-elt _ ,(car elt) ,(caddr elt)) + ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (map-elt _ ,elt) ,var))) + (t `(app (map-elt _ ',elt) ,elt))))) args)) (defun map--make-pcase-patterns (args) From 0a4d4781ddc079509cb256edf803d663439dcf92 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 21 Feb 2024 21:49:35 +0800 Subject: [PATCH 294/385] * java/org/gnu/emacs/EmacsContextMenu.java (display): Reduce timeout. --- java/org/gnu/emacs/EmacsContextMenu.java | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/java/org/gnu/emacs/EmacsContextMenu.java b/java/org/gnu/emacs/EmacsContextMenu.java index f1d70f05a25..2bbf2a313d6 100644 --- a/java/org/gnu/emacs/EmacsContextMenu.java +++ b/java/org/gnu/emacs/EmacsContextMenu.java @@ -367,16 +367,15 @@ private static final class Item implements MenuItem.OnMenuItemClickListener rc = display1 (window, xPosition, yPosition); /* Android 3.0 to Android 7.0 perform duplicate calls to - onContextMenuClosed after a context menu is dismissed for - the second or third time. Since the second call after such - a dismissal is otherwise liable to prematurely cancel any - context menu displayed immediately afterwards, ignore calls - received within 300 milliseconds of this menu's being - displayed. */ + onContextMenuClosed the second time a context menu is + dismissed. Since the second call after such a dismissal is + otherwise liable to prematurely cancel any context menu + displayed immediately afterwards, ignore calls received + within 150 milliseconds of this menu's being displayed. */ if (rc && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB && Build.VERSION.SDK_INT < Build.VERSION_CODES.N) - wasSubmenuSelected = System.currentTimeMillis (); + wasSubmenuSelected = System.currentTimeMillis () - 150; return rc; } From d5757178464ca51f79c7fc1ab199a1582e92ab32 Mon Sep 17 00:00:00 2001 From: kobarity Date: Fri, 16 Feb 2024 22:52:06 +0900 Subject: [PATCH 295/385] Set tty mode to raw when setting up Inferior Python * lisp/progmodes/python.el (python-shell-setup-code): New constant. (python-shell-comint-watch-for-first-prompt-output-filter): Send `python-shell-setup-code' to the Inferior Python process. * test/lisp/progmodes/python-tests.el (python-ffap-module-path-1): Eliminate skipping on Mac. (Bug#68559) --- lisp/progmodes/python.el | 11 +++++++++++ test/lisp/progmodes/python-tests.el | 5 ----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index b7e43f3fc68..5501926e69d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3521,6 +3521,16 @@ eventually provide a shell." :version "25.1" :type 'hook) +(defconst python-shell-setup-code + "\ +try: + import tty +except ImportError: + pass +else: + tty.setraw(0)" + "Code used to setup the inferior Python processes.") + (defconst python-shell-eval-setup-code "\ def __PYTHON_EL_eval(source, filename): @@ -3586,6 +3596,7 @@ The coding cookie regexp is specified in PEP 263.") (format "exec(%s)\n" (python-shell--encode-string string)))))) ;; Bootstrap: the normal definition of `python-shell-send-string' ;; depends on the Python code sent here. + (python-shell-send-string-no-output python-shell-setup-code) (python-shell-send-string-no-output python-shell-eval-setup-code) (python-shell-send-string-no-output python-shell-eval-file-setup-code)) (with-current-buffer (current-buffer) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index af6c199b5bd..6c6cd9eee2b 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5037,11 +5037,6 @@ import abc (ert-deftest python-ffap-module-path-1 () (skip-unless (executable-find python-tests-shell-interpreter)) - ;; Skip the test on macOS, since the standard Python installation uses - ;; libedit rather than readline which confuses the running of an inferior - ;; interpreter in this case (see bug#59477 and bug#25753). - (skip-when (eq system-type 'darwin)) - (trace-function 'python-shell-output-filter) (python-tests-with-temp-buffer-with-shell " import abc From a2eb123fb606af2a62ad6d0d0162255d7f0601e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 21 Feb 2024 15:22:21 +0100 Subject: [PATCH 296/385] ; * src/lisp.h: Add Lisp_Object tagging scheme overview --- src/lisp.h | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/lisp.h b/src/lisp.h index db053ba9f70..b02466390f1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -478,6 +478,16 @@ typedef EMACS_INT Lisp_Word; #endif +/* Lisp_Object tagging scheme: + Tag location + Upper bits Lower bits Type Payload + 000....... .......000 symbol offset from lispsym to struct Lisp_Symbol + 001....... .......001 unused + 01........ ........10 fixnum signed integer of FIXNUM_BITS + 110....... .......011 cons pointer to struct Lisp_Cons + 100....... .......100 string pointer to struct Lisp_String + 101....... .......101 vectorlike pointer to union vectorlike_header + 111....... .......111 float pointer to struct Lisp_Float */ enum Lisp_Type { /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ From 8987e1b093b07756d18c861d1c7febb85fe88bef Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 21 Feb 2024 17:16:45 +0200 Subject: [PATCH 297/385] Remove redundant call to 'eln_load_path_final_clean_up' * src/emacs.c (shut_down_emacs): Remove redundant call to 'eln_load_path_final_clean_up'. We call it from 'kill-emacs' right before the call to 'exit'. --- src/emacs.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 97c65fbfd33..f4bfb9a6bbd 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -3116,10 +3116,6 @@ shut_down_emacs (int sig, Lisp_Object stuff) check_message_stack (); } -#ifdef HAVE_NATIVE_COMP - eln_load_path_final_clean_up (); -#endif - #ifdef MSDOS dos_cleanup (); #endif From 7215c63fc0f9d7f48ac20578d310a8b3d86b0eae Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 11:18:06 +0100 Subject: [PATCH 298/385] * Make 'comp--compute-function-types' a pass * lisp/emacs-lisp/comp.el (comp-passes): Add comp--compute-function-types. (comp--compute-function-types): New function. (comp--compute-function-type): Move it. (comp--final): Update it. --- lisp/emacs-lisp/comp.el | 61 +++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 27 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 593291a379e..b27cf2b6620 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") comp--tco comp--fwprop comp--remove-type-hints + comp--compute-function-types comp--final) "Passes to be executed in order.") @@ -2994,32 +2995,7 @@ These are substituted with a normal `set' op." (comp-ctxt-funcs-h comp-ctxt))) -;;; Final pass specific code. - -(defun comp--args-to-lambda-list (args) - "Return a lambda list for ARGS." - (cl-loop - with res - repeat (comp-args-base-min args) - do (push t res) - finally - (if (comp-args-p args) - (cl-loop - with n = (- (comp-args-max args) (comp-args-min args)) - initially (unless (zerop n) - (push '&optional res)) - repeat n - do (push t res)) - (cl-loop - with n = (- (comp-nargs-nonrest args) (comp-nargs-min args)) - initially (unless (zerop n) - (push '&optional res)) - repeat n - do (push t res) - finally (when (comp-nargs-rest args) - (push '&rest res) - (push 't res)))) - (cl-return (reverse res)))) +;;; Function types pass specific code. (defun comp--compute-function-type (_ func) "Compute type specifier for `comp-func' FUNC. @@ -3047,6 +3023,38 @@ Set it into the `type' slot." ;; Fix it up. (setf (comp-cstr-imm (comp-func-type func)) type)))) +(defun comp--compute-function-types (_) + "" + (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) + + +;;; Final pass specific code. + +(defun comp--args-to-lambda-list (args) + "Return a lambda list for ARGS." + (cl-loop + with res + repeat (comp-args-base-min args) + do (push t res) + finally + (if (comp-args-p args) + (cl-loop + with n = (- (comp-args-max args) (comp-args-min args)) + initially (unless (zerop n) + (push '&optional res)) + repeat n + do (push t res)) + (cl-loop + with n = (- (comp-nargs-nonrest args) (comp-nargs-min args)) + initially (unless (zerop n) + (push '&optional res)) + repeat n + do (push t res) + finally (when (comp-nargs-rest args) + (push '&rest res) + (push 't res)))) + (cl-return (reverse res)))) + (defun comp--finalize-container (cont) "Finalize data container CONT." (setf (comp-data-container-l cont) @@ -3149,7 +3157,6 @@ Prepare every function for final compilation and drive the C back-end." (defun comp--final (_) "Final pass driving the C back-end for code emission." - (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt)) (unless comp-dry-run ;; Always run the C side of the compilation as a sub-process ;; unless during bootstrap or async compilation (bug#45056). GCC From 1e1d3f3acd8567addc0dab4bc34dc5c7f2405556 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 11:18:28 +0100 Subject: [PATCH 299/385] ; * lisp/emacs-lisp/comp.el (native-comp-debug): Fix spacing. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b27cf2b6620..6532fb8d1ce 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -68,7 +68,7 @@ :safe #'integerp :version "28.1") -(defcustom native-comp-debug 0 +(defcustom native-comp-debug 0 "Debug level for native compilation, a number between 0 and 3. This is intended for debugging the compiler itself. 0 no debug output. From 5aeea8dc2c0bdd01de3ad271723e9d1737d8a056 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:06:18 +0100 Subject: [PATCH 300/385] * lisp/emacs-lisp/comp-cstr.el (comp-cstr): Rename constructors. --- lisp/emacs-lisp/comp-cstr.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 0bc97e51592..48e3645629b 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -44,7 +44,7 @@ ;; TODO can we just add t in `cl--typeof-types'? "Like `cl--typeof-types' but with t as common supertype.") -(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr +(cl-defstruct (comp-cstr (:constructor comp--type-to-cstr (type &aux (null (eq type 'null)) (integer (eq type 'integer)) @@ -55,7 +55,7 @@ '(nil))) (range (when integer '((- . +)))))) - (:constructor comp-value-to-cstr + (:constructor comp--value-to-cstr (value &aux (integer (integerp value)) (valset (unless integer @@ -63,7 +63,7 @@ (range (when integer `((,value . ,value)))) (typeset ()))) - (:constructor comp-irange-to-cstr + (:constructor comp--irange-to-cstr (irange &aux (range (list irange)) (typeset ()))) @@ -229,10 +229,10 @@ Return them as multiple value." ;; builds. (defvar comp-ctxt nil) -(defvar comp-cstr-one (comp-value-to-cstr 1) +(defvar comp-cstr-one (comp--value-to-cstr 1) "Represent the integer immediate one.") -(defvar comp-cstr-t (comp-type-to-cstr t) +(defvar comp-cstr-t (comp--type-to-cstr t) "Represent the superclass t.") @@ -1212,14 +1212,14 @@ FN non-nil indicates we are parsing a function lambda list." ('nil (make-comp-cstr :typeset ())) ('fixnum - (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) + (comp--irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum))) ('boolean (comp-type-spec-to-cstr '(member t nil))) ('integer - (comp-irange-to-cstr '(- . +))) - ('null (comp-value-to-cstr nil)) + (comp--irange-to-cstr '(- . +))) + ('null (comp--value-to-cstr nil)) ((pred atom) - (comp-type-to-cstr type-spec)) + (comp--type-to-cstr type-spec)) (`(or . ,rest) (apply #'comp-cstr-union-make (mapcar #'comp-type-spec-to-cstr rest))) @@ -1229,16 +1229,16 @@ FN non-nil indicates we are parsing a function lambda list." (`(not ,cstr) (comp-cstr-negation-make (comp-type-spec-to-cstr cstr))) (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h)) - (comp-irange-to-cstr `(,l . ,h))) + (comp--irange-to-cstr `(,l . ,h))) (`(integer * ,(and (pred integerp) h)) - (comp-irange-to-cstr `(- . ,h))) + (comp--irange-to-cstr `(- . ,h))) (`(integer ,(and (pred integerp) l) *) - (comp-irange-to-cstr `(,l . +))) + (comp--irange-to-cstr `(,l . +))) (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p)) ;; No float range support :/ - (comp-type-to-cstr 'float)) + (comp--type-to-cstr 'float)) (`(member . ,rest) - (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest))) + (apply #'comp-cstr-union-make (mapcar #'comp--value-to-cstr rest))) (`(function ,args ,ret) (make-comp-cstr-f :args (mapcar (lambda (x) From c65a59a9e90524efa23d9151c31dad66a08ccb90 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:45:10 +0100 Subject: [PATCH 301/385] * Add few missing entries in 'comp-known-predicates' * lisp/emacs-lisp/comp.el (comp-known-predicates): Add framep, markerp, number-or-marker-p, overlayp, processp, subrp and windowp and sort it alphabetically. --- lisp/emacs-lisp/comp.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6532fb8d1ce..a833bf5bfc4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -191,28 +191,34 @@ Useful to hook into pass checkers.") (defconst comp-known-predicates '((arrayp . array) (atom . atom) - (characterp . fixnum) - (booleanp . boolean) (bool-vector-p . bool-vector) + (booleanp . boolean) (bufferp . buffer) - (natnump . (integer 0 *)) (char-table-p . char-table) - (hash-table-p . hash-table) + (characterp . fixnum) (consp . cons) - (integerp . integer) (floatp . float) + (framep . frame) (functionp . (or function symbol)) + (hash-table-p . hash-table) + (integer-or-marker-p . integer-or-marker) (integerp . integer) (keywordp . keyword) (listp . list) - (numberp . number) + (markerp . marker) + (natnump . (integer 0 *)) (null . null) + (number-or-marker-p . number-or-marker) (numberp . number) + (numberp . number) + (overlayp . overlay) + (processp . process) (sequencep . sequence) (stringp . string) + (subrp . subr) (symbolp . symbol) (vectorp . vector) - (integer-or-marker-p . integer-or-marker)) + (windowp . window)) "Alist predicate -> matched type specifier.") (defconst comp-known-predicates-h From 88abbf00af69cf7e5f36e318e6935f7d1500af7f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 15:45:40 +0100 Subject: [PATCH 302/385] ; Add two comments on comp-known-predicates cl-deftype-satisfies * lisp/emacs-lisp/comp.el (comp-known-predicates): Add comment. * lisp/emacs-lisp/cl-macs.el: Likewise. --- lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/comp.el | 3 +++ 2 files changed, 4 insertions(+) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 06a09885c88..44ebadeebff 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3460,6 +3460,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (or (cdr (assq sym byte-compile-function-environment)) (cdr (assq sym macroexpand-all-environment)))))) +;; Please keep it in sync with `comp-known-predicates'. (pcase-dolist (`(,type . ,pred) ;; Mostly kept in alphabetical order. '((array . arrayp) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a833bf5bfc4..46d2896f2be 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -188,6 +188,9 @@ Useful to hook into pass checkers.") finally return h) "Hash table function -> `comp-constraint'.") +;; Keep it in sync with the `cl-deftype-satisfies' property set in +;; cl-macs.el. We can't use `cl-deftype-satisfies' directly as the +;; relation type <-> predicate is not bijective (bug#45576). (defconst comp-known-predicates '((arrayp . array) (atom . atom) From 35d99b1ec7c56d4a5c09af36e6bbd7f0f959cccc Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 21 Feb 2024 10:14:05 -0600 Subject: [PATCH 303/385] ; Update URL of the tree-sitter-lua grammar * admin/notes/tree-sitter/build-module/build.sh: * lisp/progmodes/lua-ts-mode.el: * test/infra/Dockerfile.emba: Use the new URL. (bug#69304) --- admin/notes/tree-sitter/build-module/build.sh | 2 +- lisp/progmodes/lua-ts-mode.el | 4 ++-- test/infra/Dockerfile.emba | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index 969187b7f92..9a567bb094d 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -43,7 +43,7 @@ case "${lang}" in org="phoenixframework" ;; "lua") - org="MunifTanjim" + org="tree-sitter-grammars" ;; "typescript") sourcedir="tree-sitter-typescript/typescript/src" diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index c7f5ac50b04..8bd3db2b75f 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -26,8 +26,8 @@ ;; This package provides `lua-ts-mode' which is a major mode for Lua ;; files that uses Tree Sitter to parse the language. ;; -;; This package is compatible with and tested against the grammar -;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua +;; This package is compatible with and tested against the grammar for +;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua ;;; Code: diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 8e583fade9f..d79072b06b5 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \ (java "https://github.com/tree-sitter/tree-sitter-java") \ (javascript "https://github.com/tree-sitter/tree-sitter-javascript") \ (json "https://github.com/tree-sitter/tree-sitter-json") \ - (lua "https://github.com/MunifTanjim/tree-sitter-lua") \ + (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua") \ (python "https://github.com/tree-sitter/tree-sitter-python") \ (ruby "https://github.com/tree-sitter/tree-sitter-ruby") \ (tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \ From e6882a5cc89d9375dfa73156db6836af19ef7b8a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Thu, 1 Feb 2024 12:30:24 +0100 Subject: [PATCH 304/385] ; Fix mid-symbol updating/cycling completion preview This fixes an issue where 'completion-preview-next-candidate' would fail to take into account the part of the symbol that follows point (the suffix) when point is at the middle of a symbol, as well as a similar issue in 'completion-preview--show' that would manifest with slow 'completion-at-point-functions'. * lisp/completion-preview.el (completion-preview-next-candidate) (completion-preview--show): Ensure that the completion preview remains at the end of a symbol, when updating it while point is in the middle of that symbol. * test/lisp/completion-preview-tests.el (completion-preview-mid-symbol-cycle): New test. (Bug#68875) --- lisp/completion-preview.el | 24 ++++++++++++------------ test/lisp/completion-preview-tests.el | 15 +++++++++++++++ 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 6fd60f3c416..e827da43a08 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -302,21 +302,21 @@ point, otherwise hide it." ;; never display a stale preview and that the preview doesn't ;; flicker, even with slow completion backends. (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (max (point) (overlay-start completion-preview--overlay))) (cands (completion-preview--get 'completion-preview-cands)) (index (completion-preview--get 'completion-preview-index)) (cand (nth index cands)) - (len (length cand)) - (end (+ beg len)) - (cur (point)) - (face (get-text-property 0 'face (completion-preview--get 'after-string)))) - (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand)) + (after (completion-preview--get 'after-string)) + (face (get-text-property 0 'face after))) + (if (and (<= beg (point) end (1- (+ beg (length cand)))) + (string-prefix-p (buffer-substring beg end) cand)) ;; The previous preview is still applicable, update it. (overlay-put (completion-preview--make-overlay - cur (propertize (substring cand (- cur beg)) + end (propertize (substring cand (- end beg)) 'face face 'mouse-face 'completion-preview-highlight 'keymap completion-preview--mouse-map)) - 'completion-preview-end cur) + 'completion-preview-end end) ;; The previous preview is no longer applicable, hide it. (completion-preview-active-mode -1)))) ;; Run `completion-at-point-functions' to get a new candidate. @@ -366,16 +366,16 @@ prefix argument and defaults to 1." (interactive "p") (when completion-preview-active-mode (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (completion-preview--get 'completion-preview-end)) (all (completion-preview--get 'completion-preview-cands)) (cur (completion-preview--get 'completion-preview-index)) (len (length all)) (new (mod (+ cur direction) len)) - (str (nth new all)) - (pos (point))) - (while (or (<= (+ beg (length str)) pos) - (not (string-prefix-p (buffer-substring beg pos) str))) + (str (nth new all))) + (while (or (<= (+ beg (length str)) end) + (not (string-prefix-p (buffer-substring beg end) str))) (setq new (mod (+ new direction) len) str (nth new all))) - (let ((aft (propertize (substring str (- pos beg)) + (let ((aft (propertize (substring str (- end beg)) 'face (if (< 1 len) 'completion-preview 'completion-preview-exact) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 190764e9125..5b2c28bd3dd 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -181,4 +181,19 @@ instead." (completion-preview--post-command)) (completion-preview-tests--check-preview "barbaz" 'exact))) +(ert-deftest completion-preview-mid-symbol-cycle () + "Test cycling the completion preview with point at the middle of a symbol." + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar" "foobaz")))) + (insert "fooba") + (forward-char -2) + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "r") + (completion-preview-next-candidate 1) + (completion-preview-tests--check-preview "z"))) + ;;; completion-preview-tests.el ends here From 44d5c667d7775f881473c7c6f7d9bdef7594bd79 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 17:45:41 +0100 Subject: [PATCH 305/385] * lisp/emacs-lisp/comp.el (comp--compute-function-types): Fix missing doc. --- lisp/emacs-lisp/comp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 46d2896f2be..e0da01bcc5d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3033,7 +3033,7 @@ Set it into the `type' slot." (setf (comp-cstr-imm (comp-func-type func)) type)))) (defun comp--compute-function-types (_) - "" + "Compute and store the type specifier for all functions." (maphash #'comp--compute-function-type (comp-ctxt-funcs-h comp-ctxt))) From f28a557c7d4b39f302630ed2b19a73fc375e7ff4 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 21 Feb 2024 19:43:28 +0200 Subject: [PATCH 306/385] * doc/lispref/modes.texi (Tabulated List Mode): Update. In the description of 'tabulated-list-format' document the missing value 'props' that was added long ago. --- doc/lispref/modes.texi | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index bd4c055c2c2..9fe4d332a21 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1124,7 +1124,7 @@ column is sorted in the descending order. This buffer-local variable specifies the format of the Tabulated List data. Its value should be a vector. Each element of the vector represents a data column, and should be a list @code{(@var{name} -@var{width} @var{sort})}, where +@var{width} @var{sort} . @var{props})}, where @itemize @item @@ -1141,6 +1141,13 @@ sorted by comparing string values. Otherwise, this should be a predicate function for @code{sort} (@pxref{Rearrangement}), which accepts two arguments with the same form as the elements of @code{tabulated-list-entries} (see below). + +@item +@var{props} is a plist (@pxref{Property Lists}) of additional column +properties. If the value of the property @code{:right-align} is +non-@code{nil} then the column should be right-aligned. And the +property @code{:pad-right} specifies the number of additional padding +spaces to the right of the column (by default 1 if omitted). @end itemize @end defvar From b214cb2843851c410d603e7fb487a462d5f7bee1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Feb 2024 21:38:11 +0100 Subject: [PATCH 307/385] ; * lisp/emacs-lisp/comp-run.el: Fix typo. --- lisp/emacs-lisp/comp-run.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el index 5d1a193269d..8fcbe31cf0b 100644 --- a/lisp/emacs-lisp/comp-run.el +++ b/lisp/emacs-lisp/comp-run.el @@ -25,7 +25,7 @@ ;; While the main native compiler is implemented in comp.el, when ;; commonly used as a jit compiler it is only loaded by Emacs sub -;; processes performing async compilation. This files contains all +;; processes performing async compilation. This file contains all ;; the code needed to drive async compilations and any Lisp code ;; needed at runtime to run native code. From 39a84232700c40fa74305970dd16cd5cb8b8bea0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 09:53:48 +0800 Subject: [PATCH 308/385] Enable inotify on systems with inotify_init yet no init1 variant * configure.ac (HAVE_INOTIFY): Check for the presence of inotify_init in addition to inotify_init1. * src/inotify.c (Finotify_add_watch): Implement with inotify_init if inotify_init1 is absent. --- configure.ac | 8 ++++---- src/inotify.c | 10 ++++++++++ 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/configure.ac b/configure.ac index 847fdbd54d2..71a899f5f40 100644 --- a/configure.ac +++ b/configure.ac @@ -4088,16 +4088,16 @@ case $with_file_notification,$opsys in fi ;; esac -dnl inotify is available only on GNU/Linux. +dnl inotify is available only on Linux-kernel based systems. case $with_file_notification,$NOTIFY_OBJ in inotify, | yes,) AC_CHECK_HEADER([sys/inotify.h]) if test "$ac_cv_header_sys_inotify_h" = yes ; then - AC_CHECK_FUNC([inotify_init1]) - if test "$ac_cv_func_inotify_init1" = yes; then + AC_CHECK_FUNCS([inotify_init inotify_init1]) + if test "$ac_cv_func_inotify_init" = yes; then AC_DEFINE([HAVE_INOTIFY], [1], [Define to 1 to use inotify.]) NOTIFY_OBJ=inotify.o - NOTIFY_SUMMARY="yes -lglibc (inotify)" + NOTIFY_SUMMARY="yes (inotify)" fi fi ;; esac diff --git a/src/inotify.c b/src/inotify.c index 2ee874530cc..7140568f1b6 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -26,6 +26,8 @@ along with GNU Emacs. If not, see . */ #include "termhooks.h" #include +#include + #include #include @@ -434,7 +436,15 @@ IN_ONESHOT */) if (inotifyfd < 0) { +#ifdef HAVE_INOTIFY_INIT1 inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC); +#else /* !HAVE_INOTIFY_INIT1 */ + /* This is prey to race conditions with other threads calling + exec. */ + inotifyfd = inotify_init (); + fcntl (inotifyfd, F_SETFL, O_NONBLOCK); + fcntl (inotifyfd, F_SETFD, O_CLOEXEC); +#endif /* HAVE_INOTIFY_INIT1 */ if (inotifyfd < 0) report_file_notify_error ("File watching is not available", Qnil); watch_list = Qnil; From f024b63ecf8d4ebfd518beb4c2dfc853d725ec19 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 10:08:12 +0800 Subject: [PATCH 309/385] ; * admin/CPP-DEFINES: Update with Android defines. --- admin/CPP-DEFINES | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 06986ec8f48..8143a394578 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -25,6 +25,9 @@ SOLARIS2 USG USG5_4 HAIKU Compiling on Haiku. +__ANDROID__ Compiling for the Android operating system. +__ANDROID_API__ A numerical "API level" indicating the version of + Android being compiled for; see http://apilevels.com. ** Distinguishing GUIs ** @@ -35,10 +38,14 @@ NS_IMPL_COCOA Compile support for Cocoa (Apple) implementation of NS GUI API. HAVE_X11 Compile support for the X11 GUI. HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs. HAVE_HAIKU Compile support for the Haiku window system. -HAVE_X_WINDOWS Compile support for X Window system - (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must - be, and vice versa. At least, this is true for configure, and - msdos; not sure about nt.) +HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11. +HAVE_ANDROID Compiling the Android GUI interface. Enough of this + code is compiled for the build machine cross-compiling + the Android port to produce an Emacs binary that can + Lisp code in batch mode, for the purpose of compiling + Lisp code for packaging. +ANDROID_STUBIFY The Android GUI interface is being compiled for the build + machine, as above. ** X Windows features ** HAVE_X11R6 Whether or not the system has X11R6. (Always defined.) From ee6343556a53770cd2c7730b48ce1731423d8825 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 10:21:12 +0800 Subject: [PATCH 310/385] ; * admin/CPP-DEFINES: Fix typos. --- admin/CPP-DEFINES | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 8143a394578..c07fdc487ee 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -42,8 +42,8 @@ HAVE_X_WINDOWS Compile support for X Window system. Equivalent to HAVE_X11. HAVE_ANDROID Compiling the Android GUI interface. Enough of this code is compiled for the build machine cross-compiling the Android port to produce an Emacs binary that can - Lisp code in batch mode, for the purpose of compiling - Lisp code for packaging. + run Lisp code in batch mode, for the purpose of running + the byte-compiler. ANDROID_STUBIFY The Android GUI interface is being compiled for the build machine, as above. From 8e0f134653b2951e80cd5659fba5c36e416931fa Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 22 Feb 2024 13:30:18 +0800 Subject: [PATCH 311/385] ; Insert missing JNI prologues * src/android.c (shouldForwardMultimediaButtons) (shouldForwardCtrlSpace, notifyPixelsChanged, setupSystemThread): * src/androidvfs.c (safSyncAndReadInput, safSync, safPostRequest) (ftruncate): Insert absent JNI prologues. --- src/android.c | 8 ++++++++ src/androidvfs.c | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/src/android.c b/src/android.c index 4d56df1da3f..41481afa475 100644 --- a/src/android.c +++ b/src/android.c @@ -2519,6 +2519,8 @@ JNIEXPORT jboolean JNICALL NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + /* Yes, android_pass_multimedia_buttons_to_system is being read from the UI thread. */ return !android_pass_multimedia_buttons_to_system; @@ -2527,6 +2529,8 @@ NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env, JNIEXPORT jboolean JNICALL NATIVE_NAME (shouldForwardCtrlSpace) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + return !android_intercept_control_space; } @@ -2630,6 +2634,8 @@ JNIEXPORT void JNICALL NATIVE_NAME (notifyPixelsChanged) (JNIEnv *env, jobject object, jobject bitmap) { + JNI_STACK_ALIGNMENT_PROLOGUE; + void *data; /* Lock and unlock the bitmap. This calls @@ -2683,6 +2689,8 @@ NATIVE_NAME (answerQuerySpin) (JNIEnv *env, jobject object) JNIEXPORT void JNICALL NATIVE_NAME (setupSystemThread) (void) { + JNI_STACK_ALIGNMENT_PROLOGUE; + sigset_t sigset; /* Block everything except for SIGSEGV and SIGBUS; those two are diff --git a/src/androidvfs.c b/src/androidvfs.c index 3030bd56cdc..d618e351204 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -6317,6 +6317,8 @@ static sem_t saf_completion_sem; JNIEXPORT jint JNICALL NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + while (sem_wait (&saf_completion_sem) < 0) { if (input_blocked_p ()) @@ -6338,6 +6340,8 @@ NATIVE_NAME (safSyncAndReadInput) (JNIEnv *env, jobject object) JNIEXPORT void JNICALL NATIVE_NAME (safSync) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + while (sem_wait (&saf_completion_sem) < 0) process_pending_signals (); } @@ -6345,12 +6349,16 @@ NATIVE_NAME (safSync) (JNIEnv *env, jobject object) JNIEXPORT void JNICALL NATIVE_NAME (safPostRequest) (JNIEnv *env, jobject object) { + JNI_STACK_ALIGNMENT_PROLOGUE; + sem_post (&saf_completion_sem); } JNIEXPORT jboolean JNICALL NATIVE_NAME (ftruncate) (JNIEnv *env, jobject object, jint fd) { + JNI_STACK_ALIGNMENT_PROLOGUE; + if (ftruncate (fd, 0) < 0) return false; From 6b6761d534259ab4d5409e72754e46af13623dda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20Bornemann?= Date: Sat, 17 Feb 2024 21:18:02 +0100 Subject: [PATCH 312/385] Recognize functions and macros as defuns in 'cmake-ts-mode' * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--function-name): Renamed to 'cmake-ts-mode--defun-name' since the function handles now functions and macros. (cmake-ts-mode--defun-name): Return text of the first 'argument' node below 'function_def' and 'macro_def' nodes. (cmake-ts-mode): Set up treesit-defun-type-regexp and 'treesit-defun-name-function'. Change the imenu setup to recognize macros too. Since we have set up 'treesit-defun-name-function', we don't have to pass 'cmake-ts-mode--function-name' anymore. (Bug#69186) To make `treesit-defun-at-point' work properly, we have to recognize function_def/macro_def nodes, not the lower-level *_command nodes. --- lisp/progmodes/cmake-ts-mode.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 29c9e957d3c..45c4882d873 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -193,13 +193,13 @@ Check if a node type is available, then return the right font lock rules." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `cmake-ts-mode'.") -(defun cmake-ts-mode--function-name (node) - "Return the function name of NODE. -Return nil if there is no name or if NODE is not a function node." +(defun cmake-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." (pcase (treesit-node-type node) - ("function_command" + ((or "function_def" "macro_def") (treesit-node-text - (treesit-search-subtree node "^argument$" nil nil 2) + (treesit-search-subtree node "^argument$" nil nil 3) t)))) ;;;###autoload @@ -216,9 +216,15 @@ Return nil if there is no name or if NODE is not a function node." (setq-local comment-end "") (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) + ;; Defuns. + (setq-local treesit-defun-type-regexp (rx (or "function" "macro") + "_def")) + (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name) + ;; Imenu. (setq-local treesit-simple-imenu-settings - `(("Function" "\\`function_command\\'" nil cmake-ts-mode--function-name))) + `(("Function" "^function_def$") + ("Macro" "^macro_def$"))) (setq-local which-func-functions nil) ;; Indent. From 70cf4b694b317b367a046b0b03746c56e23fcb91 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 22 Feb 2024 15:15:53 +0200 Subject: [PATCH 313/385] ; * etc/PROBLEMS: Describe input lags due to GTK IM (bug#69246). --- etc/PROBLEMS | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 60904408af8..b4df40f5d8e 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -432,7 +432,7 @@ than the corresponding .el file. Alternatively, if you set the option 'load-prefer-newer' non-nil, Emacs will load whichever version of a file is the newest. -*** Watch out for the EMACSLOADPATH environment variable +*** Watch out for the EMACSLOADPATH environment variable. EMACSLOADPATH overrides which directories the function "load" will search. @@ -441,7 +441,7 @@ environment. ** Keyboard problems -*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier +*** PGTK build of Emacs running on Wayland doesn't recognize Hyper modifier. If you arrange for the Wayland compositor to send the Hyper key modifier (e.g., via XKB customizations), the Hyper modifier will still @@ -452,6 +452,17 @@ Since GDK 3.x is no longer developed, this bug in GDK will probably never be solved. And the Emacs PGTK build cannot yet support GTK4, where this problem is reportedly solved. +*** Emacs built with GTK lags in its response to keyboard input. +This can happen when input methods are used. It happens because Emacs +behaves in an unconventional way with respect to GTK input methods: it +registers to receive keyboard input as unprocessed key events with +metadata (as opposed to receiving them as text strings). Most GTK +programs use the latter approach, so some modern input methods have +bugs and misbehave when faced with the way Emacs does it. + +A workaround is to set GTK_IM_MODULE=none in the environment, or maybe +find a different input method without these problems. + *** Unable to enter the M-| key on some German keyboards. Some users have reported that M-| suffers from "keyboard ghosting". This can't be fixed by Emacs, as the keypress never gets passed to it From cc58626f643c1b19e66bab9c6a39026c7e419ab9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 22 Feb 2024 19:38:17 +0200 Subject: [PATCH 314/385] * lisp/help-fns.el (describe-mode-outline): New user option (bug#64684). (describe-mode, describe-mode--minor-modes): Use 'describe-mode-outline'. * lisp/help-mode.el (help-setup-xref): After disabling outline-minor-mode also kill all outline-related local variables. So that they won't affect the output of other help commands in the same help buffer. --- etc/NEWS | 4 ++ lisp/help-fns.el | 97 +++++++++++++++++++++++++++++++++-------------- lisp/help-mode.el | 12 +++++- 3 files changed, 83 insertions(+), 30 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7b248c3fe78..13b41feccbc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,10 @@ the signature) the automatically inferred function type as well. This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. +--- +*** 'C-h m' ('describe-mode') uses outlining by default. +Set 'describe-mode-outline' to nil to get back the old behavior. + ** Outline Mode +++ diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1ba848c107d..15d87f9925c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2133,6 +2133,12 @@ keymap value." (when used-gentemp (makunbound keymap)))) +(defcustom describe-mode-outline t + "Non-nil enables outlines in the output buffer of `describe-mode'." + :type 'boolean + :group 'help + :version "30.1") + ;;;###autoload (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes. @@ -2145,7 +2151,10 @@ variable \(listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode. If called from Lisp with a non-nil BUFFER argument, display -documentation for the major and minor modes of that buffer." +documentation for the major and minor modes of that buffer. + +When `describe-mode-outline' is non-nil, Outline minor mode +is enabled in the Help buffer." (interactive "@") (unless buffer (setq buffer (current-buffer))) @@ -2159,13 +2168,20 @@ documentation for the major and minor modes of that buffer." (with-current-buffer (help-buffer) ;; Add the local minor modes at the start. (when local-minors - (insert (format "Minor mode%s enabled in this buffer:" - (if (length> local-minors 1) - "s" ""))) + (unless describe-mode-outline + (insert (format "Minor mode%s enabled in this buffer:" + (if (length> local-minors 1) + "s" "")))) (describe-mode--minor-modes local-minors)) ;; Document the major mode. (let ((major (buffer-local-value 'major-mode buffer))) + (when describe-mode-outline + (goto-char (point-min)) + (put-text-property + (point) (progn (insert (format "Major mode %S" major)) (point)) + 'outline-level 1) + (insert "\n\n")) (insert "The major mode is " (buttonize (propertize (format-mode-line @@ -2189,36 +2205,56 @@ documentation for the major and minor modes of that buffer." ;; Insert the global minor modes after the major mode. (when global-minor-modes - (insert (format "Global minor mode%s enabled:" - (if (length> global-minor-modes 1) - "s" ""))) - (describe-mode--minor-modes global-minor-modes) - (when (re-search-forward "^\f") - (beginning-of-line) - (ensure-empty-lines 1))) + (unless describe-mode-outline + (insert (format "Global minor mode%s enabled:" + (if (length> global-minor-modes 1) + "s" "")))) + (describe-mode--minor-modes global-minor-modes t) + (unless describe-mode-outline + (when (re-search-forward "^\f") + (beginning-of-line) + (ensure-empty-lines 1)))) + + (when describe-mode-outline + (setq-local outline-search-function #'outline-search-level) + (setq-local outline-level (lambda () 1)) + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t + outline-minor-mode-use-buttons 'insert) + (outline-minor-mode 1)) + ;; For the sake of IELM and maybe others nil))))) -(defun describe-mode--minor-modes (modes) +(defun describe-mode--minor-modes (modes &optional global) (dolist (mode (seq-sort #'string< modes)) (let ((pretty-minor-mode (capitalize (replace-regexp-in-string "\\(\\(-minor\\)?-mode\\)?\\'" "" (symbol-name mode))))) - (insert - " " - (buttonize - pretty-minor-mode - (lambda (mode) - (goto-char (point-min)) - (text-property-search-forward - 'help-minor-mode mode t) - (beginning-of-line)) - mode)) + (if (not describe-mode-outline) + (insert + " " + (buttonize + pretty-minor-mode + (lambda (mode) + (goto-char (point-min)) + (text-property-search-forward + 'help-minor-mode mode t) + (beginning-of-line)) + mode)) + (goto-char (point-max)) + (put-text-property + (point) (progn (insert (if global "Global" "Local") + (format " minor mode %S" mode)) + (point)) + 'outline-level 1) + (insert "\n\n")) (save-excursion - (goto-char (point-max)) - (insert "\n\n\f\n") + (unless describe-mode-outline + (goto-char (point-max)) + (insert "\n\n\f\n")) ;; Document the minor modes fully. (insert (buttonize (propertize pretty-minor-mode 'help-minor-mode mode) @@ -2232,11 +2268,14 @@ documentation for the major and minor modes of that buffer." (format "indicator%s" indicator))))) (insert (or (help-split-fundoc (documentation mode) nil 'doc) - "No docstring"))))) - (forward-line -1) - (fill-paragraph nil) - (forward-paragraph 1) - (ensure-empty-lines 1)) + "No docstring")) + (when describe-mode-outline + (insert "\n\n"))))) + (unless describe-mode-outline + (forward-line -1) + (fill-paragraph nil) + (forward-paragraph 1) + (ensure-empty-lines 1))) (defun help-fns--list-local-commands () (let ((functions nil)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 9c405efeee5..f9ec8a5cc2b 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -501,7 +501,17 @@ restore it properly when going back." ;; Disable `outline-minor-mode' in a reused Help buffer ;; created by `describe-bindings' that enables this mode. (when (bound-and-true-p outline-minor-mode) - (outline-minor-mode -1)) + (outline-minor-mode -1) + (mapc #'kill-local-variable + '(outline-search-function + outline-regexp + outline-heading-end-regexp + outline-level + outline-minor-mode-cycle + outline-minor-mode-highlight + outline-minor-mode-use-buttons + outline-default-state + outline-default-rules))) (when help-xref-stack-item (push (cons (point) help-xref-stack-item) help-xref-stack) (setq help-xref-forward-stack nil)) From 58ca91fe0723c861d53375f52e5b6dd54a49a2e3 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 22 Feb 2024 20:40:57 +0100 Subject: [PATCH 315/385] * Fix 'parse-colon-path' entry in 'comp-known-type-specifiers' * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): Fix 'parse-colon-path'. --- lisp/emacs-lisp/comp-common.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index 6ba9664ea5c..ca21ed05bb4 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -309,7 +309,7 @@ Used to modify the compiler environment." (numberp (function (t) boolean)) (one-window-p (function (&optional t t) boolean)) (overlayp (function (t) boolean)) - (parse-colon-path (function (string) cons)) + (parse-colon-path (function (string) list)) (plist-get (function (list t &optional t) t)) (plist-member (function (list t &optional t) list)) (point (function () integer)) From b868690feff44c7242c942490d1d8bc6d2811fa2 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 23 Feb 2024 10:18:17 +0800 Subject: [PATCH 316/385] Fix bug#69140 * src/window.c (grow_mini_window): Don't adjust frame matrices or force redisplay if the provided window cannot be resized. (bug#69140) --- src/window.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 565ad00804f..0c84b4f4bf3 100644 --- a/src/window.c +++ b/src/window.c @@ -5380,7 +5380,14 @@ grow_mini_window (struct window *w, int delta) grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (- delta), Qt); - if (FIXNUMP (grow) && window_resize_check (r, false)) + if (FIXNUMP (grow) + /* It might be impossible to resize the window, in which case + calling resize_mini_window_apply will set off an infinite + loop where the redisplay cycle so forced returns to + resize_mini_window, making endless attempts to expand the + minibuffer window to this impossible size. (bug#69140) */ + && XFIXNUM (grow) != 0 + && window_resize_check (r, false)) resize_mini_window_apply (w, -XFIXNUM (grow)); } } From f85280503a3a67e1618069b1c7d6810efa924fe8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 22 Feb 2024 17:20:58 +0100 Subject: [PATCH 317/385] Tone down python-mode warning to a simple message (bug#68559) * lisp/progmodes/python.el (python-shell-completion-native-turn-on-maybe): There is no need for an alarming warning when using an inferior Python without GNU readline; a calm message will do. --- lisp/progmodes/python.el | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5501926e69d..bedc61408ef 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4536,18 +4536,11 @@ With argument MSG show activation/deactivation message." ((python-shell-completion-native-setup) (when msg (message "Shell native completion is enabled."))) - (t (lwarn - '(python python-shell-completion-native-turn-on-maybe) - :warning - (concat - "Your `python-shell-interpreter' doesn't seem to " - "support readline, yet `python-shell-completion-native-enable' " - (format "was t and %S is not part of the " - (file-name-nondirectory python-shell-interpreter)) - "`python-shell-completion-native-disabled-interpreters' " - "list. Native completions have been disabled locally. " - "Consider installing the python package \"readline\". ")) - (python-shell-completion-native-turn-off msg)))))) + (t + (when msg + (message (concat "Python does not use GNU readline;" + " no completion in multi-line commands."))) + (python-shell-completion-native-turn-off nil)))))) (defun python-shell-completion-native-turn-on-maybe-with-msg () "Like `python-shell-completion-native-turn-on-maybe' but force messages." From 53e60fb004c0e8b40b01fcfcf7f406557e35aa3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 22 Feb 2024 20:15:33 +0100 Subject: [PATCH 318/385] * src/fns.c (hash_string): Suppress warning on 32-bit platforms Remove a shift-too-wide complaint by GCC in code that is never reached on platforms where that shift is too wide. --- src/fns.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/fns.c b/src/fns.c index 0a9692f36e8..737757d06cc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5086,6 +5086,8 @@ hash_string (char const *ptr, ptrdiff_t len) /* String is shorter than an EMACS_UINT. Use smaller loads. */ eassume (p <= end && end - p < sizeof (EMACS_UINT)); EMACS_UINT tail = 0; + verify (sizeof tail <= 8); +#if EMACS_INT_MAX > INT32_MAX if (end - p >= 4) { uint32_t c; @@ -5093,6 +5095,7 @@ hash_string (char const *ptr, ptrdiff_t len) tail = (tail << (8 * sizeof c)) + c; p += sizeof c; } +#endif if (end - p >= 2) { uint16_t c; From 6a53836a245a8154f1f176ce2a787c24aa7409cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 23 Feb 2024 11:26:45 +0100 Subject: [PATCH 319/385] * src/fns.c (sxhash_bignum): Include sign bit in hash. --- src/fns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fns.c b/src/fns.c index 737757d06cc..550545d1486 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5193,7 +5193,7 @@ sxhash_bignum (Lisp_Object bignum) { mpz_t const *n = xbignum_val (bignum); size_t i, nlimbs = mpz_size (*n); - EMACS_UINT hash = 0; + EMACS_UINT hash = mpz_sgn(*n) < 0; for (i = 0; i < nlimbs; ++i) hash = sxhash_combine (hash, mpz_getlimbn (*n, i)); From 32843c7b36b8bf3dc9ac82059a1c3cab03cd8c98 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 23 Feb 2024 01:07:46 +0100 Subject: [PATCH 320/385] * src/pdumper.c (dump_subr): Rename 'native_comp' -> 'non_primitive'. --- src/pdumper.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 509fb079db7..778d8facabd 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2912,17 +2912,17 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, subr, header.size); #ifdef HAVE_NATIVE_COMP - bool native_comp = !NILP (subr->native_comp_u); + bool non_primitive = !NILP (subr->native_comp_u); #else - bool native_comp = false; + bool non_primitive = false; #endif - if (native_comp) + if (non_primitive) out.function.a0 = NULL; else dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); DUMP_FIELD_COPY (&out, subr, min_args); DUMP_FIELD_COPY (&out, subr, max_args); - if (native_comp) + if (non_primitive) { dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); dump_remember_cold_op (ctx, @@ -2947,7 +2947,7 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL); #endif dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); - if (native_comp && ctx->flags.dump_object_contents) + if (non_primitive && ctx->flags.dump_object_contents) /* We'll do the final addr relocation during VERY_LATE_RELOCS time after the compilation units has been loaded. */ dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], From aa82fe9931851e66aa335e96ae35fd967951b281 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 8 Feb 2024 18:23:00 +0100 Subject: [PATCH 321/385] Use obarray-make instead of make-vector to create obarrays This prepares for the introduction of an actual obarray type. * lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-dynamic-map) (semantic-lex-spp-dynamic-map-stack, semantic-lex-make-spp-table): * lisp/cedet/semantic/lex.el (semantic-lex-make-keyword-table) (semantic-lex-make-type-table): * lisp/completion.el (cmpl-prefix-obarray, cmpl-obarray) (clear-all-completions): * lisp/emacs-lisp/checkdoc.el (checkdoc-defun-info): * lisp/emacs-lisp/eldoc.el (eldoc-message-commands) (eldoc-edit-message-commands): * lisp/mail/mail-extr.el (mail-extr-all-top-level-domains): * lisp/mail/rmailkwd.el (rmail-label-obarray): * lisp/net/dns.el (dns-cache): * lisp/net/eww.el (eww-suggested-uris): * lisp/net/imap.el (imap-open, imap-mailbox-select-1) (imap-message-copyuid-1, imap-message-appenduid-1): * lisp/obsolete/pgg.el (pgg-passphrase-cache, pgg-pending-timers): * lisp/play/cookie1.el (cookie-cache): * lisp/progmodes/cc-defs.el (c-lang-constants, c-define-lang-constant): * lisp/progmodes/cc-langs.el (c-keywords-obarray): * lisp/vc/vc-hooks.el (vc-file-prop-obarray): * test/lisp/obarray-tests.el (obarrayp-test): * test/src/minibuf-tests.el (minibuf-tests--strings-to-obarray): Use obarray-make instead of obarray-make. --- lisp/cedet/semantic/lex-spp.el | 6 +++--- lisp/cedet/semantic/lex.el | 4 ++-- lisp/completion.el | 8 ++++---- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/eldoc.el | 4 ++-- lisp/mail/mail-extr.el | 2 +- lisp/mail/rmailkwd.el | 2 +- lisp/net/dns.el | 2 +- lisp/net/eww.el | 2 +- lisp/net/imap.el | 8 ++++---- lisp/obsolete/pgg.el | 4 ++-- lisp/play/cookie1.el | 2 +- lisp/progmodes/cc-defs.el | 4 ++-- lisp/progmodes/cc-langs.el | 2 +- lisp/vc/vc-hooks.el | 2 +- test/lisp/obarray-tests.el | 3 ++- test/src/minibuf-tests.el | 2 +- 17 files changed, 30 insertions(+), 29 deletions(-) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index a4be5bf67e2..f63d316c1ac 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -153,13 +153,13 @@ The search priority is: "Return the dynamic macro map for the current buffer." (or semantic-lex-spp-dynamic-macro-symbol-obarray (setq semantic-lex-spp-dynamic-macro-symbol-obarray - (make-vector 13 0)))) + (obarray-make 13)))) (defsubst semantic-lex-spp-dynamic-map-stack () "Return the dynamic macro map for the current buffer." (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack - (make-vector 13 0)))) + (obarray-make 13)))) (defun semantic-lex-spp-value-valid-p (value) "Return non-nil if VALUE is valid." @@ -260,7 +260,7 @@ NAME is the name of the spp macro symbol to define. REPLACEMENT a string that would be substituted in for NAME." ;; Create the symbol hash table - (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0)) + (let ((semantic-lex-spp-macro-symbol-obarray (obarray-make 13)) spec) ;; fill it with stuff (while specs diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index b32cb96bed9..f3d671ac312 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -259,7 +259,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and apply those properties. PROPSPECS must be a list of (NAME PROPERTY VALUE) elements." ;; Create the symbol hash table - (let ((semantic-flex-keywords-obarray (make-vector 13 0)) + (let ((semantic-flex-keywords-obarray (obarray-make 13)) spec) ;; fill it with stuff (while specs @@ -416,7 +416,7 @@ If optional argument PROPSPECS is non-nil, then interpret it, and apply those properties. PROPSPECS must be a list of (TYPE PROPERTY VALUE)." ;; Create the symbol hash table - (let* ((semantic-lex-types-obarray (make-vector 13 0)) + (let* ((semantic-lex-types-obarray (obarray-make 13)) spec type tokens token alist default) ;; fill it with stuff (while specs diff --git a/lisp/completion.el b/lisp/completion.el index ab7f2a7bc52..6c758e56eab 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -875,11 +875,11 @@ This is sensitive to `case-fold-search'." ;; GNU implements obarrays (defconst cmpl-obarray-length 511) -(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) +(defvar cmpl-prefix-obarray (obarray-make cmpl-obarray-length) "An obarray used to store the downcased completion prefixes. Each symbol is bound to a list of completion entries.") -(defvar cmpl-obarray (make-vector cmpl-obarray-length 0) +(defvar cmpl-obarray (obarray-make cmpl-obarray-length) "An obarray used to store the downcased completions. Each symbol is bound to a single completion entry.") @@ -962,8 +962,8 @@ Each symbol is bound to a single completion entry.") (defun clear-all-completions () "Initialize the completion storage. All existing completions are lost." (interactive) - (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) - (setq cmpl-obarray (make-vector cmpl-obarray-length 0))) + (setq cmpl-prefix-obarray (obarray-make cmpl-obarray-length)) + (setq cmpl-obarray (obarray-make cmpl-obarray-length))) (defun list-all-completions () "Return a list of all the known completion entries." diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 82c6c03a592..02c11cae573 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1994,7 +1994,7 @@ from the comment." (defun-depth (ppss-depth (syntax-ppss))) (lst nil) (ret nil) - (oo (make-vector 3 0))) ;substitute obarray for `read' + (oo (obarray-make 3))) ;substitute obarray for `read' (forward-char 1) (forward-sexp 1) (skip-chars-forward " \n\t") diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 912a7357ca7..24afd03fbe6 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -155,7 +155,7 @@ Remember to keep it a prime number to improve hash performance.") (defvar eldoc-message-commands ;; Don't define as `defconst' since it would then go to (read-only) purespace. - (make-vector eldoc-message-commands-table-size 0) + (obarray-make eldoc-message-commands-table-size) "Commands after which it is appropriate to print in the echo area. ElDoc does not try to print function arglists, etc., after just any command, because some commands print their own messages in the echo area and these @@ -191,7 +191,7 @@ It should receive the same arguments as `message'.") When `eldoc-print-after-edit' is non-nil, ElDoc messages are only printed after commands contained in this obarray." - (let ((cmds (make-vector 31 0)) + (let ((cmds (obarray-make 31)) (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) (mapatoms (lambda (s) (and (commandp s) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 668cae05521..cfdbc1b2509 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1845,7 +1845,7 @@ place. It affects how `mail-extract-address-components' works." ;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains (defconst mail-extr-all-top-level-domains - (let ((ob (make-vector 739 0))) + (let ((ob (obarray-make 739))) (mapc (lambda (x) (put (intern (downcase (car x)) ob) diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index d9c4cb8cfee..a13c42edb5c 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -31,7 +31,7 @@ ;; Global to all RMAIL buffers. It exists for the sake of completion. ;; It is better to use strings with the label functions and let them ;; worry about making the label. -(defvar rmail-label-obarray (make-vector 47 0) +(defvar rmail-label-obarray (obarray-make 47) "Obarray of labels used by Rmail. `rmail-read-label' uses this to offer completion.") diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 23ea88ef4ad..54f4d227a49 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." result)) ;;; Interface functions. -(defvar dns-cache (make-vector 4096 0)) +(defvar dns-cache (obarray-make 4096)) (defun dns-query-cached (name &optional type fullp reversep) (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6ae1e6d3d0a..5a25eef9e3c 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -340,7 +340,7 @@ parameter, and should return the (possibly) transformed URL." (defun eww-suggested-uris nil "Return the list of URIs to suggest at the `eww' prompt. This list can be customized via `eww-suggest-uris'." - (let ((obseen (make-vector 42 0)) + (let ((obseen (obarray-make 42)) (uris nil)) (dolist (fun eww-suggest-uris) (let ((ret (funcall fun))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index f10b5b8fc12..a06740528e9 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated." (setq imap-capability nil) (setq streams nil)))))) (when (imap-opened buffer) - (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) + (setq imap-mailbox-data (obarray-make imap-mailbox-prime))) ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer) (when imap-stream buffer)))) @@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select." (concat (if examine "EXAMINE" "SELECT") " \"" mailbox "\""))) (progn - (setq imap-message-data (make-vector imap-message-prime 0) + (setq imap-message-data (obarray-make imap-message-prime) imap-state (if examine 'examine 'selected)) imap-current-mailbox) ;; Failed SELECT/EXAMINE unselects current mailbox @@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'." (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) (let ((old-mailbox imap-current-mailbox) (state imap-state) - (imap-message-data (make-vector 2 0))) + (imap-message-data (obarray-make 2))) (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch-safe '("*" . "*:*") "UID") @@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved articles' UIDs." (imap-mailbox-get-1 'appenduid mailbox) (let ((old-mailbox imap-current-mailbox) (state imap-state) - (imap-message-data (make-vector 2 0))) + (imap-message-data (obarray-make 2))) (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch-safe '("*" . "*:*") "UID") diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index 6c00ad201f1..4c7b653155e 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el @@ -85,9 +85,9 @@ is true, or else the output buffer is displayed." (set-buffer standard-output) (insert-buffer-substring pgg-errors-buffer)))) -(defvar pgg-passphrase-cache (make-vector 7 0)) +(defvar pgg-passphrase-cache (obarray-make 7)) -(defvar pgg-pending-timers (make-vector 7 0) +(defvar pgg-pending-timers (obarray-make 7) "Hash table for managing scheduled pgg cache management timers. We associate key and timer, so the timer can be canceled if a new diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index c8e9d097a5f..c4697a0d3b9 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -65,7 +65,7 @@ (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" "Delimiter used to separate cookie file entries.") -(defvar cookie-cache (make-vector 511 0) +(defvar cookie-cache (obarray-make 511) "Cache of cookie files that have already been snarfed.") (defun cookie-check-file (file) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f84d95dbc94..e45ab76ec07 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2425,7 +2425,7 @@ system." (error "Unknown base mode `%s'" base-mode)) (put mode 'c-fallback-mode base-mode)) -(defvar c-lang-constants (make-vector 151 0)) +(defvar c-lang-constants (obarray-make 151)) ;; Obarray used as a cache to keep track of the language constants. ;; The constants stored are those defined by `c-lang-defconst' and the values ;; computed by `c-lang-const'. It's mostly used at compile time but it's not @@ -2630,7 +2630,7 @@ constant. A file is identified by its base name." ;; Clear the evaluated values that depend on this source. (let ((agenda (get sym 'dependents)) - (visited (make-vector 101 0)) + (visited (obarray-make 101)) ptr) (while agenda (setq sym (car agenda) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ba0d1d0fc49..ae2389c75c2 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3511,7 +3511,7 @@ Note that Java specific rules are currently applied to tell this from (let* ((alist (c-lang-const c-keyword-member-alist)) kwd lang-const-list - (obarray (make-vector (* (length alist) 2) 0))) + (obarray (obarray-make (* (length alist) 2)))) (while alist (setq kwd (caar alist) lang-const-list (cdar alist) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1493845e2d9..a95cc732dab 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -197,7 +197,7 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]: ;; during any subsequent VC operations, and forget them when ;; the buffer is killed. -(defvar vc-file-prop-obarray (make-vector 17 0) +(defvar vc-file-prop-obarray (obarray-make 17) "Obarray for per-file properties.") (defvar vc-touched-properties nil) diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index d7e547fcf29..dd8f1c8abd4 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,7 +32,8 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (make-vector 7 0)))) + (should (obarrayp (obarray-make 7))) + (should (obarrayp (make-vector 7 0)))) ; for compatibility? (ert-deftest obarrayp-unchecked-content-test () "Should fail to check content of passed obarray." diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index cb305ca0e55..99d522d1856 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -34,7 +34,7 @@ (let ((num 0)) (mapcar (lambda (str) (cons str (cl-incf num))) list))) (defun minibuf-tests--strings-to-obarray (list) - (let ((ob (make-vector 7 0))) + (let ((ob (obarray-make 7))) (mapc (lambda (str) (intern str ob)) list) ob)) (defun minibuf-tests--strings-to-string-hashtable (list) From 3beaa3131e78bea618cb93d03c5d8b0f8977fb94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 10 Feb 2024 20:59:42 +0100 Subject: [PATCH 322/385] Use obarrayp, not vectorp, to detect obarrays * lisp/abbrev.el (abbrev--active-tables): * lisp/mail/mailabbrev.el (mail-abbrevs-setup, build-mail-abbrevs) (define-mail-abbrev, mail-resolve-all-aliases) (mail-abbrev-insert-alias): * lisp/mail/rmail.el (rmail-resend): * lisp/minibuffer.el (completion-table-with-context): * lisp/progmodes/etags.el (etags-tags-apropos-additional): (etags--xref-apropos-additional): Use obarrayp as predicate for obarrays. --- lisp/abbrev.el | 2 +- lisp/mail/mailabbrev.el | 12 ++++++------ lisp/mail/rmail.el | 2 +- lisp/minibuffer.el | 2 +- lisp/progmodes/etags.el | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2bd9faad69d..b523977fed5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -721,7 +721,7 @@ either a single abbrev table or a list of abbrev tables." ;; to treat the distinction between a single table and a list of tables. (cond ((consp tables) tables) - ((vectorp tables) (list tables)) + ((obarrayp tables) (list tables)) (t (let ((tables (if (listp local-abbrev-table) (append local-abbrev-table diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 68d325ea261..c8006294a7d 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -171,7 +171,7 @@ no aliases, which is represented by this being a table with no entries.)") ;;;###autoload (defun mail-abbrevs-setup () "Initialize use of the `mailabbrev' package." - (if (and (not (vectorp mail-abbrevs)) + (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (progn (setq mail-abbrev-modtime @@ -196,7 +196,7 @@ no aliases, which is represented by this being a table with no entries.)") "Read mail aliases from personal mail alias file and set `mail-abbrevs'. By default this is the file specified by `mail-personal-alias-file'." (setq file (expand-file-name (or file mail-personal-alias-file))) - (if (vectorp mail-abbrevs) + (if (obarrayp mail-abbrevs) nil (setq mail-abbrevs nil) (define-abbrev-table 'mail-abbrevs '())) @@ -278,7 +278,7 @@ double-quotes." ;; true, and we do some evil space->comma hacking like /bin/mail does. (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") ;; Read the defaults first, if we have not done so. - (unless (vectorp mail-abbrevs) (build-mail-abbrevs)) + (unless (obarrayp mail-abbrevs) (build-mail-abbrevs)) ;; strip garbage from front and end (if (string-match "\\`[ \t\n,]+" definition) (setq definition (substring definition (match-end 0)))) @@ -355,7 +355,7 @@ double-quotes." (if mail-abbrev-aliases-need-to-be-resolved (progn ;; (message "Resolving mail aliases...") - (if (vectorp mail-abbrevs) + (if (obarrayp mail-abbrevs) (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) (setq mail-abbrev-aliases-need-to-be-resolved nil) ;; (message "Resolving mail aliases... done.") @@ -555,9 +555,9 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (defun mail-abbrev-insert-alias (&optional alias) "Prompt for and insert a mail alias." (interactive (progn - (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) + (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) (list (completing-read "Expand alias: " mail-abbrevs nil t)))) - (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) + (if (not (obarrayp mail-abbrevs)) (mail-abbrevs-setup)) (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")) (mail-abbrev-expand-hook)) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 85eaec33660..6f343c23bbe 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4097,7 +4097,7 @@ typically for purposes of moderating a list." (let ((end (point-marker)) (local-abbrev-table mail-abbrevs) (old-syntax-table (syntax-table))) - (if (and (not (vectorp mail-abbrevs)) + (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (unless mail-abbrev-syntax-table diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 708f3684d11..099fa1599d5 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -321,7 +321,7 @@ the form (concat S2 S)." ;; Predicates are called differently depending on the nature of ;; the completion table :-( (cond - ((vectorp table) ;Obarray. + ((obarrayp table) (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) ((hash-table-p table) (lambda (s _v) (funcall pred (concat prefix s)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b9bd772ddfc..476037eb8bd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1488,7 +1488,7 @@ hits the start of file." (setq symbs (symbol-value symbs)) (insert (format-message "symbol `%s' has no value\n" symbs)) (setq symbs nil))) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms ins-symb symbs) (dolist (sy symbs) (funcall ins-symb (car sy)))) @@ -2183,7 +2183,7 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (setq symbs (symbol-value symbs)) (warn "symbol `%s' has no value" symbs) (setq symbs nil)) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms add-xref symbs) (dolist (sy symbs) (funcall add-xref (car sy)))) From 6a182658a533acab94d8fa0aec3e2b7a4f7d6a93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 11 Feb 2024 18:30:22 +0100 Subject: [PATCH 323/385] Add obarray-clear and use it * lisp/obarray.el (obarray-clear): New. * lisp/abbrev.el (clear-abbrev-table): * lisp/vc/vc.el (vc-clear-context): Use it instead of assuming the obarray is a vector that can be 0-filled. * test/lisp/obarray-tests.el (obarray-clear): New test. --- lisp/abbrev.el | 3 +-- lisp/obarray.el | 5 +++++ lisp/vc/vc.el | 2 +- test/lisp/obarray-tests.el | 10 ++++++++++ 4 files changed, 17 insertions(+), 3 deletions(-) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index b523977fed5..188eeb720c0 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -602,8 +602,7 @@ It is nil if the abbrev has already been unexpanded.") "Undefine all abbrevs in abbrev table TABLE, leaving TABLE empty." (setq abbrevs-changed t) (let* ((sym (obarray-get table ""))) - (dotimes (i (length table)) - (aset table i 0)) + (obarray-clear table) ;; Preserve the table's properties. (cl-assert sym) (let ((newsym (obarray-put table ""))) diff --git a/lisp/obarray.el b/lisp/obarray.el index a26992df8e2..e1ebb2ade51 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -66,5 +66,10 @@ Return t on success, nil otherwise." "Call function FN on every symbol in obarray OB and return nil." (mapatoms fn ob)) +(defun obarray-clear (ob) + "Remove all symbols from obarray OB." + ;; FIXME: This doesn't change the symbols to uninterned status. + (fillarray ob 0)) + (provide 'obarray) ;;; obarray.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 619b469bebb..3cd17276fa4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -935,7 +935,7 @@ is sensitive to blank lines." (defun vc-clear-context () "Clear all cached file properties." (interactive) - (fillarray vc-file-prop-obarray 0)) + (obarray-clear vc-file-prop-obarray)) (defmacro with-vc-properties (files form settings) "Execute FORM, then maybe set per-file properties for FILES. diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index dd8f1c8abd4..dd40d0f4d76 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -89,5 +89,15 @@ (obarray-map collect-names table) (should (equal (sort syms #'string<) '("a" "b" "c"))))) +(ert-deftest obarray-clear () + (let ((o (obarray-make))) + (intern "a" o) + (intern "b" o) + (intern "c" o) + (obarray-clear o) + (let ((n 0)) + (mapatoms (lambda (_) (setq n (1+ n))) o) + (should (equal n 0))))) + (provide 'obarray-tests) ;;; obarray-tests.el ends here From 462d8ba813e07a25b71f5c1b38810a29e21f784c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 10 Feb 2024 21:14:09 +0100 Subject: [PATCH 324/385] Add a proper type for obarrays The new opaque type replaces the previous use of vectors for obarrays. `obarray-make` now returns objects of this type. Functions that take obarrays continue to accept vectors for compatibility, now just using their first slot to store an actual obarray object. obarray-size and obarray-default-size now obsolete. * lisp/obarray.el (obarray-default-size, obarray-size): Declare obsolete. (obarray-make, obarrayp, obarray-clear): Remove from here. * src/fns.c (reduce_emacs_uint_to_hash_hash): Remove from here. * src/lisp.h (struct Lisp_Obarray, OBARRAYP, XOBARRAY, CHECK_OBARRAY) (make_lisp_obarray, obarray_size, check_obarray) (obarray_iter_t, make_obarray_iter, obarray_iter_at_end) (obarray_iter_step, obarray_iter_symbol, DOOBARRAY, knuth_hash): New. (reduce_emacs_uint_to_hash_hash): Moved here. * src/lread.c (check_obarray): Renamed and reworked as... (checked_obarray_slow): ...this. (intern_sym, Funintern, oblookup, map_obarray) (Finternal__obarray_buckets): Adapt to new type. (obarray_index, allocate_obarray, make_obarray, grow_obarray) (obarray_default_bits, Fobarray_make, Fobarrayp, Fobarray_clear): New. * etc/emacs_lldb.py (Lisp_Object): * lisp/emacs-lisp/cl-macs.el (`(,type . ,pred)): * lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): * lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers): * lisp/emacs-lisp/comp.el (comp-known-predicates): * src/alloc.c (cleanup_vector, process_mark_stack): * src/data.c (Ftype_of, syms_of_data): * src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion): * src/pdumper.c (dump_obarray_buckets, dump_obarray, dump_vectorlike): * src/print.c (print_vectorlike_unreadable): * test/lisp/abbrev-tests.el (abbrev-make-abbrev-table-test): * test/lisp/obarray-tests.el (obarrayp-test) (obarrayp-unchecked-content-test, obarray-make-default-test) (obarray-make-with-size-test): Adapt to new type. --- etc/emacs_lldb.py | 1 + lisp/emacs-lisp/cl-macs.el | 1 + lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/emacs-lisp/comp-common.el | 3 +- lisp/emacs-lisp/comp.el | 1 + lisp/emacs-lisp/shortdoc.el | 19 +- lisp/obarray.el | 27 +-- src/alloc.c | 26 ++- src/data.c | 2 + src/fns.c | 17 +- src/lisp.h | 136 ++++++++++++++- src/lread.c | 297 ++++++++++++++++++++++---------- src/minibuf.c | 110 ++++-------- src/pdumper.c | 47 +++++ src/print.c | 10 ++ test/lisp/abbrev-tests.el | 4 +- test/lisp/obarray-tests.el | 22 +-- 17 files changed, 499 insertions(+), 226 deletions(-) diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index fdf4314e2d0..9865fe391a2 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -56,6 +56,7 @@ class Lisp_Object: "PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector", "PVEC_BUFFER": "struct buffer", "PVEC_HASH_TABLE": "struct Lisp_Hash_Table", + "PVEC_OBARRAY": "struct Lisp_Obarray", "PVEC_TERMINAL": "struct terminal", "PVEC_WINDOW_CONFIGURATION": "struct save_window_data", "PVEC_SUBR": "struct Lisp_Subr", diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 44ebadeebff..ddc9775bcce 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3488,6 +3488,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (natnum . natnump) (number . numberp) (null . null) + (obarray . obarrayp) (overlay . overlayp) (process . processp) (real . numberp) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d533eea9e73..840219c2260 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -73,7 +73,7 @@ (module-function function atom) (buffer atom) (char-table array sequence atom) (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) + (frame atom) (hash-table atom) (terminal atom) (obarray atom) (thread atom) (mutex atom) (condvar atom) (font-spec atom) (font-entity atom) (font-object atom) (vector array sequence atom) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index ca21ed05bb4..221f819e474 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -240,7 +240,8 @@ Used to modify the compiler environment." (integer-or-marker-p (function (t) boolean)) (integerp (function (t) boolean)) (interactive-p (function () boolean)) - (intern-soft (function ((or string symbol) &optional vector) symbol)) + (intern-soft (function ((or string symbol) &optional (or obarray vector)) + symbol)) (invocation-directory (function () string)) (invocation-name (function () string)) (isnan (function (float) boolean)) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e0da01bcc5d..ae964b041d0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -214,6 +214,7 @@ Useful to hook into pass checkers.") (number-or-marker-p . number-or-marker) (numberp . number) (numberp . number) + (obarrayp . obarray) (overlayp . overlay) (processp . process) (sequencep . sequence) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index cde28985cd0..cbb5618ffce 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -747,9 +747,13 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (intern :eval (intern "abc")) (intern-soft + :eval (intern-soft "list") :eval (intern-soft "Phooey!")) (make-symbol :eval (make-symbol "abc")) + (gensym + :no-eval (gensym) + :eg-result g37) "Comparing symbols" (eq :eval (eq 'abc 'abc) @@ -760,7 +764,20 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (equal 'abc 'abc)) "Name" (symbol-name - :eval (symbol-name 'abc))) + :eval (symbol-name 'abc)) + "Obarrays" + (obarray-make + :eval (obarray-make)) + (obarrayp + :eval (obarrayp (obarray-make)) + :eval (obarrayp nil)) + (unintern + :no-eval (unintern "abc" my-obarray) + :eg-result t) + (mapatoms + :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) + (obarray-clear + :no-eval (obarray-clear my-obarray))) (define-short-documentation-group comparison "General-purpose" diff --git a/lisp/obarray.el b/lisp/obarray.el index e1ebb2ade51..e6e51c1382a 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -27,24 +27,12 @@ ;;; Code: -(defconst obarray-default-size 59 - "The value 59 is an arbitrary prime number that gives a good hash.") +(defconst obarray-default-size 4) +(make-obsolete-variable 'obarray-default-size + "obarrays now grow automatically" "30.1") -(defun obarray-make (&optional size) - "Return a new obarray of size SIZE or `obarray-default-size'." - (let ((size (or size obarray-default-size))) - (if (< 0 size) - (make-vector size 0) - (signal 'wrong-type-argument '(size 0))))) - -(defun obarray-size (ob) - "Return the number of slots of obarray OB." - (length ob)) - -(defun obarrayp (object) - "Return t if OBJECT is an obarray." - (and (vectorp object) - (< 0 (length object)))) +(defun obarray-size (_ob) obarray-default-size) +(make-obsolete 'obarray-size "obarrays now grow automatically" "30.1") ;; Don’t use obarray as a variable name to avoid shadowing. (defun obarray-get (ob name) @@ -66,10 +54,5 @@ Return t on success, nil otherwise." "Call function FN on every symbol in obarray OB and return nil." (mapatoms fn ob)) -(defun obarray-clear (ob) - "Remove all symbols from obarray OB." - ;; FIXME: This doesn't change the symbols to uninterned status. - (fillarray ob 0)) - (provide 'obarray) ;;; obarray.el ends here diff --git a/src/alloc.c b/src/alloc.c index 8c94c7eb33c..2ffd2415447 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -360,13 +360,13 @@ static struct gcstat object_ct total_intervals, total_free_intervals; object_ct total_buffers; - /* Size of the ancillary arrays of live hash-table objects. + /* Size of the ancillary arrays of live hash-table and obarray objects. The objects themselves are not included (counted as vectors above). */ byte_ct total_hash_table_bytes; } gcstat; -/* Total size of ancillary arrays of all allocated hash-table objects, - both dead and alive. This number is always kept up-to-date. */ +/* Total size of ancillary arrays of all allocated hash-table and obarray + objects, both dead and alive. This number is always kept up-to-date. */ static ptrdiff_t hash_table_allocated_bytes = 0; /* Points to memory space allocated as "spare", to be freed if we run @@ -3455,6 +3455,15 @@ cleanup_vector (struct Lisp_Vector *vector) hash_table_allocated_bytes -= bytes; } } + break; + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray); + xfree (o->buckets); + ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets; + hash_table_allocated_bytes -= bytes; + } + break; /* Keep the switch exhaustive. */ case PVEC_NORMAL_VECTOR: case PVEC_FREE: @@ -5632,7 +5641,8 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } -/* Like xmalloc, but makes allocation count toward the total consing. +/* Like xmalloc, but makes allocation count toward the total consing + and hash table or obarray usage. Return NULL for a zero-sized allocation. */ void * hash_table_alloc_bytes (ptrdiff_t nbytes) @@ -7310,6 +7320,14 @@ process_mark_stack (ptrdiff_t base_sp) break; } + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr; + set_vector_marked (ptr); + mark_stack_push_values (o->buckets, obarray_size (o)); + break; + } + case PVEC_CHAR_TABLE: case PVEC_SUB_CHAR_TABLE: mark_char_table (ptr, (enum pvec_type) pvectype); diff --git a/src/data.c b/src/data.c index f2f35fb355a..bb4cdd62d66 100644 --- a/src/data.c +++ b/src/data.c @@ -231,6 +231,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_BOOL_VECTOR: return Qbool_vector; case PVEC_FRAME: return Qframe; case PVEC_HASH_TABLE: return Qhash_table; + case PVEC_OBARRAY: return Qobarray; case PVEC_FONT: if (FONT_SPEC_P (object)) return Qfont_spec; @@ -4229,6 +4230,7 @@ syms_of_data (void) DEFSYM (Qtreesit_parser, "treesit-parser"); DEFSYM (Qtreesit_node, "treesit-node"); DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query"); + DEFSYM (Qobarray, "obarray"); DEFSYM (Qdefun, "defun"); diff --git a/src/fns.c b/src/fns.c index 550545d1486..0a64e515402 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4450,16 +4450,6 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, return hash_table_user_defined_call (ARRAYELTS (args), args, h); } -/* Reduce an EMACS_UINT hash value to hash_hash_t. */ -static inline hash_hash_t -reduce_emacs_uint_to_hash_hash (EMACS_UINT x) -{ - verify (sizeof x <= 2 * sizeof (hash_hash_t)); - return (sizeof x == sizeof (hash_hash_t) - ? x - : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); -} - static EMACS_INT sxhash_eq (Lisp_Object key) { @@ -4645,16 +4635,11 @@ copy_hash_table (struct Lisp_Hash_Table *h1) return make_lisp_hash_table (h2); } - /* Compute index into the index vector from a hash value. */ static inline ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash) { - /* Knuth multiplicative hashing, tailored for 32-bit indices - (avoiding a 64-bit multiply). */ - uint32_t alpha = 2654435769; /* 2**32/phi */ - /* Note the cast to uint64_t, to make it work for index_bits=0. */ - return (uint64_t)((uint32_t)hash * alpha) >> (32 - h->index_bits); + return knuth_hash (hash, h->index_bits); } /* Resize hash table H if it's too full. If H cannot be resized diff --git a/src/lisp.h b/src/lisp.h index b02466390f1..5fbbef80e8e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1032,6 +1032,7 @@ enum pvec_type PVEC_BOOL_VECTOR, PVEC_BUFFER, PVEC_HASH_TABLE, + PVEC_OBARRAY, PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, @@ -2386,6 +2387,118 @@ INLINE int definition is done by lread.c's define_symbol. */ #define DEFSYM(sym, name) /* empty */ + +struct Lisp_Obarray +{ + union vectorlike_header header; + + /* Array of 2**size_bits values, each being either a (bare) symbol or + the fixnum 0. The symbols for each bucket are chained via + their s.next field. */ + Lisp_Object *buckets; + + unsigned size_bits; /* log2(size of buckets vector) */ + unsigned count; /* number of symbols in obarray */ +}; + +INLINE bool +OBARRAYP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_OBARRAY); +} + +INLINE struct Lisp_Obarray * +XOBARRAY (Lisp_Object a) +{ + eassert (OBARRAYP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray); +} + +INLINE void +CHECK_OBARRAY (Lisp_Object x) +{ + CHECK_TYPE (OBARRAYP (x), Qobarrayp, x); +} + +INLINE Lisp_Object +make_lisp_obarray (struct Lisp_Obarray *o) +{ + eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY)); + return make_lisp_ptr (o, Lisp_Vectorlike); +} + +INLINE ptrdiff_t +obarray_size (const struct Lisp_Obarray *o) +{ + return (ptrdiff_t)1 << o->size_bits; +} + +Lisp_Object check_obarray_slow (Lisp_Object); + +/* Return an obarray object from OBARRAY or signal an error. */ +INLINE Lisp_Object +check_obarray (Lisp_Object obarray) +{ + return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray); +} + +/* Obarray iterator state. Don't access these members directly. + The iterator functions must be called in the order followed by DOOBARRAY. */ +typedef struct { + struct Lisp_Obarray *o; + ptrdiff_t idx; /* Current bucket index. */ + struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end + of current bucket. */ +} obarray_iter_t; + +INLINE obarray_iter_t +make_obarray_iter (struct Lisp_Obarray *oa) +{ + return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL}; +} + +/* Whether IT has reached the end and there are no more symbols. + If true, IT is dead and cannot be used any more. */ +INLINE bool +obarray_iter_at_end (obarray_iter_t *it) +{ + if (it->symbol) + return false; + ptrdiff_t size = obarray_size (it->o); + while (++it->idx < size) + { + Lisp_Object obj = it->o->buckets[it->idx]; + if (!BASE_EQ (obj, make_fixnum (0))) + { + it->symbol = XBARE_SYMBOL (obj); + return false; + } + } + return true; +} + +/* Advance IT to the next symbol if any. */ +INLINE void +obarray_iter_step (obarray_iter_t *it) +{ + it->symbol = it->symbol->u.s.next; +} + +/* The Lisp symbol at IT, if obarray_iter_at_end returned false. */ +INLINE Lisp_Object +obarray_iter_symbol (obarray_iter_t *it) +{ + return make_lisp_symbol (it->symbol); +} + +/* Iterate IT over the symbols of the obarray OA. + The body shouldn't add or remove symbols in OA, but disobeying that rule + only risks symbols to be iterated more than once or not at all, + not crashes or data corruption. */ +#define DOOBARRAY(oa, it) \ + for (obarray_iter_t it = make_obarray_iter (oa); \ + !obarray_iter_at_end (&it); obarray_iter_step (&it)) + /*********************************************************************** Hash Tables @@ -2666,6 +2779,28 @@ SXHASH_REDUCE (EMACS_UINT x) return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } +/* Reduce an EMACS_UINT hash value to hash_hash_t. */ +INLINE hash_hash_t +reduce_emacs_uint_to_hash_hash (EMACS_UINT x) +{ + verify (sizeof x <= 2 * sizeof (hash_hash_t)); + return (sizeof x == sizeof (hash_hash_t) + ? x + : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); +} + +/* Reduce HASH to a value BITS wide. */ +INLINE ptrdiff_t +knuth_hash (hash_hash_t hash, unsigned bits) +{ + /* Knuth multiplicative hashing, tailored for 32-bit indices + (avoiding a 64-bit multiply). */ + uint32_t alpha = 2654435769; /* 2**32/phi */ + /* Note the cast to uint64_t, to make it work for bits=0. */ + return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits); +} + + struct Lisp_Marker { union vectorlike_header header; @@ -4585,7 +4720,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t, ATTRIBUTE_FORMAT_PRINTF (5, 0); /* Defined in lread.c. */ -extern Lisp_Object check_obarray (Lisp_Object); extern Lisp_Object intern_1 (const char *, ptrdiff_t); extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index c11c641440d..c4a34c5d73f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4886,30 +4886,43 @@ static Lisp_Object initial_obarray; static size_t oblookup_last_bucket_number; -/* Get an error if OBARRAY is not an obarray. - If it is one, return it. */ +static Lisp_Object make_obarray (unsigned bits); +/* Slow path obarray check: return the obarray to use or signal an error. */ Lisp_Object -check_obarray (Lisp_Object obarray) +check_obarray_slow (Lisp_Object obarray) { - /* We don't want to signal a wrong-type-argument error when we are - shutting down due to a fatal error, and we don't want to hit - assertions in VECTORP and ASIZE if the fatal error was during GC. */ - if (!fatal_error_in_progress - && (!VECTORP (obarray) || ASIZE (obarray) == 0)) + /* For compatibility, we accept vectors whose first element is 0, + and store an obarray object there. */ + if (VECTORP (obarray) && ASIZE (obarray) > 0) { - /* If Vobarray is now invalid, force it to be valid. */ - if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; - wrong_type_argument (Qvectorp, obarray); + Lisp_Object obj = AREF (obarray, 0); + if (OBARRAYP (obj)) + return obj; + if (BASE_EQ (obj, make_fixnum (0))) + { + /* Put an actual obarray object in the first slot. + The rest of the vector remains unused. */ + obj = make_obarray (0); + ASET (obarray, 0, obj); + return obj; + } } - return obarray; + /* Reset Vobarray to the standard obarray for nicer error handling. */ + if (BASE_EQ (Vobarray, obarray)) Vobarray = initial_obarray; + + wrong_type_argument (Qobarrayp, obarray); } +static void grow_obarray (struct Lisp_Obarray *o); + /* Intern symbol SYM in OBARRAY using bucket INDEX. */ +/* FIXME: retype arguments as pure C types */ static Lisp_Object intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { + eassert (BARE_SYMBOL_P (sym) && OBARRAYP (obarray) && FIXNUMP (index)); struct Lisp_Symbol *s = XBARE_SYMBOL (sym); s->u.s.interned = (BASE_EQ (obarray, initial_obarray) ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY @@ -4925,9 +4938,13 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) SET_SYMBOL_VAL (s, sym); } - Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index)); + struct Lisp_Obarray *o = XOBARRAY (obarray); + Lisp_Object *ptr = o->buckets + XFIXNUM (index); s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL; *ptr = sym; + o->count++; + if (o->count > obarray_size (o)) + grow_obarray (o); return sym; } @@ -5082,7 +5099,6 @@ usage: (unintern NAME OBARRAY) */) { register Lisp_Object tem; Lisp_Object string; - size_t hash; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); @@ -5122,41 +5138,42 @@ usage: (unintern NAME OBARRAY) */) /* if (NILP (tem) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ - XBARE_SYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; + struct Lisp_Symbol *sym = XBARE_SYMBOL (tem); + sym->u.s.interned = SYMBOL_UNINTERNED; - hash = oblookup_last_bucket_number; + ptrdiff_t idx = oblookup_last_bucket_number; + Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx]; - if (BASE_EQ (AREF (obarray, hash), tem)) - { - if (XBARE_SYMBOL (tem)->u.s.next) - { - Lisp_Object sym; - XSETSYMBOL (sym, XBARE_SYMBOL (tem)->u.s.next); - ASET (obarray, hash, sym); - } - else - ASET (obarray, hash, make_fixnum (0)); - } + eassert (BARE_SYMBOL_P (*loc)); + struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc); + if (sym == prev) + *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0); else - { - Lisp_Object tail, following; + while (1) + { + struct Lisp_Symbol *next = prev->u.s.next; + if (next == sym) + { + prev->u.s.next = next->u.s.next; + break; + } + prev = next; + } - for (tail = AREF (obarray, hash); - XBARE_SYMBOL (tail)->u.s.next; - tail = following) - { - XSETSYMBOL (following, XBARE_SYMBOL (tail)->u.s.next); - if (BASE_EQ (following, tem)) - { - set_symbol_next (tail, XBARE_SYMBOL (following)->u.s.next); - break; - } - } - } + XOBARRAY (obarray)->count--; return Qt; } + +/* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */ +static ptrdiff_t +obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte) +{ + EMACS_UINT hash = hash_string (str, size_byte); + return knuth_hash (reduce_emacs_uint_to_hash_hash (hash), oa->size_bits); +} + /* Return the symbol in OBARRAY whose names matches the string of SIZE characters (SIZE_BYTE bytes) at PTR. If there is no such symbol, return the integer bucket number of @@ -5167,36 +5184,27 @@ usage: (unintern NAME OBARRAY) */) Lisp_Object oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte) { - size_t hash; - size_t obsize; - register Lisp_Object tail; - Lisp_Object bucket, tem; + struct Lisp_Obarray *o = XOBARRAY (obarray); + ptrdiff_t idx = obarray_index (o, ptr, size_byte); + Lisp_Object bucket = o->buckets[idx]; - obarray = check_obarray (obarray); - /* This is sometimes needed in the middle of GC. */ - obsize = gc_asize (obarray); - hash = hash_string (ptr, size_byte) % obsize; - bucket = AREF (obarray, hash); - oblookup_last_bucket_number = hash; - if (BASE_EQ (bucket, make_fixnum (0))) - ; - else if (!BARE_SYMBOL_P (bucket)) - /* Like CADR error message. */ - xsignal2 (Qwrong_type_argument, Qobarrayp, - build_string ("Bad data in guts of obarray")); - else - for (tail = bucket; ; XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next)) - { - Lisp_Object name = XBARE_SYMBOL (tail)->u.s.name; - if (SBYTES (name) == size_byte - && SCHARS (name) == size - && !memcmp (SDATA (name), ptr, size_byte)) - return tail; - else if (XBARE_SYMBOL (tail)->u.s.next == 0) - break; - } - XSETINT (tem, hash); - return tem; + oblookup_last_bucket_number = idx; + if (!BASE_EQ (bucket, make_fixnum (0))) + { + Lisp_Object sym = bucket; + while (1) + { + struct Lisp_Symbol *s = XBARE_SYMBOL (sym); + Lisp_Object name = s->u.s.name; + if (SBYTES (name) == size_byte && SCHARS (name) == size + && memcmp (SDATA (name), ptr, size_byte) == 0) + return sym; + if (s->u.s.next == NULL) + break; + sym = make_lisp_symbol(s->u.s.next); + } + } + return make_fixnum (idx); } /* Like 'oblookup', but considers 'Vread_symbol_shorthands', @@ -5263,24 +5271,134 @@ oblookup_considering_shorthand (Lisp_Object obarray, const char *in, } -void -map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) +static struct Lisp_Obarray * +allocate_obarray (void) { - ptrdiff_t i; - register Lisp_Object tail; - CHECK_VECTOR (obarray); - for (i = ASIZE (obarray) - 1; i >= 0; i--) + return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY); +} + +static Lisp_Object +make_obarray (unsigned bits) +{ + struct Lisp_Obarray *o = allocate_obarray (); + o->count = 0; + o->size_bits = bits; + ptrdiff_t size = (ptrdiff_t)1 << bits; + o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets); + for (ptrdiff_t i = 0; i < size; i++) + o->buckets[i] = make_fixnum (0); + return make_lisp_obarray (o); +} + +enum { + obarray_default_bits = 3, + word_size_log2 = word_size < 8 ? 5 : 6, /* good enough */ + obarray_max_bits = min (8 * sizeof (int), + 8 * sizeof (ptrdiff_t) - word_size_log2) - 1, +}; + +static void +grow_obarray (struct Lisp_Obarray *o) +{ + ptrdiff_t old_size = obarray_size (o); + eassert (o->count > old_size); + Lisp_Object *old_buckets = o->buckets; + + int new_bits = o->size_bits + 1; + if (new_bits > obarray_max_bits) + error ("Obarray too big"); + ptrdiff_t new_size = (ptrdiff_t)1 << new_bits; + o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets); + for (ptrdiff_t i = 0; i < new_size; i++) + o->buckets[i] = make_fixnum (0); + o->size_bits = new_bits; + + /* Rehash symbols. + FIXME: this is expensive since we need to recompute the hash for every + symbol name. Would it be reasonable to store it in the symbol? */ + for (ptrdiff_t i = 0; i < old_size; i++) { - tail = AREF (obarray, i); - if (BARE_SYMBOL_P (tail)) - while (1) - { - (*fn) (tail, arg); - if (XBARE_SYMBOL (tail)->u.s.next == 0) - break; - XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next); - } + Lisp_Object obj = old_buckets[i]; + if (BARE_SYMBOL_P (obj)) + { + struct Lisp_Symbol *s = XBARE_SYMBOL (obj); + while (1) + { + Lisp_Object name = s->u.s.name; + ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name)); + Lisp_Object *loc = o->buckets + idx; + struct Lisp_Symbol *next = s->u.s.next; + s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL; + *loc = make_lisp_symbol (s); + if (next == NULL) + break; + s = next; + } + } } + + hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets); +} + +DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0, + doc: /* Return a new obarray of size SIZE. +The obarray will grow to accommodate any number of symbols; the size, if +given, is only a hint for the expected number. */) + (Lisp_Object size) +{ + int bits; + if (NILP (size)) + bits = obarray_default_bits; + else + { + CHECK_FIXNAT (size); + EMACS_UINT n = XFIXNUM (size); + bits = elogb (n) + 1; + if (bits > obarray_max_bits) + xsignal (Qargs_out_of_range, size); + } + return make_obarray (bits); +} + +DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0, + doc: /* Return t iff OBJECT is an obarray. */) + (Lisp_Object object) +{ + return OBARRAYP (object) ? Qt : Qnil; +} + +DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0, + doc: /* Remove all symbols from OBARRAY. */) + (Lisp_Object obarray) +{ + CHECK_OBARRAY (obarray); + struct Lisp_Obarray *o = XOBARRAY (obarray); + + /* This function does not bother setting the status of its contained symbols + to uninterned. It doesn't matter very much. */ + int new_bits = obarray_default_bits; + int new_size = (ptrdiff_t)1 << new_bits; + Lisp_Object *new_buckets + = hash_table_alloc_bytes (new_size * sizeof *new_buckets); + for (ptrdiff_t i = 0; i < new_size; i++) + new_buckets[i] = make_fixnum (0); + + int old_size = obarray_size (o); + hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets); + o->buckets = new_buckets; + o->size_bits = new_bits; + o->count = 0; + + return Qnil; +} + +void +map_obarray (Lisp_Object obarray, + void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) +{ + CHECK_OBARRAY (obarray); + DOOBARRAY (XOBARRAY (obarray), it) + (*fn) (obarray_iter_symbol (&it), arg); } static void @@ -5307,12 +5425,13 @@ DEFUN ("internal--obarray-buckets", (Lisp_Object obarray) { obarray = check_obarray (obarray); - ptrdiff_t size = ASIZE (obarray); + ptrdiff_t size = obarray_size (XOBARRAY (obarray)); + Lisp_Object ret = Qnil; for (ptrdiff_t i = 0; i < size; i++) { Lisp_Object bucket = Qnil; - Lisp_Object sym = AREF (obarray, i); + Lisp_Object sym = XOBARRAY (obarray)->buckets[i]; if (BARE_SYMBOL_P (sym)) while (1) { @@ -5332,6 +5451,7 @@ DEFUN ("internal--obarray-buckets", void init_obarray_once (void) { + /* FIXME: use PVEC_OBARRAY */ Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); @@ -5715,6 +5835,9 @@ syms_of_lread (void) defsubr (&Smapatoms); defsubr (&Slocate_file_internal); defsubr (&Sinternal__obarray_buckets); + defsubr (&Sobarray_make); + defsubr (&Sobarrayp); + defsubr (&Sobarray_clear); DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'. diff --git a/src/minibuf.c b/src/minibuf.c index 7c0c9799a60..df6ca7ce1d8 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1615,13 +1615,15 @@ or from one of the possible completions. */) ptrdiff_t bestmatchsize = 0; /* These are in bytes, too. */ ptrdiff_t compare, matchsize; + if (VECTORP (collection)) + collection = check_obarray (collection); enum { function_table, list_table, obarray_table, hash_table} type = (HASH_TABLE_P (collection) ? hash_table - : VECTORP (collection) ? obarray_table + : OBARRAYP (collection) ? obarray_table : ((NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection))) ? list_table : function_table)); - ptrdiff_t idx = 0, obsize = 0; + ptrdiff_t idx = 0; int matchcount = 0; Lisp_Object bucket, zero, end, tem; @@ -1634,12 +1636,9 @@ or from one of the possible completions. */) /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; + obarray_iter_t obit; if (type == obarray_table) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } + obit = make_obarray_iter (XOBARRAY (collection)); while (1) { @@ -1658,24 +1657,10 @@ or from one of the possible completions. */) } else if (type == obarray_table) { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->u.s.next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) + if (obarray_iter_at_end (&obit)) break; - else - { - bucket = AREF (collection, idx); - continue; - } + elt = eltstring = obarray_iter_symbol (&obit); + obarray_iter_step (&obit); } else /* if (type == hash_table) */ { @@ -1858,10 +1843,12 @@ with a space are ignored unless STRING itself starts with a space. */) { Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; + if (VECTORP (collection)) + collection = check_obarray (collection); int type = HASH_TABLE_P (collection) ? 3 - : VECTORP (collection) ? 2 + : OBARRAYP (collection) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); - ptrdiff_t idx = 0, obsize = 0; + ptrdiff_t idx = 0; Lisp_Object bucket, tem, zero; CHECK_STRING (string); @@ -1872,12 +1859,9 @@ with a space are ignored unless STRING itself starts with a space. */) /* If COLLECTION is not a list, set TAIL just for gc pro. */ tail = collection; + obarray_iter_t obit; if (type == 2) - { - collection = check_obarray (collection); - obsize = ASIZE (collection); - bucket = AREF (collection, idx); - } + obit = make_obarray_iter (XOBARRAY (collection)); while (1) { @@ -1896,24 +1880,10 @@ with a space are ignored unless STRING itself starts with a space. */) } else if (type == 2) { - if (!EQ (bucket, zero)) - { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); - elt = bucket; - eltstring = elt; - if (XSYMBOL (bucket)->u.s.next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); - else - XSETFASTINT (bucket, 0); - } - else if (++idx >= obsize) + if (obarray_iter_at_end (&obit)) break; - else - { - bucket = AREF (collection, idx); - continue; - } + elt = eltstring = obarray_iter_symbol (&obit); + obarray_iter_step (&obit); } else /* if (type == 3) */ { @@ -2059,7 +2029,7 @@ If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object tail, tem = Qnil, arg = Qnil; + Lisp_Object tem = Qnil, arg = Qnil; CHECK_STRING (string); @@ -2069,38 +2039,30 @@ the values STRING, PREDICATE and `lambda'. */) if (NILP (tem)) return Qnil; } - else if (VECTORP (collection)) + else if (OBARRAYP (collection) || VECTORP (collection)) { + collection = check_obarray (collection); /* Bypass intern-soft as that loses for nil. */ tem = oblookup (collection, SSDATA (string), SCHARS (string), SBYTES (string)); - if (completion_ignore_case && !SYMBOLP (tem)) - { - for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--) - { - tail = AREF (collection, i); - if (SYMBOLP (tail)) - while (1) - { - if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), - Qnil, - Fsymbol_name (tail), - make_fixnum (0) , Qnil, Qt), - Qt)) - { - tem = tail; - break; - } - if (XSYMBOL (tail)->u.s.next == 0) - break; - XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); - } - } - } + if (completion_ignore_case && !BARE_SYMBOL_P (tem)) + DOOBARRAY (XOBARRAY (collection), it) + { + Lisp_Object obj = obarray_iter_symbol (&it); + if (BASE_EQ (Fcompare_strings (string, make_fixnum (0), + Qnil, + Fsymbol_name (obj), + make_fixnum (0) , Qnil, Qt), + Qt)) + { + tem = obj; + break; + } + } - if (!SYMBOLP (tem)) + if (!BARE_SYMBOL_P (tem)) return Qnil; } else if (HASH_TABLE_P (collection)) diff --git a/src/pdumper.c b/src/pdumper.c index 778d8facabd..ca457858219 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2748,6 +2748,51 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) return offset; } +static dump_off +dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o) +{ + dump_align_output (ctx, DUMP_ALIGNMENT); + dump_off start_offset = ctx->offset; + ptrdiff_t n = obarray_size (o); + + struct dump_flags old_flags = ctx->flags; + ctx->flags.pack_objects = true; + + for (ptrdiff_t i = 0; i < n; i++) + { + Lisp_Object out; + const Lisp_Object *slot = &o->buckets[i]; + dump_object_start (ctx, &out, sizeof out); + dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG); + dump_object_finish (ctx, &out, sizeof out); + } + + ctx->flags = old_flags; + return start_offset; +} + +static dump_off +dump_obarray (struct dump_context *ctx, Lisp_Object object) +{ +#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_XXXXXXXXXX +# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." +#endif + const struct Lisp_Obarray *in_oa = XOBARRAY (object); + struct Lisp_Obarray munged_oa = *in_oa; + struct Lisp_Obarray *oa = &munged_oa; + START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out); + dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header); + DUMP_FIELD_COPY (out, oa, count); + DUMP_FIELD_COPY (out, oa, size_bits); + dump_field_fixup_later (ctx, out, oa, &oa->buckets); + dump_off offset = finish_dump_pvec (ctx, &out->header); + dump_remember_fixup_ptr_raw + (ctx, + offset + dump_offsetof (struct Lisp_Obarray, buckets), + dump_obarray_buckets (ctx, oa)); + return offset; +} + static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { @@ -3031,6 +3076,8 @@ dump_vectorlike (struct dump_context *ctx, return dump_bool_vector(ctx, v); case PVEC_HASH_TABLE: return dump_hash_table (ctx, lv); + case PVEC_OBARRAY: + return dump_obarray (ctx, lv); case PVEC_BUFFER: return dump_buffer (ctx, XBUFFER (lv)); case PVEC_SUBR: diff --git a/src/print.c b/src/print.c index e2252562915..76c577ec800 100644 --- a/src/print.c +++ b/src/print.c @@ -2078,6 +2078,16 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun, } return; + case PVEC_OBARRAY: + { + struct Lisp_Obarray *o = XOBARRAY (obj); + /* FIXME: Would it make sense to print the actual symbols (up to + a limit)? */ + int i = sprintf (buf, "#", o->count); + strout (buf, i, i, printcharfun); + return; + } + /* Types handled earlier. */ case PVEC_NORMAL_VECTOR: case PVEC_RECORD: diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index bfdfac8be1b..cdd1a7832d3 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -57,12 +57,10 @@ (ert-deftest abbrev-make-abbrev-table-test () ;; Table without properties: (let ((table (make-abbrev-table))) - (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size))) + (should (abbrev-table-p table))) ;; Table with one property 'foo with value 'bar: (let ((table (make-abbrev-table '(foo bar)))) (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size)) (should (eq (abbrev-table-get table 'foo) 'bar)))) (ert-deftest abbrev--table-symbols-test () diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index dd40d0f4d76..f9f97dba535 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,28 +32,18 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (obarray-make 7))) - (should (obarrayp (make-vector 7 0)))) ; for compatibility? - -(ert-deftest obarrayp-unchecked-content-test () - "Should fail to check content of passed obarray." - :expected-result :failed (should-not (obarrayp ["a" "b" "c"])) - (should-not (obarrayp [1 2 3]))) - -(ert-deftest obarray-make-default-test () - (let ((table (obarray-make))) - (should (obarrayp table)) - (should (eq (obarray-size table) obarray-default-size)))) + (should-not (obarrayp [1 2 3])) + (should-not (obarrayp (make-vector 7 0))) + (should-not (obarrayp (vector (obarray-make)))) + (should (obarrayp (obarray-make))) + (should (obarrayp (obarray-make 7)))) (ert-deftest obarray-make-with-size-test () ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal, ;; so we shouldn't enforce this misbehavior in tests! (should-error (obarray-make -1) :type 'wrong-type-argument) - (should-error (obarray-make 0) :type 'wrong-type-argument) - (let ((table (obarray-make 1))) - (should (obarrayp table)) - (should (eq (obarray-size table) 1)))) + (should-error (obarray-make 'a) :type 'wrong-type-argument)) (ert-deftest obarray-get-test () (let ((table (obarray-make 3))) From 3ea77c735de975ebda707e0e1e8bb5e0adad2bf5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 11 Feb 2024 15:11:21 +0100 Subject: [PATCH 325/385] Use the new obarray type for the initial obarray This can improve performance a lot, especially after the obarray has been fed many symbols. * src/lread.c (OBARRAY_SIZE): Remove. (load_path_check): Create an obarray object instead of a vector. --- src/lread.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/lread.c b/src/lread.c index c4a34c5d73f..49683d02401 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5446,13 +5446,10 @@ DEFUN ("internal--obarray-buckets", return Fnreverse (ret); } -#define OBARRAY_SIZE 15121 - void init_obarray_once (void) { - /* FIXME: use PVEC_OBARRAY */ - Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0)); + Vobarray = make_obarray (15); initial_obarray = Vobarray; staticpro (&initial_obarray); From 6803b70c1972bc82f7dc1f1d6bbb2a60b6f40367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 17 Feb 2024 13:27:25 +0100 Subject: [PATCH 326/385] Update NEWS and manual after obarray changes * doc/lispref/abbrevs.texi (Abbrev Tables): * doc/lispref/symbols.texi (Creating Symbols): * doc/lispref/objects.texi (Type Predicates): Update text for obarray now being an opaque type. * etc/NEWS: Announce. --- doc/lispref/abbrevs.texi | 2 +- doc/lispref/objects.texi | 5 +++- doc/lispref/symbols.texi | 63 ++++++++++++++-------------------------- etc/NEWS | 20 +++++++++++++ 4 files changed, 47 insertions(+), 43 deletions(-) diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi index 9b719145584..d89cec4bc2b 100644 --- a/doc/lispref/abbrevs.texi +++ b/doc/lispref/abbrevs.texi @@ -65,7 +65,7 @@ expanded in the buffer. For the user-level commands for abbrevs, see @defun make-abbrev-table &optional props This function creates and returns a new, empty abbrev table---an -obarray containing no symbols. It is a vector filled with zeros. +obarray containing no symbols. @var{props} is a property list that is applied to the new table (@pxref{Abbrev Table Properties}). @end defun diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index b8fd5ed4345..e6def69454e 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2121,6 +2121,9 @@ with references to further information. @item numberp @xref{Predicates on Numbers, numberp}. +@item obarrayp +@xref{Creating Symbols, obarrayp}. + @item overlayp @xref{Overlays, overlayp}. @@ -2181,7 +2184,7 @@ This function returns a symbol naming the primitive type of @code{condition-variable}, @code{cons}, @code{finalizer}, @code{float}, @code{font-entity}, @code{font-object}, @code{font-spec}, @code{frame}, @code{hash-table}, @code{integer}, -@code{marker}, @code{mutex}, @code{overlay}, @code{process}, +@code{marker}, @code{mutex}, @code{obarray}, @code{overlay}, @code{process}, @code{string}, @code{subr}, @code{symbol}, @code{thread}, @code{vector}, @code{window}, or @code{window-configuration}. However, if @var{object} is a record, the type specified by its first diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index e95e53d972d..5207ea4ea7b 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -177,34 +177,16 @@ know how Lisp reads them. Lisp must ensure that it finds the same symbol every time it reads the same sequence of characters in the same context. Failure to do so would cause complete confusion. -@cindex symbol name hashing -@cindex hashing @cindex obarray -@cindex bucket (in obarray) When the Lisp reader encounters a name that references a symbol in -the source code, it reads all the characters of that name. Then it -looks up that name in a table called an @dfn{obarray} to find the -symbol that the programmer meant. The technique used in this lookup -is called ``hashing'', an efficient method of looking something up by -converting a sequence of characters to a number, known as a ``hash -code''. For example, instead of searching a telephone book cover to -cover when looking up Jan Jones, you start with the J's and go from -there. That is a simple version of hashing. Each element of the -obarray is a @dfn{bucket} which holds all the symbols with a given -hash code; to look for a given name, it is sufficient to look through -all the symbols in the bucket for that name's hash code. (The same -idea is used for general Emacs hash tables, but they are a different -data type; see @ref{Hash Tables}.) +the source code, it looks up that name in a table called an @dfn{obarray} +to find the symbol that the programmer meant. An obarray is an unordered +container of symbols, indexed by name. -When looking up names, the Lisp reader also considers ``shorthands''. +The Lisp reader also considers ``shorthands''. If the programmer supplied them, this allows the reader to find a symbol even if its name isn't present in its full form in the source -code. Of course, the reader needs to be aware of some pre-established -context about such shorthands, much as one needs context to be to able -to refer uniquely to Jan Jones by just the name ``Jan'': it's probably -fine when amongst the Joneses, or when Jan has been mentioned -recently, but very ambiguous in any other situation. -@xref{Shorthands}. +code. @xref{Shorthands}. @cindex interning If a symbol with the desired name is found, the reader uses that @@ -236,23 +218,6 @@ to gain access to it is by finding it in some other object or as the value of a variable. Uninterned symbols are sometimes useful in generating Lisp code, see below. - In Emacs Lisp, an obarray is actually a vector. Each element of the -vector is a bucket; its value is either an interned symbol whose name -hashes to that bucket, or 0 if the bucket is empty. Each interned -symbol has an internal link (invisible to the user) to the next symbol -in the bucket. Because these links are invisible, there is no way to -find all the symbols in an obarray except using @code{mapatoms} (below). -The order of symbols in a bucket is not significant. - - In an empty obarray, every element is 0, so you can create an obarray -with @code{(make-vector @var{length} 0)}. @strong{This is the only -valid way to create an obarray.} Prime numbers as lengths tend -to result in good hashing; lengths one less than a power of two are also -good. - - @strong{Do not try to put symbols in an obarray yourself.} This does -not work---only @code{intern} can enter a symbol in an obarray properly. - @cindex CL note---symbol in obarrays @quotation @b{Common Lisp note:} Unlike Common Lisp, Emacs Lisp does not provide @@ -262,9 +227,21 @@ Emacs Lisp provides a different namespacing system called ``shorthands'' (@pxref{Shorthands}). @end quotation +@defun obarray-make &optional size +This function creates and returns a new obarray. +The optional @var{size} may be used to specify the number of symbols +that it is expected to hold, but since obarrays grow automatically +as needed, this rarely provide any benefit. +@end defun + +@defun obarrayp object +This function returns @code{t} if @var{object} is an obarray, +@code{nil} otherwise. +@end defun + Most of the functions below take a name and sometimes an obarray as arguments. A @code{wrong-type-argument} error is signaled if the name -is not a string, or if the obarray is not a vector. +is not a string, or if the obarray is not an obarray object. @defun symbol-name symbol This function returns the string that is @var{symbol}'s name. For example: @@ -416,6 +393,10 @@ If @code{unintern} does delete a symbol, it returns @code{t}. Otherwise it returns @code{nil}. @end defun +@defun obarray-clear obarray +This function removes all symbols from @var{obarray}. +@end defun + @node Symbol Properties @section Symbol Properties @cindex symbol property diff --git a/etc/NEWS b/etc/NEWS index 13b41feccbc..1a5ddf0f7e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1993,6 +1993,26 @@ The 'test' parameter is omitted if it is 'eql' (the default), as is 'data' if empty. 'rehash-size', 'rehash-threshold' and 'size' are always omitted, and ignored if present when the object is read back in. +** Obarrays + ++++ +*** New obarray type. +Obarrays are now represented by an opaque type instead of using vectors. +They are created by 'obarray-make' and manage their internal storage +automatically, which means that the size parameter to 'obarray-make' can +safely be omitted. That is, they do not become slower as they fill up. + +The old vector representation is still accepted by functions operating +on obarrays, but 'obarrayp' only returns 't' for obarray objects. +'type-of' now returns 'obarray' for obarray objects. + ++++ +*** New function 'obarray-clear' removes all symbols from an obarray. + +--- +*** 'obarray-size' and 'obarray-default-size' are now obsolete. +They pertained to the internal storage size which is now irrelevant. + +++ ** 'treesit-install-language-grammar' can handle local directory instead of URL. It is now possible to pass a directory of a local repository as URL From a8f167547bc15eacaf5fbc07c1e75f603e70862d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 23 Feb 2024 13:14:18 +0100 Subject: [PATCH 327/385] Replace use of obsolete eshell-kill-output in test * test/lisp/eshell/eshell-tests.el (eshell-test/flush-output): Use eshell-delete-output instead of eshell-kill-output. --- test/lisp/eshell/eshell-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index e01e033e25e..e58b5a14ed9 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -153,7 +153,7 @@ insert the queued one at the next prompt, and finally run it." "Test flushing of previous output" (with-temp-eshell (eshell-insert-command "echo alpha") - (eshell-kill-output) + (eshell-delete-output) (should (eshell-match-output (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) From 90d3b3408e404aba383302c3147d3ca614619986 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 23 Feb 2024 13:57:04 +0100 Subject: [PATCH 328/385] Warn about docstrings with control characters It is easy to include control chars in doc strings by mistake, and the result is often an unreadable mess. * lisp/emacs-lisp/bytecomp.el (byte-compile-warning-types) (byte-compile-warnings, byte-compile--docstring-style-warn): Add `docstrings-control-chars` warning. * etc/NEWS: Announce. --- etc/NEWS | 14 ++++++++++++++ lisp/emacs-lisp/bytecomp.el | 21 +++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 1a5ddf0f7e3..6725b596ea9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1921,6 +1921,20 @@ name 'ignored-return-value'. The warning will only be issued for calls to functions declared 'important-return-value' or 'side-effect-free' (but not 'error-free'). +--- +*** Warn about docstrings that contain control characters. +The compiler now warns about docstrings with control characters other +than newline and tab. This is often a result of improper escaping. +Example: + + (defun my-fun () + "Uses c:\remote\dir\files and the key \C-x." + ...) + +where the doc string contains four control characters CR, DEL, FF and ^X. + +The warning name is 'docstrings-control-chars'. + --- *** The warning about wide docstrings can now be disabled separately. Its warning name is 'docstrings-wide'. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5d2aa3355be..c3355eedd75 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -285,6 +285,7 @@ The information is logged to `byte-compile-log-buffer'." (defconst byte-compile-warning-types '( callargs constants docstrings docstrings-non-ascii-quotes docstrings-wide + docstrings-control-chars empty-body free-vars ignored-return-value interactive-only lexical lexical-dynamic make-local mapcar ; obsolete @@ -307,6 +308,8 @@ Elements of the list may be: docstrings that are too wide, containing lines longer than both `byte-compile-docstring-max-column' and `fill-column' characters. Only enabled when `docstrings' also is. + docstrings-control-chars + docstrings that contain control characters other than NL and TAB empty-body body argument to a special form or macro is empty. free-vars references to variables not in the current lexical scope. ignored-return-value @@ -1769,6 +1772,24 @@ It is too wide if it has any lines longer than the largest of (byte-compile-warn-x name "%sdocstring wider than %s characters" (funcall prefix) col))) + + (when (byte-compile-warning-enabled-p 'docstrings-control-chars) + (let ((start 0) + (len (length docs))) + (while (and (< start len) + (string-match (rx (intersection (in (0 . 31) 127) + (not (in "\n\t")))) + docs start)) + (let* ((ofs (match-beginning 0)) + (c (aref docs ofs))) + ;; FIXME: it should be possible to use the exact source position + ;; of the control char in most cases, and it would be helpful + (byte-compile-warn-x + name + "%sdocstring contains control char #x%02x (position %d)" + (funcall prefix) c ofs) + (setq start (1+ ofs)))))) + ;; There's a "naked" ' character before a symbol/list, so it ;; should probably be quoted with \=. (when (string-match-p (rx (| (in " \t") bol) From 2b7dc7fef814753f1c6d4c352fe69bb6e167cd07 Mon Sep 17 00:00:00 2001 From: "Robert A. Burks" Date: Fri, 16 Feb 2024 18:17:52 -0500 Subject: [PATCH 329/385] Fix Flymake lighter tool-tip from generating errors Flymake tool-tip was generating errors on mouse over of mode-line lighter on inactive windows and on the minor mode indicator in the describe-mode Help page. * lisp/progmodes/flymake.el (flymake--mode-line-title): 'help-echo' now uses buffer local state and makes null check. (Bug#69248) Copyright-paperwork-exempt: yes --- lisp/progmodes/flymake.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5974f076556..db00cc59c0e 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1569,13 +1569,19 @@ correctly.") ,flymake-mode-line-lighter mouse-face mode-line-highlight help-echo - ,(lambda (&rest _) - (concat - (format "%s known backends\n" (hash-table-count flymake--state)) - (format "%s running\n" (length (flymake-running-backends))) - (format "%s disabled\n" (length (flymake-disabled-backends))) - "mouse-1: Display minor mode menu\n" - "mouse-2: Show help for minor mode")) + ,(lambda (w &rest _) + (with-current-buffer (window-buffer w) + ;; Mouse can activate tool-tip without window being active. + ;; `flymake--state' is buffer local and is null when line + ;; lighter appears in *Help* `describe-mode'. + (concat + (unless (null flymake--state) + (concat + (format "%s known backends\n" (hash-table-count flymake--state)) + (format "%s running\n" (length (flymake-running-backends))) + (format "%s disabled\n" (length (flymake-disabled-backends))))) + "mouse-1: Display minor mode menu\n" + "mouse-2: Show help for minor mode"))) keymap ,(let ((map (make-sparse-keymap))) (define-key map [mode-line down-mouse-1] From 0b855e1465b26f69156a35befebb4167145cdccf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:31:43 -0500 Subject: [PATCH 330/385] (rmail-font-lock-keywords): Avoid old-style `font-lock*-face` variables * lisp/mail/rmail.el (rmail-font-lock-keywords): Refer directly to the font-lock faces. --- lisp/mail/rmail.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 6f343c23bbe..7ebfff3d7af 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -805,8 +805,8 @@ that knows the exact ordering of the \\( \\) subexpressions.") "\\(" cite-chars "[ \t]*\\)\\)+\\)" "\\(.*\\)") (beginning-of-line) (end-of-line) - (1 font-lock-comment-delimiter-face nil t) - (5 font-lock-comment-face nil t))) + (1 'font-lock-comment-delimiter-face nil t) + (5 'font-lock-comment-face nil t))) '("^\\(X-[a-z0-9-]+\\|In-Reply-To\\|Date\\):.*\\(\n[ \t]+.*\\)*$" . 'rmail-header-name)))) "Additional expressions to highlight in Rmail mode.") From 048eaadd8cc97faf0f3e70a8d81d06f915c52081 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:37:24 -0500 Subject: [PATCH 331/385] rmail.el: Prefer #' to quote function names * lisp/mail/rmail.el (rmail-pop-to-buffer, rmail-mode-map) (rmail-mode-1, rmail-generate-viewer-buffer, rmail-variables) (rmail-find-all-files, rmail-insert-inbox-text) (rmail-set-message-counters, rmail-only-expunge, rmail-reply) (rmail-resend, rmail-fontify-buffer-function) (rmail-unfontify-buffer-function, rmail-install-speedbar-variables) (after-save-hook): Use #' where applicable. --- lisp/mail/rmail.el | 160 +++++++++++++++++++++++---------------------- 1 file changed, 81 insertions(+), 79 deletions(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7ebfff3d7af..7006d59be66 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -815,7 +815,7 @@ that knows the exact ordering of the \\( \\) subexpressions.") (defun rmail-pop-to-buffer (&rest args) "Like `pop-to-buffer', but with `split-width-threshold' set to nil." (let (split-width-threshold) - (apply 'pop-to-buffer args))) + (apply #'pop-to-buffer args))) ;; Perform BODY in the summary buffer ;; in such a way that its cursor is properly updated in its own window. @@ -1008,66 +1008,66 @@ The buffer is expected to be narrowed to just the header of the message." (defvar rmail-mode-map (let ((map (make-keymap))) (suppress-keymap map) - (define-key map "a" 'rmail-add-label) - (define-key map "b" 'rmail-bury) - (define-key map "c" 'rmail-continue) - (define-key map "d" 'rmail-delete-forward) - (define-key map "\C-d" 'rmail-delete-backward) - (define-key map "e" 'rmail-edit-current-message) + (define-key map "a" #'rmail-add-label) + (define-key map "b" #'rmail-bury) + (define-key map "c" #'rmail-continue) + (define-key map "d" #'rmail-delete-forward) + (define-key map "\C-d" #'rmail-delete-backward) + (define-key map "e" #'rmail-edit-current-message) ;; If you change this, change the rmail-resend menu-item's :keys. - (define-key map "f" 'rmail-forward) - (define-key map "g" 'rmail-get-new-mail) - (define-key map "h" 'rmail-summary) - (define-key map "i" 'rmail-input) - (define-key map "j" 'rmail-show-message) - (define-key map "k" 'rmail-kill-label) - (define-key map "l" 'rmail-summary-by-labels) - (define-key map "\e\C-h" 'rmail-summary) - (define-key map "\e\C-l" 'rmail-summary-by-labels) - (define-key map "\e\C-r" 'rmail-summary-by-recipients) - (define-key map "\e\C-s" 'rmail-summary-by-regexp) - (define-key map "\e\C-f" 'rmail-summary-by-senders) - (define-key map "\e\C-t" 'rmail-summary-by-topic) - (define-key map "m" 'rmail-mail) - (define-key map "\em" 'rmail-retry-failure) - (define-key map "n" 'rmail-next-undeleted-message) - (define-key map "\en" 'rmail-next-message) - (define-key map "\e\C-n" 'rmail-next-labeled-message) - (define-key map "o" 'rmail-output) - (define-key map "\C-o" 'rmail-output-as-seen) - (define-key map "p" 'rmail-previous-undeleted-message) - (define-key map "\ep" 'rmail-previous-message) - (define-key map "\e\C-p" 'rmail-previous-labeled-message) - (define-key map "q" 'rmail-quit) - (define-key map "r" 'rmail-reply) + (define-key map "f" #'rmail-forward) + (define-key map "g" #'rmail-get-new-mail) + (define-key map "h" #'rmail-summary) + (define-key map "i" #'rmail-input) + (define-key map "j" #'rmail-show-message) + (define-key map "k" #'rmail-kill-label) + (define-key map "l" #'rmail-summary-by-labels) + (define-key map "\e\C-h" #'rmail-summary) + (define-key map "\e\C-l" #'rmail-summary-by-labels) + (define-key map "\e\C-r" #'rmail-summary-by-recipients) + (define-key map "\e\C-s" #'rmail-summary-by-regexp) + (define-key map "\e\C-f" #'rmail-summary-by-senders) + (define-key map "\e\C-t" #'rmail-summary-by-topic) + (define-key map "m" #'rmail-mail) + (define-key map "\em" #'rmail-retry-failure) + (define-key map "n" #'rmail-next-undeleted-message) + (define-key map "\en" #'rmail-next-message) + (define-key map "\e\C-n" #'rmail-next-labeled-message) + (define-key map "o" #'rmail-output) + (define-key map "\C-o" #'rmail-output-as-seen) + (define-key map "p" #'rmail-previous-undeleted-message) + (define-key map "\ep" #'rmail-previous-message) + (define-key map "\e\C-p" #'rmail-previous-labeled-message) + (define-key map "q" #'rmail-quit) + (define-key map "r" #'rmail-reply) ;; I find I can't live without the default M-r command -- rms. - ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) - (define-key map "s" 'rmail-expunge-and-save) - (define-key map "\es" 'rmail-search) - (define-key map "t" 'rmail-toggle-header) - (define-key map "u" 'rmail-undelete-previous-message) - (define-key map "v" 'rmail-mime) - (define-key map "w" 'rmail-output-body-to-file) - (define-key map "\C-c\C-w" 'rmail-widen) - (define-key map "x" 'rmail-expunge) - (define-key map "." 'rmail-beginning-of-message) - (define-key map "/" 'rmail-end-of-message) - (define-key map "<" 'rmail-first-message) - (define-key map ">" 'rmail-last-message) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\177" 'scroll-down-command) - (define-key map "?" 'describe-mode) - (define-key map "\C-c\C-d" 'rmail-epa-decrypt) - (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) - (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) - (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author) - (define-key map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) - (define-key map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) - (define-key map "\C-c\C-s\C-l" 'rmail-sort-by-lines) - (define-key map "\C-c\C-s\C-k" 'rmail-sort-by-labels) - (define-key map "\C-c\C-n" 'rmail-next-same-subject) - (define-key map "\C-c\C-p" 'rmail-previous-same-subject) + ;; (define-key rmail-mode-map "\er" #'rmail-search-backwards) + (define-key map "s" #'rmail-expunge-and-save) + (define-key map "\es" #'rmail-search) + (define-key map "t" #'rmail-toggle-header) + (define-key map "u" #'rmail-undelete-previous-message) + (define-key map "v" #'rmail-mime) + (define-key map "w" #'rmail-output-body-to-file) + (define-key map "\C-c\C-w" #'rmail-widen) + (define-key map "x" #'rmail-expunge) + (define-key map "." #'rmail-beginning-of-message) + (define-key map "/" #'rmail-end-of-message) + (define-key map "<" #'rmail-first-message) + (define-key map ">" #'rmail-last-message) + (define-key map " " #'scroll-up-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map "\177" #'scroll-down-command) + (define-key map "?" #'describe-mode) + (define-key map "\C-c\C-d" #'rmail-epa-decrypt) + (define-key map "\C-c\C-s\C-d" #'rmail-sort-by-date) + (define-key map "\C-c\C-s\C-s" #'rmail-sort-by-subject) + (define-key map "\C-c\C-s\C-a" #'rmail-sort-by-author) + (define-key map "\C-c\C-s\C-r" #'rmail-sort-by-recipient) + (define-key map "\C-c\C-s\C-c" #'rmail-sort-by-correspondent) + (define-key map "\C-c\C-s\C-l" #'rmail-sort-by-lines) + (define-key map "\C-c\C-s\C-k" #'rmail-sort-by-labels) + (define-key map "\C-c\C-n" #'rmail-next-same-subject) + (define-key map "\C-c\C-p" #'rmail-previous-same-subject) (define-key map [menu-bar] (make-sparse-keymap)) @@ -1344,9 +1344,9 @@ Instead, these commands are available: (setq local-abbrev-table text-mode-abbrev-table) ;; Functions to support buffer swapping: (add-hook 'write-region-annotate-functions - 'rmail-write-region-annotate nil t) - (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t) - (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t)) + #'rmail-write-region-annotate nil t) + (add-hook 'kill-buffer-hook #'rmail-mode-kill-buffer-hook nil t) + (add-hook 'change-major-mode-hook #'rmail-change-major-mode-hook nil t)) (defun rmail-generate-viewer-buffer () "Return a reusable buffer suitable for viewing messages. @@ -1363,7 +1363,7 @@ Create the buffer if necessary." (file-name-nondirectory (or buffer-file-name (buffer-name))))))) (with-current-buffer newbuf - (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t)) + (add-hook 'kill-buffer-hook #'rmail-view-buffer-kill-buffer-hook nil t)) newbuf))) (defun rmail-swap-buffers () @@ -1479,7 +1479,7 @@ If so restore the actual mbox message collection." ;; Don't turn off auto-saving based on the size of the buffer ;; because that code does not understand buffer-swapping. (setq-local auto-save-include-big-deletions t) - (setq-local revert-buffer-function 'rmail-revert) + (setq-local revert-buffer-function #'rmail-revert) (setq-local font-lock-defaults '(rmail-font-lock-keywords t t nil nil @@ -1490,7 +1490,7 @@ If so restore the actual mbox message collection." (setq-local file-precious-flag t) (setq-local desktop-save-buffer t) (setq-local save-buffer-coding-system 'no-conversion) - (setq next-error-move-function 'rmail-next-error-move)) + (setq next-error-move-function #'rmail-next-error-move)) ;; Handle M-x revert-buffer done in an rmail-mode buffer. (defun rmail-revert (arg noconfirm) @@ -1606,7 +1606,7 @@ The duplicate copy goes into the Rmail file just after the original." (files (directory-files start t rmail-secondary-file-regexp))) ;; Sort here instead of in directory-files ;; because this list is usually much shorter. - (sort files 'string<)))) + (sort files #'string<)))) (defun rmail-list-to-menu (menu-name l action &optional full-name) (let ((menu (make-sparse-keymap menu-name)) @@ -2026,7 +2026,7 @@ Value is the size of the newly read mail after conversion." rmail-movemail-flags) (list file tofile) (if password (list password) nil)))) - (apply 'call-process args)) + (apply #'call-process args)) (if (not (buffer-modified-p errors)) ;; No output => movemail won nil @@ -2518,7 +2518,7 @@ Output a helpful message unless NOMSG is non-nil." ;; which will never be used. (push nil messages-head) (push ?0 deleted-head) - (setq rmail-message-vector (apply 'vector messages-head) + (setq rmail-message-vector (apply #'vector messages-head) rmail-deleted-vector (concat deleted-head)) (setq rmail-summary-vector (make-vector rmail-total-messages nil) @@ -3605,10 +3605,10 @@ If `rmail-confirm-expunge' is non-nil, ask user to confirm." (cons (aref messages number) nil))) (setq rmail-current-message new-message-number rmail-total-messages counter - rmail-message-vector (apply 'vector messages-head) + rmail-message-vector (apply #'vector messages-head) rmail-deleted-vector (make-string (1+ counter) ?\s) rmail-summary-vector (vconcat (nreverse new-summary)) - rmail-msgref-vector (apply 'vector (nreverse new-msgref)) + rmail-msgref-vector (apply #'vector (nreverse new-msgref)) win t))) (message "Expunging deleted messages...done") (if (not win) @@ -3891,7 +3891,7 @@ use \\[mail-yank-original] to yank the original message into it." (if (or references message-id) (list (cons "References" (if references (concat - (mapconcat 'identity references " ") + (mapconcat #'identity references " ") " " message-id) message-id))))))) @@ -4089,7 +4089,7 @@ typically for purposes of moderating a list." (insert "Resent-Bcc: " (user-login-name) "\n")) (insert "Resent-To: " (if (stringp address) address - (mapconcat 'identity address ",\n\t")) + (mapconcat #'identity address ",\n\t")) "\n") ;; Expand abbrevs in the recipients. (save-excursion @@ -4335,7 +4335,7 @@ This has an effect only if a summary buffer exists." (defun rmail-fontify-buffer-function () ;; This function's symbol is bound to font-lock-fontify-buffer-function. - (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) + (add-hook 'rmail-show-message-hook #'rmail-fontify-message nil t) ;; If we're already showing a message, fontify it now. (if rmail-current-message (rmail-fontify-message)) ;; Prevent Font Lock mode from kicking in. @@ -4346,7 +4346,7 @@ This has an effect only if a summary buffer exists." (with-silent-modifications (save-restriction (widen) - (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) + (remove-hook 'rmail-show-message-hook #'rmail-fontify-message t) (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) (font-lock-default-unfontify-buffer)))) @@ -4381,11 +4381,12 @@ browsing, and moving of messages." "Install those variables used by speedbar to enhance rmail." (unless rmail-speedbar-key-map (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) - (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) - (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) - (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) + (declare-function speedbar-edit-line "speedbar") + (define-key rmail-speedbar-key-map "e" #'speedbar-edit-line) + (define-key rmail-speedbar-key-map "r" #'speedbar-edit-line) + (define-key rmail-speedbar-key-map "\C-m" #'speedbar-edit-line) (define-key rmail-speedbar-key-map "M" - 'rmail-speedbar-move-message-to-folder-on-line))) + #'rmail-speedbar-move-message-to-folder-on-line))) ;; Mouse-3. (defvar rmail-speedbar-menu-items @@ -4829,7 +4830,8 @@ Content-Transfer-Encoding: base64\n") (with-current-buffer (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer) (setq buffer-file-coding-system rmail-message-encoding)))) -(add-hook 'after-save-hook 'rmail-after-save-hook) +;; FIXME: Don't do it globally!! +(add-hook 'after-save-hook #'rmail-after-save-hook) ;;; Mailing list support From 3599a9a1cf1f8bed7c7f00fd8f00b2bfc0c4271f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 11:38:48 -0500 Subject: [PATCH 332/385] * lisp/mail/rmail.el (rmail-resend): Use `with-syntax-table` --- lisp/mail/rmail.el | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7006d59be66..d422383acdf 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4095,20 +4095,18 @@ typically for purposes of moderating a list." (save-excursion (if (featurep 'mailabbrev) (let ((end (point-marker)) - (local-abbrev-table mail-abbrevs) - (old-syntax-table (syntax-table))) + (local-abbrev-table mail-abbrevs)) (if (and (not (obarrayp mail-abbrevs)) (file-exists-p mail-personal-alias-file)) (build-mail-abbrevs)) (unless mail-abbrev-syntax-table (mail-abbrev-make-syntax-table)) - (set-syntax-table mail-abbrev-syntax-table) - (goto-char before) - (while (and (< (point) end) - (progn (forward-word-strictly 1) - (<= (point) end))) - (expand-abbrev)) - (set-syntax-table old-syntax-table)) + (with-syntax-table mail-abbrev-syntax-table + (goto-char before) + (while (and (< (point) end) + (progn (forward-word-strictly 1) + (<= (point) end))) + (expand-abbrev)))) (expand-mail-aliases before (point))))) ;;>> Set up comment, if any. (if (and (sequencep comment) (not (zerop (length comment)))) From 84f72f19e514db8f8f6e469340fb5fa0719d40b6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 16:46:01 -0500 Subject: [PATCH 333/385] elisp-mode.el: Use `handler-bind` instead of `debug-on-error` * lisp/progmodes/elisp-mode.el (elisp-enable-lexical-binding): Don't get fooled by a global binding of `lexical-binding` to t. (elisp--eval-last-sexp-fake-value): Delete var. (elisp--eval-defun): Don't let-bind `debug-on-error` since it's already arranged by the only caller. (eval-last-sexp, eval-defun): Use `handler-bind` instead of `debug-on-error`. --- lisp/progmodes/elisp-mode.el | 38 ++++++++++++------------------------ 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index e0c18214ef7..4b1f8022f81 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -309,7 +309,7 @@ Comments in the form will be lost." INTERACTIVE non-nil means ask the user for confirmation; this happens in interactive invocations." (interactive "p") - (if lexical-binding + (if (and (local-variable-p 'lexical-binding) lexical-binding) (when interactive (message "lexical-binding already enabled!") (ding)) @@ -371,6 +371,12 @@ be used instead. ;; Font-locking support. +(defun elisp--font-lock-shorthand (_limit) + ;; Add faces on shorthands between point and LIMIT. + ;; ... + ;; Return nil to tell font-lock, that there's nothing left to do. + nil) + (defun elisp--font-lock-flush-elisp-buffers (&optional file) ;; We're only ever called from after-load-functions, load-in-progress can ;; still be t in case of nested loads. @@ -1582,9 +1588,6 @@ character)." (buffer-substring-no-properties beg end)) )))) - -(defvar elisp--eval-last-sexp-fake-value (make-symbol "t")) - (defun eval-sexp-add-defvars (exp &optional pos) "Prepend EXP with all the `defvar's that precede it in the buffer. POS specifies the starting position where EXP was found and defaults to point." @@ -1626,16 +1629,9 @@ integer value is also printed as a character of that codepoint. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") - (if (null eval-expression-debug-on-error) - (values--store-value - (elisp--eval-last-sexp eval-last-sexp-arg-internal)) - (let ((value - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) - debug-on-error)))) - (unless (eq (cdr value) elisp--eval-last-sexp-fake-value) - (setq debug-on-error (cdr value))) - (car value)))) + (values--store-value + (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) "Treat some expressions in FORM specially. @@ -1694,8 +1690,7 @@ Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. (defvar elisp--eval-defun-result) - (let ((debug-on-error eval-expression-debug-on-error) - (edebugging edebug-all-defs) + (let ((edebugging edebug-all-defs) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1774,15 +1769,8 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (if (null eval-expression-debug-on-error) - (elisp--eval-defun) - (let (new-value value) - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (setq value (elisp--eval-defun)) - (setq new-value debug-on-error)) - (unless (eq elisp--eval-last-sexp-fake-value new-value) - (setq debug-on-error new-value)) - value))))) + (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (elisp--eval-defun))))) ;;; ElDoc Support From 26290870b3505b8971c73fe3a82b69e3c4e86b88 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Feb 2024 17:03:10 -0500 Subject: [PATCH 334/385] diff-mode.el (diff-refine-nonmodified): New option * lisp/vc/diff-mode.el (diff-font-lock-keywords): Refer directly to font-lock faces. (diff-apply-hunk): Use `user-error` for errors usually not due to bugs. (diff--refine-propertize): New function. (diff-refine-nonmodified): New custom var (bug#61396). (diff--refine-hunk): Use them. --- etc/NEWS | 5 +++++ lisp/vc/diff-mode.el | 51 ++++++++++++++++++++++++++++++++------------ 2 files changed, 42 insertions(+), 14 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6725b596ea9..5653b51784f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -596,6 +596,11 @@ It allows tweaking the thresholds for rename and copy detection. ** Diff mode +--- +*** New user option 'diff-refine-nonmodified'. +Makes 'diff-refine' highlight added and removed whole lines with the +same faces as the words added and removed within modified lines. + +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. When called with a non-nil prefix argument, diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 34a4b70691d..f914cc76790 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -517,8 +517,8 @@ use the face `diff-removed' for removed lines, and the face ("^Only in .*\n" . 'diff-nonexistent) ("^Binary files .* differ\n" . 'diff-file-header) ("^\\(#\\)\\(.*\\)" - (1 font-lock-comment-delimiter-face) - (2 font-lock-comment-face)) + (1 'font-lock-comment-delimiter-face) + (2 'font-lock-comment-face)) ("^diff: .*" (0 'diff-error)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) (,#'diff--font-lock-syntax) @@ -944,7 +944,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")." (when (and (string-match (concat "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n" "\\1\\(.*\\)\\3\n" - "\\(.*\\(\\2\\).*\\)\\'") str) + "\\(.*\\(\\2\\).*\\)\\'") + str) (equal to (match-string 5 str))) (concat (substring str (match-beginning 5) (match-beginning 6)) (match-string 4 str) @@ -1999,7 +2000,7 @@ With a prefix argument, REVERSE the hunk." (diff-find-source-location nil reverse))) (cond ((null line-offset) - (error "Can't find the text to patch")) + (user-error "Can't find the text to patch")) ((with-current-buffer buf (and buffer-file-name (backup-file-name-p buffer-file-name) @@ -2008,7 +2009,7 @@ With a prefix argument, REVERSE the hunk." (yes-or-no-p (format "Really apply this hunk to %s? " (file-name-nondirectory buffer-file-name))))))) - (error "%s" + (user-error "%s" (substitute-command-keys (format "Use %s\\[diff-apply-hunk] to apply it to the other file" (if (not reverse) "\\[universal-argument] "))))) @@ -2275,6 +2276,18 @@ Return new point, if it was moved." (end (progn (diff-end-of-hunk) (point)))) (diff--refine-hunk beg end))))) +(defun diff--refine-propertize (beg end face) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff-mode 'fine) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face face))) + +(defcustom diff-refine-nonmodified nil + "If non-nil also highlight as \"refined\" the added/removed lines. +This is currently only implemented for `unified' diffs." + :version "30.1" + :type 'boolean) + (defun diff--refine-hunk (start end) (require 'smerge-mode) (goto-char start) @@ -2289,18 +2302,28 @@ Return new point, if it was moved." (goto-char beg) (pcase style ('unified - (while (re-search-forward "^-" end t) + (while (re-search-forward "^[-+]" end t) (let ((beg-del (progn (beginning-of-line) (point))) beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) + (cond + ((eq (char-after) ?+) + (diff--forward-while-leading-char ?+ end) + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) 'diff-refine-added))) + ((and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) (smerge-refine-regions beg-del beg-add beg-add end-add - nil #'diff-refine-preproc props-r props-a))))) + nil #'diff-refine-preproc props-r props-a)) + (t ;; If we're here, it's because + ;; (diff--forward-while-leading-char ?+ end) failed. + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) + 'diff-refine-removed))))))) ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) From 65d4bf711055dc8d23cea9b2ec8a57cdbfa6cf05 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 24 Feb 2024 10:01:03 +0800 Subject: [PATCH 335/385] ; * .dir-locals.el (java-mode): Transfer suitable c-mode options. --- .dir-locals.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.dir-locals.el b/.dir-locals.el index 89fb76a55f3..1a6acecc206 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -23,6 +23,11 @@ (electric-quote-string . nil) (indent-tabs-mode . t) (mode . bug-reference-prog))) + (java-mode . ((c-file-style . "GNU") + (electric-quote-comment . nil) + (electric-quote-string . nil) + (indent-tabs-mode . t) + (mode . bug-reference-prog))) (objc-mode . ((c-file-style . "GNU") (electric-quote-comment . nil) (electric-quote-string . nil) From 8d5983aa78e36afa815325e7bce85a81d314e67b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 24 Feb 2024 10:01:57 +0800 Subject: [PATCH 336/385] Fix bug#69321 * java/org/gnu/emacs/EmacsWindow.java (onKeyDown, onKeyUp): Provide Right Alt (Alt Gr) masks to system keymap routines. (bug#69321) --- java/org/gnu/emacs/EmacsWindow.java | 68 ++++++++++++++++++++--------- 1 file changed, 48 insertions(+), 20 deletions(-) diff --git a/java/org/gnu/emacs/EmacsWindow.java b/java/org/gnu/emacs/EmacsWindow.java index 427a1a92332..6e8bdaf7401 100644 --- a/java/org/gnu/emacs/EmacsWindow.java +++ b/java/org/gnu/emacs/EmacsWindow.java @@ -661,7 +661,7 @@ private static class Coordinate public void onKeyDown (int keyCode, KeyEvent event) { - int state, state_1, num_lock_flag; + int state, state_1, extra_ignored; long serial; String characters; @@ -682,23 +682,37 @@ private static class Coordinate state = eventModifiers (event); - /* Num Lock and Scroll Lock aren't supported by systems older than - Android 3.0. */ + /* Num Lock, Scroll Lock and Meta aren't supported by systems older + than Android 3.0. */ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) - num_lock_flag = (KeyEvent.META_NUM_LOCK_ON - | KeyEvent.META_SCROLL_LOCK_ON); + extra_ignored = (KeyEvent.META_NUM_LOCK_ON + | KeyEvent.META_SCROLL_LOCK_ON + | KeyEvent.META_META_MASK); else - num_lock_flag = 0; + extra_ignored = 0; /* Ignore meta-state understood by Emacs for now, or key presses - such as Ctrl+C and Meta+C will not be recognized as an ASCII - key press event. */ + such as Ctrl+C and Meta+C will not be recognized as ASCII key + press events. */ state_1 = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK - | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK - | num_lock_flag); + | KeyEvent.META_SYM_ON | extra_ignored); + + /* There's no distinction between Right Alt and Alt Gr on Android, + so restore META_ALT_RIGHT_ON if set in state to enable composing + characters. (bug#69321) */ + + if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0) + { + state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON; + + /* If Alt is also not depressed, remove its bit from the mask + reported to Emacs. */ + if ((state & KeyEvent.META_ALT_LEFT_ON) == 0) + state &= ~KeyEvent.META_ALT_MASK; + } synchronized (eventStrings) { @@ -719,29 +733,43 @@ private static class Coordinate public void onKeyUp (int keyCode, KeyEvent event) { - int state, state_1, unicode_char, num_lock_flag; + int state, state_1, unicode_char, extra_ignored; long time; /* Compute the event's modifier mask. */ state = eventModifiers (event); - /* Num Lock and Scroll Lock aren't supported by systems older than - Android 3.0. */ + /* Num Lock, Scroll Lock and Meta aren't supported by systems older + than Android 3.0. */ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB) - num_lock_flag = (KeyEvent.META_NUM_LOCK_ON - | KeyEvent.META_SCROLL_LOCK_ON); + extra_ignored = (KeyEvent.META_NUM_LOCK_ON + | KeyEvent.META_SCROLL_LOCK_ON + | KeyEvent.META_META_MASK); else - num_lock_flag = 0; + extra_ignored = 0; /* Ignore meta-state understood by Emacs for now, or key presses - such as Ctrl+C and Meta+C will not be recognized as an ASCII - key press event. */ + such as Ctrl+C and Meta+C will not be recognized as ASCII key + press events. */ state_1 = state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK - | KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK - | num_lock_flag); + | KeyEvent.META_SYM_ON | extra_ignored); + + /* There's no distinction between Right Alt and Alt Gr on Android, + so restore META_ALT_RIGHT_ON if set in state to enable composing + characters. */ + + if ((state & KeyEvent.META_ALT_RIGHT_ON) != 0) + { + state_1 |= KeyEvent.META_ALT_ON | KeyEvent.META_ALT_RIGHT_ON; + + /* If Alt is also not depressed, remove its bit from the mask + reported to Emacs. */ + if ((state & KeyEvent.META_ALT_LEFT_ON) == 0) + state &= ~KeyEvent.META_ALT_MASK; + } unicode_char = getEventUnicodeChar (event, state_1); From 56706254a8ee09e651097fb5075cae75b3bd4e22 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 21 Feb 2024 20:08:37 -0800 Subject: [PATCH 337/385] ; Don't mention erc-branded Compat macros in ERC-NEWS * doc/misc/erc.texi: Change fancy SASL example to also demonstrate `let'-binding a local module. * etc/ERC-NEWS: Don't mention `erc-compat-call' and `erc-compat-function' because Emacs now ships with a compat.el stub library. * lisp/erc/erc-backend.el (erc-decode-parsed-server-response): Add comments. * lisp/erc/erc.el (erc): Mention return value. --- doc/misc/erc.texi | 33 +++++++++++++++++++-------------- etc/ERC-NEWS | 2 -- lisp/erc/erc-backend.el | 2 ++ lisp/erc/erc.el | 5 +++-- 4 files changed, 24 insertions(+), 18 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index f877fb681fe..c7ab7e7bf21 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -1230,25 +1230,30 @@ machine Example.Net login aph-bot password sesame (defun my-erc-up (network) (interactive "Snetwork: ") - - (pcase network - ('libera - (let ((erc-sasl-mechanism 'external)) - (erc-tls :server "irc.libera.chat" :port 6697 - :client-certificate t))) - ('example - (let ((erc-sasl-auth-source-function - #'erc-sasl-auth-source-password-as-host)) - (erc-tls :server "irc.example.net" :port 6697 - :user "alyssa" - :password "Example.Net"))))) + (require 'erc-sasl) + (or (let ((erc-modules (cons 'sasl erc-modules))) + (pcase network + ('libera + (let ((erc-sasl-mechanism 'external)) + (erc-tls :server "irc.libera.chat" + :client-certificate t))) + ('example + (let ((erc-sasl-auth-source-function + #'erc-sasl-auth-source-password-as-host)) + (erc-tls :server "irc.example.net" + :user "alyssa" + :password "Example.Net"))))) + ;; Non-SASL + (call-interactively #'erc-tls))) @end lisp You've started storing your credentials with auth-source and have decided to try SASL on another network as well. But there's a catch: this network doesn't support @samp{EXTERNAL}. You use -@code{let}-binding to get around this and successfully authenticate to -both networks. +@code{let}-binding to work around this and successfully authenticate +to both networks. (Note that this example assumes you've removed +@code{sasl} from @code{erc-modules} globally and have instead opted to +add it locally when connecting to preconfigured networks.) @end itemize diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b2aceaa9f39..e8082582de3 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -694,8 +694,6 @@ by toggling a provided compatibility switch. See source code around the function 'erc-send-action' for details. *** Miscellaneous changes -Two helper macros from GNU ELPA's Compat library are now available to -third-party modules as 'erc-compat-call' and 'erc-compat-function'. 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-backend.el b/lisp/erc/erc-backend.el index 7b782d0ef44..9fc8a4d29f4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1479,10 +1479,12 @@ for decoding." (let ((args (erc-response.command-args parsed-response)) (decode-target nil) (decoded-args ())) + ;; FIXME this should stop after the first match. (dolist (arg args nil) (when (string-match "^[#&].*" arg) (setq decode-target arg))) (when (stringp decode-target) + ;; FIXME `decode-target' should be passed as TARGET. (setq decode-target (erc-decode-string-from-target decode-target nil))) (setf (erc-response.unparsed parsed-response) (erc-decode-string-from-target diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f250584e47a..5c8b3785bc6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2772,8 +2772,9 @@ PORT, NICK, and PASSWORD, along with USER and FULL-NAME when given a prefix argument. Non-interactively, expect the rarely needed ID parameter, when non-nil, to be a symbol or a string for naming the server buffer and identifying the connection -unequivocally. (See Info node `(erc) Connecting' for details -about all mentioned parameters.) +unequivocally. Once connected, return the server buffer. (See +Info node `(erc) Connecting' for details about all mentioned +parameters.) Together with `erc-tls', this command serves as the main entry point for ERC, the powerful, modular, and extensible IRC client. From 15a140a24664e96620838136640d660f842dfa49 Mon Sep 17 00:00:00 2001 From: Emanuel Berg Date: Tue, 23 Jan 2024 14:21:49 +0100 Subject: [PATCH 338/385] Make erc-cmd-AMSG session local; add /GMSG, /AME and /GME * etc/ERC-NEWS: Mention new slash commands. * lisp/erc/erc.el (erc-cmd-AMSG): Make it consistent with the doc string by only affecting the current connection. (erc-cmd-GMSG, erc-cmd-AME, erc-cmd-GME): New IRC slash commands. * test/lisp/erc/erc-scenarios-misc-commands.el (erc-scenarios-misc-commands--AMSG-GMSG-AME-GME): New test. * test/lisp/erc/resources/commands/amsg-barnet.eld: New file. * test/lisp/erc/resources/commands/amsg-foonet.eld: New file. (Bug#68401) --- etc/ERC-NEWS | 9 +- lisp/erc/erc.el | 38 ++++++-- test/lisp/erc/erc-scenarios-misc-commands.el | 90 +++++++++++++++++++ .../erc/resources/commands/amsg-barnet.eld | 54 +++++++++++ .../erc/resources/commands/amsg-foonet.eld | 56 ++++++++++++ 5 files changed, 239 insertions(+), 8 deletions(-) create mode 100644 test/lisp/erc/resources/commands/amsg-barnet.eld create mode 100644 test/lisp/erc/resources/commands/amsg-foonet.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index e8082582de3..d7f513addfb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -334,6 +334,11 @@ has changed in some way. At present, ERC does not perform this step automatically on your behalf, even if a change was made in a 'Custom-mode' buffer or via 'setopt'. +** New broadcast-oriented slash commands /AME, /GME, and /GMSG. +Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME', +and 'erc-cmd-GMSG', these new slash commands can prove handy in test +environments. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -1375,7 +1380,7 @@ reconnection attempts that ERC will make per server. in seconds, that ERC will wait between successive reconnect attempts. *** erc-server-send-ping-timeout: Determines when to consider a connection -stalled and restart it. The default is after 120 seconds. +stalled and restart it. The default is after 120 seconds. *** erc-system-name: Determines the system name to use when logging in. The default is to figure this out by calling `system-name'. @@ -2336,7 +2341,7 @@ in XEmacs. Please use M-x customize-variable RET erc-modules RET to change the default if it does not suite your needs. -** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers +** The symbol used in `erc-nickserv-passwords' for debian.org IRC servers (formerly called OpenProjects, now FreeNode) has changed from openprojects to freenode. You may need to update your configuration for a successful automatic nickserv identification. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5c8b3785bc6..cce3b2508fb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4046,16 +4046,42 @@ this function from interpreting the line as a command." ;; Input commands handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun erc-cmd-AMSG (line) - "Send LINE to all channels of the current server that you are on." - (interactive "sSend to all channels you're on: ") - (setq line (erc-trim-string line)) +(defun erc--connected-and-joined-p () + (and (erc--current-buffer-joined-p) + erc-server-connected)) + +(defun erc-cmd-GMSG (line) + "Send LINE to all channels on all networks you are on." + (setq line (string-remove-prefix " " line)) (erc-with-all-buffers-of-server nil - (lambda () - (erc-channel-p (erc-default-target))) + #'erc--connected-and-joined-p + (erc-send-message line))) +(put 'erc-cmd-GMSG 'do-not-parse-args t) + +(defun erc-cmd-AMSG (line) + "Send LINE to all channels of the current network. +Interactively, prompt for the line of text to send." + (interactive "sSend to all channels on this network: ") + (setq line (string-remove-prefix " " line)) + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p (erc-send-message line))) (put 'erc-cmd-AMSG 'do-not-parse-args t) +(defun erc-cmd-GME (line) + "Send LINE as an action to all channels on all networks you are on." + (erc-with-all-buffers-of-server nil + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-GME 'do-not-parse-args t) + +(defun erc-cmd-AME (line) + "Send LINE as an action to all channels on the current network." + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-AME 'do-not-parse-args t) + (defun erc-cmd-SAY (line) "Send LINE to the current query or channel as a message, not a command. diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el index d6ed53b5358..da6855caf57 100644 --- a/test/lisp/erc/erc-scenarios-misc-commands.el +++ b/test/lisp/erc/erc-scenarios-misc-commands.el @@ -123,4 +123,94 @@ (should (string= (erc-server-user-host (erc-get-server-user "tester")) "some.host.test.cc")))))) +;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME, +;; the latter three introduced by bug#68401. It mainly asserts +;; correct routing behavior, especially not sending or inserting +;; messages in buffers belonging to disconnected sessions. Left +;; unaddressed are interactions with the `command-indicator' module +;; (`erc-noncommands-list') and whatever future `echo-message' +;; implementation manifests out of bug#49860. +(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "commands") + (erc-server-flood-penalty 0.1) + (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet)) + (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet and join #foo") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-foonet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#foo"))) + + (ert-info ("Connect to barnet and join #bar") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-barnet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#bar"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + (funcall expect 10 "welcome")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) + (funcall expect 10 "welcome")) + + (ert-info ("/AMSG only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/amsg 1 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/amsg 2 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 " 1 foonet only") + (funcall expect 10 " bob: Our queen and all")) + (with-current-buffer "#bar" + (funcall expect 10 " 2 barnet only") + (funcall expect 10 " mike: And secretly to greet"))) + + (ert-info ("/AME only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/ame 3 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/ame 4 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 "* tester 3 foonet only") + (funcall expect 10 " bob: You have discharged this")) + (with-current-buffer "#bar" + (funcall expect 10 "* tester 4 barnet only") + (funcall expect 10 " mike: That same Berowne"))) + + (ert-info ("/GMSG and /GME sent to all servers") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 5 all nets") + (erc-scenarios-common-say "/gme 6 all nets")) + (with-current-buffer "#bar" + (funcall expect 10 " 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 " mike: Mehercle! if their sons"))) + + (ert-info ("/GMSG and /GME only sent to connected servers") + (with-current-buffer "barnet" + (erc-cmd-QUIT "") + (funcall expect 10 "ERC finished")) + (with-current-buffer "#foo" + (funcall expect 10 " 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 " bob: Stand you!")) + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 7 all live nets") + (erc-scenarios-common-say "/gme 8 all live nets")) + ;; Message *not* inserted in disconnected buffer. + (with-current-buffer "#bar" + (funcall expect -0.1 " 7 all live nets") + (funcall expect -0.1 "* tester 8 all live nets"))) + + (with-current-buffer "#foo" + (funcall expect 10 " 7 all live nets") + (funcall expect 10 "* tester 8 all live nets") + (funcall expect 10 " alice: Live, and be prosperous;")))) + ;;; erc-scenarios-misc-commands.el ends here diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld b/test/lisp/erc/resources/commands/amsg-barnet.eld new file mode 100644 index 00000000000..53b3e18651a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-barnet.eld @@ -0,0 +1,54 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") + (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC") + (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.barnet.org 252 tester 0 :IRC Operators online") + (0 ":irc.barnet.org 253 tester 0 :unregistered connections") + (0 ":irc.barnet.org 254 tester 1 :channels formed") + (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.barnet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.barnet.org 221 tester +i") + (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #bar") + (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar") + (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester") + (0 ":irc.barnet.org 366 tester #bar :End of NAMES list")) + +((mode-bar 10 "MODE #bar") + (0 ":irc.barnet.org 324 tester #bar +nt") + (0 ":irc.barnet.org 329 tester #bar 1620104779") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now.")) + +((privmsg-2 10 "PRIVMSG #bar :2 barnet only") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends.")) + +((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go.")) + +((privmsg-5 10 "PRIVMSG #bar :5 all nets")) + +((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us.")) + +((quit 5 "QUIT :\2ERC\2") + (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld b/test/lisp/erc/resources/commands/amsg-foonet.eld new file mode 100644 index 00000000000..eb3d84d646a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-foonet.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") + (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0 ":irc.foonet.org 254 tester 1 :channels formed") + (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.foonet.org 221 tester +i") + (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #foo") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo") + (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob") + (0 ":irc.foonet.org 366 tester #foo :End of NAMES list")) + +((mode-foo 10 "MODE #foo") + (0 ":irc.foonet.org 324 tester #foo +nt") + (0 ":irc.foonet.org 329 tester #foo 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden.")) + +((privmsg-1 10 "PRIVMSG #foo :1 foonet only") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon.")) + +((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")) + +((privmsg-5 10 "PRIVMSG #foo :5 all nets")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")) + +((privmsg-6 10 "PRIVMSG #foo :7 all live nets") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow.")) From c7a2b7d023dfef78f6cb6f00fc8194ce8eaaf8a4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 24 Feb 2024 11:09:05 +0800 Subject: [PATCH 339/385] * configure.ac: Detect renameat2 with gl_CHECK_FUNCS_ANDROID. --- configure.ac | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 71a899f5f40..452aa0838f1 100644 --- a/configure.ac +++ b/configure.ac @@ -5907,13 +5907,15 @@ pthread_sigmask strsignal setitimer \ sendto recvfrom getsockname getifaddrs freeifaddrs \ gai_strerror sync \ endpwent getgrent endgrent \ -renameat2 \ cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \ pthread_set_name_np]) # getpwent is not present in older versions of Android. (bug#65319) gl_CHECK_FUNCS_ANDROID([getpwent], [[#include ]]) +# renameat2 is not present in older versions of Android. +gl_CHECK_FUNCS_ANDROID([renameat2], [[#include ]]) + if test "$ac_cv_func_cfmakeraw" != "yes"; then # On some systems (Android), cfmakeraw is inline, so AC_CHECK_FUNCS # cannot find it. Check if some code including termios.h and using From 15b6d72599b961ebe23e820e44ba2ffc12e49c31 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 09:21:35 +0200 Subject: [PATCH 340/385] ; * etc/NEWS: How to fix old code that uses vectors as obarrays. --- etc/NEWS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 5653b51784f..6acafe6ea4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2025,6 +2025,14 @@ The old vector representation is still accepted by functions operating on obarrays, but 'obarrayp' only returns 't' for obarray objects. 'type-of' now returns 'obarray' for obarray objects. +If you have code which creates obarrays as a simple Lisp vector: + + (make-vector N nil) + +and then calls 'intern' using such an obarray as second argument, this +will now signal a wrong-type-argument error; replace nil with zero to +make it work again. + +++ *** New function 'obarray-clear' removes all symbols from an obarray. From 8b1f10f8cf473cdc57e780845393d8681ee2ed4c Mon Sep 17 00:00:00 2001 From: Morgan Smith Date: Fri, 23 Feb 2024 19:03:13 -0500 Subject: [PATCH 341/385] ; Normalize Morgan Smith's attributions. --- .mailmap | 2 +- admin/authors.el | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.mailmap b/.mailmap index 5e733728b5a..32f56c07e1e 100644 --- a/.mailmap +++ b/.mailmap @@ -126,7 +126,7 @@ Maxim Nikulin Michael Albinus Michalis V Miha Rihtaršič -Morgan J. Smith +Morgan Smith Nick Drozd Nicolas Petton Nitish Chandra diff --git a/admin/authors.el b/admin/authors.el index 083023a3dad..78a047f14a4 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -199,6 +199,7 @@ files.") ("Mikio Nakajima" "Nakajima Mikio") (nil "montag451@laposte\\.net") (nil "na@aisrntairetnraoitn") + ("Morgan Smith" "Morgan J. Smith") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") ("Noorul Islam" "Noorul Islam K M") From afe49c7e2a2340432418df264f93d8ac88bca95f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 09:32:06 +0200 Subject: [PATCH 342/385] ; * admin/authors.el (authors-aliases): Fix last change. --- admin/authors.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/authors.el b/admin/authors.el index 78a047f14a4..3764c16adf0 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -199,7 +199,7 @@ files.") ("Mikio Nakajima" "Nakajima Mikio") (nil "montag451@laposte\\.net") (nil "na@aisrntairetnraoitn") - ("Morgan Smith" "Morgan J. Smith") + ("Morgan Smith" "Morgan J\\. Smith") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") ("Noah Peart" "noah\\.v\\.peart@gmail\\.com") ("Noorul Islam" "Noorul Islam K M") From d1fe392f93ce7e71cd378326814ec4e3a4143f0c Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Sat, 24 Feb 2024 09:30:16 +0100 Subject: [PATCH 343/385] ; Fix compiler warning * lisp/textmodes/reftex-vars.el (reftex-cite-format-builtin): Fix character escaping in the docstring. (bug#69341) --- lisp/textmodes/reftex-vars.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index a0bc5c11ece..791b10412c9 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -235,11 +235,10 @@ distribution. Mixed-case symbols are convenience aliases.") "ConTeXt bib module" ((?\C-m . "\\cite[%l]") (?s . "\\cite[][%l]") - (?n . "\\nocite[%l]"))) - ) + (?n . "\\nocite[%l]")))) "Builtin versions of the citation format. The following conventions are valid for all alist entries: -`?\C-m' should always point to a straight \\cite{%l} macro. +`?\\C-m' should always point to a straight \\cite{%l} macro. `?t' should point to a textual citation (citation as a noun). `?p' should point to a parenthetical citation.") From 0bdd2eb9af171fa9d825bc6d09e0ad5d114684c4 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 14 Feb 2024 11:09:33 -0500 Subject: [PATCH 344/385] Add context to errors thrown by server-start during startup When server-start errors during startup, the error is printed to the terminal without context. To help the user understand better what went wrong, that printed error now mentions that the error came from starting up the daemon. * lisp/startup.el (command-line): Catch and annotate errors thrown by server-start. (bug#68799) --- lisp/startup.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/startup.el b/lisp/startup.el index 1c21b5de857..33e1124b998 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1639,7 +1639,9 @@ Consider using a subdirectory instead, e.g.: %s" (let ((dn (daemonp))) (when dn (when (stringp dn) (setq server-name dn)) - (server-start) + (condition-case err + (server-start) + (error (error "Unable to start daemon: %s; exiting" (error-message-string err)))) (if server-process (daemon-initialized) (if (stringp dn) From 526c262149839702b94253d5eff195054ac5cd9e Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 13 Feb 2024 12:20:39 -0500 Subject: [PATCH 345/385] Check daemon is initialized before suppressing its init errors Previously, the default error handler would correctly suppress unhandled errors raised when IS_DAEMON and the initial frame was current, since this is the normal state of operation for a daemon-mode Emacs. However, this also incorrectly suppressed errors raised while a daemon-mode Emacs was starting up. Now, errors raised while a daemon-mode Emacs is starting up will be handled just like errors when a non-daemon Emacs is starting up. This was previously the case before changes for bug#1310 and bug#1836, which added the suppression of errors when IS_DAEMON. DAEMON_RUNNING didn't exist at the time of those changes, but now it does, so we can do better. * src/keyboard.c (Fcommand_error_default_function): Check !DAEMON_RUNNING in addition to IS_DAEMON. (Bug#68799) * src/lisp.h (DAEMON_RUNNING): Add a clarifying comment about what this #define means. --- src/keyboard.c | 5 +++-- src/lisp.h | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 4b5e20fb24c..eb0de98bad1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1076,8 +1076,9 @@ Default value of `command-error-function'. */) write to stderr and quit. In daemon mode, there are many other potential errors that do not prevent frames from being created, so continuing as normal is better in - that case. */ - || (!IS_DAEMON && FRAME_INITIAL_P (sf)) + that case, as long as the daemon has actually finished + initialization. */ + || (!(IS_DAEMON && !DAEMON_RUNNING) && FRAME_INITIAL_P (sf)) || noninteractive)) { print_error_message (data, Qexternal_debugging_output, diff --git a/src/lisp.h b/src/lisp.h index 5fbbef80e8e..309bea02238 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5153,6 +5153,7 @@ extern bool build_details; /* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ extern int daemon_type; #define IS_DAEMON (daemon_type != 0) +/* True means daemon-initialized has not yet been called. */ #define DAEMON_RUNNING (daemon_type >= 0) #else /* WINDOWSNT */ extern void *w32_daemon_event; From 03fce8401639a1d60bb66bf374d3d44b3331ac8a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 11:27:12 +0200 Subject: [PATCH 346/385] ; Fix last change in lisp.h. --- src/lisp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lisp.h b/src/lisp.h index 309bea02238..f353e4956eb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5153,7 +5153,7 @@ extern bool build_details; /* 0 not a daemon, 1 foreground daemon, 2 background daemon. */ extern int daemon_type; #define IS_DAEMON (daemon_type != 0) -/* True means daemon-initialized has not yet been called. */ +/* Non-zero means daemon-initialized has not yet been called. */ #define DAEMON_RUNNING (daemon_type >= 0) #else /* WINDOWSNT */ extern void *w32_daemon_event; From 01ebc95114fe89ef623bc7ebdd3c3e1b9ef06b4e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 11:59:30 +0200 Subject: [PATCH 347/385] Fix 'help-quick-toggle' * lisp/help.el (help-quick-sections): Fix "kill-region" command. Add a doc string. (Bug#69345) --- lisp/help.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index accd01e56f5..24e4b9890a7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -151,7 +151,7 @@ buffer.") ("Mark & Kill" (set-mark-command . "mark") (kill-line . "kill line") - (kill-ring-save . "kill region") + (kill-region . "kill region") (yank . "yank") (exchange-point-and-mark . "swap")) ("Projects" @@ -165,7 +165,15 @@ buffer.") (isearch-forward . "search") (isearch-backward . "reverse search") (query-replace . "search & replace") - (fill-paragraph . "reformat")))) + (fill-paragraph . "reformat"))) + "Data structure for `help-quick'. +Value should be a list of elements, each element should of the form + + (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...) + +where GROUP-NAME is the name of the group of the commands, +COMMAND is the symbol of a command and DESCRIPTION is its short +description, 10 to 15 char5acters at most.") (declare-function prop-match-value "text-property-search" (match)) From 477eb882b57b3defd43ea8dd9510cfdf5fd9ee79 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 13 Feb 2024 10:38:48 +0100 Subject: [PATCH 348/385] Add sml-mode entry to 'eglot-server-programs' * lisp/progmodes/eglot.el (eglot-server-programs): Use the "millet" LSP server (https://github.com/azdavis/millet). --- lisp/progmodes/eglot.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 2f32a8e6eda..f341428cac3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -310,7 +310,10 @@ automatically)." ("vscode-markdown-language-server" "--stdio")))) (graphviz-dot-mode . ("dot-language-server" "--stdio")) (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific From 1972beda6de3d6895cc197dc292721ca963b234c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 24 Feb 2024 11:43:28 +0100 Subject: [PATCH 349/385] ; * etc/NEWS: Recommend obarray-make as correct replacement. --- etc/NEWS | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6acafe6ea4a..a47376f7f02 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2025,13 +2025,9 @@ The old vector representation is still accepted by functions operating on obarrays, but 'obarrayp' only returns 't' for obarray objects. 'type-of' now returns 'obarray' for obarray objects. -If you have code which creates obarrays as a simple Lisp vector: - - (make-vector N nil) - -and then calls 'intern' using such an obarray as second argument, this -will now signal a wrong-type-argument error; replace nil with zero to -make it work again. +Old code which incorrectly created "obarrays" as Lisp vectors filled +with something other than 0, as in '(make-vector N nil)', will no longer +work at all and should be rewritten to use 'obarray-make'. +++ *** New function 'obarray-clear' removes all symbols from an obarray. From 4eed2768b10d074612853b68248a4b255a5c7d58 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 13:03:11 +0200 Subject: [PATCH 350/385] ; Fix last change. --- etc/NEWS | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a47376f7f02..0578da899bb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2025,9 +2025,10 @@ The old vector representation is still accepted by functions operating on obarrays, but 'obarrayp' only returns 't' for obarray objects. 'type-of' now returns 'obarray' for obarray objects. -Old code which incorrectly created "obarrays" as Lisp vectors filled +Old code which (incorrectly) created "obarrays" as Lisp vectors filled with something other than 0, as in '(make-vector N nil)', will no longer -work at all and should be rewritten to use 'obarray-make'. +work, and should be rewritten to use 'obarray-make'. Alternatively, you +can fill the vector with 0. +++ *** New function 'obarray-clear' removes all symbols from an obarray. From eeb89a5cb292bffe40ba7d0b0cf81f82f8452bf8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 24 Feb 2024 12:08:09 +0100 Subject: [PATCH 351/385] Suppress docstring control char warning in macro-generated function * lisp/progmodes/cc-defs.el (c-lang-defconst): Make sure that `val` won't be treated as a docstring. --- lisp/progmodes/cc-defs.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e45ab76ec07..2c793c8a99d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2579,7 +2579,8 @@ constant. A file is identified by its base name." ;; dependencies on the `c-lang-const's in VAL.) (setq val (c--macroexpand-all val)) - (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) + (setq bindings `(cons (cons ',assigned-mode (lambda () nil ,val)) + ,bindings) args (cdr args)))) ;; Compile in the other files that have provided source From 3076e79a6a11f9df33c5bcaa7aa58955550aeef0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Feb 2024 17:13:47 +0200 Subject: [PATCH 352/385] ; Fix a recent change in diff-mode.el * lisp/vc/diff-mode.el (diff-refine-nonmodified): Doc fix. * etc/NEWS: Improve wording. --- etc/NEWS | 7 +++++-- lisp/vc/diff-mode.el | 10 ++++++++-- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 0578da899bb..882d97ec423 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -598,8 +598,11 @@ It allows tweaking the thresholds for rename and copy detection. --- *** New user option 'diff-refine-nonmodified'. -Makes 'diff-refine' highlight added and removed whole lines with the -same faces as the words added and removed within modified lines. +When this is non-nil, 'diff-refine' will highlight lines that were added +or removed in their entirety (as opposed to modified lines, where some +parts of the line were modified), using the same faces as for +highlighting the words added and removed within modified lines. The +default value is nil. +++ *** 'diff-ignore-whitespace-hunk' can now be applied to all hunks. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index f914cc76790..14a401667e9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2283,8 +2283,14 @@ Return new point, if it was moved." (overlay-put ol 'face face))) (defcustom diff-refine-nonmodified nil - "If non-nil also highlight as \"refined\" the added/removed lines. -This is currently only implemented for `unified' diffs." + "If non-nil, also highlight the added/removed lines as \"refined\". +The lines highlighted when this is non-nil are those that were +added or removed in their entirety, as opposed to lines some +parts of which were modified. The added lines are highlighted +using the `diff-refine-added' face, while the removed lines are +highlighted using the `diff-refine-removed' face. +This is currently implemented only for diff formats supported +by `diff-refine-hunk'." :version "30.1" :type 'boolean) From 68096a716bfe3c212a68b3d285a0386ea0867130 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 11:02:37 -0500 Subject: [PATCH 353/385] (diff-refine-nonmodified): Complete the implementation * lisp/vc/diff-mode.el (diff--refine-hunk): Implement `diff-refine-nonmodified` for old-style-context and "normal" diffs. --- lisp/vc/diff-mode.el | 47 ++++++++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 14a401667e9..99ac50c155a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2333,26 +2333,43 @@ by `diff-refine-hunk'." ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) - (while (and middle - (re-search-forward "^\\(?:!.*\n\\)+" middle t)) - (smerge-refine-regions (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - #'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) + (when middle + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-regions (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + #'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))) + (when diff-refine-nonmodified + (goto-char beg) + (while (re-search-forward "^\\(?:-.*\n\\)+" middle t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-removed)) + (goto-char middle) + (while (re-search-forward "^\\(?:+.*\n\\)+" end t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-added)))))) (_ ;; Normal diffs. (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) + (cond + ((re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. (smerge-refine-regions beg1 (match-beginning 0) (match-end 0) end - nil #'diff-refine-preproc props-r props-a))))))) + nil #'diff-refine-preproc props-r props-a)) + (diff-refine-nonmodified + (diff--refine-propertize + beg1 end + (if (eq (char-after beg1) ?<) + 'diff-refine-removed 'diff-refine-added))))))))) (defun diff--iterate-hunks (max fun) "Iterate over all hunks between point and MAX. From 56beeff14365d8e802ab7b4888aa7e95b2cf9509 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 12:23:41 -0500 Subject: [PATCH 354/385] * src/editfns.c (Fget_pos_property): Fix thinko (bug#69358) --- src/editfns.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index cce52cddbf8..4ccf765bd4b 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -301,8 +301,8 @@ at POSITION. */) struct buffer *obuf = current_buffer; struct itree_node *node; struct sortvec items[2]; - struct sortvec *result = NULL; struct buffer *b = XBUFFER (object); + struct sortvec *result = NULL; Lisp_Object res = Qnil; set_buffer_temp (b); @@ -326,7 +326,10 @@ at POSITION. */) if (NILP (res) || (make_sortvec_item (this, node->data), compare_overlays (result, this) < 0)) - res = tem; + { + result = this; + res = tem; + } } set_buffer_temp (obuf); From de6b1e1efb1a36c69e7a6e09297e1de5b1477121 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 24 Feb 2024 17:47:37 +0100 Subject: [PATCH 355/385] Replace XSETSYMBOL with make_lisp_symbol * src/lisp.h (XSETSYMBOL): Remove. All callers changed to use make_lisp_symbol. --- src/alloc.c | 12 ++++-------- src/buffer.c | 4 ++-- src/data.c | 33 ++++++++++++++------------------- src/eval.c | 2 +- src/lisp.h | 1 - 5 files changed, 21 insertions(+), 31 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 2ffd2415447..16257469aa6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3960,7 +3960,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { ASAN_UNPOISON_SYMBOL (symbol_free_list); - XSETSYMBOL (val, symbol_free_list); + val = make_lisp_symbol (symbol_free_list); symbol_free_list = symbol_free_list->u.s.next; } else @@ -3976,7 +3976,7 @@ Its value is void, and its function definition and property list are nil. */) } ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); - XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); + val = make_lisp_symbol (&symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -7398,12 +7398,8 @@ process_mark_stack (ptrdiff_t base_sp) mark_stack_push_value (SYMBOL_VAL (ptr)); break; case SYMBOL_VARALIAS: - { - Lisp_Object tem; - XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); - mark_stack_push_value (tem); - break; - } + mark_stack_push_value (make_lisp_symbol (SYMBOL_ALIAS (ptr))); + break; case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr); diff --git a/src/buffer.c b/src/buffer.c index d67e1d67cd6..e235ff8f9f8 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1334,7 +1334,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) case SYMBOL_LOCALIZED: { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); - XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update In case of aliasing. */ result = assq_no_quit (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { @@ -4971,7 +4971,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, sym->u.s.declared_special = true; sym->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (sym, bo_fwd); - XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); + PER_BUFFER_SYMBOL (offset) = make_lisp_symbol (sym); if (PER_BUFFER_IDX (offset) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding diff --git a/src/data.c b/src/data.c index bb4cdd62d66..da507901b76 100644 --- a/src/data.c +++ b/src/data.c @@ -1256,7 +1256,7 @@ If OBJECT is not a symbol, just return it. */) struct Lisp_Symbol *sym = XSYMBOL (object); while (sym->u.s.redirect == SYMBOL_VARALIAS) sym = SYMBOL_ALIAS (sym); - XSETSYMBOL (object, sym); + object = make_lisp_symbol (sym); } return object; } @@ -1506,12 +1506,9 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ if (blv->fwd.fwdptr) set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Choose the new binding. */ - { - Lisp_Object var; - XSETSYMBOL (var, symbol); - tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); - set_blv_where (blv, Fcurrent_buffer ()); - } + tem1 = assq_no_quit (make_lisp_symbol (symbol), + BVAR (current_buffer, local_var_alist)); + set_blv_where (blv, Fcurrent_buffer ()); if (!(blv->found = !NILP (tem1))) tem1 = blv->defcell; @@ -1655,7 +1652,8 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, set_blv_value (blv, do_symval_forwarding (blv->fwd)); /* Find the new binding. */ - XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ + /* May have changed via aliasing. */ + symbol = make_lisp_symbol (sym); Lisp_Object tem1 = assq_no_quit (symbol, BVAR (XBUFFER (where), local_var_alist)); @@ -2059,13 +2057,10 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, union Lisp_Val_Fwd valcontents) { struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv); - Lisp_Object symbol; - Lisp_Object tem; - - XSETSYMBOL (symbol, sym); - tem = Fcons (symbol, (forwarded - ? do_symval_forwarding (valcontents.fwd) - : valcontents.value)); + Lisp_Object tem = Fcons (make_lisp_symbol (sym), + forwarded + ? do_symval_forwarding (valcontents.fwd) + : valcontents.value); /* Buffer_Local_Values cannot have as realval a buffer-local or keyboard-local forwarding. */ @@ -2221,7 +2216,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) } /* Make sure this buffer has its own value of symbol. */ - XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { @@ -2301,7 +2296,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); /* Get rid of this buffer's alist element, if any. */ - XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ + variable = make_lisp_symbol (sym); /* Propagate variable indirection. */ tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) bset_local_var_alist @@ -2346,7 +2341,7 @@ Also see `buffer-local-boundp'.*/) Lisp_Object tmp; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETBUFFER (tmp, buf); - XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ if (EQ (blv->where, tmp)) /* The binding is already loaded. */ return blv_found (blv) ? Qt : Qnil; @@ -2396,7 +2391,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); if (blv->local_if_set) return Qt; - XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ + variable = make_lisp_symbol (sym); /* Update in case of aliasing. */ return Flocal_variable_p (variable, buffer); } case SYMBOL_FORWARDED: diff --git a/src/eval.c b/src/eval.c index 95eb21909d2..9d3b98eb359 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3475,7 +3475,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: - sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; + sym = SYMBOL_ALIAS (sym); symbol = make_lisp_symbol (sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ diff --git a/src/lisp.h b/src/lisp.h index f353e4956eb..4fc44745211 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1380,7 +1380,6 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) -#define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) /* Return a Lisp_Object value that does not correspond to any object. From 5fa6042c739b2b0abb320964d5391704c8fbb5a6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 12:49:20 -0500 Subject: [PATCH 356/385] * etc/NEWS.25: Add missing announcement of 'obarray' package --- etc/NEWS.25 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/etc/NEWS.25 b/etc/NEWS.25 index 3c5e9569b49..1f26e7705d9 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -1158,6 +1158,11 @@ few or no entries have changed. * New Modes and Packages in Emacs 25.1 +** New preloaded package 'obarray' + +Provides obarray operations under the 'obarray-' prefix, such as +'obarray-make' and 'obarray-map'. + ** pinentry.el allows GnuPG passphrase to be prompted through the minibuffer instead of a graphical dialog, depending on whether the gpg command is called from Emacs (i.e., INSIDE_EMACS environment variable From 0503657a9cffbe3a5fc4f0023ee9985073e62d2c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 13:12:20 -0500 Subject: [PATCH 357/385] * etc/NEWS.25: Add 'obarrayp' as well --- etc/NEWS.25 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS.25 b/etc/NEWS.25 index 1f26e7705d9..f647809074b 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -1161,7 +1161,7 @@ few or no entries have changed. ** New preloaded package 'obarray' Provides obarray operations under the 'obarray-' prefix, such as -'obarray-make' and 'obarray-map'. +'obarray-make', 'obarrayp', and 'obarray-map'. ** pinentry.el allows GnuPG passphrase to be prompted through the minibuffer instead of a graphical dialog, depending on whether the gpg From 9a801f0b4621a46149ccf650ed1dc27942157562 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 24 Feb 2024 17:52:14 -0500 Subject: [PATCH 358/385] * lisp/progmodes/elisp-mode.el (eval-last-sexp, eval-defun): Fix thinko --- lisp/progmodes/elisp-mode.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4b1f8022f81..8a713bd19a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1630,7 +1630,8 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (values--store-value - (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) @@ -1769,7 +1770,8 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (handler-bind ((error (if #'eval-expression--debug #'ignore))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) (elisp--eval-defun))))) ;;; ElDoc Support From 05116eac0c199b0c8409a32b349a42a21b5a0fb0 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 25 Feb 2024 11:41:02 +0800 Subject: [PATCH 359/385] Arrange for dialog boxes during emacsclient requests on Android * lisp/server.el (server-execute): Bind use-dialog-box-override if (featurep 'android). * lisp/subr.el (use-dialog-box-override): New option. (use-dialog-box-p): Always display dialog boxes if variable is set. --- lisp/server.el | 6 +++++- lisp/subr.el | 22 ++++++++++++++-------- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index 66e6d729f8a..b65053267a6 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1439,7 +1439,11 @@ invocations of \"emacs\".") ;; including code that needs to wait. (with-local-quit (condition-case err - (let ((buffers (server-visit-files files proc nowait))) + (let ((buffers (server-visit-files files proc nowait)) + ;; On Android, the Emacs server generally can't provide + ;; feedback to the user except by means of dialog boxes, + ;; which are displayed in the GUI emacsclient wrapper. + (use-dialog-box-override (featurep 'android))) (mapc 'funcall (nreverse commands)) (let ((server-eval-args-left (nreverse evalexprs))) (while server-eval-args-left diff --git a/lisp/subr.el b/lisp/subr.el index c317d558e24..30314343650 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3832,16 +3832,22 @@ confusing to some users.") (declare-function android-detect-keyboard "androidfns.c") +(defvar use-dialog-box-override nil + "Whether `use-dialog-box-p' should always return t.") + (defun use-dialog-box-p () "Return non-nil if the current command should prompt the user via a dialog box." - (and last-input-event ; not during startup - (or (consp last-nonmenu-event) ; invoked by a mouse event - (and (null last-nonmenu-event) - (consp last-input-event)) - (and (featurep 'android) ; Prefer dialog boxes on Android. - (not (android-detect-keyboard))) ; If no keyboard is connected. - from--tty-menu-p) ; invoked via TTY menu - use-dialog-box)) + (or use-dialog-box-override + (and last-input-event ; not during startup + (or (consp last-nonmenu-event) ; invoked by a mouse event + (and (null last-nonmenu-event) + (consp last-input-event)) + (and (featurep 'android) ; Prefer dialog boxes on + ; Android. + (not (android-detect-keyboard))) ; If no keyboard is + ; connected. + from--tty-menu-p) ; invoked via TTY menu + use-dialog-box))) ;; Actually in textconv.c. (defvar overriding-text-conversion-style) From 782ff2f826e2fde75f6491f3a6cf0d7fcd5510b2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Feb 2024 08:20:44 +0200 Subject: [PATCH 360/385] * nt/cmdproxy.c (_snprintf) [_UCRT]: Redirect to 'snprintf'. --- nt/cmdproxy.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 0500b653bb2..c012151cf96 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -38,6 +38,14 @@ along with GNU Emacs. If not, see . */ #include /* strlen */ #include /* isspace, isalpha */ +/* UCRT has a C99-compatible snprintf, and _snprintf is defined inline + in stdio.h, which we don't want to include here. Since the + differences in behavior between snprintf and _snprintf don't matter + in this file, we take the easy way out. */ +#ifdef _UCRT +# define _snprintf snprintf +#endif + /* We don't want to include stdio.h because we are already duplicating lots of it here */ extern int _snprintf (char *buffer, size_t count, const char *format, ...); From 6b800f9adf3506bf113539cf22cd07c7cda9f7b8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 25 Feb 2024 09:32:45 +0200 Subject: [PATCH 361/385] * lisp/progmodes/project.el (project-any-command): Allow local keymaps. Use overriding-terminal-local-map instead of overriding-local-map. This allows using keys from local maps (bug#69242). --- lisp/progmodes/project.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index aa92a73336e..9622b1b6768 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1866,12 +1866,12 @@ Otherwise, `default-directory' is temporarily set to the current project's root. If OVERRIDING-MAP is non-nil, it will be used as -`overriding-local-map' to provide shorter bindings from that map -which will take priority over the global ones." +`overriding-terminal-local-map' to provide shorter bindings +from that map which will take priority over the global ones." (interactive) (let* ((pr (project-current t)) (prompt-format (or prompt-format "[execute in %s]:")) - (command (let ((overriding-local-map overriding-map)) + (command (let ((overriding-terminal-local-map overriding-map)) (key-binding (read-key-sequence (format prompt-format (project-root pr))) t))) From e680827e814e155cf79175d87ff7c6ee3a08b69a Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Fri, 16 Feb 2024 22:07:18 +0100 Subject: [PATCH 362/385] Don't warn about _ not left unused in if-let and alike The macro expansions did not leave a variable _ unused; this triggered an irritating compiler warning (bug#69108). * lisp/subr.el (internal--build-binding): Handle bindings of the form (_ EXPR) separately. --- lisp/subr.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/subr.el b/lisp/subr.el index 30314343650..301e2e42566 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2580,6 +2580,8 @@ Affects only hooks run in the current buffer." (list binding binding)) ((null (cdr binding)) (list (make-symbol "s") (car binding))) + ((eq '_ (car binding)) + (list (make-symbol "s") (cadr binding))) (t binding))) (when (> (length binding) 2) (signal 'error From 67ba629a91aee3db39f3c81744e88c02ee710bdc Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Sun, 18 Feb 2024 02:27:56 +0100 Subject: [PATCH 363/385] ; * lisp/subr.el (if-let, and-let*): Tweak doc strings. (Bug#69108) --- lisp/subr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 301e2e42566..e2279170297 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2622,7 +2622,7 @@ This is like `when-let' but doesn't handle a VARLIST of the form (defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally evaluate BODY. Like `when-let*', except if BODY is empty and all the bindings -are non-nil, then the result is non-nil." +are non-nil, then the result is the value of the last binding." (declare (indent 1) (debug if-let*)) (let (res) (if varlist @@ -2635,7 +2635,8 @@ are non-nil, then the result is non-nil." "Bind variables according to SPEC and evaluate THEN or ELSE. Evaluate each binding in turn, as in `let*', stopping if a binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. +THEN, otherwise the value of the last form in ELSE, or nil if +there are none. Each element of SPEC is a list (SYMBOL VALUEFORM) that binds SYMBOL to the value of VALUEFORM. An element can additionally be From 39e3fce0d5e0f5db00e44905bcd2590170098d63 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Feb 2024 10:06:09 +0100 Subject: [PATCH 364/385] 'read-passwd' can toggle the visibility of passwords * doc/lispref/minibuf.texi (Reading a Password): * etc/NEWS: 'read-passwd' can toggle the visibility of passwords. * etc/images/README: Mention the new images below. * etc/images/conceal.pbm: * etc/images/conceal.svg: * etc/images/reveal.pbm: * etc/images/reveal.svg: New images. * lisp/simple.el (read-passwd--mode-line-buffer) (read-passwd--mode-line-icon): New defvars. (read-passwd--toggle-visibility, read-passwd-mode): New defuns. * lisp/subr.el (read-passwd-map): Add 'TAB' binding. (read-passwd--hide-password): New defvar. (read-passwd--hide-password): Rename function from `read-password--hide-password'. Adapt callees. Implement both hiding and showing the password. (Bug#69237) (read-passwd): Call `read-passwd-mode'. --- doc/lispref/minibuf.texi | 8 ++++ etc/NEWS | 11 +++++- etc/images/README | 7 +++- etc/images/conceal.pbm | Bin 0 -> 41 bytes etc/images/conceal.svg | 4 ++ etc/images/reveal.pbm | Bin 0 -> 41 bytes etc/images/reveal.svg | 4 ++ lisp/simple.el | 81 +++++++++++++++++++++++++++++++++++++++ lisp/subr.el | 21 +++++++--- 9 files changed, 128 insertions(+), 8 deletions(-) create mode 100644 etc/images/conceal.pbm create mode 100644 etc/images/conceal.svg create mode 100644 etc/images/reveal.pbm create mode 100644 etc/images/reveal.svg diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index aa27de72ba0..0247c93f7b8 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2562,6 +2562,14 @@ times match. The optional argument @var{default} specifies the default password to return if the user enters empty input. If @var{default} is @code{nil}, then @code{read-passwd} returns the null string in that case. + +This function uses @code{read-passwd-mode}, a minor mode. It binds two +keys in the minbuffer: @kbd{C-u} (@code{delete-minibuffer-contents}) +deletes the password, and @kbd{TAB} +(@code{read-passwd--toggle-visibility}) toggles the visibility of the +password. There is also an additional icon in the mode-line. Clicking +on this icon with @key{mouse-1} toggles the visibility of the password +as well. @end defun @node Minibuffer Commands diff --git a/etc/NEWS b/etc/NEWS index 882d97ec423..6d444daf152 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -322,6 +322,12 @@ Previously, it was set to t but this broke remote file name detection. ** Multi-character key echo now ends with a suggestion to use Help. Customize 'echo-keystrokes-help' to nil to prevent that. ++++ +** 'read-passwd' can toggle the visibility of passwords. +Use 'TAB' in the minibuffer to show or hide the password. Likewise, +there is an icon on the mode-line, which toggles the visibility of the +password when clicking with 'mouse-1'. + * Editing Changes in Emacs 30.1 @@ -1939,7 +1945,8 @@ Example: "Uses c:\remote\dir\files and the key \C-x." ...) -where the doc string contains four control characters CR, DEL, FF and ^X. +where the docstring contains four control characters 'CR', 'DEL', 'FF' +and 'C-x'. The warning name is 'docstrings-control-chars'. @@ -2025,7 +2032,7 @@ automatically, which means that the size parameter to 'obarray-make' can safely be omitted. That is, they do not become slower as they fill up. The old vector representation is still accepted by functions operating -on obarrays, but 'obarrayp' only returns 't' for obarray objects. +on obarrays, but 'obarrayp' only returns t for obarray objects. 'type-of' now returns 'obarray' for obarray objects. Old code which (incorrectly) created "obarrays" as Lisp vectors filled diff --git a/etc/images/README b/etc/images/README index a778d9ce6c3..8e112448373 100644 --- a/etc/images/README +++ b/etc/images/README @@ -125,7 +125,7 @@ For more information see the adwaita-icon-theme repository at: https://gitlab.gnome.org/GNOME/adwaita-icon-theme -Emacs images and their source in the Adwaita/scalable directory: +Emacs images and their source in the Adwaita/symbolic directory: checked.svg ui/checkbox-checked-symbolic.svg unchecked.svg ui/checkbox-symbolic.svg @@ -137,3 +137,8 @@ Emacs images and their source in the Adwaita/scalable directory: left.svg ui/pan-start-symbolic.svg right.svg ui/pan-end-symbolic.svg up.svg ui/pan-up-symbolic.svg + conceal.svg actions/view-conceal-symbolic.svg + reveal.svg actions/view-reveal-symbolic.svg + +conceal.pbm and reveal.pbm are generated from the respective *.svg +files, using the ImageMagick converter tool. diff --git a/etc/images/conceal.pbm b/etc/images/conceal.pbm new file mode 100644 index 0000000000000000000000000000000000000000..3df787d6fd60b8efaf82cd6b2d9fca47473e81d8 GIT binary patch literal 41 xcmWGA;W9K+Ff`+0U`Svne_;PZ#>P)Bz3=n+kLL^CRn*zo$j@Ov$H2zG000o_4iW$W literal 0 HcmV?d00001 diff --git a/etc/images/conceal.svg b/etc/images/conceal.svg new file mode 100644 index 00000000000..172b73ed3d3 --- /dev/null +++ b/etc/images/conceal.svg @@ -0,0 +1,4 @@ + + + + diff --git a/etc/images/reveal.pbm b/etc/images/reveal.pbm new file mode 100644 index 0000000000000000000000000000000000000000..79d2f1f330769ba7344ac6b8218fd17c1f99bac3 GIT binary patch literal 41 ucmWGA;W9K+Ff`+000Q<0@;_{BD&z|LKA-=5zOb)C&c;Um2m1q{6axVFcnu){ literal 0 HcmV?d00001 diff --git a/etc/images/reveal.svg b/etc/images/reveal.svg new file mode 100644 index 00000000000..41ae3733a53 --- /dev/null +++ b/etc/images/reveal.svg @@ -0,0 +1,4 @@ + + + + diff --git a/lisp/simple.el b/lisp/simple.el index 9a33049f4ca..5992afec255 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10858,6 +10858,87 @@ and setting it to nil." (setq-local vis-mode-saved-buffer-invisibility-spec buffer-invisibility-spec) (setq buffer-invisibility-spec nil))) + + +(defvar read-passwd--mode-line-buffer nil + "Buffer to modify `mode-line-format' for showing/hiding passwords.") + +(defvar read-passwd--mode-line-icon nil + "Propertized mode line icon for showing/hiding passwords.") + +(defun read-passwd--toggle-visibility () + "Toggle minibuffer contents visibility. +Adapt also mode line." + (interactive) + (setq read-passwd--hide-password (not read-passwd--hide-password)) + (with-current-buffer read-passwd--mode-line-buffer + (setq read-passwd--mode-line-icon + `(:propertize + ,(if icon-preference + (icon-string + (if read-passwd--hide-password + 'read-passwd--show-password-icon + 'read-passwd--hide-password-icon)) + "") + mouse-face mode-line-highlight + local-map + (keymap + (mode-line keymap (mouse-1 . read-passwd--toggle-visibility))))) + (force-mode-line-update)) + (read-passwd--hide-password)) + +(define-minor-mode read-passwd-mode + "Toggle visibility of password in minibuffer." + :group 'mode-line + :group 'minibuffer + :keymap read-passwd-map + :version "30.1" + + (require 'icons) + ;; It would be preferable to use "👁" ("\N{EYE}"). However, there is + ;; no corresponding Unicode char with a slash. So we use symbols as + ;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for + ;; hiding the password. + (define-icon read-passwd--show-password-icon nil + '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) + (symbol "👁") + (text "o")) + "Mode line icon to show a hidden password." + :group mode-line-faces + :version "30.1" + :help-echo "mouse-1: Toggle password visibility") + (define-icon read-passwd--hide-password-icon nil + '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) + (symbol "⦵") + (text "x")) + "Mode line icon to hide a visible password." + :group mode-line-faces + :version "30.1" + :help-echo "mouse-1: Toggle password visibility") + + (setq read-passwd--hide-password nil + ;; Stolen from `eldoc-minibuffer-message'. + read-passwd--mode-line-buffer + (window-buffer + (or (window-in-direction 'above (minibuffer-window)) + (minibuffer-selected-window) + (get-largest-window)))) + + (if read-passwd-mode + (with-current-buffer read-passwd--mode-line-buffer + ;; Add `read-passwd--mode-line-icon'. + (when (listp mode-line-format) + (setq mode-line-format + (cons '(:eval read-passwd--mode-line-icon) + mode-line-format)))) + (with-current-buffer read-passwd--mode-line-buffer + ;; Remove `read-passwd--mode-line-icon'. + (when (listp mode-line-format) + (setq mode-line-format (cdr mode-line-format))))) + + (when read-passwd-mode + (read-passwd--toggle-visibility))) + (defvar messages-buffer-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/subr.el b/lisp/subr.el index e2279170297..d89c69976e4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3378,14 +3378,23 @@ with Emacs. Do not call it directly in your own packages." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 + (define-key map "\t" #'read-passwd--toggle-visibility) map) "Keymap used while reading passwords.") -(defun read-password--hide-password () +(defvar read-passwd--hide-password t) + +(defun read-passwd--hide-password () + "Make password in minibuffer hidden or visible." (let ((beg (minibuffer-prompt-end))) (dotimes (i (1+ (- (buffer-size) beg))) - (put-text-property (+ i beg) (+ 1 i beg) - 'display (string (or read-hide-char ?*)))))) + (if read-passwd--hide-password + (put-text-property + (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*))) + (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display))) + (put-text-property + (+ i beg) (+ 1 i beg) + 'help-echo "C-u: Clear password\nTAB: Toggle password visibility")))) (defun read-passwd (prompt &optional confirm default) "Read a password, prompting with PROMPT, and return it. @@ -3423,18 +3432,20 @@ by doing (clear-string STRING)." (setq-local inhibit-modification-hooks nil) ;bug#15501. (setq-local show-paren-mode nil) ;bug#16091. (setq-local inhibit--record-char t) - (add-hook 'post-command-hook #'read-password--hide-password nil t)) + (read-passwd-mode 1) + (add-hook 'post-command-hook #'read-passwd--hide-password nil t)) (unwind-protect (let ((enable-recursive-minibuffers t) (read-hide-char (or read-hide-char ?*))) (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf + (read-passwd-mode -1) ;; Not sure why but it seems that there might be cases where the ;; minibuffer is not always properly reset later on, so undo ;; whatever we've done here (bug#11392). (remove-hook 'after-change-functions - #'read-password--hide-password 'local) + #'read-passwd--hide-password 'local) (kill-local-variable 'post-self-insert-hook) ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) From e02c4a864f02787f0e194c9e8a6d4ab0b18ca39f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 25 Feb 2024 15:37:06 +0100 Subject: [PATCH 365/385] Modify last change acc to comments * lisp/simple.el (read-passwd-mode): Change `text' entry of icons. (read-passwd-toggle-visibility): Rename. (read-passwd-mode): * lisp/subr.el (read-passwd-map): Adapt callees. --- lisp/simple.el | 10 +++++----- lisp/subr.el | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 5992afec255..f127290231b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10866,7 +10866,7 @@ and setting it to nil." (defvar read-passwd--mode-line-icon nil "Propertized mode line icon for showing/hiding passwords.") -(defun read-passwd--toggle-visibility () +(defun read-passwd-toggle-visibility () "Toggle minibuffer contents visibility. Adapt also mode line." (interactive) @@ -10883,7 +10883,7 @@ Adapt also mode line." mouse-face mode-line-highlight local-map (keymap - (mode-line keymap (mouse-1 . read-passwd--toggle-visibility))))) + (mode-line keymap (mouse-1 . read-passwd-toggle-visibility))))) (force-mode-line-update)) (read-passwd--hide-password)) @@ -10902,7 +10902,7 @@ Adapt also mode line." (define-icon read-passwd--show-password-icon nil '((image "reveal.svg" "reveal.pbm" :height (0.8 . em)) (symbol "👁") - (text "o")) + (text "")) "Mode line icon to show a hidden password." :group mode-line-faces :version "30.1" @@ -10910,7 +10910,7 @@ Adapt also mode line." (define-icon read-passwd--hide-password-icon nil '((image "conceal.svg" "conceal.pbm" :height (0.8 . em)) (symbol "⦵") - (text "x")) + (text "<\\>")) "Mode line icon to hide a visible password." :group mode-line-faces :version "30.1" @@ -10937,7 +10937,7 @@ Adapt also mode line." (setq mode-line-format (cdr mode-line-format))))) (when read-passwd-mode - (read-passwd--toggle-visibility))) + (read-passwd-toggle-visibility))) (defvar messages-buffer-mode-map diff --git a/lisp/subr.el b/lisp/subr.el index d89c69976e4..d58f8ba3b27 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3378,7 +3378,7 @@ with Emacs. Do not call it directly in your own packages." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 - (define-key map "\t" #'read-passwd--toggle-visibility) + (define-key map "\t" #'read-passwd-toggle-visibility) map) "Keymap used while reading passwords.") From c6f2add964ce1ac69ba6705bc869ee2f447da3cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 25 Feb 2024 13:18:08 -0500 Subject: [PATCH 366/385] * lisp/vc/vc-hooks.el (vc-mode): Give a body to the function (bug#69387) --- lisp/vc/vc-hooks.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index a95cc732dab..75f68dd80d1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -186,7 +186,8 @@ revision number and lock status." This minor mode is automatically activated whenever you visit a file under control of one of the revision control systems in `vc-handled-backends'. VC commands are globally reachable under the prefix \\[vc-prefix-map]: -\\{vc-prefix-map}") +\\{vc-prefix-map}" + nil) (defmacro vc-error-occurred (&rest body) `(condition-case nil (progn ,@body nil) (error t))) From babe6a5e948985f961ffd36f64323950abd98b7f Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 26 Feb 2024 14:13:14 +0800 Subject: [PATCH 367/385] Introduce a new TRAMP method `androidsu' * doc/misc/tramp.texi (Quick Start Guide): Document the new method. * etc/NEWS (Tramp): Announce new method. * lisp/net/tramp-adb.el (tramp-adb-handle-file-attributes) (tramp-adb-handle-directory-files-and-attributes) (tramp-adb-handle-file-name-all-completions): Properly print ls's exit status in the presence of a pipe. (tramp-adb-handle-copy-file): If the androidsu backend is in use, call cp rather than adb push. (tramp-adb-send-command): Disable ADB-specific code under androidsu. (tramp-adb-send-command-and-check): New argument COMMAND-AUGMENTED-P. * lisp/net/tramp-androidsu.el (tramp, tramp-adb, tramp-sh) (tramp-androidsu-method, add-to-list) (tramp-androidsu-maybe-open-connection) (tramp-androidsu-generate-wrapper) (tramp-androidsu-handle-access-file) (tramp-androidsu-handle-add-name-to-file) (tramp-androidsu-handle-copy-directory) (tramp-androidsu-adb-handle-copy-file) (tramp-androidsu-adb-handle-delete-directory) (tramp-androidsu-adb-handle-delete-file) (tramp-androidsu-handle-directory-file-name) (tramp-androidsu-handle-directory-files) (tramp-androidsu-adb-handle-directory-files-and-attributes) (tramp-androidsu-handle-dired-uncache) (tramp-androidsu-adb-handle-exec-path) (tramp-androidsu-handle-expand-file-name) (tramp-androidsu-handle-file-accessible-directory-p) (tramp-androidsu-adb-handle-file-attributes) (tramp-androidsu-handle-file-directory-p) (tramp-androidsu-handle-file-equal-p) (tramp-androidsu-adb-handle-file-executable-p) (tramp-androidsu-adb-handle-file-exists-p) (tramp-androidsu-handle-file-group-gid) (tramp-androidsu-handle-file-in-directory-p) (tramp-androidsu-sh-handle-file-local-copy) (tramp-androidsu-handle-file-locked-p) (tramp-androidsu-handle-file-modes) (tramp-androidsu-adb-handle-file-name-all-completions) (tramp-androidsu-handle-file-name-as-directory) (tramp-androidsu-handle-file-name-case-insensitive-p) (tramp-androidsu-handle-file-name-completion) (tramp-androidsu-handle-file-name-directory) (tramp-androidsu-handle-file-name-nondirectory) (tramp-androidsu-handle-file-newer-than-file-p) (tramp-androidsu-handle-file-notify-add-watch) (tramp-androidsu-handle-file-notify-rm-watch) (tramp-androidsu-handle-file-notify-valid-p) (tramp-androidsu-adb-handle-file-readable-p) (tramp-androidsu-handle-file-regular-p) (tramp-androidsu-handle-file-remote-p) (tramp-androidsu-handle-file-selinux-context) (tramp-androidsu-handle-file-symlink-p) (tramp-androidsu-adb-handle-file-system-info) (tramp-androidsu-handle-file-truename) (tramp-androidsu-handle-file-user-uid) (tramp-androidsu-adb-handle-file-writable-p) (tramp-androidsu-handle-find-backup-file-name) (tramp-androidsu-handle-insert-directory) (tramp-androidsu-handle-insert-file-contents) (tramp-androidsu-handle-list-system-processes) (tramp-androidsu-handle-load, tramp-androidsu-handle-lock-file) (tramp-androidsu-handle-make-auto-save-file-name) (tramp-androidsu-adb-handle-make-directory) (tramp-androidsu-handle-make-lock-file-name) (tramp-androidsu-handle-make-nearby-temp-file) (tramp-androidsu-adb-handle-make-process) (tramp-androidsu-sh-handle-make-symbolic-link) (tramp-androidsu-handle-memory-info) (tramp-androidsu-handle-process-attributes) (tramp-androidsu-adb-handle-process-file) (tramp-androidsu-adb-handle-rename-file) (tramp-androidsu-adb-handle-set-file-modes) (tramp-androidsu-adb-handle-set-file-times) (tramp-androidsu-handle-set-visited-file-modtime) (tramp-androidsu-handle-shell-command) (tramp-androidsu-handle-start-file-process) (tramp-androidsu-handle-substitute-in-file-name) (tramp-androidsu-handle-temporary-file-directory) (tramp-androidsu-adb-handle-get-remote-gid) (tramp-androidsu-adb-handle-get-remote-groups) (tramp-androidsu-adb-handle-get-remote-uid) (tramp-androidsu-handle-unlock-file) (tramp-androidsu-handle-verify-visited-file-modtime) (tramp-androidsu-handle-write-region) (tramp-androidsu-file-name-handler-alist) (tramp-androidsu-file-name-p, tramp-androidsu-file-name-handler) (tramp-register-foreign-file-name-handler) (tramp-adb-connection-local-default-ps-profile, shell) (tramp-unload-hook, tramp-androidsu): New file. --- doc/misc/tramp.texi | 7 + etc/NEWS | 6 + lisp/net/tramp-adb.el | 54 +++- lisp/net/tramp-androidsu.el | 537 ++++++++++++++++++++++++++++++++++++ 4 files changed, 589 insertions(+), 15 deletions(-) create mode 100644 lisp/net/tramp-androidsu.el diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6d4654f1a8a..09b875ad3fa 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -523,6 +523,8 @@ is used as the group to change to. The default host name is the same. @cindex @option{sudo} method @cindex method @option{doas} @cindex @option{doas} method +@cindex method @option{androidsu} +@cindex @option{androidsu} method If the @option{su}, @option{sudo} or @option{doas} option should be performed on another host, it can be combined with a leading @@ -533,6 +535,11 @@ a simple case, the syntax looks like @file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}. @xref{Ad-hoc multi-hops}. +The @option{su} method and other shell-based methods conflict with +non-standard @command{su} implementations popular among Android users +and the restricted command-line utilities distributed with that system. +The @option{androidsu} method enables accessing files through +@command{su} on such systems, but multi-hops are not supported. @anchor{Quick Start Guide sudoedit method} @section Using @command{sudoedit} diff --git a/etc/NEWS b/etc/NEWS index 6d444daf152..b4a1c887f2e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -902,6 +902,12 @@ mode line. 'header' will display in the header line; ** Tramp ++++ +*** New connection method "androidsu". +This provides access to system files with elevated privileges granted by +the idiosyncratic 'su' implementations and system utilities customary on +Android. + +++ *** New connection methods "dockercp" and "podmancp". These are the external methods counterparts of "docker" and "podman". diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 96625fc5680..4f04912c032 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -263,9 +263,10 @@ arguments to pass to the OPERATION." (tramp-convert-file-attributes v localname id-format (and (tramp-adb-send-command-and-check - v (format "%s -d -l %s | cat" + v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat" (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (tramp-shell-quote-argument localname)) + nil t) (with-current-buffer (tramp-get-buffer v) (tramp-adb-sh-fix-ls-output) (cdar (tramp-do-parse-file-attributes-with-ls v))))))) @@ -316,9 +317,10 @@ arguments to pass to the OPERATION." directory full match nosort id-format count (with-current-buffer (tramp-get-buffer v) (when (tramp-adb-send-command-and-check - v (format "%s -a -l %s | cat" + v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat" (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (tramp-shell-quote-argument localname)) + nil t) ;; We insert also filename/. and filename/.., because "ls" ;; doesn't on some file systems, like "sdcard". (unless (search-backward-regexp (rx "." eol) nil t) @@ -440,10 +442,12 @@ Emacs dired can't find files." filename (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (tramp-adb-send-command - v (format "%s -a %s | cat" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) + (unless (tramp-adb-send-command-and-check + v (format "(%s -a %s; echo tramp_exit_status $?) | cat" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname)) + nil t) + (erase-buffer)) (mapcar (lambda (f) (if (file-directory-p (expand-file-name f directory)) @@ -637,10 +641,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (unless (tramp-adb-execute-adb-command - v "push" - (file-name-unquote filename) - (file-name-unquote localname)) + (unless (if (tramp-adb-file-name-p v) + (tramp-adb-execute-adb-command + v "push" + (file-name-unquote filename) + (file-name-unquote localname)) + ;; Otherwise, this operation was initiated + ;; by the androidsu backend, so both files + ;; must be present on the local machine and + ;; transferable with a simple local copy. + (tramp-adb-send-command-and-check + v + (format + "cp -f %s %s" + (tramp-shell-quote-argument + (file-name-unquote filename)) + (tramp-shell-quote-argument + (file-name-unquote localname))))) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) @@ -1110,7 +1127,9 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p (rx multibyte) command) + (if (and (equal (tramp-file-name-method vec) + tramp-androidsu-method) + (string-match-p (rx multibyte) command)) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1142,17 +1161,22 @@ error and non-nil on success." (while (search-forward-regexp (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) -(defun tramp-adb-send-command-and-check (vec command &optional exit-status) +(defun tramp-adb-send-command-and-check (vec command &optional exit-status + command-augmented-p) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if the exit status is not equal 0, and t otherwise. +If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit +status upon completion and need not be modified. + Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (tramp-adb-send-command vec (if command - (format "%s; echo tramp_exit_status $?" command) + (if command-augmented-p command + (format "%s; echo tramp_exit_status $?" command)) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el new file mode 100644 index 00000000000..417ef25ed8a --- /dev/null +++ b/lisp/net/tramp-androidsu.el @@ -0,0 +1,537 @@ +;;; tramp-androidsu.el --- TRAMP method for Android superuser shells -*- lexical-binding:t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Keywords: comm, processes +;; Package: tramp + +;; 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: + +;; The `su' method struggles (as do other shell-based methods) with the +;; crippled versions of many Unix utilities installed on Android, +;; workarounds for which are implemented in the `adb' method. This +;; method defines a shell-based method that is identical in function to +;; `su', but reuses such code from the `adb' method where applicable and +;; also provides for certain mannerisms of popular Android `su' +;; implementations. + +;;; Code: + +(require 'tramp) +(require 'tramp-adb) +(require 'tramp-sh) + +;;;###tramp-autoload +(defconst tramp-androidsu-method "androidsu" + "When this method name is used, forward all calls to su.") + +;;;###tramp-autoload +(tramp--with-startup + (add-to-list 'tramp-methods + `(,tramp-androidsu-method + (tramp-login-program "su") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/system/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c")) + (tramp-tmpdir "/data/local/tmp") + (tramp-connection-timeout 10))) + + (add-to-list 'tramp-default-host-alist + `(,tramp-androidsu-method nil "localhost"))) + +(defun tramp-androidsu-maybe-open-connection (vec) + "Open a connection VEC if not already open. +Mostly identical to `tramp-adb-maybe-open-connection', but also disables +multibyte mode and waits for the shell prompt to appear." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + + (with-tramp-debug-message vec "Opening connection" + (let ((p (tramp-get-connection-process vec)) + (process-name (tramp-get-connection-property vec "process-name")) + (process-environment (copy-sequence process-environment))) + ;; Open a new connection. + (condition-case err + (unless (process-live-p p) + (with-tramp-progress-reporter + vec 3 + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) + (format "Opening connection %s for %s using %s" + process-name + (tramp-file-name-host vec) + (tramp-file-name-method vec)) + (format "Opening connection %s for %s@%s using %s" + process-name + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-method vec))) + (let* ((coding-system-for-read 'utf-8-unix) + (process-connection-type tramp-process-connection-type) + (p (apply + #'start-process + (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + (append + `(,tramp-encoding-shell) + (and tramp-encoding-command-interactive + `(,tramp-encoding-command-interactive))))) + (user (tramp-file-name-user vec)) + command) + ;; Set sentinel. Initialize variables. + (set-process-sentinel p #'tramp-process-sentinel) + (tramp-post-process-creation p vec) + + ;; Replace `login-args' place holders. + (setq command (format "exec su - %s || exit" + (or user "root"))) + ;; Send the command. + (tramp-message vec 3 "Sending command `%s'" command) + (tramp-adb-send-command vec command t t) + + ;; Android su binaries contact a background service to + ;; obtain authentication; during this process, input + ;; received is discarded, so input cannot be + ;; guaranteed to reach the root shell until its prompt + ;; is displayed. + (with-current-buffer (process-buffer p) + (tramp-wait-for-regexp p tramp-connection-timeout + "#[[:space:]]*$")) + + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + + ;; Change prompt. + (tramp-adb-send-command + vec (format "PS1=%s" + (tramp-shell-quote-argument tramp-end-of-output))) + + ;; Disable line editing. + (tramp-adb-send-command + vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") + + ;; Dump option settings in the traces. + (when (>= tramp-verbose 9) + (tramp-adb-send-command vec "set -o")) + + ;; Disable Unicode. + (tramp-adb-send-command vec "set +U") + + ;; Disable echo expansion. + (tramp-adb-send-command + vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t) + + ;; Check whether the echo has really been disabled. + ;; Some implementations, like busybox, don't support + ;; disabling. + (tramp-adb-send-command vec "echo foo" t) + (with-current-buffer (process-buffer p) + (goto-char (point-min)) + (when (looking-at-p "echo foo") + (tramp-set-connection-property p "remote-echo" t) + (tramp-message vec 5 "Remote echo still on. Ok.") + ;; Make sure backspaces and their echo are enabled + ;; and no line width magic interferes with them. + (tramp-adb-send-command vec + "stty icanon erase ^H cols 32767" + t))) + + ;; Set the remote PATH to a suitable value. + (tramp-set-connection-property vec "remote-path" + "/system/bin:/system/xbin") + + ;; Mark it as connected. + (tramp-set-connection-property p "connected" t)))) + + ;; Cleanup, and propagate the signal. + ((error quit) + (tramp-cleanup-connection vec t) + (signal (car err) (cdr err))))))) + +(defun tramp-androidsu-generate-wrapper (function) + "Return connection wrapper function for FUNCTION. +Return a function which temporarily substitutes local replacements for +the `adb' method's connection management functions around a call to +FUNCTION." + (lambda (&rest args) + (let ((tramp-adb-wait-for-output + (symbol-function #'tramp-adb-wait-for-output)) + (tramp-adb-maybe-open-connection + (symbol-function #'tramp-adb-maybe-open-connection))) + (unwind-protect + (progn + ;; tramp-adb-wait-for-output addresses problems introduced + ;; by the adb utility itself, not Android utilities, so + ;; replace it with the regular TRAMP function. + (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output) + ;; Likewise, except some special treatment is necessary on + ;; account of flaws in Android's su implementation. + (fset 'tramp-adb-maybe-open-connection + #'tramp-androidsu-maybe-open-connection) + (apply function args)) + ;; Restore the original definitions of the functions overridden + ;; above. + (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output) + (fset 'tramp-adb-maybe-open-connection tramp-adb-maybe-open-connection))))) + +(defalias 'tramp-androidsu-handle-access-file + (tramp-androidsu-generate-wrapper #'tramp-handle-access-file)) + +(defalias 'tramp-androidsu-handle-add-name-to-file + (tramp-androidsu-generate-wrapper #'tramp-handle-add-name-to-file)) + +(defalias 'tramp-androidsu-handle-copy-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) + +(defalias 'tramp-androidsu-adb-handle-copy-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-copy-file)) + +(defalias 'tramp-androidsu-adb-handle-delete-directory + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) + +(defalias 'tramp-androidsu-adb-handle-delete-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file)) + +(defalias 'tramp-androidsu-handle-directory-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-directory-file-name)) + +(defalias 'tramp-androidsu-handle-directory-files + (tramp-androidsu-generate-wrapper #'tramp-handle-directory-files)) + +(defalias 'tramp-androidsu-adb-handle-directory-files-and-attributes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-directory-files-and-attributes)) + +(defalias 'tramp-androidsu-handle-dired-uncache + (tramp-androidsu-generate-wrapper #'tramp-handle-dired-uncache)) + +(defalias 'tramp-androidsu-adb-handle-exec-path + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path)) + +(defalias 'tramp-androidsu-handle-expand-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-expand-file-name)) + +(defalias 'tramp-androidsu-handle-file-accessible-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-accessible-directory-p)) + +(defalias 'tramp-androidsu-adb-handle-file-attributes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes)) + +(defalias 'tramp-androidsu-handle-file-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-directory-p)) + +(defalias 'tramp-androidsu-handle-file-equal-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-equal-p)) + +(defalias 'tramp-androidsu-adb-handle-file-executable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p)) + +(defalias 'tramp-androidsu-adb-handle-file-exists-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p)) + +(defalias 'tramp-androidsu-handle-file-group-gid + (tramp-androidsu-generate-wrapper #'tramp-handle-file-group-gid)) + +(defalias 'tramp-androidsu-handle-file-in-directory-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-in-directory-p)) + +(defalias 'tramp-androidsu-sh-handle-file-local-copy + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-file-local-copy)) + +(defalias 'tramp-androidsu-handle-file-locked-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-locked-p)) + +(defalias 'tramp-androidsu-handle-file-modes + (tramp-androidsu-generate-wrapper #'tramp-handle-file-modes)) + +(defalias 'tramp-androidsu-adb-handle-file-name-all-completions + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-name-all-completions)) + +(defalias 'tramp-androidsu-handle-file-name-as-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-as-directory)) + +(defalias 'tramp-androidsu-handle-file-name-case-insensitive-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-case-insensitive-p)) + +(defalias 'tramp-androidsu-handle-file-name-completion + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-completion)) + +(defalias 'tramp-androidsu-handle-file-name-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-directory)) + +(defalias 'tramp-androidsu-handle-file-name-nondirectory + (tramp-androidsu-generate-wrapper #'tramp-handle-file-name-nondirectory)) + +(defalias 'tramp-androidsu-handle-file-newer-than-file-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-newer-than-file-p)) + +(defalias 'tramp-androidsu-handle-file-notify-add-watch + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-add-watch)) + +(defalias 'tramp-androidsu-handle-file-notify-rm-watch + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-rm-watch)) + +(defalias 'tramp-androidsu-handle-file-notify-valid-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-notify-valid-p)) + +(defalias 'tramp-androidsu-adb-handle-file-readable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p)) + +(defalias 'tramp-androidsu-handle-file-regular-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-regular-p)) + +(defalias 'tramp-androidsu-handle-file-remote-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-remote-p)) + +(defalias 'tramp-androidsu-handle-file-selinux-context + (tramp-androidsu-generate-wrapper #'tramp-handle-file-selinux-context)) + +(defalias 'tramp-androidsu-handle-file-symlink-p + (tramp-androidsu-generate-wrapper #'tramp-handle-file-symlink-p)) + +(defalias 'tramp-androidsu-adb-handle-file-system-info + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info)) + +(defalias 'tramp-androidsu-handle-file-truename + (tramp-androidsu-generate-wrapper #'tramp-handle-file-truename)) + +(defalias 'tramp-androidsu-handle-file-user-uid + (tramp-androidsu-generate-wrapper #'tramp-handle-file-user-uid)) + +(defalias 'tramp-androidsu-adb-handle-file-writable-p + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p)) + +(defalias 'tramp-androidsu-handle-find-backup-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-find-backup-file-name)) + +(defalias 'tramp-androidsu-handle-insert-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-insert-directory)) + +(defalias 'tramp-androidsu-handle-insert-file-contents + (tramp-androidsu-generate-wrapper #'tramp-handle-insert-file-contents)) + +(defalias 'tramp-androidsu-handle-list-system-processes + (tramp-androidsu-generate-wrapper #'tramp-handle-list-system-processes)) + +(defalias 'tramp-androidsu-handle-load + (tramp-androidsu-generate-wrapper #'tramp-handle-load)) + +(defalias 'tramp-androidsu-handle-lock-file + (tramp-androidsu-generate-wrapper #'tramp-handle-lock-file)) + +(defalias 'tramp-androidsu-handle-make-auto-save-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-make-auto-save-file-name)) + +(defalias 'tramp-androidsu-adb-handle-make-directory + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory)) + +(defalias 'tramp-androidsu-handle-make-lock-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-make-lock-file-name)) + +(defalias 'tramp-androidsu-handle-make-nearby-temp-file + (tramp-androidsu-generate-wrapper #'tramp-handle-make-nearby-temp-file)) + +(defalias 'tramp-androidsu-adb-handle-make-process + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-process)) + +(defalias 'tramp-androidsu-sh-handle-make-symbolic-link + (tramp-androidsu-generate-wrapper + #'tramp-sh-handle-make-symbolic-link)) + +(defalias 'tramp-androidsu-handle-memory-info + (tramp-androidsu-generate-wrapper #'tramp-handle-memory-info)) + +(defalias 'tramp-androidsu-handle-process-attributes + (tramp-androidsu-generate-wrapper #'tramp-handle-process-attributes)) + +(defalias 'tramp-androidsu-adb-handle-process-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) + +(defalias 'tramp-androidsu-adb-handle-rename-file + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-rename-file)) + +(defalias 'tramp-androidsu-adb-handle-set-file-modes + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) + +(defalias 'tramp-androidsu-adb-handle-set-file-times + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times)) + +(defalias 'tramp-androidsu-handle-set-visited-file-modtime + (tramp-androidsu-generate-wrapper #'tramp-handle-set-visited-file-modtime)) + +(defalias 'tramp-androidsu-handle-shell-command + (tramp-androidsu-generate-wrapper #'tramp-handle-shell-command)) + +(defalias 'tramp-androidsu-handle-start-file-process + (tramp-androidsu-generate-wrapper #'tramp-handle-start-file-process)) + +(defalias 'tramp-androidsu-handle-substitute-in-file-name + (tramp-androidsu-generate-wrapper #'tramp-handle-substitute-in-file-name)) + +(defalias 'tramp-androidsu-handle-temporary-file-directory + (tramp-androidsu-generate-wrapper #'tramp-handle-temporary-file-directory)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-gid + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-groups + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups)) + +(defalias 'tramp-androidsu-adb-handle-get-remote-uid + (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid)) + +(defalias 'tramp-androidsu-handle-unlock-file + (tramp-androidsu-generate-wrapper #'tramp-handle-unlock-file)) + +(defalias 'tramp-androidsu-handle-verify-visited-file-modtime + (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) + +(defalias 'tramp-androidsu-handle-write-region + (tramp-androidsu-generate-wrapper #'tramp-handle-write-region)) + +;;;###tramp-autoload +(defconst tramp-androidsu-file-name-handler-alist + '(;; `abbreviate-file-name' performed by default handler. + (access-file . tramp-androidsu-handle-access-file) + (add-name-to-file . tramp-androidsu-handle-add-name-to-file) + ;; `byte-compiler-base-file-name' performed by default handler. + (copy-directory . tramp-androidsu-handle-copy-directory) + (copy-file . tramp-androidsu-adb-handle-copy-file) + (delete-directory . tramp-androidsu-adb-handle-delete-directory) + (delete-file . tramp-androidsu-adb-handle-delete-file) + ;; `diff-latest-backup-file' performed by default handler. + (directory-file-name . tramp-androidsu-handle-directory-file-name) + (directory-files . tramp-androidsu-handle-directory-files) + (directory-files-and-attributes + . tramp-androidsu-adb-handle-directory-files-and-attributes) + (dired-compress-file . ignore) + (dired-uncache . tramp-androidsu-handle-dired-uncache) + (exec-path . tramp-androidsu-adb-handle-exec-path) + (expand-file-name . tramp-androidsu-handle-expand-file-name) + (file-accessible-directory-p . tramp-androidsu-handle-file-accessible-directory-p) + (file-acl . ignore) + (file-attributes . tramp-androidsu-adb-handle-file-attributes) + (file-directory-p . tramp-androidsu-handle-file-directory-p) + (file-equal-p . tramp-androidsu-handle-file-equal-p) + (file-executable-p . tramp-androidsu-adb-handle-file-executable-p) + (file-exists-p . tramp-androidsu-adb-handle-file-exists-p) + (file-group-gid . tramp-androidsu-handle-file-group-gid) + (file-in-directory-p . tramp-androidsu-handle-file-in-directory-p) + (file-local-copy . tramp-androidsu-sh-handle-file-local-copy) + (file-locked-p . tramp-androidsu-handle-file-locked-p) + (file-modes . tramp-androidsu-handle-file-modes) + (file-name-all-completions . tramp-androidsu-adb-handle-file-name-all-completions) + (file-name-as-directory . tramp-androidsu-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-androidsu-handle-file-name-case-insensitive-p) + (file-name-completion . tramp-androidsu-handle-file-name-completion) + (file-name-directory . tramp-androidsu-handle-file-name-directory) + (file-name-nondirectory . tramp-androidsu-handle-file-name-nondirectory) + ;; `file-name-sans-versions' performed by default handler. + (file-newer-than-file-p . tramp-androidsu-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-androidsu-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-androidsu-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-androidsu-handle-file-notify-valid-p) + (file-ownership-preserved-p . ignore) + (file-readable-p . tramp-androidsu-adb-handle-file-readable-p) + (file-regular-p . tramp-androidsu-handle-file-regular-p) + (file-remote-p . tramp-androidsu-handle-file-remote-p) + (file-selinux-context . tramp-androidsu-handle-file-selinux-context) + (file-symlink-p . tramp-androidsu-handle-file-symlink-p) + (file-system-info . tramp-androidsu-adb-handle-file-system-info) + (file-truename . tramp-androidsu-handle-file-truename) + (file-user-uid . tramp-androidsu-handle-file-user-uid) + (file-writable-p . tramp-androidsu-adb-handle-file-writable-p) + (find-backup-file-name . tramp-androidsu-handle-find-backup-file-name) + ;; `get-file-buffer' performed by default handler. + (insert-directory . tramp-androidsu-handle-insert-directory) + (insert-file-contents . tramp-androidsu-handle-insert-file-contents) + (list-system-processes . tramp-androidsu-handle-list-system-processes) + (load . tramp-androidsu-handle-load) + (lock-file . tramp-androidsu-handle-lock-file) + (make-auto-save-file-name . tramp-androidsu-handle-make-auto-save-file-name) + (make-directory . tramp-androidsu-adb-handle-make-directory) + (make-directory-internal . ignore) + (make-lock-file-name . tramp-androidsu-handle-make-lock-file-name) + (make-nearby-temp-file . tramp-androidsu-handle-make-nearby-temp-file) + (make-process . tramp-androidsu-adb-handle-make-process) + (make-symbolic-link . tramp-androidsu-sh-handle-make-symbolic-link) + (memory-info . tramp-androidsu-handle-memory-info) + (process-attributes . tramp-androidsu-handle-process-attributes) + (process-file . tramp-androidsu-adb-handle-process-file) + (rename-file . tramp-androidsu-adb-handle-rename-file) + (set-file-acl . ignore) + (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) + (set-file-selinux-context . ignore) + (set-file-times . tramp-androidsu-adb-handle-set-file-times) + (set-visited-file-modtime . tramp-androidsu-handle-set-visited-file-modtime) + (shell-command . tramp-androidsu-handle-shell-command) + (start-file-process . tramp-androidsu-handle-start-file-process) + (substitute-in-file-name . tramp-androidsu-handle-substitute-in-file-name) + (temporary-file-directory . tramp-androidsu-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) + (tramp-get-remote-gid . tramp-androidsu-adb-handle-get-remote-gid) + (tramp-get-remote-groups . tramp-androidsu-adb-handle-get-remote-groups) + (tramp-get-remote-uid . tramp-androidsu-adb-handle-get-remote-uid) + (tramp-set-file-uid-gid . ignore) + (unhandled-file-name-directory . ignore) + (unlock-file . tramp-androidsu-handle-unlock-file) + (vc-registered . ignore) + (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) + (write-region . tramp-androidsu-handle-write-region)) + "Alist of TRAMP handler functions for superuser sessions on Android.") + +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. +;;;###tramp-autoload +(defsubst tramp-androidsu-file-name-p (vec-or-filename) + "Check whether VEC-OR-FILENAME is for the `androidsu' method." + (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))) + (equal (tramp-file-name-method vec) tramp-androidsu-method))) + +;;;###tramp-autoload +(defun tramp-androidsu-file-name-handler (operation &rest args) + "Invoke the `androidsu' handler for OPERATION. +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." + (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist))) + (prog1 (save-match-data (apply (cdr fn) args)) + (setq tramp-debug-message-fnh-function (cdr fn))) + (prog1 (tramp-run-real-handler operation args) + (setq tramp-debug-message-fnh-function operation)))) + +;;;###tramp-autoload +(tramp--with-startup + (tramp-register-foreign-file-name-handler + #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler)) + +(connection-local-set-profile-variables + 'tramp-adb-connection-local-default-ps-profile + tramp-adb-connection-local-default-ps-variables) + +(with-eval-after-load 'shell + (connection-local-set-profiles + `(:application tramp :protocol ,tramp-adb-method) + 'tramp-adb-connection-local-default-shell-profile + 'tramp-adb-connection-local-default-ps-profile)) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-androidsu 'force))) + +(provide 'tramp-androidsu) +;;; tramp-androidsu.el ends here From 1687adcb5c93b490e2e7edcd14615af295e791ed Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 26 Feb 2024 14:13:49 +0800 Subject: [PATCH 368/385] ; Delete trailing whitespace * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Delete trailing whitespace. --- lisp/net/tramp-androidsu.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 417ef25ed8a..06800205f2e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -158,7 +158,7 @@ multibyte mode and waits for the shell prompt to appear." ;; Mark it as connected. (tramp-set-connection-property p "connected" t)))) - + ;; Cleanup, and propagate the signal. ((error quit) (tramp-cleanup-connection vec t) From 76fa7f1f2fb7fbc3dcbd0be7928d0ec112e532e7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Feb 2024 19:26:04 +0200 Subject: [PATCH 369/385] Fix display of reordered Arabic text * src/xdisp.c (compute_stop_pos): Fix a year-old thinko in handling auto-composed characters. It was introduced as part of solving bug#62780, which optimized the search for composable characters. (Bug#69384) --- src/xdisp.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 4d60915f31c..d03769e2a31 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4345,10 +4345,7 @@ compute_stop_pos (struct it *it) } } - if (it->cmp_it.id < 0 - && (STRINGP (it->string) - || ((!it->bidi_p || it->bidi_it.scan_dir >= 0) - && it->cmp_it.stop_pos <= IT_CHARPOS (*it)))) + if (it->cmp_it.id < 0) { ptrdiff_t stoppos = it->end_charpos; @@ -4357,7 +4354,9 @@ compute_stop_pos (struct it *it) characters to that position. */ if (it->bidi_p && it->bidi_it.scan_dir < 0) stoppos = -1; - else if (cmp_limit_pos > 0) + else if (!STRINGP (it->string) + && it->cmp_it.stop_pos <= IT_CHARPOS (*it) + && cmp_limit_pos > 0) stoppos = cmp_limit_pos; /* Force composition_compute_stop_pos avoid the costly search for static compositions, since those were already found by From 25cfccfb8b5bced05d5547f3eabb4d0508a575c8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 26 Feb 2024 12:33:35 -0500 Subject: [PATCH 370/385] (edebug-tests-trivial-comma): Avoid interaction (bug#69406) * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-trivial-backquote): Don't use obsolete `edebug-eval-defun`. (edebug-tests-trivial-comma): Use `inhibit-read-only`; don't use obsolete `edebug-eval-defun`; and fix bug#69406 by binding `eval-expression-debug-on-error`. --- test/lisp/emacs-lisp/edebug-tests.el | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 8c0f729dc39..29adbcff947 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -860,8 +860,7 @@ test and possibly others should be updated." (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) (insert "`1")) - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (edebug-eval-defun nil)) + (eval-defun nil) ;; `eval-defun' outputs its message to the echo area in a rather ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed ;; there in separate pieces (via `print' rather than via `message'). @@ -871,18 +870,21 @@ test and possibly others should be updated." (setq edebug-initial-mode 'go) ;; In Bug#23651 Edebug would hang reading `1. - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (edebug-eval-defun t)))) + (eval-defun t) + (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)") + edebug-tests-messages)))) (ert-deftest edebug-tests-trivial-comma () "Edebug can read a trivial comma expression (Bug#23651)." (edebug-tests-with-normal-env - (read-only-mode -1) - (delete-region (point-min) (point-max)) - (insert ",1") - (read-only-mode) - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (should-error (edebug-eval-defun t))))) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert ",1")) + ;; FIXME: This currently signals a "Source has changed" error, which is + ;; itself a bug (the source hasn't changed). All we're testing here + ;; is that the Edebug gets past the step of reading the sexp. + (should-error (let ((eval-expression-debug-on-error nil)) + (eval-defun t))))) (ert-deftest edebug-tests-circular-read-syntax () "Edebug can instrument code using circular read object syntax (Bug#23660)." From a67b8d7f448804d34bce85d2b6ab8d022f14161f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 26 Feb 2024 18:42:44 +0100 Subject: [PATCH 371/385] Make tree-sitter tests work installed in .emacs.d/tree-sitter * test/Makefile.in (ert_opts): Set treesit-extra-load-path, because HOME is not valid when running tests from the Makefile (bug#69405). --- test/Makefile.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Makefile.in b/test/Makefile.in index 720f5c7ff8c..3cbdbec4414 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -92,6 +92,10 @@ export TEST_LOAD_EL ?= \ # Additional settings for ert. ert_opts = +# Supply a path to local tree-sitter installations, as we run tests +# without a valid HOME. +ert_opts += --eval "(setq treesit-extra-load-path '(\"$(HOME)/.emacs.d/tree-sitter\"))" + # Maximum length of lines in ert backtraces; nil for no limit. # (if empty, use the default ert-batch-backtrace-right-margin). TEST_BACKTRACE_LINE_LENGTH = From b3eb49a4661e31306555e82bdf24db6c36d67ad2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 26 Feb 2024 14:32:08 -0500 Subject: [PATCH 372/385] tex-mode.el: Increase depth of braces highlighted in $...$ blocks * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-1): Increase depth of braces supported in $...$ blocks. (tex-font-lock-keywords-2, tex-font-lock-syntactic-face-function): Refer directly to font-lock faces. --- lisp/textmodes/tex-mode.el | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5c5ca573f38..616b8871090 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -511,9 +511,14 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; This would allow highlighting \newcommand\CMD but requires ;; adapting subgroup numbers below. ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) - (inbraces-re (lambda (re) - (concat "\\(?:[^{}\\]\\|\\\\.\\|" re "\\)"))) - (arg (concat "{\\(" (funcall inbraces-re "{[^}]*}") "+\\)"))) + (inbraces-re + (lambda (n) ;; Level of nesting of braces we should support. + (let ((re "[^}]")) + (dotimes (_ n) + (setq re + (concat "\\(?:[^{}\\]\\|\\\\.\\|{" re "*}\\)"))) + re))) + (arg (concat "{\\(" (funcall inbraces-re 2) "+\\)"))) `(;; Verbatim-like args. ;; Do it first, because we don't want to highlight them ;; in comments (bug#68827), but we do want to highlight them @@ -523,8 +528,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; This is done at the very beginning so as to interact with the other ;; keywords in the same way as comments and strings. (,(concat "\\$\\$?\\(?:[^$\\{}]\\|\\\\.\\|{" - (funcall inbraces-re - (concat "{" (funcall inbraces-re "{[^}]*}") "*}")) + (funcall inbraces-re 6) "*}\\)+\\$?\\$") (0 'tex-math keep)) ;; Heading args. @@ -605,14 +609,14 @@ An alternative value is \" . \", if you use a font with a narrow period." (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) "\\(\\(.\\|\n\\)+?\\)" (regexp-opt `("''" "\">" "\"'" ">>" "»") t)) - '(1 font-lock-keyword-face) - '(2 font-lock-string-face) - '(4 font-lock-keyword-face)) + '(1 'font-lock-keyword-face) + '(2 'font-lock-string-face) + '(4 'font-lock-keyword-face)) ;; ;; Command names, special and general. (cons (concat slash specials-1) 'font-lock-warning-face) (list (concat "\\(" slash specials-2 "\\)\\([^a-zA-Z@]\\|\\'\\)") - 1 'font-lock-warning-face) + '(1 'font-lock-warning-face)) (concat slash general) ;; ;; Font environments. It seems a bit dubious to use `bold' etc. faces @@ -680,7 +684,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (eval-when-compile (defconst tex-syntax-propertize-rules (syntax-propertize-precompile-rules - ("\\\\verb\\**\\([^a-z@*]\\)" + ("\\\\verb\\**\\([^a-z@*]\\)" (1 (prog1 "\"" (tex-font-lock-verb (match-beginning 0) (char-after (match-beginning 1)))))))) @@ -764,7 +768,7 @@ automatically inserts its partner." (regexp-quote (buffer-substring arg-start arg-end))) (text-clone-create arg-start arg-end)))))))) (scan-error nil) - (error (message "Error in latex-env-before-change: %s" err))))) + (error (message "Error in latex-env-before-change: %S" err))))) (defun tex-font-lock-unfontify-region (beg end) (font-lock-default-unfontify-region beg end) @@ -852,7 +856,7 @@ START is the position of the \\ and DELIM is the delimiter char." (let ((char (nth 3 state))) (cond ((not char) - (if (eq 2 (nth 7 state)) 'tex-verbatim font-lock-comment-face)) + (if (eq 2 (nth 7 state)) 'tex-verbatim 'font-lock-comment-face)) ((eq char ?$) 'tex-math) ;; A \verb element. (t 'tex-verbatim)))) @@ -1265,8 +1269,8 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (setq-local facemenu-end-add-face "}") (setq-local facemenu-remove-face-function t) (setq-local font-lock-defaults - '((tex-font-lock-keywords tex-font-lock-keywords-1 - tex-font-lock-keywords-2 tex-font-lock-keywords-3) + '(( tex-font-lock-keywords tex-font-lock-keywords-1 + tex-font-lock-keywords-2 tex-font-lock-keywords-3) nil nil nil nil ;; Who ever uses that anyway ??? (font-lock-mark-block-function . mark-paragraph) From 32b4f9d21b14190f1ed1611515751abe4b90fa68 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 27 Feb 2024 10:05:56 +0800 Subject: [PATCH 373/385] Disable process tracing before launching /system/bin/su * lisp/net/tramp-androidsu.el (tramp-androidsu-maybe-open-connection): Disable process tracing around start-process, that the setuid su binary may be started regardless of its status. --- lisp/net/tramp-androidsu.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 06800205f2e..cf6b0d7202c 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -55,6 +55,8 @@ (add-to-list 'tramp-default-host-alist `(,tramp-androidsu-method nil "localhost"))) +(defvar android-use-exec-loader) ; androidfns.c. + (defun tramp-androidsu-maybe-open-connection (vec) "Open a connection VEC if not already open. Mostly identical to `tramp-adb-maybe-open-connection', but also disables @@ -84,14 +86,17 @@ multibyte mode and waits for the shell prompt to appear." (tramp-file-name-method vec))) (let* ((coding-system-for-read 'utf-8-unix) (process-connection-type tramp-process-connection-type) - (p (apply - #'start-process - (tramp-get-connection-name vec) - (tramp-get-connection-buffer vec) - (append - `(,tramp-encoding-shell) - (and tramp-encoding-command-interactive - `(,tramp-encoding-command-interactive))))) + ;; The executable loader cannot execute setuid + ;; binaries, such as su. + (android-use-exec-loader nil) + (p (start-process (tramp-get-connection-name vec) + (tramp-get-connection-buffer vec) + ;; Disregard + ;; tramp-encoding-shell, as + ;; there's no guarantee that it's + ;; possible to execute with + ;; `android-use-exec-loader' off. + "/system/bin/sh" "-i")) (user (tramp-file-name-user vec)) command) ;; Set sentinel. Initialize variables. From b59d7094b6cb1a09f46f933807e9cd00a8bd1547 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 27 Feb 2024 10:32:08 +0100 Subject: [PATCH 374/385] Allow vc-git-clone to check-out arbitrary revisions * lisp/vc/vc-git.el (vc-git-clone): If "git clone --branch" fails, then clone the repository regularly and checkout the requested revision. --- lisp/vc/vc-git.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 456417e566e..18b4a8691e9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1411,9 +1411,16 @@ This prompts for a branch to merge from." (vc-message-unresolved-conflicts buffer-file-name))) (defun vc-git-clone (remote directory rev) - (if rev - (vc-git--out-ok "clone" "--branch" rev remote directory) + "Attempt to clone REMOTE repository into DIRECTORY at revision REV." + (cond + ((null rev) (vc-git--out-ok "clone" remote directory)) + ((ignore-errors + (vc-git--out-ok "clone" "--branch" rev remote directory))) + ((vc-git--out-ok "clone" remote directory) + (let ((default-directory directory)) + (vc-git--out-ok "checkout" rev))) + ((error "Failed to check out %s at %s" remote rev))) directory) ;;; HISTORY FUNCTIONS From 6a77355527b2f7f1dca9c2296c2684033c9aa875 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 27 Feb 2024 08:24:45 -0500 Subject: [PATCH 375/385] vhdl-mode.el: Reduce use of `eval` * lisp/progmodes/vhdl-mode.el (vhdl--re2-region): New function. (vhdl--signal-regions-functions): New constant, extracted from `vhdl-update-sensitivity-list`. (vhdl-update-sensitivity-list): Use it. --- lisp/progmodes/vhdl-mode.el | 76 ++++++++++++++++++++----------------- 1 file changed, 41 insertions(+), 35 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f52baf049aa..144bfa944d3 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -8398,6 +8398,44 @@ buffer." (message "Updating sensitivity lists...done"))) (when noninteractive (save-buffer))) +(defun vhdl--re2-region (beg-re end-re) + "Return a function searching for a region delimited by a pair of regexps. +BEG-RE and END-RE are the regexps delimiting the region to search for." + (lambda (proc-end) + (when (vhdl-re-search-forward beg-re proc-end t) + (save-excursion + (vhdl-re-search-forward end-re proc-end t))))) + +(defconst vhdl--signal-regions-functions + (list + ;; right-hand side of signal/variable assignment + ;; (special case: "<=" is relational operator in a condition) + (vhdl--re2-region "[<:]=" + ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>") + ;; if condition + (vhdl--re2-region "^\\s-*if\\>" "\\") + ;; elsif condition + (vhdl--re2-region "\\" "\\") + ;; while loop condition + (vhdl--re2-region "^\\s-*while\\>" "\\") + ;; exit/next condition + (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";") + ;; assert condition + (vhdl--re2-region "\\" "\\(\\\\|\\\\|;\\)") + ;; case expression + (vhdl--re2-region "^\\s-*case\\>" "\\") + ;; parameter list of procedure call, array index + (lambda (proc-end) + (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) + (forward-char -1) + (save-excursion + (forward-sexp) + (while (looking-at "(") (forward-sexp)) (point))))) + "Define syntactic regions where signals are read. +Each function is called with one arg (a limit for the (forward) search) and +should return either nil or the end position of the region (in which case +point will be set to its beginning).") + (defun vhdl-update-sensitivity-list () "Update sensitivity list." (let ((proc-beg (point)) @@ -8418,35 +8456,6 @@ buffer." (let ;; scan for visible signals ((visible-list (vhdl-get-visible-signals)) - ;; define syntactic regions where signals are read - (scan-regions-list - `(;; right-hand side of signal/variable assignment - ;; (special case: "<=" is relational operator in a condition) - ((vhdl-re-search-forward "[<:]=" ,proc-end t) - (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) - ;; if condition - ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; elsif condition - ((vhdl-re-search-forward "\\" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; while loop condition - ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; exit/next condition - ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) - (vhdl-re-search-forward ";" ,proc-end t)) - ;; assert condition - ((vhdl-re-search-forward "\\" ,proc-end t) - (vhdl-re-search-forward "\\(\\\\|\\\\|;\\)" ,proc-end t)) - ;; case expression - ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) - (vhdl-re-search-forward "\\" ,proc-end t)) - ;; parameter list of procedure call, array index - ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) - (1- (point))) - (progn (backward-char) (forward-sexp) - (while (looking-at "(") (forward-sexp)) (point))))) name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list @@ -8475,11 +8484,9 @@ buffer." (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process - (while scan-regions-list + (dolist (scan-fun vhdl--signal-regions-functions) (goto-char proc-mid) - (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) - (setq end (eval (nth 1 (car scan-regions-list))))) - (goto-char beg) + (while (setq end (funcall scan-fun proc-end)) (unless (or (vhdl-in-literal) (and seq-region-list (let ((tmp-list seq-region-list)) @@ -8518,8 +8525,7 @@ buffer." (car tmp-list)) (setq read-list (delete (car tmp-list) read-list))) (setq tmp-list (cdr tmp-list))))) - (goto-char (match-end 1))))) - (setq scan-regions-list (cdr scan-regions-list))) + (goto-char (match-end 1)))))) ;; update sensitivity list (goto-char sens-beg) (if sens-end From f1db8cf9a0595f7db29b548b38ce98196f36e09b Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 28 Feb 2024 12:05:59 +0800 Subject: [PATCH 376/385] Lift restrictions on `tramp-androidsu's app data access * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): Remove code now unnecessary. * lisp/net/tramp-androidsu.el (tramp-androidsu-mount-global-namespace): New user option. (tramp-androidsu-su-mm-supported): New variable. (tramp-androidsu-maybe-open-connection): Detect whether su supports the -mm option, and provide it if so. (tramp-androidsu-adb-handle-copy-file) (tramp-androidsu-adb-handle-rename-file): Delete functions. (tramp-androidsu-sh-handle-copy-file) (tramp-androidsu-sh-handle-rename-file): New functions. (tramp-androidsu-file-name-handler-alist): Switch to tramp-sh's copy and rename handlers. --- lisp/net/tramp-adb.el | 21 +++----------- lisp/net/tramp-androidsu.el | 55 ++++++++++++++++++++++++++++++------- 2 files changed, 49 insertions(+), 27 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4f04912c032..3f216ba403a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -641,23 +641,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (unless (if (tramp-adb-file-name-p v) - (tramp-adb-execute-adb-command - v "push" - (file-name-unquote filename) - (file-name-unquote localname)) - ;; Otherwise, this operation was initiated - ;; by the androidsu backend, so both files - ;; must be present on the local machine and - ;; transferable with a simple local copy. - (tramp-adb-send-command-and-check - v - (format - "cp -f %s %s" - (tramp-shell-quote-argument - (file-name-unquote filename)) - (tramp-shell-quote-argument - (file-name-unquote localname))))) + (unless (tramp-adb-execute-adb-command + v "push" + (file-name-unquote filename) + (file-name-unquote localname)) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname))))))))) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index cf6b0d7202c..6d4ac2c17f1 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -40,6 +40,22 @@ (defconst tramp-androidsu-method "androidsu" "When this method name is used, forward all calls to su.") +;;;###tramp-autoload +(defcustom tramp-androidsu-mount-global-namespace t + "When non-nil, browse files from within the global mount namespace. +On systems that assign each application a unique view of the filesystem +by executing them within individual mount namespaces and thus conceal +each application's data directories from others, invoke `su' with the +option `-mm' in order for the shell launched to run within the global +mount namespace, so that TRAMP may edit files belonging to any and all +applications." + :group 'tramp + :version "30.1" + :type 'boolean) + +(defvar tramp-androidsu-su-mm-supported 'unknown + "Whether `su -mm' is supported on this system.") + ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-methods @@ -94,7 +110,7 @@ multibyte mode and waits for the shell prompt to appear." ;; Disregard ;; tramp-encoding-shell, as ;; there's no guarantee that it's - ;; possible to execute with + ;; possible to execute it with ;; `android-use-exec-loader' off. "/system/bin/sh" "-i")) (user (tramp-file-name-user vec)) @@ -103,13 +119,32 @@ multibyte mode and waits for the shell prompt to appear." (set-process-sentinel p #'tramp-process-sentinel) (tramp-post-process-creation p vec) - ;; Replace `login-args' place holders. + ;; Replace `login-args' place holders. (setq command (format "exec su - %s || exit" (or user "root"))) - ;; Send the command. + + ;; Attempt to execute the shell inside the global mount + ;; namespace if requested. + (when tramp-androidsu-mount-global-namespace + (progn + (when (eq tramp-androidsu-su-mm-supported 'unknown) + ;; Change the prompt in advance so that + ;; tramp-adb-send-command-and-check can call + ;; tramp-search-regexp. + (tramp-adb-send-command + vec (format "PS1=%s" + (tramp-shell-quote-argument + tramp-end-of-output))) + (setq tramp-androidsu-su-mm-supported + ;; Detect support for `su -mm'. + (tramp-adb-send-command-and-check + vec "su -mm -c 'exit 24'" 24))) + (when tramp-androidsu-su-mm-supported + (setq command (format "exec su -mm - %s || exit" + (or user "root")))))) + ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-adb-send-command vec command t t) - ;; Android su binaries contact a background service to ;; obtain authentication; during this process, input ;; received is discarded, so input cannot be @@ -204,8 +239,8 @@ FUNCTION." (defalias 'tramp-androidsu-handle-copy-directory (tramp-androidsu-generate-wrapper #'tramp-handle-copy-directory)) -(defalias 'tramp-androidsu-adb-handle-copy-file - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-copy-file)) +(defalias 'tramp-androidsu-sh-handle-copy-file + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-copy-file)) (defalias 'tramp-androidsu-adb-handle-delete-directory (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory)) @@ -367,8 +402,8 @@ FUNCTION." (defalias 'tramp-androidsu-adb-handle-process-file (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file)) -(defalias 'tramp-androidsu-adb-handle-rename-file - (tramp-androidsu-generate-wrapper #'tramp-adb-handle-rename-file)) +(defalias 'tramp-androidsu-sh-handle-rename-file + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-rename-file)) (defalias 'tramp-androidsu-adb-handle-set-file-modes (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes)) @@ -416,7 +451,7 @@ FUNCTION." (add-name-to-file . tramp-androidsu-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. (copy-directory . tramp-androidsu-handle-copy-directory) - (copy-file . tramp-androidsu-adb-handle-copy-file) + (copy-file . tramp-androidsu-sh-handle-copy-file) (delete-directory . tramp-androidsu-adb-handle-delete-directory) (delete-file . tramp-androidsu-adb-handle-delete-file) ;; `diff-latest-backup-file' performed by default handler. @@ -478,7 +513,7 @@ FUNCTION." (memory-info . tramp-androidsu-handle-memory-info) (process-attributes . tramp-androidsu-handle-process-attributes) (process-file . tramp-androidsu-adb-handle-process-file) - (rename-file . tramp-androidsu-adb-handle-rename-file) + (rename-file . tramp-androidsu-sh-handle-rename-file) (set-file-acl . ignore) (set-file-modes . tramp-androidsu-adb-handle-set-file-modes) (set-file-selinux-context . ignore) From 977a56d5c7d71b958767dbae05b75c5e5cb87571 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 28 Feb 2024 12:23:32 +0800 Subject: [PATCH 377/385] ; Fix last change * lisp/net/tramp-androidsu.el (tramp-androidsu-handle-write-region): Delete function. (tramp-androidsu-sh-handle-write-region): New function. (tramp-androidsu-file-name-handler-alist): Avoid infinite recursion by replacing handle-write-region with the tramp-sh implementation. --- lisp/net/tramp-androidsu.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 6d4ac2c17f1..fd9edb6a92e 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -441,8 +441,8 @@ FUNCTION." (defalias 'tramp-androidsu-handle-verify-visited-file-modtime (tramp-androidsu-generate-wrapper #'tramp-handle-verify-visited-file-modtime)) -(defalias 'tramp-androidsu-handle-write-region - (tramp-androidsu-generate-wrapper #'tramp-handle-write-region)) +(defalias 'tramp-androidsu-sh-handle-write-region + (tramp-androidsu-generate-wrapper #'tramp-sh-handle-write-region)) ;;;###tramp-autoload (defconst tramp-androidsu-file-name-handler-alist @@ -532,7 +532,7 @@ FUNCTION." (unlock-file . tramp-androidsu-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-androidsu-handle-verify-visited-file-modtime) - (write-region . tramp-androidsu-handle-write-region)) + (write-region . tramp-androidsu-sh-handle-write-region)) "Alist of TRAMP handler functions for superuser sessions on Android.") ;; It must be a `defsubst' in order to push the whole code into From 3412b64ac8851a0fa8e55c6319d2e710ae27a74c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 11:35:04 +0100 Subject: [PATCH 378/385] ; Update Lisp_Obarray hash for CHECK_STRUCTS This follows commit 462d8ba813 of 2024-02-23 "Add a proper type for obarrays". --- src/pdumper.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index ca457858219..f0bce09cbde 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2774,8 +2774,8 @@ dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o) static dump_off dump_obarray (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_XXXXXXXXXX -# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." +#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_D2757E61AD +# error "Lisp_Obarray changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Obarray *in_oa = XOBARRAY (object); struct Lisp_Obarray munged_oa = *in_oa; @@ -3049,7 +3049,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_D8A254BC70 +#if CHECK_STRUCTS && !defined HASH_pvec_type_2D583AC566 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); From 8a2d013be37d8c3d3a25cfe1da505cd2e27dda5c Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Wed, 21 Feb 2024 12:40:06 +0800 Subject: [PATCH 379/385] Fix Python shell completion test failures * test/lisp/progmodes/python-tests.el (python-tests-with-temp-buffer-with-shell): Set XDG_CACHE_HOME to a temporary directory. (python-tests--pythonstartup-file): New function. (python-shell-completion-at-point-jedi-completer) (python-shell-completion-at-point-ipython): Use Jedi as the native completion backend when possible. (bug#68559) --- test/lisp/progmodes/python-tests.el | 87 ++++++++++++++++++----------- 1 file changed, 53 insertions(+), 34 deletions(-) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 6c6cd9eee2b..1ceee690cfb 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -55,21 +55,27 @@ BODY is code to be executed within the temp buffer. Point is always located at the beginning of buffer. Native completion is turned off. Shell buffer will be killed on exit." (declare (indent 1) (debug t)) - `(with-temp-buffer - (let ((python-indent-guess-indent-offset nil) - (python-shell-completion-native-enable nil)) - (python-mode) - (unwind-protect - (progn - (run-python nil t) - (insert ,contents) - (goto-char (point-min)) - (python-tests-shell-wait-for-prompt) - ,@body) - (when (python-shell-get-buffer) - (python-shell-with-shell-buffer - (let (kill-buffer-hook kill-buffer-query-functions) - (kill-buffer)))))))) + (let ((dir (make-symbol "dir"))) + `(with-temp-buffer + (let ((python-indent-guess-indent-offset nil) + (python-shell-completion-native-enable nil)) + (python-mode) + (unwind-protect + ;; Prevent test failures when Jedi is used as a completion + ;; backend, either directly or indirectly (e.g., via + ;; IPython). Jedi needs to store cache, but the + ;; "/nonexistent" HOME directory is not writable. + (ert-with-temp-directory ,dir + (with-environment-variables (("XDG_CACHE_HOME" ,dir)) + (run-python nil t) + (insert ,contents) + (goto-char (point-min)) + (python-tests-shell-wait-for-prompt) + ,@body)) + (when (python-shell-get-buffer) + (python-shell-with-shell-buffer + (let (kill-buffer-hook kill-buffer-query-functions) + (kill-buffer))))))))) (defmacro python-tests-with-temp-file (contents &rest body) "Create a `python-mode' enabled file with CONTENTS. @@ -4860,17 +4866,28 @@ def foo(): (should (string= "IGNORECASE" (buffer-substring (line-beginning-position) (point))))) +(defun python-tests--pythonstartup-file () + "Return Jedi readline setup file if PYTHONSTARTUP is not set." + (or (getenv "PYTHONSTARTUP") + (with-temp-buffer + (if (eql 0 (call-process python-tests-shell-interpreter + nil t nil "-m" "jedi" "repl")) + (string-trim (buffer-string)) + "")))) + (ert-deftest python-shell-completion-at-point-jedi-completer () "Check if Python shell completion works when Jedi completer is used." (skip-unless (executable-find python-tests-shell-interpreter)) - (python-tests-with-temp-buffer-with-shell - "" - (python-shell-with-shell-buffer - (python-shell-completion-native-turn-on) - (skip-unless (string= python-shell-readline-completer-delims "")) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-tests--completion-extra-context)))) + (with-environment-variables + (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) (ert-deftest python-shell-completion-at-point-ipython () "Check if Python shell completion works for IPython." @@ -4880,17 +4897,19 @@ def foo(): (and (executable-find python-shell-interpreter) (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) - (python-tests-with-temp-buffer-with-shell - "" - (python-shell-with-shell-buffer - (python-shell-completion-native-turn-off) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-shell-completion-native-turn-on) - (skip-unless (string= python-shell-readline-completer-delims "")) - (python-tests--completion-module) - (python-tests--completion-parameters) - (python-tests--completion-extra-context))))) + (with-environment-variables + (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context)))))) ;;; PDB Track integration From 1ddd9c8e29f721fcf6fcb17ef7a07fac0421c4f7 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 15:30:41 +0100 Subject: [PATCH 380/385] ; * .mailmap: Fix GitHub address (bug#68559#170). --- .mailmap | 1 + 1 file changed, 1 insertion(+) diff --git a/.mailmap b/.mailmap index 7c474fcdaf6..c9bdede6c73 100644 --- a/.mailmap +++ b/.mailmap @@ -116,6 +116,7 @@ Lars Ingebrigtsen Lars Ingebrigtsen Laurence Warne Lin Sun +Liu Hui Ludovic Courtès Luke Lee Martin Rudalics From e490d2f8724c5e47d83c40c388f60e84f541dae5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 28 Feb 2024 16:31:25 +0100 Subject: [PATCH 381/385] Revert change in tramp-adb-send-command * lisp/net/tramp-adb.el (tramp-adb-send-command): Revert check for `tramp-androidsu-method'. There is no need to restrict the check. --- lisp/net/tramp-adb.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 3f216ba403a..8ad7c271b4f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1114,9 +1114,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (and (equal (tramp-file-name-method vec) - tramp-androidsu-method) - (string-match-p (rx multibyte) command)) + (if (string-match-p (rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1148,8 +1146,8 @@ error and non-nil on success." (while (search-forward-regexp (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) -(defun tramp-adb-send-command-and-check (vec command &optional exit-status - command-augmented-p) +(defun tramp-adb-send-command-and-check + (vec command &optional exit-status command-augmented-p) "Run COMMAND and check its exit status. Sends `echo $?' along with the COMMAND for checking the exit status. If COMMAND is nil, just sends `echo $?'. Returns nil if @@ -1162,7 +1160,8 @@ Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (tramp-adb-send-command vec (if command - (if command-augmented-p command + (if command-augmented-p + command (format "%s; echo tramp_exit_status $?" command)) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) From f7c2fe3337bb5e5721d17f40f79dbc1275e17b0d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 16:38:21 +0100 Subject: [PATCH 382/385] Pacify some docstring control char warnings Other instances are discussed in the following thread: https://lists.gnu.org/r/emacs-devel/2024-02/msg00797.html * lisp/allout.el (allout-command-prefix): Declare :type as key-sequence. Mark up key sequences in docstring. * lisp/auth-source.el (auth-source--decode-octal-string): * lisp/ffap.el (ffap-search-backward-file-end): * lisp/gnus/gnus-art.el (gnus-page-delimiter): * lisp/gnus/nnheader.el (nnheader-strip-cr): * lisp/proced.el (proced-log): * lisp/progmodes/idlw-shell.el (idlwave-shell-prompt-pattern): * lisp/url/url-http.el (url-http-clean-headers): * lisp/vcursor.el (vcursor-interpret-input): Quote control characters in docstrings. --- lisp/allout.el | 6 +++--- lisp/auth-source.el | 2 +- lisp/ffap.el | 4 ++-- lisp/gnus/gnus-art.el | 2 +- lisp/gnus/nnheader.el | 2 +- lisp/proced.el | 2 +- lisp/progmodes/idlw-shell.el | 4 ++-- lisp/url/url-http.el | 2 +- lisp/vcursor.el | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/allout.el b/lisp/allout.el index a7121efb14a..e3fe8d08841 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -161,9 +161,9 @@ respective `allout-mode' keybinding variables, `allout-command-prefix', (defcustom allout-command-prefix "\C-c " "Key sequence to be used as prefix for outline mode command key bindings. -Default is `\C-c'; just `\C-c' is more short-and-sweet, if you're -willing to let allout use a bunch of \C-c keybindings." - :type 'string +Default is \\`C-c SPC'; just \\`C-c' is more short-and-sweet, if you're +willing to let allout use a bunch of \\`C-c' keybindings." + :type 'key-sequence :group 'allout-keybindings :set #'allout-compose-and-institute-keymap) ;;;_ = allout-keybindings-binding diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 1f233f9f60f..5f5629d9cfc 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1985,7 +1985,7 @@ entries for git.gnus.org: (defun auth-source--decode-octal-string (string) - "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"." + "Convert octal STRING to utf-8 string. E.g.: \"a\\134b\" to \"a\\b\"." (let ((list (string-to-list string)) (size (length string))) (decode-coding-string diff --git a/lisp/ffap.el b/lisp/ffap.el index 3492dcbf17a..5383f743878 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1098,12 +1098,12 @@ Suppose the cursor is somewhere that might be near end of file, the guessing would position point before punctuation (like comma) after the file extension: - C:\temp\file.log, which contain .... + C:\\temp\\file.log, which contain .... =============================== (before) ---------------- (after) - C:\temp\file.log on Windows or /tmp/file.log on Unix + C:\\temp\\file.log on Windows or /tmp/file.log on Unix =============================== (before) ---------------- (after) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c3c5eab7d89..9f313108089 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -694,7 +694,7 @@ used as possible file names." (defcustom gnus-page-delimiter "^\^L" "Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the +The default value is \"^\\^L\", which is a form linefeed at the beginning of a line." :type 'regexp :group 'gnus-article-various) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 97821894b48..ea679759f3e 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1016,7 +1016,7 @@ See `find-file-noselect' for the arguments." (nnheader-skeleton-replace from to t)) (defun nnheader-strip-cr () - "Strip all \r's from the current buffer." + "Strip all \\r's from the current buffer." (nnheader-skeleton-replace "\r")) (define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") diff --git a/lisp/proced.el b/lisp/proced.el index 3435f1ab8cd..7d7de1e2ce3 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -2261,7 +2261,7 @@ If LOG is a string and there are more args, it is formatted with those ARGS. Usually the LOG string ends with a \\n. End each bunch of errors with (proced-log t signal): this inserts the current time, buffer and signal at the start of the page, -and \f (formfeed) at the end." +and \\f (formfeed) at the end." (let ((obuf (current-buffer))) (with-current-buffer (get-buffer-create proced-log-buffer) (goto-char (point-max)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 0f11103cf02..b5d91f46b17 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -96,8 +96,8 @@ (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " "Regexp to match IDL prompt at beginning of a line. -For example, \"^\r?IDL> \" or \"^\r?WAVE> \". -The \"^\r?\" is needed, to indicate the beginning of the line, with +For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \". +The \"^\\r?\" is needed, to indicate the beginning of the line, with optional return character (which IDL seems to output randomly). This variable is used to initialize `comint-prompt-regexp' in the process buffer." diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index d6a1d0eade8..184c1278072 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -427,7 +427,7 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')." ;; Parsing routines (defun url-http-clean-headers () - "Remove trailing \r from header lines. + "Remove trailing \\r from header lines. This allows us to use `mail-fetch-field', etc. Return the number of characters removed." (let ((end (marker-position url-http-end-of-headers))) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index ec5adbd832c..15791285b13 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -433,7 +433,7 @@ Default is nil." (defcustom vcursor-interpret-input nil "If non-nil, input from the vcursor is treated as interactive input. This will cause text insertion to be much slower. Note that no special -interpretation of strings is done: \"\C-x\" is a string of four +interpretation of strings is done: \"\\C-x\" is a string of four characters. The default is simply to copy strings." :type 'boolean :version "20.3") From bca3c9b466e24aacd561c818f2d19665af6efc11 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Feb 2024 17:02:41 +0100 Subject: [PATCH 383/385] ; Fix :type of text-mode-ispell-word-completion. --- lisp/textmodes/text-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 87f6668cecb..e8e1f4898ce 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -88,7 +88,7 @@ nor does it extend `completion-at-point-functions'. This user option only takes effect when you customize it in Custom or with `setopt', not with `setq'." :group 'text - :type 'boolean + :type '(choice (const completion-at-point) boolean) :version "30.1" :set (lambda (sym val) (if (and (set sym val) From 91b90885aca17b5140b56fa3b5c4960baf8672a1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:38:02 +0100 Subject: [PATCH 384/385] * lisp/emacs-lisp/comp.el (comp-known-predicates): Add 'symbol-with-pos-p'. --- lisp/emacs-lisp/comp.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index ae964b041d0..21e2bb01ed0 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -220,6 +220,7 @@ Useful to hook into pass checkers.") (sequencep . sequence) (stringp . string) (subrp . subr) + (symbol-with-pos-p . symbol-with-pos) (symbolp . symbol) (vectorp . vector) (windowp . window)) From 05195e129fc933db32c9e08a155a94bfa4d75b54 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 28 Feb 2024 20:38:30 +0100 Subject: [PATCH 385/385] * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add 'symbol-with-pos'. --- lisp/emacs-lisp/cl-macs.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ddc9775bcce..be477b7a6df 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3496,6 +3496,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (subr . subrp) (string . stringp) (symbol . symbolp) + (symbol-with-pos . symbol-with-pos-p) (vector . vectorp) (window . windowp) ;; FIXME: Do we really want to consider these types?