commit 9b9dcc146ba8132ef02afd12f20b302a78c7bbe2 (HEAD, refs/remotes/origin/master) Author: Harald Jörg Date: Sun Jul 2 00:35:31 2023 +0200 ; cperl-mode.el: Fix two indentation bugs (Bug#11733) * lisp/progmodes/cperl-mode.el (cperl-sniff-for-indent): Detect whether we have a label or a regex/string. (cperl-calculate-indent): Check for things which look like labels but aren't. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-11733): Test the examples provided in the bug report. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl: Examples from the bug report. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c1e55944b7e..1abe57c15ea 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2866,10 +2866,13 @@ cperl-sniff-for-indent ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. ;; (Had \, too) - (while (and (eq (preceding-char) ?:) + (while (save-excursion + (and (eq (preceding-char) ?:) (re-search-backward (rx (sequence (eval cperl--label-rx) point)) - nil t)) + nil t) + ;; Ignore if in comment or RE + (not (nth 3 (syntax-ppss))))) ;; This is always FALSE? (if (eq (preceding-char) ?\,) ;; Will go to beginning of line, essentially. @@ -3129,7 +3132,8 @@ cperl-calculate-indent ;; Now it is a hash reference (+ cperl-indent-level cperl-close-paren-offset)) ;; Labels do not take :: ... - (if (looking-at "\\(\\w\\|_\\)+[ \t]*:[^:]") + (if (and (looking-at "\\(\\w\\|_\\)+[ \t]*:[^:]") + (not (looking-at (rx (eval cperl--false-label-rx))))) (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ;; Do not move `parse-data', this should diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl new file mode 100644 index 00000000000..a474e431222 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl @@ -0,0 +1,50 @@ +# This resource file can be run with cperl--run-testcases from +# cperl-tests.el and works with both perl-mode and cperl-mode. + +# -------- Multiline declaration: input ------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +sub foo + { + } + +sub bar + { + } +# -------- Multiline declaration: expected output ------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +sub foo +{ +} + +sub bar +{ +} +# -------- Multiline declaration: end ------- + +# -------- Fred Colon at work: input -------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +while (<>) +{ +m:^ \d+ p: +or die; +m:^ \d+ : +or die; +} +# -------- Fred Colon at work: expected output -------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +while (<>) + { + m:^ \d+ p: + or die; + m:^ \d+ : + or die; + } +# -------- Fred Colon at work: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index fced2171767..8162953cefb 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -855,6 +855,17 @@ cperl-test-bug-10483 (should (string-match "poop ('foo', \n 'bar')" (buffer-string)))))) +(ert-deftest cperl-test-bug-11733 () + "Verify indentation of braces after newline and non-labels." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (cperl--run-test-cases + (ert-resource-file "cperl-bug-11733.pl") + (goto-char (point-min)) + (while (null (eobp)) + (cperl-indent-command) + (forward-line 1)))) + + (ert-deftest cperl-test-bug-11996 () "Verify that we give the right syntax property to a backslash operator." (with-temp-buffer commit a371e1def79dcb2a6448f4b673aea0920c9788d3 Author: João Távora Date: Sat Jul 1 22:49:24 2023 +0100 Eglot: fix broken indentation of eglot--sig-info * lisp/progmodes/eglot.el (eglot--sig-info): Fix. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d9a835ae844..897cf3bc93e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3196,51 +3196,51 @@ eglot--sig-info ((:documentation sigdoc)) parameters activeParameter) sig (with-temp-buffer - (insert siglabel) - ;; Ad-hoc attempt to parse label as () - ;; Add documentation, indented so we can distinguish multiple signatures - (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc))) - (goto-char (point-max)) - (insert "\n" (replace-regexp-in-string "^" " " doc))) - ;; Now to the parameters - (cl-loop - with active-param = (or sig-active activeParameter) - for i from 0 for parameter across parameters do - (eglot--dbind ((ParameterInformation) - ((:label parlabel)) - ((:documentation pardoc))) - parameter - (when (zerop i) - (goto-char (elt parlabel 0)) - (search-backward "(" nil t) - (add-face-text-property (point-min) (point) - 'font-lock-function-name-face)) - ;; ...perhaps highlight it in the formals list - (when (= i active-param) - (save-excursion - (goto-char (point-min)) - (pcase-let - ((`(,beg ,end) - (if (stringp parlabel) - (let ((case-fold-search nil)) - (and (search-forward parlabel (line-end-position) t) - (list (match-beginning 0) (match-end 0)))) - (mapcar #'1+ (append parlabel nil))))) - (if (and beg end) - (add-face-text-property - beg end - 'eldoc-highlight-function-argument))))) - ;; ...and/or maybe add its doc on a line by its own. - (let (fpardoc) - (when (and pardoc (not briefp) - (not (string-empty-p - (setq fpardoc (eglot--format-markup pardoc))))) - (insert "\n " - (propertize - (if (stringp parlabel) parlabel - (apply #'substring siglabel (mapcar #'1+ parlabel))) - 'face (and (eq i active-param) 'eldoc-highlight-function-argument)) - ": " fpardoc))))) + (insert siglabel) + ;; Ad-hoc attempt to parse label as () + ;; Add documentation, indented so we can distinguish multiple signatures + (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc))) + (goto-char (point-max)) + (insert "\n" (replace-regexp-in-string "^" " " doc))) + ;; Now to the parameters + (cl-loop + with active-param = (or sig-active activeParameter) + for i from 0 for parameter across parameters do + (eglot--dbind ((ParameterInformation) + ((:label parlabel)) + ((:documentation pardoc))) + parameter + (when (zerop i) + (goto-char (elt parlabel 0)) + (search-backward "(" nil t) + (add-face-text-property (point-min) (point) + 'font-lock-function-name-face)) + ;; ...perhaps highlight it in the formals list + (when (= i active-param) + (save-excursion + (goto-char (point-min)) + (pcase-let + ((`(,beg ,end) + (if (stringp parlabel) + (let ((case-fold-search nil)) + (and (search-forward parlabel (line-end-position) t) + (list (match-beginning 0) (match-end 0)))) + (mapcar #'1+ (append parlabel nil))))) + (if (and beg end) + (add-face-text-property + beg end + 'eldoc-highlight-function-argument))))) + ;; ...and/or maybe add its doc on a line by its own. + (let (fpardoc) + (when (and pardoc (not briefp) + (not (string-empty-p + (setq fpardoc (eglot--format-markup pardoc))))) + (insert "\n " + (propertize + (if (stringp parlabel) parlabel + (apply #'substring siglabel (mapcar #'1+ parlabel))) + 'face (and (eq i active-param) 'eldoc-highlight-function-argument)) + ": " fpardoc))))) (buffer-string)))) (defun eglot-signature-eldoc-function (cb) commit f6e6d6c7302da1d4d18a9284576471b47da4b6af Author: João Távora Date: Sat Jul 1 22:48:07 2023 +0100 Eglot: bail out of eglot-imenu if no server capability (bug#64274) * lisp/progmodes/eglot.el (eglot-imenu): Bail out if no capability. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 94ca5c94245..d9a835ae844 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3350,9 +3350,11 @@ eglot--imenu-DocumentSymbol (mapcar (lambda (c) (apply #'dfs c)) children)))))) (mapcar (lambda (s) (apply #'dfs s)) res))) -(defun eglot-imenu () +(cl-defun eglot-imenu () "Eglot's `imenu-create-index-function'. Returns a list as described in docstring of `imenu--index-alist'." + (unless (eglot--server-capable :textDocument/documentSymbol) + (cl-return-from eglot-imenu)) (let* ((res (eglot--request (eglot--current-server-or-lose) :textDocument/documentSymbol `(:textDocument commit 03d4ca6f6ba39389e5742e392dc557220d330e0e Author: João Távora Date: Sat Jul 1 22:46:43 2023 +0100 Eglot: improve heuristic to highlight function names in signatures * lisp/progmodes/eglot.el (eglot--sig-info): Rework. See https://github.com/joaotavora/eglot/discussions/1251. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index e2478f2dde3..94ca5c94245 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3196,11 +3196,8 @@ eglot--sig-info ((:documentation sigdoc)) parameters activeParameter) sig (with-temp-buffer - (save-excursion (insert siglabel)) - ;; Ad-hoc attempt to parse label as () - (when (looking-at "\\([^(]*\\)(\\([^)]+\\))") - (add-face-text-property (match-beginning 1) (match-end 1) - 'font-lock-function-name-face)) + (insert siglabel) + ;; Ad-hoc attempt to parse label as () ;; Add documentation, indented so we can distinguish multiple signatures (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc))) (goto-char (point-max)) @@ -3213,8 +3210,13 @@ eglot--sig-info ((:label parlabel)) ((:documentation pardoc))) parameter + (when (zerop i) + (goto-char (elt parlabel 0)) + (search-backward "(" nil t) + (add-face-text-property (point-min) (point) + 'font-lock-function-name-face)) ;; ...perhaps highlight it in the formals list - (when (and (eq i active-param)) + (when (= i active-param) (save-excursion (goto-char (point-min)) (pcase-let commit ce8e6cea4213ce08d04507632546dfe02cc7410b Author: Harald Jörg Date: Sat Jul 1 21:37:29 2023 +0200 cperl-mode.el: Support Perl 5.38 syntax for subroutine signatures * lisp/progmodes/cperl-mode.el (defconst): New rx sequence describing a signature with initialization. (cperl-init-faces): integrate the new rx sequence into the font-lock-defaults init routine (Bug#64190) (Bug#64364). * test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl: Add test data for a signature with initialization (tests indentation). * test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl: Add test data for a signature with initialization (tests fontification). diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index adfaeee8c97..c1e55944b7e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1349,11 +1349,22 @@ cperl-menu (optional (sequence ,cperl--ws*-rx) "," ) ,cperl--ws*-rx ")") - "A regular expression for a subroutine signature. + "A rx sequence subroutine signature without initializers. These are a bit more restricted than \"my\" declaration lists because they allow only one slurpy variable, and only in the last place.") + (defconst cperl--sloppy-signature-rx + `(sequence "(" + ,cperl--ws*-rx + (or ,cperl--basic-scalar-rx + ,cperl--basic-array-rx + ,cperl--basic-hash-rx) + ,cperl--ws*-rx + (or "," "=" "||=" "//=" ")")) + "A rx sequence for the begin of a signature with initializers. +Initializers can contain almost all Perl constructs and thus can not be covered by regular expressions. This sequence captures enough to distinguish a signature from a prototype.") + (defconst cperl--package-rx `(sequence (group "package") ,cperl--ws+-rx @@ -5920,40 +5931,46 @@ cperl-init-faces ;; statement ends in a "{" (definition) or ";" ;; (declaration without body) (list (concat "\\<" cperl-sub-regexp + ;; group 1: optional subroutine name (rx (sequence (eval cperl--ws+-rx) - (group (optional (eval cperl--normal-identifier-rx))))) -;; "\\([^ \n\t{;()]+\\)" ; 2=name (assume non-anonymous) - (rx - (optional - (group (sequence (group (eval cperl--ws*-rx)) - (eval cperl--prototype-rx))))) -;; "\\(" -;; cperl-maybe-white-and-comment-rex ;whitespace/comments? - ;; "([^()]*)\\)?" ; prototype + (group (optional + (eval cperl--normal-identifier-rx))))) + ;; "fontified" elsewhere: Prototype + (rx (optional + (sequence (eval cperl--ws*-rx) + (eval cperl--prototype-rx)))) + ;; fontified elsewhere: Attributes (rx (optional (sequence (eval cperl--ws*-rx) (eval cperl--attribute-list-rx)))) -; cperl-maybe-white-and-comment-rex ; whitespace/comments? - (rx (group-n 3 - (optional (sequence(eval cperl--ws*-rx) - (eval cperl--signature-rx))))) (rx (eval cperl--ws*-rx)) - "[{;]") - '(1 (if (eq (char-after (cperl-1- (match-end 0))) ?\{ ) - 'font-lock-function-name-face - 'font-lock-variable-name-face) + ;; group 2: Identifies the start of the anchor + (rx (group + (or (group-n 3 ";") ; Either a declaration... + "{" ; ... or a code block + ;; ... or a complete signature + (sequence (eval cperl--signature-rx) + (eval cperl--ws*-rx)) + ;; ... or the start of a "sloppy" signature + (sequence (eval cperl--sloppy-signature-rx) + ;; arbtrarily continue "a few lines" + (repeat 0 200 (not (in "{")))))))) + '(1 (if (match-beginning 3) + 'font-lock-variable-name-face + 'font-lock-function-name-face) t ;; override t) ;; laxmatch in case of anonymous subroutines ;; -------- anchored: Signature - `(,(rx (or (eval cperl--basic-scalar-rx) - (eval cperl--basic-array-rx) - (eval cperl--basic-hash-rx))) + `(,(rx (sequence (in "(,") + (eval cperl--ws*-rx) + (group (or (eval cperl--basic-scalar-rx) + (eval cperl--basic-array-rx) + (eval cperl--basic-hash-rx))))) (progn - (goto-char (match-beginning 3)) ; pre-match: Back to sig - (match-end 3)) - + (goto-char (match-beginning 2)) ; pre-match: Back to sig + (match-end 2)) nil - (0 font-lock-variable-name-face))) + (1 font-lock-variable-name-face))) ;; -------- various stuff calling for a package name ;; (matcher subexp facespec) `(,(rx (sequence symbol-start diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl index af188cbedac..62ef6982f38 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl @@ -24,3 +24,32 @@ package P { } } # -------- Bug#64364: end ------- + +# Now do this with multiline initializers +# -------- signature with init: input ------- +package P { +sub way { ...; } +# perl 5.38 or newer +sub bus +:lvalue +($sig, +$na //= 42, +@ture) +{ +...; +} +} +# -------- signature with init: expected output ------- +package P { + sub way { ...; } + # perl 5.38 or newer + sub bus + :lvalue + ($sig, + $na //= 42, + @ture) + { + ...; + } +} +# -------- signature with init: end ------- diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl index 6ed5c0dfc41..1f898250252 100644 --- a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl +++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl @@ -34,9 +34,17 @@ # A signature with a trailing comma (weird, but legal) sub sub_5 ($foo,$bar,) { ...; } +# Perl 5.38-style initializer +sub sub_6 + ($foo, + $bar //= "baz") +{ +} + + # Part 2: Same constructs for anonymous subs # A plain named subroutine without any optional stuff -my $subref_0 = sub { ...; } +my $subref_0 = sub { ...; }; # A prototype and a trivial subroutine attribute { commit 75278855f4ac0c4514c0e343cd0248ef5c814ff4 Author: Jim Porter Date: Fri May 12 20:03:48 2023 -0700 Document optional Eshell modules * lisp/eshell/em-rebind.el (eshell-rebind): Correct/reword docstring. * doc/misc/eshell.texi (Built-ins): Move disabled-by-default commands to... (Tramp extensions, Extra built-in commands): ...here (Optional modules, Key rebinding, Smart scrolling): Add documentation. (Bug and ideas): Documentation is no longer incomplete! diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index bb1ee99ffc0..0e2f5e02973 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -586,14 +586,6 @@ Built-ins Set environment variables using input like Bash's @command{export}, as in @samp{export @var{var1}=@var{val1} @var{var2}=@var{val2} @dots{}}. -@item expr -@cmindex expr -An implementation of @command{expr} using the Calc package. -@xref{Top,,, calc, The GNU Emacs Calculator}. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - @item grep @cmindex grep @itemx agrep @@ -628,15 +620,6 @@ Built-ins reader. @xref{Misc Help, , , emacs, The GNU Emacs Manual}. -@item intersection -@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. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - @item jobs @cmindex jobs List subprocesses of the Emacs process, if any, using the function @@ -706,15 +689,6 @@ Built-ins Display Man pages using the Emacs @code{man} command. @xref{Man Page, , , emacs, The GNU Emacs Manual}. -@item mismatch -@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. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - @item mkdir @cmindex mkdir Make new directories. @@ -771,24 +745,6 @@ Built-ins @cmindex rmdir Removes directories if they are empty. -@item set-difference -@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. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - -@item set-exclusive-or -@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. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - @item set @cmindex set Set variable values, using the function @code{set} like a command @@ -808,27 +764,6 @@ Built-ins confused with the command @command{.}, which sources a file in the current environment. -@item su -@cmindex su -@itemx sudo -@cmindex sudo -@itemx doas -@cmindex doas -Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method -@pxref{Inline methods, , , tramp} to run a command via @command{su}, -@command{sudo}, or @command{doas}. These commands are in the -eshell-tramp module, which is disabled by default. - - -@item substitute -@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. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - @item time @cmindex time Show the time elapsed during a command's execution. @@ -838,15 +773,6 @@ Built-ins Set or view the default file permissions for newly created files and directories. -@item union -@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 -comparing lists of strings. - -This command can be loaded as part of the eshell-xtra module, which is -disabled by default. - @item unset @cmindex unset Unset one or more variables. As with @command{set}, a variable name @@ -2029,7 +1955,10 @@ Extension modules @node Optional modules @section Optional modules -This section is not yet written. +In addition to the various modules enabled by default (documented +above), Eshell provides several other modules which are @emph{not} +enabled by default. If you want to enable these, you can add them to +@code{eshell-modules-list}. @menu * Key rebinding:: @@ -2042,12 +1971,66 @@ Optional modules @node Key rebinding @subsection Key rebinding -This section is not yet written. +This module allows for special keybindings that only take effect +while the point is in a region of input text. The default keybindings +mimic the bindings used in other shells when the user is editing new +input text. To enable this module, add @code{eshell-rebind} to +@code{eshell-modules-list}. + +For example, it binds @kbd{C-u} to kill the current input text and +@kbd{C-w} to @code{backward-kill-word}. If the history module is +enabled, it also binds @kbd{C-p} and @kbd{C-n} to move through the +input history. + +If @code{eshell-confine-point-to-input} is non-@code{nil}, this module +prevents certain commands from causing the point to leave the input +area, such as @code{backward-word}, @code{previous-line}, etc. @node Smart scrolling @subsection Smart scrolling -This section is not yet written. +This module combines the facility of normal, modern shells with some +of the edit/review concepts inherent in the design of Plan 9's 9term. +To enable it, add @code{eshell-smart} to @code{eshell-modules-list}. + +@itemize @bullet +@item +When you invoke a command, it is assumed that you want to read the +output of that command. + +@item +If the output is not what you wanted, it is assumed that you will want +to edit, and then resubmit a refined version of that command. + +@item +If the output is valid, pressing any self-inserting character key will +jump to end of the buffer and insert that character, in order to begin +entry of a new command. + +@item +If you show an intention to edit the previous command -- by moving +around within it -- then the next self-inserting characters will +insert *there*, instead of at the bottom of the buffer. + +@item +If you show an intention to review old commands, such as @kbd{M-p} or +@kbd{M-r}, point will jump to the bottom of the buffer before invoking +that command. + +@item +If none of the above has happened yet (i.e.@: your point is just +sitting on the previous command), you can use @kbd{SPC} and +@kbd{BACKSPACE} (or @kbd{Delete}) to page forward and backward +@emph{through the output of the last command only}. It will constrain +the movement of the point and window so that the maximum amount of +output is always displayed at all times. + +@item +While output is being generated from a command, the window will be +constantly reconfigured (until it would otherwise make no difference) +in order to always show you the most output from the command possible. +This happens if you change window sizes, scroll, etc. +@end itemize @node Electric forward slash @subsection Electric forward slash @@ -2107,12 +2090,76 @@ Electric forward slash @node Tramp extensions @subsection Tramp extensions -This section is not yet written. +This module adds built-in commands that use Tramp to handle running +other commands as different users, replacing the corresponding +external commands. To enable it, add @code{eshell-tramp} to +@code{eshell-modules-list}. -@node Extra built-in functions -@subsection Extra built-in functions +@table @code + +@item su +@cmindex su +@itemx sudo +@cmindex sudo +@itemx doas +@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}. -This section is not yet written. +@end table + +@node Extra built-in commands +@subsection Extra built-in commands + +This module provides several extra built-in commands documented below, +primarily for working with lists of strings in Eshell. To enable it, +add @code{eshell-xtra} to @code{eshell-modules-list}. + +@table @code + +@item expr +@cmindex expr +An implementation of @command{expr} using the Calc package. +@xref{Top,,, calc, The GNU Emacs Calculator}. + +@item intersection +@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 +@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 +@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 +@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 +@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 +@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 +comparing lists of strings. + +@end table @node Writing a module @section Writing a module @@ -2164,8 +2211,6 @@ Bugs and ideas which is the version included with Emacs 22. @table @asis -@item Documentation incomplete - @item Differentiate between aliases and functions Allow for a Bash-compatible syntax, such as: diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 75a2848a9d5..e4579497edc 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -29,14 +29,17 @@ (progn (defgroup eshell-rebind nil "This module allows for special keybindings that only take effect -while the point is in a region of input text. By default, it binds -C-a to move to the beginning of the input text (rather than just the -beginning of the line), and C-p and C-n to move through the input -history, C-u kills the current input text, etc. It also, if -`eshell-confine-point-to-input' is non-nil, does not allow certain -commands to cause the point to leave the input area, such as -`backward-word', `previous-line', etc. This module intends to mimic -the behavior of normal shells while the user editing new input text." +while the point is in a region of input text. The default +keybindings mimic the bindings used in other shells when the user +is editing new input text. + +For example, it binds C-u to kill the current input text and C-w +to `backward-kill-word'. If the history module is enabled, it +also binds C-p and C-n to move through the input history, etc. + +If `eshell-confine-point-to-input' is non-nil, this module prevents +certain commands from causing the point to leave the input area, such +as `backward-word', `previous-line', etc." :tag "Rebind keys at input" :group 'eshell-module)) commit 77f13edab0fdb9eee25cf75f88c2dbfa4a7ee31b Author: Jim Porter Date: Fri May 12 20:11:01 2023 -0700 Correct the Eshell documentation about how to write new modules * doc/misc/eshell.texi (Writing a module): Fix the documentation. 'eshell-defgroup' doesn't exist anymore. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 001c96a0bea..bb1ee99ffc0 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2117,23 +2117,27 @@ Extra built-in functions @node Writing a module @section Writing a module -An Eshell module is defined the same as any other library but one requirement: the -module must define a Customize@footnote{@xref{Customization, , , -elisp, The Emacs Lisp Reference Manual}.} -group using @code{eshell-defgroup} (in place of @code{defgroup}) with -@code{eshell-module} as the parent group.@footnote{If the module has -no user-customizable options, then there is no need to define it as an -Eshell module.} You also need to load the following as shown: +An Eshell module is defined the same as any other library but with two +additional requirements: first, the module's source file should be +named @file{em-@var{name}.el}; second, the module must define an +autoloaded Customize group (@pxref{Customization, , , elisp, The Emacs +Lisp Reference Manual}) with @code{eshell-module} as the parent group. +In order to properly autoload this group, you should wrap its +definition with @code{progn} as follows: @example -(eval-when-compile - (require 'cl-lib) - (require 'esh-mode) - (require 'eshell)) - -(require 'esh-util) +;;;###autoload +(progn +(defgroup eshell-my-module nil + "My module lets you do very cool things in Eshell." + :tag "My module" + :group 'eshell-module)) @end example +Even if you don't have any Customize options in your module, you +should still define the group so that Eshell can include your module +in the Customize interface for @code{eshell-modules-list}. + @node Bugs and ideas @chapter Bugs and ideas @cindex reporting bugs and ideas commit f2981a1681d34b145753296e506f4c3ca7cba359 Author: Jim Porter Date: Sun Jan 29 19:59:56 2023 -0800 Restructure Eshell extension modules documentation This adds a section for documenting all the optional modules. * doc/misc/eshell.texi (Extension modules): Move explanation about writing modules to... (Writing a module): ... here. (Module testing): Remove. Testing an Eshell module doesn't require any special documentation. (Key binding, Smart scrolling, Electric forward slash): Move under... (Optional modules): ... here. (Directory handling, Terminal emulation): Remove. These modules are enabled by default, and so are documented above. (Tramp extensions, Extra built-in commands): New sections. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 456e5c7a1a9..001c96a0bea 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2019,66 +2019,38 @@ Extension modules Eshell provides a facility for defining extension modules so that they can be disabled and enabled without having to unload and reload them, and to provide a common parent Customize group for the -modules.@footnote{ERC provides a similar module facility.} An Eshell -module is defined the same as any other library but one requirement: the -module must define a Customize@footnote{@xref{Customization, , , -elisp, The Emacs Lisp Reference Manual}.} -group using @code{eshell-defgroup} (in place of @code{defgroup}) with -@code{eshell-module} as the parent group.@footnote{If the module has -no user-customizable options, then there is no need to define it as an -Eshell module.} You also need to load the following as shown: - -@example -(eval-when-compile - (require 'cl-lib) - (require 'esh-mode) - (require 'eshell)) - -(require 'esh-util) -@end example +modules.@footnote{ERC provides a similar module facility.} @menu +* Optional modules:: * Writing a module:: -* Module testing:: -* Directory handling:: -* Key rebinding:: -* Smart scrolling:: -* Terminal emulation:: -* Electric forward slash:: @end menu -@node Writing a module -@section Writing a module - -This section is not yet written. - -@node Module testing -@section Module testing +@node Optional modules +@section Optional modules This section is not yet written. -@node Directory handling -@section Directory handling - -This section is not yet written. +@menu +* Key rebinding:: +* Smart scrolling:: +* Electric forward slash:: +* Tramp extensions:: +* Extra built-in commands:: +@end menu @node Key rebinding -@section Key rebinding +@subsection Key rebinding This section is not yet written. @node Smart scrolling -@section Smart scrolling - -This section is not yet written. - -@node Terminal emulation -@section Terminal emulation +@subsection Smart scrolling This section is not yet written. @node Electric forward slash -@section Electric forward slash +@subsection Electric forward slash To help with supplying absolute file name arguments to remote commands, you can add the @code{eshell-elecslash} module to @@ -2132,6 +2104,36 @@ Electric forward slash @code{|} and @code{;}, the electric forward slash is active only within the first command. +@node Tramp extensions +@subsection Tramp extensions + +This section is not yet written. + +@node Extra built-in functions +@subsection Extra built-in functions + +This section is not yet written. + +@node Writing a module +@section Writing a module + +An Eshell module is defined the same as any other library but one requirement: the +module must define a Customize@footnote{@xref{Customization, , , +elisp, The Emacs Lisp Reference Manual}.} +group using @code{eshell-defgroup} (in place of @code{defgroup}) with +@code{eshell-module} as the parent group.@footnote{If the module has +no user-customizable options, then there is no need to define it as an +Eshell module.} You also need to load the following as shown: + +@example +(eval-when-compile + (require 'cl-lib) + (require 'esh-mode) + (require 'eshell)) + +(require 'esh-util) +@end example + @node Bugs and ideas @chapter Bugs and ideas @cindex reporting bugs and ideas commit 194de36ca9fab6a3f9d67432818800c628f1f597 Author: Jim Porter Date: Sun Jan 29 18:29:02 2023 -0800 ; * doc/misc/eshell.texi (Bugs and ideas): Remove implemented feature. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 4e2bddf42af..456e5c7a1a9 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -2227,8 +2227,6 @@ Bugs and ideas @item Implement @samp{-r}, @samp{-n} and @samp{-s} switches for @command{cp} -@item Make @kbd{M-5 M-x eshell} switch to ``*eshell<5>*'', creating if need be - @item @samp{mv @var{dir} @var{file}.tar} does not remove directories This is because the tar option --remove-files doesn't do so. Should it commit 6ce957154b701282217191d47764187535754529 Author: F. Jason Park Date: Thu Jun 8 23:49:23 2023 -0700 Redo erc-nickname-in-use-functions as a local module * etc/ERC-NEWS: Mention new module `services-regain'. * lisp/erc/erc-backend.el: Rename option. * lisp/erc/erc-services.el (erc-services-regain-alist): Strategies for regaining a lost nickname on reconnect. This option, in addition to the rest of these changes, is a redo of `erc-nickname-in-use-functions' from commit 8c0c9826 "Add hook to regain nickname in ERC", which originally stemmed from bug#62044. (erc-services-retry-nick-on-connect, erc-services-issue-regain, erc-services-issue-ghost-and-retry-nick): New function variants for `erc-services-regain-alist. (erc-services-regain-mode, erc-services-regain-enable, erc-services-regain-disable): New local module to activate nick-regaining behavior. (erc--nickname-in-use-make-request): New method, a services-specific implementation. * lisp/erc/erc.el (erc--nickname-in-use-make-request): New generic function to request alternate nick when first choice is rejected. (erc-nickname-in-use): Call `erc--nickname-in-use-make-request' to request alternate nick. * test/lisp/erc/erc-scenarios-services-misc.el (erc-scenarios-services-misc--reconnect-retry-nick): Adopt renamed version of `erc-scenarios-base-renick-auto-regain'. (erc-scenarios-services-misc--regain-command, erc-scenarios-services-misc--ghost-and-retry-nick): New tests. * test/lisp/erc/resources/services/regain/reconnect-retry-again.eld: New test data file reusing existing blob c0529052 that once lived at resources/base/renick/regain/normal-again.eld. * test/lisp/erc/resources/services/regain/reconnect-retry.eld: New test data file reusing existing blob 9f4df70e5 that once lived at resources/base/renick/regain/normal.eld. * test/lisp/erc/resources/services/regain/taken-ghost.eld: New test data file. * test/lisp/erc/resources/services/regain/taken-regain.eld New test data file. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 68cf0e2d6ca..2f465e247d7 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -78,9 +78,9 @@ appearing in their saved logs. ** Smarter reconnect handling for users on the move. ERC now offers a new, experimental reconnect strategy in the function 'erc-server-delayed-check-reconnect', which tests for underlying -connectivity before attempting to reconnect in earnest. See options -'erc-server-reconnect-function' and 'erc-nickname-in-use-functions' to -get started. +connectivity before attempting to reconnect in earnest. See option +'erc-server-reconnect-function' and new local module 'services-regain' +(also experimental) to get started. ** Module 'fill' can add a bit of space between messages. On graphical displays, it's now possible to add some breathing room diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index b5bd96c189d..f1b51f9234a 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -427,7 +427,9 @@ erc-server-reconnect-timeout If this value is too low, servers may reject your initial nick request upon reconnecting because they haven't yet noticed that your previous connection is dead. If this happens, try setting -this value to 120 or greater." +this value to 120 or greater and/or exploring the option +`erc-regain-services-alist', which may provide a more proactive +means of handling this situation on some servers." :type 'number) (defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 5408ba405db..47c59f76b5c 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -513,6 +513,127 @@ erc-nickserv-identify nick) nil)) + +;;;; Regaining nicknames + +(defcustom erc-services-regain-alist nil + "Alist mapping networks to nickname-regaining functions. +This option depends on the `services-regain' module being loaded. +Keys can also be symbols for user-provided \"context IDs\" (see +Info node `Network Identifier'). Functions run once, when first +establishing a logical IRC connection. Although ERC currently +calls them with one argument, the desired but rejected nickname, +robust user implementations should leave room for later additions +by defining an &rest _ parameter, as well. + +The simplest value is `erc-services-retry-nick-on-connect', which +attempts to kill off stale connections without engaging services +at all. Others, like `erc-services-issue-regain', and +`erc-services-issue-ghost-and-retry-nick', only speak a +particular flavor of NickServ. See their respective doc strings +for details and use cases." + :package-version '(ERC . "5.6") + :group 'erc-hooks + :type '(alist :key-type (symbol :tag "Network") + :value-type + (choice :tag "Strategy function" + (function-item erc-services-retry-nick-on-connect) + (function-item erc-services-issue-regain) + (function-item erc-services-issue-ghost-and-retry-nick) + function))) + +(defun erc-services-retry-nick-on-connect (want) + "Try at most once to grab nickname WANT after reconnecting. +Expect to be used when automatically reconnecting to servers +that are slow to abandon the previous connection. + +Note that this strategy may only work under certain conditions, +such as when a user's account name matches their nick." + (erc-cmd-NICK want)) + +(defun erc-services-issue-regain (want) + "Ask NickServ to regain nickname WANT. +Assume WANT belongs to the user and that the services suite +offers a \"REGAIN\" sub-command." + (erc-cmd-MSG (concat "NickServ REGAIN " want))) + +(defun erc-services-issue-ghost-and-retry-nick (want) + "Ask NickServ to \"GHOST\" nickname WANT. +After which, attempt to grab WANT before the contending party +reconnects. Assume the ERC user owns WANT and that the server's +services suite lacks a \"REGAIN\" command. + +Note that this function will only work for a specific services +implementation and is meant primarily as an example for adapting +as needed." + ;; While heuristics based on error text may seem brittle, consider + ;; the fact that \"is not online\" has been present in Atheme's + ;; \"GHOST\" responses since at least 2005. + (letrec ((attempts 3) + (on-notice + (lambda (_proc parsed) + (when-let ((nick (erc-extract-nick + (erc-response.sender parsed))) + ((erc-nick-equal-p nick "nickserv")) + (contents (erc-response.contents parsed)) + (case-fold-search t) + ((string-match (rx (or "ghost" "is not online")) + contents))) + (setq attempts 1) + (erc-server-send (concat "NICK " want) 'force)) + (when (zerop (cl-decf attempts)) + (remove-hook 'erc-server-NOTICE-functions on-notice t)) + nil))) + (add-hook 'erc-server-NOTICE-functions on-notice nil t) + (erc-message "PRIVMSG" (concat "NickServ GHOST " want)))) + +;;;###autoload(put 'services-regain 'erc--feature 'erc-services) +(define-erc-module services-regain nil + "Reacquire a nickname from your past self or some interloper. +This module only concerns itself with initial nick rejections +that occur during connection registration in response to an +opening \"NICK\" command. More specifically, the following +conditions must be met for ERC to activate this mechanism and +consider its main option, `erc-services-regain-alist': + + - the server must reject the opening \"NICK\" request + - ERC must request a temporary nickname + - the user must successfully authenticate + +In practical terms, this means that this module, which is still +somewhat experimental, is likely only useful in conjunction with +SASL authentication rather than the traditional approach provided +by the `services' module it shares a library with (see Info +node `(erc) SASL' for more)." + nil nil 'local) + +(cl-defmethod erc--nickname-in-use-make-request + ((want string) temp &context (erc-server-connected null) + (erc-services-regain-mode (eql t)) + (erc-services-regain-alist cons)) + "Schedule possible regain attempt upon establishing connection. +Expect WANT to be the desired nickname and TEMP to be the current +one." + (letrec + ((after-connect + (lambda (_ nick) + (remove-hook 'erc-after-connect after-connect t) + (when-let* + (((equal temp nick)) + (conn (or (erc-networks--id-given erc-networks--id) + (erc-network))) + (found (alist-get conn erc-services-regain-alist))) + (funcall found want)))) + (on-900 + (lambda (_ parsed) + (remove-hook 'erc-server-900-functions on-900 t) + (unless erc-server-connected + (when (equal (car (erc-response.command-args parsed)) temp) + (add-hook 'erc-after-connect after-connect nil t))) + nil))) + (add-hook 'erc-server-900-functions on-900 nil t)) + (cl-call-next-method)) + (provide 'erc-services) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 70adbb15b5f..e23185934f7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4930,6 +4930,10 @@ erc-wash-quit-reason (match-string 1 reason)) reason)) +(cl-defmethod erc--nickname-in-use-make-request (_nick temp) + "Request nickname TEMP in place of rejected NICK." + (erc-cmd-NICK temp)) + (defun erc-nickname-in-use (nick reason) "If NICK is unavailable, tell the user the REASON. @@ -4963,7 +4967,7 @@ erc-nickname-in-use ;; established a connection yet (- 9 (length erc-nick-uniquifier)))) erc-nick-uniquifier))) - (erc-cmd-NICK newnick) + (erc--nickname-in-use-make-request nick newnick) (erc-display-error-notice nil (format "Nickname %s is %s, trying %s" diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index a1679d302f4..1113849578f 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -143,4 +143,109 @@ erc-scenarios-services-auth-source-reconnect (erc-services-mode -1))) +;; The server rejects your nick during registration, so ERC acquires a +;; placeholder and successfully renicks once the connection is up. +;; See also `erc-scenarios-base-renick-self-auto'. + +(ert-deftest erc-scenarios-services-misc--reconnect-retry-nick () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "services/regain") + (dumb-server (erc-d-run "localhost" t 'reconnect-retry + 'reconnect-retry-again)) + (port (process-contact dumb-server :service)) + (erc-server-auto-reconnect t) + (erc-modules `(services-regain sasl ,@erc-modules)) + (erc-services-regain-alist + '((Libera.Chat . erc-services-retry-nick-on-connect))) + (expect (erc-d-t-make-expecter))) + + ;; FIXME figure out and explain why this is so. + (should (featurep 'erc-services)) + + (ert-info ("Session succeeds but cut short") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "Last login from") + (erc-cmd-JOIN "#test"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#test")) + (funcall expect 10 "was created on")) + + (ert-info ("Service restored") + (with-current-buffer "Libera.Chat" + (erc-d-t-wait-for 10 erc--server-reconnect-timer) + (funcall expect 10 "Connection failed!") + (funcall expect 10 "already in use") + (funcall expect 10 "changed mode for tester`") + (funcall expect 10 "Last login from") + (funcall expect 10 "Your new nickname is tester"))) + + (with-current-buffer (get-buffer "#test") + (funcall expect 10 "tester ") + (funcall expect 10 "was created on")))) + +;; This only asserts that the handler fires and issues the right +;; NickServ command, but it doesn't accurately recreate a +;; disconnection, but it probably should. +(ert-deftest erc-scenarios-services-misc--regain-command () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "services/regain") + (dumb-server (erc-d-run "localhost" t 'taken-regain)) + (port (process-contact dumb-server :service)) + (erc-server-auto-reconnect t) + (erc-modules `(services-regain sasl ,@erc-modules)) + (erc-services-regain-alist + '((ExampleNet . erc-services-issue-regain))) + (expect (erc-d-t-make-expecter))) + + (should (featurep 'erc-services)) ; see note in prior test + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "dummy" + :user "tester" + :password "changeme" + :full-name "tester" + :id 'ExampleNet) + (funcall expect 10 "dummy is already in use, trying dummy`") + (funcall expect 10 "You are now logged in as tester") + (funcall expect 10 "-NickServ- dummy has been regained.") + (funcall expect 10 "*** Your new nickname is dummy") + ;; Works with "given" `:id'. + (should (and (erc-network) (not (eq (erc-network) 'ExampleNet))))))) + +(ert-deftest erc-scenarios-services-misc--ghost-and-retry-nick () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "services/regain") + (dumb-server (erc-d-run "localhost" t 'taken-ghost)) + (port (process-contact dumb-server :service)) + (erc-server-auto-reconnect t) + (erc-modules `(services-regain sasl ,@erc-modules)) + (erc-services-regain-alist + '((FooNet . erc-services-issue-ghost-and-retry-nick))) + (expect (erc-d-t-make-expecter))) + + (should (featurep 'erc-services)) ; see note in prior test + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "dummy" + :user "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "dummy is already in use, trying dummy`") + (funcall expect 10 "You are now logged in as tester") + (funcall expect 10 "-NickServ- dummy has been ghosted.") + (funcall expect 10 "*** Your new nickname is dummy")))) + ;;; erc-scenarios-services-misc.el ends here diff --git a/test/lisp/erc/resources/services/regain/reconnect-retry-again.eld b/test/lisp/erc/resources/services/regain/reconnect-retry-again.eld new file mode 100644 index 00000000000..c0529052c70 --- /dev/null +++ b/test/lisp/erc/resources/services/regain/reconnect-retry-again.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester")) + +((authenticate 10 "AUTHENTICATE PLAIN") + (0.04 ":tantalum.libera.chat NOTICE * :*** Checking Ident") + (0.01 ":tantalum.libera.chat NOTICE * :*** Looking up your hostname...") + (0.01 ":tantalum.libera.chat NOTICE * :*** Couldn't look up your hostname") + (0.06 ":tantalum.libera.chat NOTICE * :*** No Ident response") + (0.02 ":tantalum.libera.chat CAP * ACK :sasl") + (0.03 ":tantalum.libera.chat 433 * tester :Nickname is already in use.")) + +((nick 10 "NICK tester`") + (0.03 "AUTHENTICATE +")) + +((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.06 ":tantalum.libera.chat 900 tester` tester`!tester@127.0.0.1 tester :You are now logged in as tester") + (0.02 ":tantalum.libera.chat 903 tester` :SASL authentication successful")) + +((cap 10 "CAP END") + (0.02 ":tantalum.libera.chat 001 tester` :Welcome to the Libera.Chat Internet Relay Chat Network tester`") + (0.02 ":tantalum.libera.chat 002 tester` :Your host is tantalum.libera.chat[93.158.237.2/6697], running version solanum-1.0-dev") + (0.02 ":tantalum.libera.chat 003 tester` :This server was created Mon Feb 13 2023 at 12:05:04 UTC") + (0.01 ":tantalum.libera.chat 004 tester` tantalum.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI") + (0.01 ":tantalum.libera.chat 005 tester` WHOX MONITOR=100 SAFELIST ELIST=CMNTU ETRACE FNC CALLERID=g KNOCK CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server") + (0.01 ":tantalum.libera.chat 005 tester` CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server") + (0.03 ":tantalum.libera.chat 005 tester` TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server") + (0.01 ":tantalum.libera.chat 251 tester` :There are 70 users and 42977 invisible on 28 servers") + (0.00 ":tantalum.libera.chat 252 tester` 38 :IRC Operators online") + (0.00 ":tantalum.libera.chat 253 tester` 87 :unknown connection(s)") + (0.00 ":tantalum.libera.chat 254 tester` 22908 :channels formed") + (0.00 ":tantalum.libera.chat 255 tester` :I have 2507 clients and 1 servers") + (0.00 ":tantalum.libera.chat 265 tester` 2507 3232 :Current local users 2507, max 3232") + (0.00 ":tantalum.libera.chat 266 tester` 43047 51777 :Current global users 43047, max 51777") + (0.00 ":tantalum.libera.chat 250 tester` :Highest connection count: 3233 (3232 clients) (284887 connections received)") + (0.03 ":tantalum.libera.chat 375 tester` :- tantalum.libera.chat Message of the Day - ") + (0.00 ":tantalum.libera.chat 372 tester` :- This server provided by Hyperfilter (https://hyperfilter.com)") + (0.00 ":tantalum.libera.chat 372 tester` :- Email: support@libera.chat") + (0.02 ":tantalum.libera.chat 376 tester` :End of /MOTD command.")) + +((mode 10 "MODE tester` +i") + (0.01 ":tester` MODE tester` :+Ziw") + (0.02 ":SaslServ!SaslServ@services.libera.chat NOTICE tester` :Last login from: \2~tester@127.0.0.1\2 on Apr 07 01:36:25 2023 +0000.")) + +((nick 10 "NICK tester") + (0.02 ":tester`!~tester@127.0.0.1 NICK :tester")) + +((join 10 "JOIN #test") + (0.02 ":tester!~tester@127.0.0.1 JOIN #test") + (0.02 ":tantalum.libera.chat 353 tester = #test :tester zbyqbepbqre7 pusevgfpu Thrfg2187 zngbeb qnexNssvavgl wrebzr- rqpentt Ilehf grfg2 AvtugZbaxrl pevfgvvbna xrivap_ fnvybePng shohxv gxan arrqyr avpx16 NeanhqW_kzcc jvyyr wrnaogeq Wnarg cnefavc0 Xbentt RcvpArb flfqrs wfgbxre hafcrag__ Lbevpx_") + (0.02 ":tantalum.libera.chat 366 tester #test :End of /NAMES list.")) + +((mode 10 "MODE #test") + (0.02 ":tantalum.libera.chat 324 tester #test +nt") + (0.02 ":tantalum.libera.chat 329 tester #test 1621432263")) diff --git a/test/lisp/erc/resources/services/regain/reconnect-retry.eld b/test/lisp/erc/resources/services/regain/reconnect-retry.eld new file mode 100644 index 00000000000..9f4df70e580 --- /dev/null +++ b/test/lisp/erc/resources/services/regain/reconnect-retry.eld @@ -0,0 +1,53 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester")) + +((authenticate 10 "AUTHENTICATE PLAIN") + (0.02 ":cadmium.libera.chat NOTICE * :*** Checking Ident") + (0.01 ":cadmium.libera.chat NOTICE * :*** Looking up your hostname...") + (0.01 ":cadmium.libera.chat NOTICE * :*** Couldn't look up your hostname") + (0.06 ":cadmium.libera.chat NOTICE * :*** No Ident response") + (0.09 ":cadmium.libera.chat CAP * ACK :sasl") + (0.01 "AUTHENTICATE +")) + +((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.03 ":cadmium.libera.chat 900 tester tester!tester@127.0.0.1 tester :You are now logged in as tester") + (0.01 ":cadmium.libera.chat 903 tester :SASL authentication successful")) + +((cap 10 "CAP END") + (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester") + (0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev") + (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC") + (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI") + (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server") + (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server") + (0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server") + (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers") + (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online") + (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)") + (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed") + (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers") + (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187") + (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827") + (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)") + (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ") + (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)") + (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for") + (0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat") + (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.") + (0.00 ":tester MODE tester :+Ziw") + (0.02 ":SaslServ!SaslServ@services.libera.chat NOTICE tester :Last login from: \2~tester@127.0.0.1\2 on Apr 07 01:02:11 2023 +0000.")) + +((mode 10 "MODE tester +i")) + +((join 10 "JOIN #test") + (0.09 ":tester!~tester@127.0.0.1 JOIN #test")) + +((mode 10 "MODE #test") + (0.03 ":cadmium.libera.chat 353 tester = #test :tester zbyqbepbqre7 pusevgfpu Thrfg2187 zngbeb qnexNssvavgl wrebzr- rqpentt Ilehf grfg2 AvtugZbaxrl pevfgvvbna xrivap_ fnvybePng shohxv gxan arrqyr avpx16 NeanhqW_kzcc Lbevpx_ hafcrag__ wfgbxre flfqrs RcvpArb Xbentt jvyyr cnefavc0 Wnarg wrnaogeq") + (0.02 ":cadmium.libera.chat 366 tester #test :End of /NAMES list.") + (0.00 ":cadmium.libera.chat 324 tester #test +nt") + (0.01 ":cadmium.libera.chat 329 tester #test 1621432263")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/services/regain/taken-ghost.eld b/test/lisp/erc/resources/services/regain/taken-ghost.eld new file mode 100644 index 00000000000..d5afd124a43 --- /dev/null +++ b/test/lisp/erc/resources/services/regain/taken-ghost.eld @@ -0,0 +1,42 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl") + (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...") + (0.01 ":irc.example.net NOTICE * :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")) +((nick 10 "NICK dummy")) +((user 10 "USER dummy 0 * :tester")) +((authenticate 10 "AUTHENTICATE PLAIN") + (0.00 ":irc.example.net CAP * ACK :sasl") + (0.03 ":irc.example.net 433 * dummy :Nickname is already in use.") + (0.04 "AUTHENTICATE :+")) +((nick 10 "NICK dummy`") + (0.00 "PING :orrMOjk^|V")) +((~pong 10 "PONG :orrMOjk^|V")) +((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.01 ":irc.example.net 900 dummy` dummy`!dummy@10.0.2.100 tester :You are now logged in as tester") + (0.01 ":irc.example.net 903 dummy` :SASL authentication successful")) +((cap 10 "CAP END") + (0.00 ":irc.example.net 001 dummy` :Welcome to the FooNet IRC Network dummy`!dummy@10.0.2.100") + (0.03 ":irc.example.net 002 dummy` :Your host is irc.example.net, running version InspIRCd-3") + (0.01 ":irc.example.net 003 dummy` :This server was created 13:01:55 Jun 08 2023") + (0.01 ":irc.example.net 004 dummy` irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv") + (0.00 ":irc.example.net 005 dummy` ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0.01 ":irc.example.net 005 dummy` EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are supported by this server") + (0.01 ":irc.example.net 005 dummy` NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server") + (0.01 ":irc.example.net 251 dummy` :There are 2 users and 1 invisible on 2 servers") + (0.01 ":irc.example.net 253 dummy` 1 :unknown connections") + (0.00 ":irc.example.net 254 dummy` 1 :channels formed") + (0.00 ":irc.example.net 255 dummy` :I have 3 clients and 1 servers") + (0.00 ":irc.example.net 265 dummy` :Current local users: 3 Max: 4") + (0.00 ":irc.example.net 266 dummy` :Current global users: 3 Max: 4") + (0.00 ":irc.example.net 375 dummy` :irc.example.net message of the day") + (0.00 ":irc.example.net 372 dummy` : Have fun with the image!") + (0.00 ":irc.example.net 376 dummy` :End of message of the day.")) + +((mode 10 "MODE dummy` +i")) +((privmsg 10 "PRIVMSG NickServ :GHOST dummy") + (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.") + (0.00 ":irc.example.net NOTICE dummy` :*** You are connected to irc.example.net using TLS (SSL) cipher 'TLS1.3-ECDHE-RSA-AES-256-GCM-AEAD'") + (0.03 ":dummy`!dummy@10.0.2.100 MODE dummy` :+i") + (0.02 ":NickServ!NickServ@services.int NOTICE dummy` :\2dummy\2 has been ghosted.")) +((nick 10 "NICK dummy") + (0.02 ":dummy`!dummy@10.0.2.100 NICK :dummy")) diff --git a/test/lisp/erc/resources/services/regain/taken-regain.eld b/test/lisp/erc/resources/services/regain/taken-regain.eld new file mode 100644 index 00000000000..22635d4cc89 --- /dev/null +++ b/test/lisp/erc/resources/services/regain/taken-regain.eld @@ -0,0 +1,42 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl") + (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...") + (0.01 ":irc.example.net NOTICE * :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")) +((nick 10 "NICK dummy")) +((user 10 "USER dummy 0 * :tester")) +;; This also happens to a test late ACK (see ghost variant for server-sent PING) +((authenticate 10 "AUTHENTICATE PLAIN") + (0.00 ":irc.example.net CAP * ACK :sasl") + (0.09 ":irc.example.net 433 * dummy :Nickname is already in use.") + (0.04 "AUTHENTICATE :+")) +((nick 10 "NICK dummy`")) +((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.00 ":irc.example.net 900 dummy` dummy`!dummy@10.0.2.100 tester :You are now logged in as tester") + (0.01 ":irc.example.net 903 dummy` :SASL authentication successful")) + +((cap 10 "CAP END") + (0.00 ":irc.example.net 001 dummy` :Welcome to the FooNet IRC Network dummy`!dummy@10.0.2.100") + (0.02 ":irc.example.net 002 dummy` :Your host is irc.example.net, running version InspIRCd-3") + (0.02 ":irc.example.net 003 dummy` :This server was created 08:16:52 Jun 08 2023") + (0.01 ":irc.example.net 004 dummy` irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv") + (0.00 ":irc.example.net 005 dummy` ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0.01 ":irc.example.net 005 dummy` EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are supported by this server") + (0.01 ":irc.example.net 005 dummy` NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server") + (0.01 ":irc.example.net 251 dummy` :There are 2 users and 1 invisible on 2 servers") + (0.01 ":irc.example.net 253 dummy` 1 :unknown connections") + (0.00 ":irc.example.net 254 dummy` 1 :channels formed") + (0.02 ":irc.example.net 255 dummy` :I have 3 clients and 1 servers") + (0.00 ":irc.example.net 265 dummy` :Current local users: 3 Max: 4") + (0.00 ":irc.example.net 266 dummy` :Current global users: 3 Max: 4") + (0.00 ":irc.example.net 375 dummy` :irc.example.net message of the day") + (0.00 ":irc.example.net 372 dummy` : Have fun with the image!") + (0.00 ":irc.example.net 376 dummy` :End of message of the day.") + (0.00 ":irc.example.net 501 dummy` x :is not a recognised user mode.") + (0.00 ":irc.example.net NOTICE dummy` :*** You are connected to irc.example.net using TLS (SSL) cipher 'TLS1.3-ECDHE-RSA-AES-256-GCM-AEAD'")) + +((mode 10 "MODE dummy` +i")) + +((privmsg 10 "PRIVMSG NickServ :REGAIN dummy") + (0.00 ":dummy`!dummy@10.0.2.100 MODE dummy` :+i") + (0.02 ":NickServ!NickServ@services.int NOTICE dummy` :\2dummy\2 has been regained.") + (0.02 ":dummy`!dummy@10.0.2.100 NICK :dummy")) commit 99d74dcd45938e2686d93eb5649800e14a88cd84 Author: F. Jason Park Date: Tue Jun 27 20:47:26 2023 -0700 Account for leading timestamps in erc-match * lisp/erc/erc-match.el (erc-text-matched-hook): Mention that stamps may be present in the narrowed buffer but absent from the message parameter. (erc-match--message): New function containing what was the body of `erc-match-message' as if the latter were simply renamed. (erc-match-message): Move body to `erc-match--message' and call it with more aggressive narrowing. This fixes a regression stemming from d880a08f "Cement ordering of essential hook members in ERC". Special thanks to Libera.Chat user jrm for reporting this bug. (Bug#60936) * test/lisp/erc/erc-scenarios-match.el: New test file. diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 6ba524ef9a8..204bf14a1cf 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -233,10 +233,14 @@ erc-beep-match-types (const :tag "Don't beep" nil))) (defcustom erc-text-matched-hook '(erc-log-matches) - "Hook run when text matches a given match-type. -Functions in this hook are passed as arguments: -\(match-type nick!user@host message) where MATCH-TYPE is a symbol of: -current-nick, keyword, pal, dangerous-host, fool." + "Abnormal hook for visiting text matching a predefined \"type\". +ERC calls members with the arguments (MATCH-TYPE NUH MESSAGE), +where MATCH-TYPE is one of the symbols `current-nick', `keyword', +`pal', `dangerous-host', `fool', and NUH is an `erc-response' +sender, like bob!~bob@example.org. Users should keep in mind +that MESSAGE may not include decorations, such as white space or +time stamps, preceding the same text as inserted in the narrowed +buffer." :options '(erc-log-matches erc-hide-fools erc-beep-on-match) :type 'hook) @@ -458,8 +462,19 @@ erc-match-directed-at-fool-p (erc-list-match fools-end msg)))) (defun erc-match-message () - "Mark certain keywords in a region. -Use this defun with `erc-insert-modify-hook'." + "Add faces to matching text in inserted message." + ;; Exclude leading whitespace, stamps, etc. + (let ((omin (point-min)) + (beg (or (and (not (get-text-property (point-min) 'erc-command)) + (next-single-property-change (point-min) 'erc-command)) + (point-min)))) + ;; FIXME when ERC no longer supports 28, use `with-restriction' + ;; with `:label' here instead of passing `omin'. + (save-restriction + (narrow-to-region beg (point-max)) + (erc-match--message omin)))) + +(defun erc-match--message (unrestricted-point-min) ;; This needs some refactoring. (goto-char (point-min)) (let* ((to-match-nick-dep '("pal" "fool" "dangerous-host")) @@ -561,12 +576,14 @@ erc-match-message 'font-lock-face match-face))) ;; Else twiddle your thumbs. (t nil)) - (run-hook-with-args - 'erc-text-matched-hook - (intern match-type) - (or nickuserhost - (concat "Server:" (erc-get-parsed-vector-type vector))) - message)))) + ;; FIXME use `without-restriction' after dropping 28. + (save-restriction + (narrow-to-region unrestricted-point-min (point-max)) + (run-hook-with-args + 'erc-text-matched-hook (intern match-type) + (or nickuserhost + (concat "Server:" (erc-get-parsed-vector-type vector))) + message))))) (if nickuserhost (append to-match-nick-dep to-match-nick-indep) to-match-nick-indep))))) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el new file mode 100644 index 00000000000..49e6a3370fc --- /dev/null +++ b/test/lisp/erc/erc-scenarios-match.el @@ -0,0 +1,120 @@ +;;; erc-scenarios-match.el --- Misc `erc-match' scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-stamp) +(require 'erc-match) + +;; This defends against a regression in which all matching by the +;; `erc-match-message' fails when `erc-add-timestamp' precedes it in +;; `erc-insert-modify-hook'. Basically, `erc-match-message' used to +;; expect an `erc-parsed' text property on the first character in a +;; message, which doesn't exist, when the message content is prefixed +;; by a leading timestamp. + +(ert-deftest erc-scenarios-match--stamp-left-current-nick () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (erc-insert-timestamp-function 'erc-insert-timestamp-left) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + (should (memq 'erc-match-message + (memq 'erc-add-timestamp erc-insert-modify-hook))) + ;; The "match type" is `current-nick'. + (funcall expect 5 "tester") + (should (eq (get-text-property (1- (point)) 'font-lock-face) + 'erc-current-nick-face)))))) + +;; This asserts that when stamps appear before a message, +;; some non-nil invisibility property spans the entire message. +(ert-deftest erc-scenarios-match--stamp-left-fools-invisible () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "join/legacy") + (dumb-server (erc-d-run "localhost" t 'foonet)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (erc-insert-timestamp-function 'erc-insert-timestamp-left) + (erc-timestamp-only-if-changed-flag nil) + (erc-fools '("bob")) + (erc-text-matched-hook '(erc-hide-fools)) + (erc-autojoin-channels-alist '((FooNet "#chan"))) + (expect (erc-d-t-make-expecter)) + (hiddenp (lambda () + (and (eq (field-at-pos (pos-bol)) 'erc-timestamp) + (get-text-property (pos-bol) 'invisible) + (>= (next-single-property-change (pos-bol) + 'invisible nil) + (pos-eol)))))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :password "changeme" + :nick "tester") + (should (memq 'erc-match-message + (memq 'erc-add-timestamp erc-insert-modify-hook))) + (funcall expect 5 "This server is in debug mode"))) + + (ert-info ("Ensure lines featuring \"bob\" are invisible") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (should (funcall expect 10 " tester, welcome!")) + (should (funcall hiddenp)) + + ;; Alice's is the only one visible. + (should (funcall expect 10 " tester, welcome!")) + (should (eq (field-at-pos (pos-bol)) 'erc-timestamp)) + (should (get-text-property (pos-bol) 'invisible)) + (should-not (get-text-property (point) 'invisible)) + + (should (funcall expect 10 " alice: But, as it seems")) + (should (funcall hiddenp)) + + (should (funcall expect 10 " bob: Well, this is the forest")) + (should (funcall hiddenp)) + + (should (funcall expect 10 " bob: And will you")) + (should (funcall hiddenp)) + + (should (funcall expect 10 " alice: Live, and be prosperous")) + (should (funcall hiddenp)) + + (should (funcall expect 10 "ERC>")) + (should-not (get-text-property (pos-bol) 'invisible)) + (should-not (get-text-property (point) 'invisible)))))) + +(eval-when-compile (require 'erc-join)) + +;;; erc-scenarios-match.el ends here commit d42b45dcc7504deb9d1e7b730fed69e18f958533 Author: Harald Jörg Date: Sat Jul 1 15:25:33 2023 +0200 cperl-mode: Fix byte-compilation warnings * lisp/progmodes/cperl-mode.el (defconst): Reformat docstring to fit into 80 columns. (cperl-find-sub-attrs): Mark lexical parameters as unused. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-attrs-and-signatures): Fix use of `match-beginning' (perl-indent-parens-as-block): Define as a variable. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index fb636d0fb78..adfaeee8c97 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1330,7 +1330,9 @@ cperl-menu `(sequence "(" (0+ (any "$@%&*;\\[]")) ")") - "A regular expression for a subroutine prototype. Not as strict as the actual prototype syntax, but good enough to distinguish prototypes from signatures.") + "A regular expression for a subroutine prototype. Not as strict +as the actual prototype syntax, but good enough to distinguish +prototypes from signatures.") (defconst cperl--signature-rx `(sequence "(" @@ -3539,7 +3541,7 @@ cperl-unwind-to-safe (setq end (point))))) (or end pos))))) -(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos) +(defun cperl-find-sub-attrs (&optional st-l _b-fname _e-fname pos) "Syntactically mark (and fontify) attributes of a subroutine. Should be called with the point before leading colon of an attribute." ;; Works *before* syntax recognition is done @@ -3608,7 +3610,6 @@ cperl-find-sub-attrs 'attrib-group (if (looking-at "{") t 0)) (and pos (progn - (< 1 (count-lines (+ 3 pos) (point))) ; end of `sub' ;; Apparently, we do not need `multiline': faces added now (put-text-property (+ 3 pos) (cperl-1+ (point)) 'syntax-type 'sub-decl)))) diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 99d5a51b3ea..fced2171767 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -184,11 +184,12 @@ cperl-test-fontify-attrs-and-signatures (when (match-beginning 2) (should (equal (get-text-property (match-beginning 2) 'face) 'font-lock-string-face)))) - (goto-char end-of-sub) ;; Subroutine signatures + (goto-char start-of-sub) (when (search-forward "$bar" end-of-sub t) - (should (equal (get-text-property (match-beginning) 'face) - 'font-lock-variable-name-face))))) + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face))) + (goto-char end-of-sub))) ;; Anonymous subroutines (while (search-forward-regexp "= sub" nil t) (let ((start-of-sub (match-beginning 0)) @@ -205,11 +206,12 @@ cperl-test-fontify-attrs-and-signatures (when (match-beginning 2) (should (equal (get-text-property (match-beginning 2) 'face) 'font-lock-string-face)))) - (goto-char end-of-sub) ;; Subroutine signatures + (goto-char start-of-sub) (when (search-forward "$bar" end-of-sub t) - (should (equal (get-text-property (match-beginning) 'face) - 'font-lock-variable-name-face)))))))) + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face))) + (goto-char end-of-sub)))))) (ert-deftest cperl-test-fontify-special-variables () "Test fontification of variables like $^T or ${^ENCODING}. @@ -314,6 +316,7 @@ cperl-test-here-doc-missing-end (defvar perl-continued-statement-offset) (defvar perl-indent-level) +(defvar perl-indent-parens-as-block) (defconst cperl--tests-heredoc-face (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc commit 2195935870ca173f8b16c4821816f77ecb2d96c3 Author: Mattias Engdegård Date: Fri Jun 30 18:34:10 2023 +0200 Add duplicate-region-final-position (bug#64185) * lisp/misc.el (duplicate-region-final-position): New defcustom. (duplicate-dwim): Use it. * lisp/rect.el (rectangle--duplicate-right): Add displacement argument. * test/lisp/misc-tests.el (misc--duplicate-dwim): Extend test. diff --git a/lisp/misc.el b/lisp/misc.el index 718750404b7..fad8d545e11 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -105,7 +105,18 @@ duplicate-line (forward-line duplicate-line-final-position) (move-to-column col)))) -(declare-function rectangle--duplicate-right "rect" (n)) +(defcustom duplicate-region-final-position 0 + "Where the region ends up after duplicating a region with `duplicate-dwim'. +When 0, leave the region in place. +When 1, put the region around the first copy. +When -1, put the region around the last copy." + :type '(choice (const :tag "Leave region in place" 0) + (const :tag "Put region around first copy" 1) + (const :tag "Put region around last copy" -1)) + :group 'editing + :version "29.1") + +(declare-function rectangle--duplicate-right "rect" (n displacement)) ;; `duplicate-dwim' preserves an active region and changes the buffer ;; outside of it: disregard the region when immediately undoing the @@ -118,24 +129,40 @@ duplicate-dwim If the region is inactive, duplicate the current line (like `duplicate-line'). Otherwise, duplicate the region, which remains active afterwards. If the region is rectangular, duplicate on its right-hand side. -Interactively, N is the prefix numeric argument, and defaults to 1." +Interactively, N is the prefix numeric argument, and defaults to 1. +The variables `duplicate-line-final-position' and +`duplicate-region-final-position' control the position of point +and the region after the duplication." (interactive "p") (unless n (setq n 1)) (cond + ((<= n 0) nil) ;; Duplicate rectangle. ((bound-and-true-p rectangle-mark-mode) - (rectangle--duplicate-right n) + (rectangle--duplicate-right n + (if (< duplicate-region-final-position 0) + n + duplicate-region-final-position)) (setq deactivate-mark nil)) ;; Duplicate (contiguous) region. ((use-region-p) (let* ((beg (region-beginning)) (end (region-end)) - (text (buffer-substring beg end))) + (text (buffer-substring beg end)) + (pt (point)) + (mk (mark))) (save-excursion (goto-char end) - (duplicate--insert-copies n text))) + (duplicate--insert-copies n text)) + (let* ((displace (if (< duplicate-region-final-position 0) + n + duplicate-region-final-position)) + (d (* displace (- end beg)))) + (unless (zerop d) + (push-mark (+ mk d)) + (goto-char (+ pt d))))) (setq deactivate-mark nil)) ;; Duplicate line. diff --git a/lisp/rect.el b/lisp/rect.el index 5ff821abb3f..8dc188b1de0 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -930,8 +930,9 @@ rectangle--unhighlight-for-redisplay (mapc #'delete-overlay (nthcdr 5 rol)) (setcar (cdr rol) nil))) -(defun rectangle--duplicate-right (n) - "Duplicate the rectangular region N times on the right-hand side." +(defun rectangle--duplicate-right (n displacement) + "Duplicate the rectangular region N times on the right-hand side. +Leave the region moved DISPLACEMENT region-wide steps to the right." (let ((cols (rectangle--pos-cols (point) (mark)))) (apply-on-rectangle (lambda (startcol endcol) @@ -940,16 +941,22 @@ rectangle--duplicate-right (move-to-column endcol t) (dotimes (_ n) (insert (cadr lines))))) - (region-beginning) (region-end)) - ;; Recompute the rectangle state; no crutches should be needed now. - (let ((p (point)) - (m (mark))) + (min (point) (mark)) + (max (point) (mark))) + ;; Recompute the rectangle state. + (let* ((p (point)) + (m (mark)) + (point-col (car cols)) + (mark-col (cdr cols)) + (d (* displacement (abs (- point-col mark-col))))) (rectangle--reset-crutches) (goto-char m) - (move-to-column (cdr cols) t) - (set-mark (point)) + (move-to-column (+ mark-col d) t) + (if (= d 0) + (set-mark (point)) + (push-mark (point))) (goto-char p) - (move-to-column (car cols) t)))) + (move-to-column (+ point-col d) t)))) (provide 'rect) diff --git a/test/lisp/misc-tests.el b/test/lisp/misc-tests.el index ea27ea1653b..b9bafe4bd11 100644 --- a/test/lisp/misc-tests.el +++ b/test/lisp/misc-tests.el @@ -24,6 +24,7 @@ ;;; Code: (require 'ert) +(require 'misc) (defmacro with-misc-test (original result &rest body) (declare (indent 2)) @@ -113,40 +114,70 @@ misc--duplicate-line (require 'rect) (ert-deftest misc--duplicate-dwim () - ;; Duplicate a line. - (with-temp-buffer - (insert "abc\ndefg\nh\n") - (goto-char 7) - (duplicate-dwim 2) - (should (equal (buffer-string) "abc\ndefg\ndefg\ndefg\nh\n")) - (should (equal (point) 7))) + (let ((duplicate-line-final-position 0) + (duplicate-region-final-position 0)) + ;; Duplicate a line. + (dolist (final-pos '(0 -1 1)) + (ert-info ((prin1-to-string final-pos) :prefix "final-pos: ") + (with-temp-buffer + (insert "abc\ndefg\nh\n") + (goto-char 7) + (let ((duplicate-line-final-position final-pos)) + (duplicate-dwim 3)) + (should (equal (buffer-string) "abc\ndefg\ndefg\ndefg\ndefg\nh\n")) + (let ((delta (* 5 (if (< final-pos 0) 3 final-pos)))) + (should (equal (point) (+ 7 delta))))))) + + ;; Duplicate a region. + (dolist (final-pos '(0 -1 1)) + (ert-info ((prin1-to-string final-pos) :prefix "final-pos: ") + (with-temp-buffer + (insert "abCDEFghi") + (set-mark 3) + (goto-char 7) + (transient-mark-mode) + (should (use-region-p)) + (let ((duplicate-region-final-position final-pos)) + (duplicate-dwim 3)) + (should (equal (buffer-string) "abCDEFCDEFCDEFCDEFghi")) + (should (region-active-p)) + (let ((delta (* 4 (if (< final-pos 0) 3 final-pos)))) + (should (equal (point) (+ 7 delta))) + (should (equal (mark) (+ 3 delta))))))) + + ;; Duplicate a rectangular region (sparse). + (with-temp-buffer + (insert "x\n>a\n>bcde\n>fg\nyz\n") + (goto-char 4) + (rectangle-mark-mode) + (goto-char 15) + (rectangle-forward-char 1) + (duplicate-dwim) + (should (equal (buffer-string) "x\n>a a \n>bcdbcde\n>fg fg \nyz\n")) + (should (equal (point) 24)) + (should (region-active-p)) + (should rectangle-mark-mode) + (should (equal (mark) 4))) + + ;; Idem (dense). + (dolist (final-pos '(0 -1 1)) + (ert-info ((prin1-to-string final-pos) :prefix "final-pos: ") + (with-temp-buffer + (insert "aBCd\neFGh\niJKl\n") + (goto-char 2) + (rectangle-mark-mode) + (goto-char 14) + (let ((duplicate-region-final-position final-pos)) + (duplicate-dwim 3)) + (should (equal (buffer-string) + "aBCBCBCBCd\neFGFGFGFGh\niJKJKJKJKl\n")) + (should (region-active-p)) + (should rectangle-mark-mode) + (let ((hdelta (* 2 (if (< final-pos 0) 3 final-pos))) + (vdelta 12)) + (should (equal (point) (+ 14 vdelta hdelta))) + (should (equal (mark) (+ 2 hdelta))))))))) - ;; Duplicate a region. - (with-temp-buffer - (insert "abc\ndef\n") - (set-mark 2) - (goto-char 7) - (transient-mark-mode) - (should (use-region-p)) - (duplicate-dwim) - (should (equal (buffer-string) "abc\ndebc\ndef\n")) - (should (equal (point) 7)) - (should (region-active-p)) - (should (equal (mark) 2))) - - ;; Duplicate a rectangular region. - (with-temp-buffer - (insert "x\n>a\n>bcde\n>fg\nyz\n") - (goto-char 4) - (rectangle-mark-mode) - (goto-char 15) - (rectangle-forward-char 1) - (duplicate-dwim) - (should (equal (buffer-string) "x\n>a a \n>bcdbcde\n>fg fg \nyz\n")) - (should (equal (point) 24)) - (should (region-active-p)) - (should rectangle-mark-mode) - (should (equal (mark) 4)))) (provide 'misc-tests) ;;; misc-tests.el ends here commit 3ba9f9657fb69de576132a73cbeefdce03ad1c0f Merge: d0eeb4c5cd6 edd36786e1e Author: Eli Zaretskii Date: Sat Jul 1 06:30:00 2023 -0400 Merge from origin/emacs-29 edd36786e1e ; * lisp/bookmark.el (bookmark-bmenu-locate): Doc fix (bu... 16eac20a5db ; Fix last change ab8d0f7b768 Add project command entries to the menu-bar fc6099bf046 ; Improve documentation of text-property-search-* functions cc660bd2651 ; * etc/PROBLEMS: Mention MinGW problems with -D_FORTIFY_... a5bd9fb8c4a ; Improve doc strings in register.el 0be18d80978 ; Fix @xref in last change to doc/emacs/regs.texi. 624c779517d ; Fix tree-sitter C binding typos in Elisp manual. 16e9bdff4f4 Improve documentation of registers commit d0eeb4c5cd64ebde321dc9ca207fc058c6dd7f0e Merge: fbdc85b8f8b 884b668b981 Author: Eli Zaretskii Date: Sat Jul 1 06:30:00 2023 -0400 ; Merge from origin/emacs-29 The following commit was skipped: 884b668b981 Use a temporary buffer in nnagent-request-set-mark (bug#6... commit fbdc85b8f8b78f1e4039c1042c780a7f00259853 Merge: 3d65afd7b7a a722e7dd152 Author: Eli Zaretskii Date: Sat Jul 1 06:29:52 2023 -0400 Merge from origin/emacs-29 a722e7dd152 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/... 65f146cf1c2 ; * lisp/calculator.el (calculator-need-3-lines): Fix las... 9e8386bdacc Support cons cell as value of ':line-width' box attribute 1d2ba6b363b ; * admin/notes/tree-sitter/treesit_record_change: Update. 02b6be892fa Add missing calls to treesit_record_change in editfns.c e982192e933 Call treesit_record_change in subst-char-in-region (bug#6... ddbb11f5657 ; * lisp/misc.el (duplicate-line-final-position): Fix las... cecbe92d5d9 ; * lisp/misc.el (duplicate-line-final-position): doc pre... 042f0d6a14c ; Fix documentation of ':box' face attribute # Conflicts: # etc/NEWS commit 3d65afd7b7a8f8d1b836fcea570b038a958d0e99 Merge: 0006245f1d3 d5cff340b3b Author: Eli Zaretskii Date: Sat Jul 1 06:29:44 2023 -0400 ; Merge from origin/emacs-29 The following commit was skipped: d5cff340b3b * lisp/misc.el (duplicate-line-final-position): New defcu... commit 0006245f1d39d678989beadffe55d7abe46d7030 Merge: e275e63eed3 ef16339918e Author: Eli Zaretskii Date: Sat Jul 1 06:29:43 2023 -0400 Merge from origin/emacs-29 ef16339918e Make js-beginning-of-defun return non-nil on success 2c90ade09a4 Tree-sitter use with-silent-modifications like jit-lock (... 11cead0d73c Fix todo-mode.el Commentary and a doc string (bug#64298) 6ae83322d4c Prevent truncation of todo-mode categories sexp ee41f07be52 Avoid making todo-mode buffers manually editable 53332bdf625 ; * doc/lispref/variables.texi: Fix define-obsolete-varia... 162c9c058eb ; Document that 'named-let' needs lexical-binding 68028f0fa31 ; * etc/PROBLEMS: Fix typo. commit e275e63eed382ccf0a56060be80288ad506fedbf Merge: e45ddf2fdc6 ac0a82ea987 Author: Eli Zaretskii Date: Sat Jul 1 06:29:43 2023 -0400 ; Merge from origin/emacs-29 The following commit was skipped: ac0a82ea987 Fix Tramp mount-spec (don't merge) commit e45ddf2fdc6b25c72ed6be29ad9e8effda6a2b6a Merge: 0bdd7707626 4df510c7a70 Author: Eli Zaretskii Date: Sat Jul 1 06:29:43 2023 -0400 Merge from origin/emacs-29 4df510c7a70 Fix VC package build when doc file isn't in a subdir 382f5fa8130 ; * doc/emacs/package.texi (Fetching Package Sources): Fi... fc7e7c3fde3 Fix type check in tramp-get-buffer-string 2aa57fe6cf9 ; Fix typo in maintaining.texi (bug#64279) commit 0bdd7707626858b48d330f78e692a96f02ab0a28 Merge: 8c7f92f25c3 1d9200d9bbb Author: Eli Zaretskii Date: Sat Jul 1 06:29:43 2023 -0400 ; Merge from origin/emacs-29 The following commits were skipped: 1d9200d9bbb ; * doc/lispintro/emacs-lisp-intro.texi (car & cdr): Fix ... 987b25d60dd Clarify list terminology commit edd36786e1eb9d3c17d4a36bd13fc9f6b2090c85 Author: Eli Zaretskii Date: Sat Jul 1 12:46:37 2023 +0300 ; * lisp/bookmark.el (bookmark-bmenu-locate): Doc fix (bug#64370). diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 11368910876..026257ff758 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2419,7 +2419,7 @@ bookmark-bmenu-rename (defun bookmark-bmenu-locate () - "Display location of this bookmark. Displays in the minibuffer." + "Display the location of the bookmark for this line." (interactive nil bookmark-bmenu-mode) (let ((bmrk (bookmark-bmenu-bookmark))) (message "%s" (bookmark-location bmrk)))) commit 16eac20a5db6952564b177263e27c90cb083d335 Author: Eli Zaretskii Date: Sat Jul 1 12:43:33 2023 +0300 ; Fix last change * lisp/menu-bar.el (menu-bar-file-menu, menu-bar-search-menu) (menu-bar-replace-menu, menu-bar-project-menu) (menu-bar-buffers-menu-command-entries): Fix help-echo text (bug#63469). diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index ac41a11379a..21785e43a6e 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -230,7 +230,7 @@ menu-bar-file-menu (bindings--define-key menu [project-open-file] '(menu-item "Open File In Project..." project-find-file :enable (menu-bar-non-minibuffer-window-p) - :help "Read an existing file in the current project into an Emacs buffer")) + :help "Read existing file that belongs to current project into an Emacs buffer")) (bindings--define-key menu [open-file] '(menu-item "Open File..." menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) @@ -357,7 +357,7 @@ menu-bar-search-menu :help "Search for a regexp in all tagged files")) (bindings--define-key menu [project-search] '(menu-item "Search in Project Files..." project-find-regexp - :help "Search for a regexp in files of the current project")) + :help "Search for a regexp in files belonging to current project")) (bindings--define-key menu [separator-tag-search] menu-bar-separator) (bindings--define-key menu [repeat-search-back] @@ -411,7 +411,7 @@ menu-bar-replace-menu :help "Interactively replace a regexp in all tagged files")) (bindings--define-key menu [project-replace] '(menu-item "Replace in Project Files..." project-query-replace-regexp - :help "Interactively replace a regexp in files of the current project")) + :help "Interactively replace a regexp in files belonging to current project")) (bindings--define-key menu [separator-replace-tags] menu-bar-separator) @@ -1785,14 +1785,14 @@ menu-bar-shell-commands-menu (defvar menu-bar-project-menu (let ((menu (make-sparse-keymap "Project"))) - (bindings--define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root")) - (bindings--define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files of the current project")) - (bindings--define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files of the current project or external files")) - (bindings--define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files of the current project")) + (bindings--define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root directory")) + (bindings--define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) + (bindings--define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files belonging to current project or external files")) + (bindings--define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files belonging to current project")) (bindings--define-key menu [separator-project-search] menu-bar-separator) (bindings--define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) - (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers..." project-list-buffers :help "Pop up a window listing all Emacs buffers in the current project")) - (bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer in the current project, and switch to it")) + (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers..." project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) + (bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to current project, and switch to it")) (bindings--define-key menu [separator-project-buffers] menu-bar-separator) (bindings--define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) (bindings--define-key menu [project-shell-command] '(menu-item "Shell Command..." project-shell-command :help "Invoke a shell command in project root and catch its output")) @@ -1803,9 +1803,9 @@ menu-bar-project-menu (bindings--define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir..." project-vc-dir :help "Show the VC status of the project repository")) (bindings--define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) - (bindings--define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open an existing directory in the current project")) - (bindings--define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open an existing file in the current project or its external roots")) - (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file in the current project")) + (bindings--define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open existing directory that belongs to current project")) + (bindings--define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open existing file that belongs to current project or its external roots")) + (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) menu)) (defun menu-bar-read-mail () @@ -2402,12 +2402,12 @@ menu-bar-buffers-menu-command-entries 'menu-item "Select Buffer In Project..." 'project-switch-to-buffer - :help "Prompt for a buffer in the current project, and switch to it") + :help "Prompt for a buffer belonging to current project, and switch to it") (list 'list-buffers-in-project 'menu-item "List Buffers In Project..." 'project-list-buffers - :help "Pop up a window listing all Emacs buffers in the current project")) + :help "Pop up a window listing all Emacs buffers belonging to current project")) "Entries to be included at the end of the \"Buffers\" menu.") (defvar menu-bar-select-buffer-function 'switch-to-buffer commit ab8d0f7b7688d103be71072ea16a4d153806ef50 Author: Spencer Baugh Date: Mon May 15 14:01:32 2023 -0400 Add project command entries to the menu-bar This will make it easier for new users to learn these increasingly important and useful commands. (Bug#63469) * lisp/menu-bar.el (menu-bar-file-menu): Add project-dired and project-find-file entries. (menu-bar-search-menu): Add project-find-regexp entry. (menu-bar-replace-menu): Add project-query-replace regexp entry. (menu-bar-shell-commands-menu): Add project-shell entry. (menu-bar-buffers-menu-command-entries): Add project-switch-to-buffer and project-list-buffer entries. (menu-bar-project-menu): Add. (menu-bar-tools-menu): Add "Project" submenu, and also project-compile entry and change text for compile entry. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index f6b87d1078d..ac41a11379a 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -219,10 +219,18 @@ menu-bar-file-menu '(menu-item "Insert File..." insert-file :enable (menu-bar-non-minibuffer-window-p) :help "Insert another file into current buffer")) + (bindings--define-key menu [project-dired] + '(menu-item "Open Project Directory" project-dired + :enable (menu-bar-non-minibuffer-window-p) + :help "Read the root directory of the current project, to operate on its files")) (bindings--define-key menu [dired] '(menu-item "Open Directory..." dired :enable (menu-bar-non-minibuffer-window-p) :help "Read a directory, to operate on its files")) + (bindings--define-key menu [project-open-file] + '(menu-item "Open File In Project..." project-find-file + :enable (menu-bar-non-minibuffer-window-p) + :help "Read an existing file in the current project into an Emacs buffer")) (bindings--define-key menu [open-file] '(menu-item "Open File..." menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) @@ -347,6 +355,9 @@ menu-bar-search-menu (bindings--define-key menu [tags-srch] '(menu-item "Search Tagged Files..." tags-search :help "Search for a regexp in all tagged files")) + (bindings--define-key menu [project-search] + '(menu-item "Search in Project Files..." project-find-regexp + :help "Search for a regexp in files of the current project")) (bindings--define-key menu [separator-tag-search] menu-bar-separator) (bindings--define-key menu [repeat-search-back] @@ -398,6 +409,9 @@ menu-bar-replace-menu (bindings--define-key menu [tags-repl] '(menu-item "Replace in Tagged Files..." tags-query-replace :help "Interactively replace a regexp in all tagged files")) + (bindings--define-key menu [project-replace] + '(menu-item "Replace in Project Files..." project-query-replace-regexp + :help "Interactively replace a regexp in files of the current project")) (bindings--define-key menu [separator-replace-tags] menu-bar-separator) @@ -1746,8 +1760,12 @@ menu-bar-encryption-decryption-menu (defvar menu-bar-shell-commands-menu (let ((menu (make-sparse-keymap "Shell Commands"))) + (bindings--define-key menu [project-interactive-shell] + '(menu-item "Run Shell In Project" project-shell + :help "Run a subshell interactively, in the current project's root directory")) + (bindings--define-key menu [interactive-shell] - '(menu-item "Run Shell Interactively" shell + '(menu-item "Run Shell" shell :help "Run a subshell interactively")) (bindings--define-key menu [async-shell-command] @@ -1765,6 +1783,31 @@ menu-bar-shell-commands-menu menu)) +(defvar menu-bar-project-menu + (let ((menu (make-sparse-keymap "Project"))) + (bindings--define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root")) + (bindings--define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files of the current project")) + (bindings--define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files of the current project or external files")) + (bindings--define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files of the current project")) + (bindings--define-key menu [separator-project-search] menu-bar-separator) + (bindings--define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) + (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers..." project-list-buffers :help "Pop up a window listing all Emacs buffers in the current project")) + (bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer in the current project, and switch to it")) + (bindings--define-key menu [separator-project-buffers] menu-bar-separator) + (bindings--define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) + (bindings--define-key menu [project-shell-command] '(menu-item "Shell Command..." project-shell-command :help "Invoke a shell command in project root and catch its output")) + (bindings--define-key menu [project-eshell] '(menu-item "Run Eshell" project-eshell :help "Run eshell for the current project")) + (bindings--define-key menu [project-shell] '(menu-item "Run Shell" project-shell :help "Run a subshell interactively, in the current project's root directory")) + (bindings--define-key menu [project-compile] '(menu-item "Compile..." project-compile :help "Invoke compiler or Make for current project, view errors")) + (bindings--define-key menu [separator-project-programs] menu-bar-separator) + (bindings--define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) + (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir..." project-vc-dir :help "Show the VC status of the project repository")) + (bindings--define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) + (bindings--define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open an existing directory in the current project")) + (bindings--define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open an existing file in the current project or its external roots")) + (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file in the current project")) + menu)) + (defun menu-bar-read-mail () "Read mail using `read-mail-command'." (interactive) @@ -1851,6 +1894,9 @@ menu-bar-tools-menu '(menu-item "Language Server Support (Eglot)" eglot :help "Start language server suitable for this buffer's major-mode")) + (bindings--define-key menu [project] + `(menu-item "Project" ,menu-bar-project-menu)) + (bindings--define-key menu [ede] '(menu-item "Project Support (EDE)" global-ede-mode @@ -1860,9 +1906,13 @@ menu-bar-tools-menu (bindings--define-key menu [gdb] '(menu-item "Debugger (GDB)..." gdb :help "Debug a program from within Emacs with GDB")) + (bindings--define-key menu [project-compile] + '(menu-item "Compile Project..." project-compile + :help "Invoke compiler or Make for current project, view errors")) + (bindings--define-key menu [compile] '(menu-item "Compile..." compile - :help "Invoke compiler or Make, view compilation errors")) + :help "Invoke compiler or Make in current buffer's directory, view errors")) (bindings--define-key menu [shell-commands] `(menu-item "Shell Commands" @@ -2347,7 +2397,17 @@ menu-bar-buffers-menu-command-entries 'menu-item "List All Buffers" 'list-buffers - :help "Pop up a window listing all Emacs buffers")) + :help "Pop up a window listing all Emacs buffers") + (list 'select-buffer-in-project + 'menu-item + "Select Buffer In Project..." + 'project-switch-to-buffer + :help "Prompt for a buffer in the current project, and switch to it") + (list 'list-buffers-in-project + 'menu-item + "List Buffers In Project..." + 'project-list-buffers + :help "Pop up a window listing all Emacs buffers in the current project")) "Entries to be included at the end of the \"Buffers\" menu.") (defvar menu-bar-select-buffer-function 'switch-to-buffer commit fc6099bf04696b01eaa21c9948a8d8d91345a66c Author: Eli Zaretskii Date: Sat Jul 1 12:28:33 2023 +0300 ; Improve documentation of text-property-search-* functions * doc/lispref/text.texi (Property Search): Improve wording and markup. * lisp/emacs-lisp/text-property-search.el (text-property-search-forward) (text-property-search-backward): Doc fixes. (Bug#64367) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index af6d6638b36..342e23beadb 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3398,37 +3398,43 @@ Property Search @end defun @defun text-property-search-forward prop &optional value predicate not-current -Search for the next region that has text property @var{prop} set to -@var{value} according to @var{predicate}. +Search for the next region of text whose property @var{prop} is a +match for @var{value} (which defaults to @code{nil}), according to +@var{predicate}. -This function is modeled after @code{search-forward} and friends in -that it moves point, but it returns a structure that describes the -match instead of returning it in @code{match-beginning} and friends. +This function is modeled after @code{search-forward} (@pxref{String +Search}) and friends, in that it moves point, but it also returns a +structure that describes the match instead of returning it in +@code{match-beginning} and friends. -If the text property can't be found, the function returns @code{nil}. -If it's found, point is placed at the end of the region that has this -text property match, and a @code{prop-match} structure is returned. +If the text property whose value is a match can't be found, the +function returns @code{nil}. If it's found, point is placed at the +end of the region that has this matching text property, and the +function returns a @code{prop-match} structure with information about +the match. @var{predicate} can either be @code{t} (which is a synonym for @code{equal}), @code{nil} (which means ``not equal''), or a predicate -that will be called with two parameters: The first is @var{value}, and -the second is the value of the text property we're inspecting. +that will be called with two arguments: @var{value} and the value of +the text property @var{prop} at the buffer position that is a +candidate for a match. The function should return non-@code{nil} if +there's a match, @code{nil} otherwise. -If @var{not-current}, if point is in a region where we have a match, -then skip past that and find the next instance instead. +If @var{not-current} is non-@code{nil}, then if point is already in a +region where we have a property match, skip past that region and find +the next region instead. -The @code{prop-match} structure has the following accessors: +The @code{prop-match} structure has the following accessor functionss: @code{prop-match-beginning} (the start of the match), @code{prop-match-end} (the end of the match), and @code{prop-match-value} (the value of @var{property} at the start of the match). -In the examples below, imagine that you're in a buffer that looks like -this: +In the examples below, we use a buffer whose contents is: -@example -This is a bold and here's bolditalic and this is the end. -@end example +@display +This is a @b{bold} and here's @b{@i{bolditalic}} and this is the end. +@end display That is, the ``bold'' words are the @code{bold} face, and the ``italic'' word is in the @code{italic} face. @@ -3452,8 +3458,9 @@ Property Search @end lisp This will pick out all the bits that have no face properties, which -will result in the list @samp{("This is a " "and here's " "and this is -the end")} (only reversed, since we used @code{push}). +will result in the list @samp{(@w{"This is a "} @w{"and here's "} +@w{"and this is the end"})} (only in reverse order, since we used +@code{push}, @pxref{List Variables}). @lisp (while (setq match (text-property-search-forward 'face nil nil)) @@ -3481,8 +3488,8 @@ Property Search @defun text-property-search-backward prop &optional value predicate not-current This is just like @code{text-property-search-forward}, but searches -backward instead. Point is placed at the beginning of the matched -region instead of the end, though. +backward instead, and if a match is found, point is placed at the +beginning of the matched region instead of the end. @end defun diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 920278b903a..669cdd97319 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -31,40 +31,41 @@ (defun text-property-search-forward (property &optional value predicate not-current) - "Search for the next region of text where PREDICATE is true. -PREDICATE is used to decide whether a value of PROPERTY should be -considered as matching VALUE. + "Search for next region of text where PREDICATE returns non-nil for PROPERTY. +PREDICATE is used to decide whether the value of PROPERTY at a given +buffer position should be considered as a match for VALUE. +VALUE defaults to nil if omitted. If PREDICATE is a function, it will be called with two arguments: -VALUE and the value of PROPERTY. The function should return -non-nil if these two values are to be considered a match. +VALUE and the value of PROPERTY at some buffer position. The function +should return non-nil if these two values are to be considered a match. Two special values of PREDICATE can also be used: -If PREDICATE is t, that means a value must `equal' VALUE to be -considered a match. -If PREDICATE is nil (which is the default value), a value will -match if is not `equal' to VALUE. Furthermore, a nil PREDICATE -means that the match region is ended if the value changes. For +If PREDICATE is t, that means the value of PROPERTY must `equal' VALUE +to be considered a match. +If PREDICATE is nil (which is the default), the value of PROPERTY will +match if it is not `equal' to VALUE. Furthermore, a nil PREDICATE +means that the match region ends where the value changes. For instance, this means that if you loop with (while (setq prop (text-property-search-forward \\='face)) ...) -you will get all distinct regions with non-nil `face' values in +you will get all the distinct regions with non-nil `face' values in the buffer, and the `prop' object will have the details about the match. See the manual for more details and examples about how VALUE and PREDICATE interact. -If NOT-CURRENT is non-nil, the function will search for the first -region that doesn't include point and has a value of PROPERTY -that matches VALUE. +If NOT-CURRENT is non-nil, current buffer position is not examined for +matches: the function will search for the first region that doesn't +include point and has a value of PROPERTY that matches VALUE. If no matches can be found, return nil and don't move point. If found, move point to the end of the region and return a `prop-match' object describing the match. To access the details of the match, use `prop-match-beginning' and `prop-match-end' for -the buffer positions that limit the region, and -`prop-match-value' for the value of PROPERTY in the region." +the buffer positions that limit the region, and `prop-match-value' +for the value of PROPERTY in the region." (interactive (list (let ((string (completing-read "Search for property: " obarray))) @@ -134,7 +135,7 @@ text-property--find-end-forward (defun text-property-search-backward (property &optional value predicate not-current) - "Search for the previous region of text whose PROPERTY matches VALUE. + "Search for previous region of text where PREDICATE returns non-nil for PROPERTY. Like `text-property-search-forward', which see, but searches backward, and if a matching region is found, place point at the start of the region." commit 8c7f92f25c39137b5ddc2872597434fd5a3b38e9 Author: Eli Zaretskii Date: Sat Jul 1 11:34:43 2023 +0300 Fix total count of messages in Rmail summary buffers * lisp/mail/rmailsum.el (rmail-new-summary-1): Actually count the messages in the summary buffer instead of relying on 'rmail-total-messages'. Reported by Andrea Monaco . diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 21dec2bbeb7..e3a6c16933b 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -742,13 +742,14 @@ rmail-new-summary-1 (setq rmail-summary-buffer nil))) (save-excursion (let ((rbuf (current-buffer)) - (total rmail-total-messages)) + (total 0)) (set-buffer sumbuf) ;; Set up the summary buffer's contents. (let ((buffer-read-only nil)) (erase-buffer) (while summary-msgs (princ (cdr (car summary-msgs)) sumbuf) + (setq total (1+ total)) (setq summary-msgs (cdr summary-msgs))) (goto-char (point-min))) ;; Set up the rest of its state and local variables. commit bfec5674c6529ed20c2e4eeb90f9350b1f899c01 Author: Davide Masserut Date: Tue Jun 20 15:55:11 2023 +0200 Recognize PKGBUILD as bash style * lisp/progmodes/sh-script.el (sh--guess-shell): Handle PKGBUILD. (Bug#64251) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 6beff9f41e9..a305c35c5f8 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1489,6 +1489,7 @@ sh--guess-shell ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") ((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") + ((equal (file-name-nondirectory buffer-file-name) "PKGBUILD") "bash") (t sh-shell-file))) ;;;###autoload commit 7bcf7b8e20eb41ba2a0ecd134a795928786b1d41 Author: Michael Albinus Date: Sat Jul 1 10:19:37 2023 +0200 Improve Tramp for remote WebDAV * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): * lisp/net/tramp-rclone.el (tramp-rclone-do-copy-or-rename-file): Improve stability for WebDAV. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 48467a92c14..27dbf324924 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1068,6 +1068,8 @@ tramp-gvfs-do-copy-or-rename-file (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) + (when (file-regular-p newname) + (delete-file newname)) (cond ;; We cannot rename volatile files, as used by Google-drive. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index f71e4f732e2..df46bd5e20e 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -226,6 +226,7 @@ tramp-rclone-do-copy-or-rename-file (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) + (equal-remote (tramp-equal-remote filename newname)) (rclone-operation (if (eq op 'copy) "copyto" "moveto")) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) @@ -236,8 +237,12 @@ tramp-rclone-do-copy-or-rename-file (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) + (when (file-regular-p newname) + (delete-file newname)) - (if (or (and t1 (not (tramp-rclone-file-name-p filename))) + (if (or (and equal-remote + (tramp-get-connection-property v "direct-copy-failed")) + (and t1 (not (tramp-rclone-file-name-p filename))) (and t2 (not (tramp-rclone-file-name-p newname)))) ;; We cannot copy or rename directly. @@ -257,9 +262,20 @@ tramp-rclone-do-copy-or-rename-file v rclone-operation (tramp-rclone-remote-file-name filename) (tramp-rclone-remote-file-name newname))) - (tramp-error - v 'file-error - "Error %s `%s' `%s'" msg-operation filename newname))) + (if (or (not equal-remote) + (and equal-remote + (tramp-get-connection-property + v "direct-copy-failed"))) + (tramp-error + v 'file-error + "Error %s `%s' `%s'" msg-operation filename newname) + + ;; Some WebDAV server, like the one from QNAP, do + ;; not support direct copy/move. Try a fallback. + (tramp-set-connection-property v "direct-copy-failed" t) + (tramp-rclone-do-copy-or-rename-file + op filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) (when (and t1 (eq op 'rename)) (while (file-exists-p filename) commit cc660bd265172ffd75851d418db9af66704d0e54 Author: Eli Zaretskii Date: Sat Jul 1 10:01:59 2023 +0300 ; * etc/PROBLEMS: Mention MinGW problems with -D_FORTIFY_SOURCE=2. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index cdce8bbc774..30769e68f11 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -2768,6 +2768,21 @@ With any of the above methods, you'd need to restart Emacs (and preferably also your Windows system) after making the changes, to have them take effect. +*** MinGW64 Emacs built with -D_FORTIFY_SOURCE=2 misbehaves + +Using this preprocessor option when building Emacs with MinGW64 +produces an Emacs binary that behaves incorrectly. In particular, +running asynchronous shell command, e.g., with 'M-&', causes Emacs to +use 100% of CPU and start allocating a lot of memory. For the same +reason, asynchronous native-compilation will hang Emacs (which could +wedge Emacs during startup, if your Emacs is configured to download +and install packages via package.el every startup). 'M-x run-python', +'M-x shell', and similar commands also hang. Other commands might +also cause high CPU and/or memory usage. + +The workaround is to rebuild Emacs without the -D_FORTIFY_SOURCE=2 +option. + ** Emacs on Windows 9X requires UNICOWS.DLL If that DLL is not available, Emacs will display an error dialog commit a5bd9fb8c4a4d96e20b05557128448a48cff36c7 Author: Eli Zaretskii Date: Fri Jun 30 14:47:12 2023 +0300 ; Improve doc strings in register.el * lisp/register.el (register-preview-delay) (register-describe-oneline, register-preview-default) (register-preview-function, register-preview, point-to-register) (window-configuration-to-register) (frame-configuration-to-register, jump-to-register) (register-val-jump-to, number-to-register, increment-register) (view-register, list-registers, register-val-describe) (insert-register, register-val-insert, copy-to-register) (append-to-register, prepend-to-register) (copy-rectangle-to-register): Doc fixes. diff --git a/lisp/register.el b/lisp/register.el index 667e03418bd..56ab089efb7 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -92,7 +92,7 @@ register-separator (character :tag "Use register" :value ?+))) (defcustom register-preview-delay 1 - "If non-nil, time to wait in seconds before popping up a preview window. + "If non-nil, time to wait in seconds before popping up register preview window. If nil, do not show register previews, unless `help-char' (or a member of `help-event-list') is pressed." :version "24.4" @@ -109,7 +109,7 @@ set-register (setf (alist-get register register-alist) value)) (defun register-describe-oneline (c) - "One-line description of register C." + "Return a one-line description of register C." (let ((d (replace-regexp-in-string "\n[ \t]*" " " (with-output-to-string (describe-register-1 c))))) @@ -118,19 +118,19 @@ register-describe-oneline d))) (defun register-preview-default (r) - "Default function for the variable `register-preview-function'." + "Function that is the default value of the variable `register-preview-function'." (format "%s: %s\n" (single-key-description (car r)) (register-describe-oneline (car r)))) (defvar register-preview-function #'register-preview-default "Function to format a register for previewing. -Takes one argument, a cons (NAME . CONTENTS) as found in `register-alist'. -Returns a string.") +Called with one argument, a cons (NAME . CONTENTS) as found in `register-alist'. +The function should return a string, the description of teh argument.") (defun register-preview (buffer &optional show-empty) - "Pop up a window to show register preview in BUFFER. -If SHOW-EMPTY is non-nil show the window even if no registers. + "Pop up a window showing the registers preview in BUFFER. +If SHOW-EMPTY is non-nil, show the window even if no registers. Format of each entry is controlled by the variable `register-preview-function'." (when (or show-empty (consp register-alist)) (with-current-buffer-window @@ -180,12 +180,12 @@ register-read-with-preview (and (get-buffer buffer) (kill-buffer buffer))))) (defun point-to-register (register &optional arg) - "Store current location of point in register REGISTER. -With prefix argument, store current frame configuration (a.k.a. \"frameset\"). + "Store current location of point in REGISTER. +With prefix argument ARG, store current frame configuration (a.k.a. \"frameset\"). Use \\[jump-to-register] to go to that location or restore that configuration. -Argument is a character, naming the register. +Argument is a character, the name of the register. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview (if current-prefix-arg "Frame configuration to register: " @@ -198,11 +198,11 @@ point-to-register (point-marker)))) (defun window-configuration-to-register (register &optional _arg) - "Store the window configuration of the selected frame in register REGISTER. + "Store the window configuration of the selected frame in REGISTER. Use \\[jump-to-register] to restore the configuration. -Argument is a character, naming the register. +Argument is a character, the name of the register. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview "Window configuration to register: ") current-prefix-arg)) @@ -215,12 +215,12 @@ window-configuration-to-register '(register) "24.4") (defun frame-configuration-to-register (register &optional _arg) - "Store the window configuration of all frames in register REGISTER. + "Store the window configurations of all frames in REGISTER. \(This window configuration is also known as \"frameset\"). Use \\[jump-to-register] to restore the configuration. -Argument is a character, naming the register. +Argument is a character, the name of the register. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview "Frame configuration to register: ") current-prefix-arg)) @@ -236,19 +236,21 @@ frame-configuration-to-register (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (register &optional delete) - "Move point to location stored in a register. -Push the mark if jumping moves point, unless called in succession. + "Go to location stored in REGISTER, or restore configuration stored there. +Push the mark if going to the location moves point, unless called in succession. If the register contains a file name, find that file. -\(To put a file name in a register, you must use `set-register'.) +If the register contains a buffer name, switch to that buffer. +\(To put a file or buffer name in a register, you must use `set-register'.) If the register contains a window configuration (one frame) or a frameset -\(all frames), restore that frame or all frames accordingly. -First argument is a character, naming the register. +\(all frames), restore the configuration of that frame or of all frames +accordingly. +First argument REGISTER is a character, the name of the register. Optional second arg DELETE non-nil (interactively, prefix argument) says to delete any existing frames that the frameset doesn't mention. \(Otherwise, these frames are iconified.) This argument is currently ignored if the register contains anything but a frameset. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview "Jump to register: ") current-prefix-arg)) (let ((val (get-register register))) @@ -256,6 +258,7 @@ jump-to-register (cl-defgeneric register-val-jump-to (_val _arg) "Execute the \"jump\" operation of VAL. +VAL is the contents of a register as returned by `get-register'. ARG is the value of the prefix argument or nil." (user-error "Register doesn't contain a buffer position or configuration")) @@ -305,13 +308,13 @@ register-swap-out (marker-position (cdr elem)))))))) (defun number-to-register (number register) - "Store a number in a register. -Two args, NUMBER and REGISTER (a character, naming the register). -If NUMBER is nil, a decimal number is read from the buffer starting + "Store NUMBER in REGISTER. +REGISTER is a character, the name of the register. +If NUMBER is nil, a decimal number is read from the buffer at point, and point moves to the end of that number. Interactively, NUMBER is the prefix arg (none means nil). -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list current-prefix-arg (register-read-with-preview "Number to register: "))) (set-register register @@ -324,8 +327,8 @@ number-to-register 0)))) (defun increment-register (prefix register) - "Augment contents of REGISTER. -Interactively, PREFIX is in raw form. + "Augment contents of REGISTER using PREFIX. +Interactively, PREFIX is the raw prefix argument. If REGISTER contains a number, add `prefix-numeric-value' of PREFIX to it. @@ -333,7 +336,7 @@ increment-register If REGISTER is empty or if it contains text, call `append-to-register' with `delete-flag' set to PREFIX. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list current-prefix-arg (register-read-with-preview "Increment register: "))) (let ((register-val (get-register register))) @@ -346,10 +349,10 @@ increment-register (t (user-error "Register does not contain a number or text"))))) (defun view-register (register) - "Display what is contained in register named REGISTER. -The Lisp value REGISTER is a character. + "Display the description of the contents of REGISTER. +REGISTER is a character, the name of the register. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview "View register: "))) (let ((val (get-register register))) (if (null val) @@ -358,7 +361,7 @@ view-register (describe-register-1 register t))))) (defun list-registers () - "Display a list of nonempty registers saying briefly what they contain." + "Display the list of nonempty registers with brief descriptions of contents." (interactive) (let ((list (copy-sequence register-alist))) (setq list (sort list (lambda (a b) (< (car a) (car b))))) @@ -376,7 +379,10 @@ describe-register-1 (register-val-describe val verbose))) (cl-defgeneric register-val-describe (val verbose) - "Print description of register value VAL to `standard-output'." + "Print description of register value VAL to `standard-output'. +Second argument VERBOSE is ignored, unless VAL is not one of the +supported kinds of register contents, in which case it is displayed +using `prin1'." (princ "Garbage:\n") (if verbose (prin1 val))) @@ -471,13 +477,14 @@ register-val-describe (princ "the empty string"))))) (defun insert-register (register &optional arg) - "Insert contents of register REGISTER. (REGISTER is a character.) -Normally puts point before and mark after the inserted text. -If optional second arg is non-nil, puts mark before and point after. -Interactively, second arg is nil if prefix arg is supplied and t -otherwise. - -Interactively, reads the register using `register-read-with-preview'." + "Insert contents of REGISTER at point. +REGISTER is a character, the name of the register. +Normally puts point before and mark after the inserted text, but +if optional second argument ARG is non-nil, puts mark before and +point after. Interactively, ARG is nil if prefix arg is supplied, +and t otherwise. + +Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (progn (barf-if-buffer-read-only) (list (register-read-with-preview "Insert register: ") @@ -488,7 +495,7 @@ insert-register (if (not arg) (exchange-point-and-mark))) (cl-defgeneric register-val-insert (_val) - "Insert register value VAL." + "Insert register value VAL in current buffer at point." (user-error "Register does not contain text")) (cl-defmethod register-val-insert ((val registerv)) @@ -511,14 +518,17 @@ register-val-insert (cl-call-next-method val))) (defun copy-to-register (register start end &optional delete-flag region) - "Copy region into register REGISTER. -With prefix arg, delete as well. -Called from program, takes five args: REGISTER, START, END, DELETE-FLAG, + "Copy region of text between START and END into REGISTER. +If DELETE-FLAG is non-nil (interactively, prefix arg), delete the region +after copying. +Called from Lisp, takes five args: REGISTER, START, END, DELETE-FLAG, and REGION. START and END are buffer positions indicating what to copy. -The optional argument REGION if non-nil, indicates that we're not just -copying some text between START and END, but we're copying the region. +The optional argument REGION, if non-nil, means START..END denotes the +region. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview' +and use mark and point as START and END; REGION is always non-nil in +this case." (interactive (list (register-read-with-preview "Copy to register: ") (region-beginning) (region-end) @@ -534,12 +544,14 @@ copy-to-register (indicate-copied-region)))) (defun append-to-register (register start end &optional delete-flag) - "Append region to text in register REGISTER. -With prefix arg, delete as well. -Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. + "Append region of text between START and END to REGISTER. +If DELETE-FLAG is non-nil (interactively, prefix arg), delete the region +after appending. +Called from Lisp, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to append. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview', +and use mark and point as START and END." (interactive (list (register-read-with-preview "Append to register: ") (region-beginning) (region-end) @@ -558,12 +570,14 @@ append-to-register (indicate-copied-region)))) (defun prepend-to-register (register start end &optional delete-flag) - "Prepend region to text in register REGISTER. -With prefix arg, delete as well. + "Prepend region of text between START and END to REGISTER. +If DELETE-FLAG is non-nil (interactively, prefix arg), delete the region +after prepending. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to prepend. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview', +and use mark and point as START and END." (interactive (list (register-read-with-preview "Prepend to register: ") (region-beginning) (region-end) @@ -582,14 +596,16 @@ prepend-to-register (indicate-copied-region)))) (defun copy-rectangle-to-register (register start end &optional delete-flag) - "Copy rectangular region into register REGISTER. -With prefix arg, delete as well. -To insert this register in the buffer, use \\[insert-register]. + "Copy rectangular region of text between START and END into REGISTER. +If DELETE-FLAG is non-nil (interactively, prefix arg), delete the region +after copying. +To insert this register into a buffer, use \\[insert-register]. -Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. +Called from Lisp, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle. -Interactively, reads the register using `register-read-with-preview'." +Interactively, prompt for REGISTER using `register-read-with-preview', +and use mark and point as START and END." (interactive (list (register-read-with-preview "Copy rectangle to register: ") (region-beginning) commit 0be18d80978ff873f8c93c7b84b1bd31ca5887c8 Author: Basil L. Contovounesios Date: Fri Jun 30 12:21:00 2023 +0100 ; Fix @xref in last change to doc/emacs/regs.texi. diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index 2bc4640cbf4..e52f68dd18e 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -194,7 +194,7 @@ Configuration Registers @kindex C-x r f You can save the window configuration of the selected frame in a register, or even the configuration of all windows in all frames, and -restore the configuration later. @xref{Windows Convenience}, for +restore the configuration later. @xref{Window Convenience}, for information about window configurations. @table @kbd commit 624c779517d0743deaf97145e7c577805730d9da Author: Basil L. Contovounesios Date: Fri Jun 30 11:58:33 2023 +0100 ; Fix tree-sitter C binding typos in Elisp manual. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 9e1df07d25c..353585f79c7 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1921,7 +1921,7 @@ Tree-sitter C API ts_node_child_count treesit-node-child-count ts_node_named_child treesit-node-child ts_node_named_child_count treesit-node-child-count -ts_node_child_by_field_name treesit-node-by-field-name +ts_node_child_by_field_name treesit-node-child-by-field-name ts_node_child_by_field_id ts_node_next_sibling treesit-node-next-sibling ts_node_prev_sibling treesit-node-prev-sibling @@ -1929,9 +1929,9 @@ Tree-sitter C API ts_node_prev_named_sibling treesit-node-prev-sibling ts_node_first_child_for_byte treesit-node-first-child-for-pos ts_node_first_named_child_for_byte treesit-node-first-child-for-pos -ts_node_descendant_for_byte_range treesit-descendant-for-range +ts_node_descendant_for_byte_range treesit-node-descendant-for-range ts_node_descendant_for_point_range -ts_node_named_descendant_for_byte_range treesit-descendant-for-range +ts_node_named_descendant_for_byte_range treesit-node-descendant-for-range ts_node_named_descendant_for_point_range ts_node_edit ts_node_eq treesit-node-eq commit 16e9bdff4f47534d62ac9ebec9c6c49fe5a0e180 Author: Eli Zaretskii Date: Fri Jun 30 10:13:53 2023 +0300 Improve documentation of registers * doc/lispref/text.texi (Registers): Document buffers in registers. Mention "frameset" as another name for "frame configuration". * doc/emacs/regs.texi (Registers, Configuration Registers) (File and Buffer Registers): Clarify and improve wording. Add cross-references and indexing. (Configuration Registers): Rename the section to a more accurate name. (Bug#64354) * lisp/register.el (jump-to-register, point-to-register) (register-alist, frame-configuration-to-register): Doc fixes. (Bug#64353) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 7071ea44edd..0efd99261ac 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -349,7 +349,7 @@ Top * Position Registers:: Saving positions in registers. * Text Registers:: Saving text in registers. * Rectangle Registers:: Saving rectangles in registers. -* Configuration Registers:: Saving window configurations in registers. +* Configuration Registers:: Saving window/frame configurations in registers. * Number Registers:: Numbers in registers. * File and Buffer Registers:: File and buffer names in registers. * Keyboard Macro Registers:: Keyboard macros in registers. diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index ec2367d71e3..2bc4640cbf4 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -22,10 +22,11 @@ Registers @findex view-register A register can store a position, a piece of text, a rectangle, a -number, a window configuration, or a file name, but only one thing at -any given time. Whatever you store in a register remains there until -you store something else in that register. To see what register -@var{r} contains, use @kbd{M-x view-register}: +number, a window or frame configuration, a buffer name, or a file +name, but only one thing at any given time. Whatever you store in a +register remains there until you store something else in that +register. To see what register @var{r} contains, use @kbd{M-x +view-register}: @table @kbd @item M-x view-register @key{RET} @var{r} @@ -50,7 +51,7 @@ Registers * Position Registers:: Saving positions in registers. * Text Registers:: Saving text in registers. * Rectangle Registers:: Saving rectangles in registers. -* Configuration Registers:: Saving window configurations in registers. +* Configuration Registers:: Saving window/frame configurations in registers. * Number Registers:: Numbers in registers. * File and Buffer Registers:: File and buffer names in registers. * Keyboard Macro Registers:: Keyboard macros in registers. @@ -182,8 +183,10 @@ Rectangle Registers rather than a text string, if the register contains a rectangle. @node Configuration Registers -@section Saving Window Configurations in Registers +@section Saving Window and Frame Configurations in Registers @cindex saving window configuration in a register +@cindex saving frame configuration in a register +@cindex frameset, saving in a register @findex window-configuration-to-register @findex frameset-to-register @@ -191,16 +194,17 @@ Configuration Registers @kindex C-x r f You can save the window configuration of the selected frame in a register, or even the configuration of all windows in all frames, and -restore the configuration later. @xref{Windows}, for information -about window configurations. +restore the configuration later. @xref{Windows Convenience}, for +information about window configurations. @table @kbd @item C-x r w @var{r} Save the state of the selected frame's windows in register @var{r} (@code{window-configuration-to-register}). +@cindex frameset @item C-x r f @var{r} -Save the state of all frames, including all their windows, in register -@var{r} (@code{frameset-to-register}). +Save the state of all frames, including all their windows (a.k.a.@: +@dfn{frameset}), in register @var{r} (@code{frameset-to-register}). @end table Use @kbd{C-x r j @var{r}} to restore a window or frame configuration. @@ -266,7 +270,7 @@ File and Buffer Registers @var{r}}. (This is the same command used to jump to a position or restore a frame configuration.) - Similarly, if there's certain buffers you visit frequently, you + Similarly, if there are certain buffers you visit frequently, you can put their names in registers. For instance, if you visit the @samp{*Messages*} buffer often, you can use the following snippet to put that buffer into the @samp{m} register: @@ -275,6 +279,9 @@ File and Buffer Registers (set-register ?m '(buffer . "*Messages*")) @end smallexample + To switch to the buffer whose name is in register @var{r}, type +@kbd{C-x r j @var{r}}. + @node Keyboard Macro Registers @section Keyboard Macro Registers @cindex saving keyboard macro in a register diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 0f43f3d464a..af6d6638b36 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4642,20 +4642,25 @@ Registers This represents a window configuration to restore in one frame, and a position to jump to in the current buffer. -@c FIXME: Mention frameset here. +@cindex frameset @item @code{(@var{frame-configuration} @var{position})} This represents a frame configuration to restore, and a position -to jump to in the current buffer. +to jump to in the current buffer. Frame configurations are also +known as @dfn{framesets}. -@item (file @var{filename}) +@item @code{(file @var{filename})} This represents a file to visit; jumping to this value visits file @var{filename}. -@item (file-query @var{filename} @var{position}) +@item @code{(file-query @var{filename} @var{position})} This represents a file to visit and a position in it; jumping to this value visits file @var{filename} and goes to buffer position @var{position}. Restoring this type of position asks the user for confirmation first. + +@item @code{(buffer @var{buffer-name})} +This represents a buffer; jumping to this value switches to buffer +@var{buffer-name}. @end table The functions in this section return unpredictable values unless diff --git a/lisp/register.el b/lisp/register.el index d30114bfbc7..667e03418bd 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -69,10 +69,12 @@ register-alist A list of the form (file-query FILE-NAME POSITION) represents position POSITION in the file named FILE-NAME, but query before visiting it. +A list of the form (buffer . BUFFER-NAME) represents the buffer BUFFER-NAME. A list of the form (WINDOW-CONFIGURATION POSITION) represents a saved window configuration plus a saved value of point. A list of the form (FRAME-CONFIGURATION POSITION) - represents a saved frame configuration plus a saved value of point.") + represents a saved frame configuration (a.k.a. \"frameset\") plus + a saved value of point.") (defgroup register nil "Register commands." @@ -179,7 +181,7 @@ register-read-with-preview (defun point-to-register (register &optional arg) "Store current location of point in register REGISTER. -With prefix argument, store current frame configuration. +With prefix argument, store current frame configuration (a.k.a. \"frameset\"). Use \\[jump-to-register] to go to that location or restore that configuration. Argument is a character, naming the register. @@ -214,6 +216,7 @@ window-configuration-to-register (defun frame-configuration-to-register (register &optional _arg) "Store the window configuration of all frames in register REGISTER. +\(This window configuration is also known as \"frameset\"). Use \\[jump-to-register] to restore the configuration. Argument is a character, naming the register. @@ -240,9 +243,10 @@ jump-to-register If the register contains a window configuration (one frame) or a frameset \(all frames), restore that frame or all frames accordingly. First argument is a character, naming the register. -Optional second arg non-nil (interactively, prefix argument) says to -delete any existing frames that the frameset doesn't mention. -\(Otherwise, these frames are iconified.) +Optional second arg DELETE non-nil (interactively, prefix argument) says +to delete any existing frames that the frameset doesn't mention. +\(Otherwise, these frames are iconified.) This argument is currently +ignored if the register contains anything but a frameset. Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Jump to register: ") commit 884b668b98152a0df0bc0bdea49137f582faa005 Author: Andrew G Cohen Date: Tue Jun 27 15:40:46 2023 +0800 Use a temporary buffer in nnagent-request-set-mark (bug#64117) Commit cb12a84f2c519a48dd87453c925e3bc36d9944db inadvertently removed the use of a temporary buffer in nnagent-request-set-mark. Bug and fix reported by Jens Schmidt * lisp/gnus/nnagent.el (nnagent-request-set-mark): Restore the use of a temporary buffer that was inadvertently removed. (cherry picked from commit 5075d752773c31d959272a7e2b73b1dc38ba184c) diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 61ec66155e4..30d5514a8b7 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -118,17 +118,18 @@ nnagent-request-post (gnus-request-accept-article "nndraft:queue" nil t t)) (deffoo nnagent-request-set-mark (group action server) - (insert "(gnus-agent-synchronize-group-flags \"" - group - "\" '") - (gnus-pp action) - (insert " \"" - (gnus-method-to-server gnus-command-method) - "\"") - (insert ")\n") - (let ((coding-system-for-write nnheader-file-coding-system)) - (write-region (point-min) (point-max) (gnus-agent-lib-file "flags") - t 'silent)) + (with-temp-buffer + (insert "(gnus-agent-synchronize-group-flags \"" + group + "\" '") + (gnus-pp action) + (insert " \"" + (gnus-method-to-server gnus-command-method) + "\"") + (insert ")\n") + (let ((coding-system-for-write nnheader-file-coding-system)) + (write-region (point-min) (point-max) (gnus-agent-lib-file "flags") + t 'silent))) ;; Also set the marks for the original back end that keeps marks in ;; the local system. (let ((gnus-agent nil)) commit a722e7dd152b809b0e71be30f83606490794c1c7 Merge: 65f146cf1c2 1d2ba6b363b Author: Eli Zaretskii Date: Thu Jun 29 21:23:12 2023 +0300 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit 65f146cf1c275cfce2265a5911c6460374ef153b Author: Eli Zaretskii Date: Thu Jun 29 21:21:28 2023 +0300 ; * lisp/calculator.el (calculator-need-3-lines): Fix last change. diff --git a/lisp/calculator.el b/lisp/calculator.el index dbfba0b5bb7..b744f11e1e9 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -746,7 +746,8 @@ calculator-need-3-lines ;; use 3 lines (let* ((bx (face-attribute 'mode-line :box)) (lh (plist-get bx :line-width))) - (and bx (or (not lh) (> (if (listp lh) (cdr lh) lh) 0)))) + ;; Value of `:line-width' can be either a number or a cons. + (and bx (or (not lh) (> (if (consp lh) (cdr lh) lh) 0)))) ;; if the mode line has an overline, use 3 lines (not (memq (face-attribute 'mode-line :overline) '(nil unspecified))))))) commit 9e8386bdacc890390bb90f69889117667019c979 Author: john muhl Date: Wed Jun 28 12:58:27 2023 -0500 Support cons cell as value of ':line-width' box attribute * lisp/calculator.el (calculator-need-3-lines): Support values of a face's ':line-width' box attribute that are cons cells. (Bug#64344) Copyright-paperwork-exempt: yes diff --git a/lisp/calculator.el b/lisp/calculator.el index 6a1d960c3e4..dbfba0b5bb7 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -746,7 +746,7 @@ calculator-need-3-lines ;; use 3 lines (let* ((bx (face-attribute 'mode-line :box)) (lh (plist-get bx :line-width))) - (and bx (or (not lh) (> lh 0)))) + (and bx (or (not lh) (> (if (listp lh) (cdr lh) lh) 0)))) ;; if the mode line has an overline, use 3 lines (not (memq (face-attribute 'mode-line :overline) '(nil unspecified))))))) commit 1d2ba6b363b2e41ca40c74f679f80363e04a54ed Author: Yuan Fu Date: Wed Jun 28 17:05:29 2023 -0700 ; * admin/notes/tree-sitter/treesit_record_change: Update. diff --git a/admin/notes/tree-sitter/treesit_record_change b/admin/notes/tree-sitter/treesit_record_change index 0dc6491e2d1..e80df4adfa7 100644 --- a/admin/notes/tree-sitter/treesit_record_change +++ b/admin/notes/tree-sitter/treesit_record_change @@ -3,10 +3,10 @@ NOTES ON TREESIT_RECORD_CHANGE It is vital that Emacs informs tree-sitter of every change made to the buffer, lest tree-sitter's parse tree would be corrupted/out of sync. -All buffer changes in Emacs are made through functions in insdel.c -(and casefiddle.c), I augmented functions in those files with calls to -treesit_record_change. Below is a manifest of all the relevant -functions in insdel.c as of Emacs 29: +Almost all buffer changes in Emacs are made through functions in +insdel.c (see below for exceptions), I augmented functions in insdel.c +with calls to treesit_record_change. Below is a manifest of all the +relevant functions in insdel.c as of Emacs 29: Function Calls ---------------------------------------------------------------------- @@ -43,8 +43,176 @@ insert_from_buffer but not insert_from_buffer_1. I also left a reminder comment. -As for casefiddle.c, do_casify_unibyte_region and +EXCEPTIONS + + +There are a couple of functions that replaces characters in-place +rather than insert/delete. They are in casefiddle.c and editfns.c. + +In casefiddle.c, do_casify_unibyte_region and do_casify_multibyte_region modifies buffer, but they are static functions and are called by casify_region, which calls treesit_record_change. Other higher-level functions calls -casify_region to do the work. \ No newline at end of file +casify_region to do the work. + +In editfns.c, subst-char-in-region and translate-region-internal might +replace characters in-place, I made them to call +treesit_record_change. transpose-regions uses memcpy to move text +around, it calls treesit_record_change too. + +I found these exceptions by grepping for signal_after_change and +checking each caller manually. Below is all the result as of Emacs 29 +and some comment for each one. Readers can use + +(highlight-regexp "^[^[:space:]]+?\\.c:[[:digit:]]+:[^z-a]+?$" 'highlight) + +to make things easier to read. + +grep [...] --color=auto -i --directories=skip -nH --null -e signal_after_change *.c + +callproc.c:789: calling prepare_to_modify_buffer and signal_after_change. +callproc.c:793: is one call to signal_after_change in each of the +callproc.c:800: signal_after_change hasn't. A continue statement +callproc.c:804: again, and this time signal_after_change gets called, + +Not code. + +callproc.c:820: signal_after_change (PT - nread, 0, nread); +callproc.c:863: signal_after_change (PT - process_coding.produced_char, + +Both are called in call-process. I don’t think we’ll ever use +tree-sitter in call-process’s stdio buffer, right? I didn’t check +line-by-line, but it seems to only use insert_1_both and del_range_2. + +casefiddle.c:558: signal_after_change (start, end - start - added, end - start); + +Called in casify-region, calls treesit_record_change. + +decompress.c:195: signal_after_change (data->orig, data->start - data->orig, + +Called in unwind_decompress, uses del_range_2, insdel function. + +decompress.c:334: signal_after_change (istart, iend - istart, unwind_data.nbytes); + +Called in zlib-decompress-region, uses del_range_2, insdel function. + +editfns.c:2139: signal_after_change (BEGV, size_a, ZV - BEGV); + +Called in replace-buffer-contents, which calls del_range and +Finsert_buffer_substring, both are ok. + +editfns.c:2416: signal_after_change (changed, + +Called in subst-char-in-region, which either calls replace_range (a +insdel function) or modifies buffer content by itself (need to call +treesit_record_change). + +editfns.c:2544: /* Reload as signal_after_change in last iteration may GC. */ + +Not code. + +editfns.c:2604: signal_after_change (pos, 1, 1); + +Called in translate-region-internal, which has three cases: + +if (nc != oc && nc >= 0) { + if (len != str_len) { + replace_range() + } else { + while (str_len-- > 0) + *p++ = *str++; + } +} +else if (nc < 0) { + replace_range() +} + +replace_range is ok, but in the case where it manually modifies buffer +content, it needs to call treesit_record_change. + +editfns.c:4779: signal_after_change (start1, end2 - start1, end2 - start1); + +Called in transpose-regions. It just uses memcpy’s and doesn’t use +insdel functions; needs to call treesit_record_change. + +fileio.c:4825: signal_after_change (PT, 0, inserted); + +Called in insert_file_contents. Uses insert_1_both (very first in the +function); del_range_1 and del_range_byte (the optimized way to +implement replace when decoding isn’t needed); del_range_byte and +insert_from_buffer (the optimized way used when decoding is needed); +decode_coding_gap or insert_from_gap_1 (I’m not sure the condition for +this, but anyway it’s safe). The function also calls memcpy and +memmove, but they are irrelevant: memcpy is used for decoding, and +memmove is moving stuff inside the gap for decode_coding_gap. + +I’d love someone to verify this function, since it’s so complicated +and large, but from what I can tell it’s safe. + +fns.c:3998: signal_after_change (XFIXNAT (beg), 0, inserted_chars); + +Called in base64-decode-region, uses insert_1_both and del_range_both, +safe. + +insdel.c:681: signal_after_change (opoint, 0, len); +insdel.c:696: signal_after_change (opoint, 0, len); +insdel.c:741: signal_after_change (opoint, 0, len); +insdel.c:757: signal_after_change (opoint, 0, len); +insdel.c:976: signal_after_change (opoint, 0, PT - opoint); +insdel.c:996: signal_after_change (opoint, 0, PT - opoint); +insdel.c:1187: signal_after_change (opoint, 0, PT - opoint); +insdel.c:1412: signal_after_change. */ +insdel.c:1585: signal_after_change (from, nchars_del, GPT - from); +insdel.c:1600: prepare_to_modify_buffer and never call signal_after_change. +insdel.c:1603: region once. Apart from signal_after_change, any caller of this +insdel.c:1747: signal_after_change (from, to - from, 0); +insdel.c:1789: signal_after_change (from, to - from, 0); +insdel.c:1833: signal_after_change (from, to - from, 0); +insdel.c:2223:signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) +insdel.c:2396: signal_after_change (begpos, endpos - begpos - change, endpos - begpos); + +I’ve checked all insdel functions. We can assume insdel functions are +all safe. + +json.c:790: signal_after_change (PT, 0, inserted); + +Called in json-insert, calls either decode_coding_gap or +insert_from_gap_1, both are safe. Calls memmove but it’s for +decode_coding_gap. + +keymap.c:2873: /* Insert calls signal_after_change which may GC. */ + +Not code. + +print.c:219: signal_after_change (PT - print_buffer.pos, 0, print_buffer.pos); + +Called in print_finish, calls copy_text and insert_1_both, safe. + +process.c:6365: process buffer is changed in the signal_after_change above. +search.c:2763: (see signal_before_change and signal_after_change). Try to error + +Not code. + +search.c:2777: signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext)); + +Called in replace_match. Calls replace_range, upcase-region, +upcase-initials-region (both calls casify_region in the end), safe. +Calls memcpy but it’s for string manipulation. + +textprop.c:1261: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1272: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1283: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1458: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1652: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1661: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1672: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1750: before changes are made and signal_after_change when we are done. +textprop.c:1752: and call signal_after_change before returning if MODIFIED. */ +textprop.c:1764: signal_after_change (XFIXNUM (start), +textprop.c:1778: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1791: signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start), +textprop.c:1810: signal_after_change (XFIXNUM (start), + +We don’t care about text property changes. + +Grep finished with 51 matches found at Wed Jun 28 15:12:23 commit 02b6be892fa1a30b42c3df21319dddd2f445175e Author: Yuan Fu Date: Wed Jun 28 17:03:19 2023 -0700 Add missing calls to treesit_record_change in editfns.c These should be all that are missing. See the next commit for detail. * src/editfns.c (Ftranslate_region_internal): (Ftranspose_regions): Call treesit_record_change. diff --git a/src/editfns.c b/src/editfns.c index 0cbeefb3262..a1e48daf6c6 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2603,6 +2603,15 @@ DEFUN ("translate-region-internal", Ftranslate_region_internal, *p++ = *str++; signal_after_change (pos, 1, 1); update_compositions (pos, pos + 1, CHECK_BORDER); + +#ifdef HAVE_TREE_SITTER + /* In the previous branch, replace_range() notifies + changes to tree-sitter, but in this branch, we + modified buffer content manually, so we need to + notify tree-sitter manually. */ + treesit_record_change (pos_byte, pos_byte + len, + pos_byte + len); +#endif } characters_changed++; } @@ -4776,6 +4785,13 @@ DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, adjust_markers_bytepos (start1, start1_byte, end2, end2_byte, 0); } +#ifdef HAVE_TREE_SITTER + /* I don't think it's common to transpose two far-apart regions, so + amalgamating the edit into one should be fine. This is what the + signal_after_change below does, too. */ + treesit_record_change (start1_byte, end2_byte, end2_byte); +#endif + signal_after_change (start1, end2 - start1, end2 - start1); return Qnil; } commit e982192e93369265cca7827065e13bf1f71aad13 Author: Yuan Fu Date: Wed Jun 28 14:16:52 2023 -0700 Call treesit_record_change in subst-char-in-region (bug#64329) * src/editfns.c (Fsubst_char_in_region): Call treesit_record_change in the else branch. diff --git a/src/editfns.c b/src/editfns.c index d02cce4aef3..0cbeefb3262 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -55,6 +55,11 @@ Copyright (C) 1985-2023 Free Software Foundation, Inc. #ifdef WINDOWSNT # include "w32common.h" #endif + +#ifdef HAVE_TREE_SITTER +#include "treesit.h" +#endif + static void update_buffer_properties (ptrdiff_t, ptrdiff_t); static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool); @@ -2391,6 +2396,14 @@ #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) if (NILP (noundo)) record_change (pos, 1); for (i = 0; i < len; i++) *p++ = tostr[i]; + +#ifdef HAVE_TREE_SITTER + /* In the previous branch, replace_range() notifies + changes to tree-sitter, but in this branch, we + modified buffer content manually, so we need to + notify tree-sitter manually. */ + treesit_record_change (pos_byte, pos_byte + len, pos_byte + len); +#endif } last_changed = pos + 1; } commit ddbb11f56572025d90497291de1dcaf2ece45500 Author: Eli Zaretskii Date: Thu Jun 29 13:00:21 2023 +0300 ; * lisp/misc.el (duplicate-line-final-position): Fix last doc change. Repeat after me: "The first line of a doc string must be a single complete sentence." diff --git a/lisp/misc.el b/lisp/misc.el index 64f3986ff4c..52df33911f7 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -64,8 +64,7 @@ copy-from-above-command (insert string))) (defcustom duplicate-line-final-position 0 - "Where to put point after duplicating a line with `duplicate-line' -or `duplicate-dwim'. + "Where to put point after `duplicate-line' or `duplicate-dwim'. When 0, leave point on the original line. When 1, move point to the first new line. When -1, move point to the last new line. commit cecbe92d5d99c427bcbeafc6ee2e53d6aac334e8 Author: Mattias Engdegård Date: Thu Jun 29 11:21:53 2023 +0200 ; * lisp/misc.el (duplicate-line-final-position): doc precision diff --git a/etc/NEWS b/etc/NEWS index aa3b758a815..9e6f0c16bcd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -698,7 +698,7 @@ between these modes while the user is inputting a command by hitting works like 'duplicate-line'. An active rectangular region is duplicated on its right-hand side. The new user option 'duplicate-line-final-position' specifies where to move point -after duplicating the line. +after duplicating a line. --- ** Files with the ".eld" extension are now visited in 'lisp-data-mode'. diff --git a/lisp/misc.el b/lisp/misc.el index 898fe9dd168..64f3986ff4c 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -64,7 +64,8 @@ copy-from-above-command (insert string))) (defcustom duplicate-line-final-position 0 - "Where to put point after duplicating the line with `duplicate-line'. + "Where to put point after duplicating a line with `duplicate-line' +or `duplicate-dwim'. When 0, leave point on the original line. When 1, move point to the first new line. When -1, move point to the last new line. commit 042f0d6a14cd99eb9d33cfccc6239534bc40e712 Author: Eli Zaretskii Date: Thu Jun 29 10:47:26 2023 +0300 ; Fix documentation of ':box' face attribute * lisp/faces.el (set-face-attribute): Update the documentation of WIDTH in the :box face attribute. (Bug#64344) diff --git a/lisp/faces.el b/lisp/faces.el index 8bf7e4429d9..696634b4ef7 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -794,19 +794,25 @@ set-face-attribute VALUE is t, draw a box with lines of width 1 in the foreground color of the face. If VALUE is a string, the string must be a color name, and the box is drawn in that color with a line width of 1. Otherwise, -VALUE must be a property list of the form `(:line-width WIDTH -:color COLOR :style STYLE)'. If a keyword/value pair is missing from -the property list, a default value will be used for the value, as -specified below. WIDTH specifies the width of the lines to draw; it -defaults to 1. If WIDTH is negative, the absolute value is the width -of the lines, and draw top/bottom lines inside the characters area, -not around it. COLOR is the name of the color to draw in, default is -the background color of the face for 3D boxes and `flat-button', and -the foreground color of the face for other boxes. STYLE specifies -whether a 3D box should be draw. If STYLE is `released-button', draw -a box looking like a released 3D button. If STYLE is `pressed-button' -draw a box that appears like a pressed button. If STYLE is nil, -`flat-button' or omitted, draw a 2D box. +VALUE must be a property list of the following form: + + (:line-width WIDTH :color COLOR :style STYLE) + +If a keyword/value pair is missing from the property list, a default +value will be used for the value, as specified below. + +WIDTH specifies the width of the lines to draw; it defaults to 1. +If WIDTH is negative, the absolute value is the width of the lines, +and draw top/bottom lines inside the characters area, not around it. +WIDTH can also be a cons (VWIDTH . HWIDTH), which specifies different +values for the vertical and the horizontal line width. +COLOR is the name of the color to use for the box lines, default is +the background color of the face for 3D and `flat-button' boxes, and +the foreground color of the face for the other boxes. +STYLE specifies whether a 3D box should be drawn. If STYLE +is `released-button', draw a box looking like a released 3D button. +If STYLE is `pressed-button', draw a box that looks like a pressed +button. If STYLE is nil, `flat-button', or omitted, draw a 2D box. `:inverse-video' commit d5cff340b3b4ab616bf4549150754cb99549afe3 Author: Juri Linkov Date: Thu Jun 29 10:13:06 2023 +0300 * lisp/misc.el (duplicate-line-final-position): New defcustom (bug#64185). * lisp/misc.el (duplicate-line): Use it. * test/lisp/misc-tests.el (misc--duplicate-line): Add tests for duplicate-line-final-position. Don't merge to master. diff --git a/etc/NEWS b/etc/NEWS index ca0d602e9ad..aa3b758a815 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -696,7 +696,9 @@ between these modes while the user is inputting a command by hitting 'duplicate-line' duplicates the current line the specified number of times. 'duplicate-dwim' duplicates the region if it is active. If not, it works like 'duplicate-line'. An active rectangular region is -duplicated on its right-hand side. +duplicated on its right-hand side. The new user option +'duplicate-line-final-position' specifies where to move point +after duplicating the line. --- ** Files with the ".eld" extension are now visited in 'lisp-data-mode'. diff --git a/lisp/misc.el b/lisp/misc.el index ca013d5f72f..898fe9dd168 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -63,21 +63,42 @@ copy-from-above-command (+ n (point))))))) (insert string))) +(defcustom duplicate-line-final-position 0 + "Where to put point after duplicating the line with `duplicate-line'. +When 0, leave point on the original line. +When 1, move point to the first new line. +When -1, move point to the last new line. +The same column is preserved after moving to a new line." + :type '(choice (const :tag "Leave point on old line" 0) + (const :tag "Move point to first new line" 1) + (const :tag "Move point to last new line" -1) + (integer)) + :group 'editing + :version "29.1") + ;;;###autoload (defun duplicate-line (&optional n) "Duplicate the current line N times. Interactively, N is the prefix numeric argument, and defaults to 1. +The user option `duplicate-line-final-position' specifies where to +move point after duplicating the line. Also see the `copy-from-above-command' command." (interactive "p") (unless n (setq n 1)) - (let ((line (buffer-substring (line-beginning-position) (line-end-position)))) - (save-excursion - (forward-line 1) - (unless (bolp) - (insert "\n")) - (dotimes (_ n) - (insert line "\n"))))) + (let ((line (buffer-substring (line-beginning-position) (line-end-position))) + (pos (point)) + (col (current-column))) + (forward-line 1) + (unless (bolp) + (insert "\n")) + (dotimes (_ n) + (insert line "\n")) + (unless (< duplicate-line-final-position 0) + (goto-char pos)) + (unless (eq duplicate-line-final-position 0) + (forward-line duplicate-line-final-position) + (move-to-column col)))) (declare-function rectangle--duplicate-right "rect" (n)) diff --git a/test/lisp/misc-tests.el b/test/lisp/misc-tests.el index f1d22e099b9..ea27ea1653b 100644 --- a/test/lisp/misc-tests.el +++ b/test/lisp/misc-tests.el @@ -88,6 +88,20 @@ misc--duplicate-line (duplicate-line 2) (should (equal (buffer-string) "abc\ndefg\ndefg\ndefg\nh\n")) (should (equal (point) 7))) + ;; Duplicate a line (twice) and move point to the first duplicated line. + (with-temp-buffer + (insert "abc\ndefg\nh\n") + (goto-char 7) + (let ((duplicate-line-final-position 1)) (duplicate-line 2)) + (should (equal (buffer-string) "abc\ndefg\ndefg\ndefg\nh\n")) + (should (equal (point) 12))) + ;; Duplicate a line (twice) and move point to the last duplicated line. + (with-temp-buffer + (insert "abc\ndefg\nh\n") + (goto-char 7) + (let ((duplicate-line-final-position -1)) (duplicate-line 2)) + (should (equal (buffer-string) "abc\ndefg\ndefg\ndefg\nh\n")) + (should (equal (point) 17))) ;; Duplicate a non-terminated line. (with-temp-buffer (insert "abc") commit ef16339918e3f31831dd271cde40cb2072069875 Author: Daniel Martín Date: Sun Jun 25 22:17:14 2023 +0200 Make js-beginning-of-defun return non-nil on success The docstring of 'beginning-of-defun-function' says that the function shall return non-nil when it found the beginning of a defun. This is specially important because the calling code decides when to move point depending on the return value. * lisp/progmodes/js.el (js-beginning-of-defun) (js--beginning-of-defun-flat): Return non-nil when the beginning of a defun is found. (Bug#64283) * test/lisp/progmodes/js-tests.el (js-mode-end-of-defun): Add a unit test. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 414b6eb2baf..a05bd758dbc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1024,38 +1024,45 @@ js--beginning-of-defun-flat "Helper function for `js-beginning-of-defun'." (let ((pstate (js--beginning-of-defun-raw))) (when pstate - (goto-char (js--pitem-h-begin (car pstate)))))) + (goto-char (js--pitem-h-begin (car pstate))) + t))) (defun js-beginning-of-defun (&optional arg) "Value of `beginning-of-defun-function' for `js-mode'." (setq arg (or arg 1)) - (while (and (not (eobp)) (< arg 0)) - (cl-incf arg) - (when (and (not js-flat-functions) - (or (eq (js-syntactic-context) 'function) - (js--function-prologue-beginning))) - (js-end-of-defun)) - - (if (js--re-search-forward - "\\_" nil t) - (goto-char (js--function-prologue-beginning)) - (goto-char (point-max)))) - - (while (> arg 0) - (cl-decf arg) - ;; If we're just past the end of a function, the user probably wants - ;; to go to the beginning of *that* function - (when (eq (char-before) ?}) - (backward-char)) - - (let ((prologue-begin (js--function-prologue-beginning))) - (cond ((and prologue-begin (< prologue-begin (point))) - (goto-char prologue-begin)) + (let ((found)) + (while (and (not (eobp)) (< arg 0)) + (cl-incf arg) + (when (and (not js-flat-functions) + (or (eq (js-syntactic-context) 'function) + (js--function-prologue-beginning))) + (js-end-of-defun)) + + (if (js--re-search-forward + "\\_" nil t) + (progn (goto-char (js--function-prologue-beginning)) + (setq found t)) + (goto-char (point-max)) + (setq found nil))) + + (while (> arg 0) + (cl-decf arg) + ;; If we're just past the end of a function, the user probably wants + ;; to go to the beginning of *that* function + (when (eq (char-before) ?}) + (backward-char)) - (js-flat-functions - (js--beginning-of-defun-flat)) - (t - (js--beginning-of-defun-nested)))))) + (let ((prologue-begin (js--function-prologue-beginning))) + (cond ((and prologue-begin (< prologue-begin (point))) + (goto-char prologue-begin) + (setq found t)) + + (js-flat-functions + (setq found (js--beginning-of-defun-flat))) + (t + (when (js--beginning-of-defun-nested) + (setq found t)))))) + found)) (defun js--flush-caches (&optional beg _ignored) "Flush the `js-mode' syntax cache after position BEG. diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 00fa78e8891..5db92b08f8a 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el @@ -237,6 +237,57 @@ "jsx-unclosed-1.jsx" (js-deftest-indent "jsx-unclosed-2.jsx") (js-deftest-indent "jsx.jsx") +;;;; Navigation tests. + +(ert-deftest js-mode-beginning-of-defun () + (with-temp-buffer + (insert "function foo() { + var value = 1; +} + +/** A comment. */ +function bar() { + var value = 1; +} +") + (js-mode) + ;; Move point inside `foo'. + (goto-char 18) + (beginning-of-defun) + (should (bobp)) + ;; Move point between the two functions. + (goto-char 37) + (beginning-of-defun) + (should (bobp)) + ;; Move point inside `bar'. + (goto-char 73) + (beginning-of-defun) + ;; Point should move to the beginning of `bar'. + (should (equal (point) 56)))) + +(ert-deftest js-mode-end-of-defun () + (with-temp-buffer + (insert "function foo() { + var value = 1; +} + +/** A comment. */ +function bar() { + var value = 1; +} +") + (js-mode) + (goto-char (point-min)) + (end-of-defun) + ;; end-of-defun from the beginning of the buffer should go to the + ;; end of `foo'. + (should (equal (point) 37)) + ;; Move point to the beginning of /** A comment. */ + (goto-char 38) + (end-of-defun) + ;; end-of-defun should move point to eob. + (should (eobp)))) + (provide 'js-tests) ;;; js-tests.el ends here commit 2c90ade09a4d52a583158cb9cacf665ac11e8387 Author: Yuan Fu Date: Tue Jun 27 20:58:34 2023 -0700 Tree-sitter use with-silent-modifications like jit-lock (bug#64321) * lisp/treesit.el (treesit--font-lock-notifier): Use with-silent-modifications when marking modified text to be fontified by jit-lock. This is what jit-lock itself does. diff --git a/lisp/treesit.el b/lisp/treesit.el index 0e1d7931d49..04d460fdea4 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1072,7 +1072,8 @@ treesit--font-lock-notifier (when treesit--font-lock-verbose (message "Notifier received range: %s-%s" (car range) (cdr range))) - (put-text-property (car range) (cdr range) 'fontified nil)))) + (with-silent-modifications + (put-text-property (car range) (cdr range) 'fontified nil))))) ;;; Indent commit 11cead0d73cadd5de077f8bec60045e85f651fc0 Author: Stephen Berman Date: Tue Jun 27 17:50:18 2023 +0200 Fix todo-mode.el Commentary and a doc string (bug#64298) * lisp/calendar/todo-mode.el: Explicitly note in the Commentary that the Todo mode user manual is a separate Info manual in the Emacs installation. (todo-always-add-time-string): Replace doc string, which was mistakenly retained in the initial merge of this version of todo-mode.el, by a correct description of this user option. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index ce04a15b2b0..ad18e8f035e 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -49,7 +49,8 @@ ;; To get started, type `M-x todo-show'. For full details of the user ;; interface, commands and options, consult the Todo mode user manual, -;; which is included in the Info documentation. +;; which is one of the Info manuals included in the standard Emacs +;; installation. ;;; Code: @@ -1710,11 +1711,19 @@ todo-diary-nonmarking :group 'todo-edit) (defcustom todo-always-add-time-string nil - "Non-nil adds current time to a new item's date header by default. -When the todo insertion commands have a non-nil \"maybe-notime\" -argument, this reverses the effect of -`todo-always-add-time-string': if t, these commands omit the -current time, if nil, they include it." + "Whether to add the time to an item's date header by default. + +If non-nil, this automatically adds the current time when adding +a new item using an insertion command without a time parameter, +or when tagging an item as done; when adding a new item using a +time parameter, or when editing the header of an existing todo item +using a time parameter, typing automatically inserts the +current time. + +When this option is nil (the default), no time string is inserted +either automatically or when typing at the time +prompt (and in the latter case, when editing an existing time +string, typing deletes it)." :type 'boolean :group 'todo-edit) commit 6ae83322d4c2792265f39ef84fefd5ca8be94b8d Author: Stephen Berman Date: Tue Jun 27 17:38:20 2023 +0200 Prevent truncation of todo-mode categories sexp * lisp/calendar/todo-mode.el (todo-delete-file) (todo-move-category, todo-convert-legacy-files) (todo-update-categories-sexp, todo-check-format): Bind print-length and print-level to nil before using prin1 and related functions, to avoid truncating the todo categories sexp and possibly corrupting the file format. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 564ead1376b..ce04a15b2b0 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1205,7 +1205,9 @@ todo-delete-file (let ((sexp (read (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (buffer-read-only nil)) + (buffer-read-only nil) + (print-length nil) + (print-level nil)) (mapc (lambda (x) (aset (cdr x) 3 0)) sexp) (delete-region (line-beginning-position) (line-end-position)) (prin1 sexp (current-buffer))))) @@ -1479,7 +1481,9 @@ todo-move-category nfile-short) (format "the category \"%s\";\n" cat) "enter a new category name: ")) - buffer-read-only) + (buffer-read-only nil) + (print-length nil) + (print-level nil)) (widen) (goto-char (point-max)) (insert content) @@ -4877,7 +4881,9 @@ todo-convert-legacy-files (insert-file-contents file) (let ((sexp (read (buffer-substring-no-properties (line-beginning-position) - (line-end-position))))) + (line-end-position)))) + (print-length nil) + (print-level nil)) (dolist (cat sexp) (let ((archive-cat (assoc (car cat) archive-sexp))) (if archive-cat @@ -5058,7 +5064,9 @@ todo-set-categories (defun todo-update-categories-sexp () "Update the `todo-categories' sexp at the top of the file." - (let (buffer-read-only) + (let ((buffer-read-only nil) + (print-length nil) + (print-level nil)) (save-excursion (save-restriction (widen) @@ -5167,7 +5175,9 @@ todo-check-format (save-restriction (widen) (goto-char (point-min)) - (let* ((cats (prin1-to-string todo-categories)) + (let* ((print-length nil) + (print-level nil) + (cats (prin1-to-string todo-categories)) (ssexp (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (sexp (read ssexp))) commit ee41f07be52455e33fbb96ce84519b3569d302be Author: Stephen Berman Date: Tue Jun 27 17:27:42 2023 +0200 Avoid making todo-mode buffers manually editable * lisp/calendar/todo-mode.el (todo-add-category) (todo-move-category, todo-edit-item--header) (todo-set-item-priority, todo-move-item, todo-item-undone) (todo-archive-done-item, todo-set-category-number): Restrict the scope of nil buffer-read-only to the function calls that change buffer text, thereby preventing todo mode buffers from becoming manually editable and hence possibly corrupted when the minibuffer is in use. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 35cac5d7310..564ead1376b 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1294,15 +1294,15 @@ todo-add-category file))) (find-file file0) (let ((counts (make-vector 4 0)) ; [todo diary done archived] - (num (1+ (length todo-categories))) - (buffer-read-only nil)) + (num (1+ (length todo-categories)))) (setq todo-current-todo-file file0) (setq todo-categories (append todo-categories (list (cons cat counts)))) (widen) (goto-char (point-max)) (save-excursion ; Save point for todo-category-select. - (insert todo-category-beg cat "\n\n" todo-category-done "\n")) + (let ((buffer-read-only nil)) + (insert todo-category-beg cat "\n\n" todo-category-done "\n"))) (todo-update-categories-sexp) ;; If invoked by user, display the newly added category, if ;; called programmatically return the category number to the @@ -1459,8 +1459,7 @@ todo-move-category (match-beginning 0) (point-max))) (content (buffer-substring-no-properties beg end)) - (counts (cdr (assoc cat todo-categories))) - buffer-read-only) + (counts (cdr (assoc cat todo-categories)))) ;; Move the category to the new file. Also update or create ;; archive file if necessary. (with-current-buffer @@ -1520,25 +1519,26 @@ todo-move-category ;; Delete the category from the old file, and if that was the ;; last category, delete the file. Also handle archive file ;; if necessary. - (remove-overlays beg end) - (delete-region beg end) - (goto-char (point-min)) - ;; Put point after todo-categories sexp. - (forward-line) - (if (eobp) ; Aside from sexp, file is empty. - (progn - ;; Skip confirming killing the archive buffer. - (set-buffer-modified-p nil) - (delete-file todo-current-todo-file) - (kill-buffer) - (when (member todo-current-todo-file todo-files) - (todo-update-filelist-defcustoms))) - (setq todo-categories (delete (assoc cat todo-categories) - todo-categories)) - (todo-update-categories-sexp) - (when (> todo-category-number (length todo-categories)) - (setq todo-category-number 1)) - (todo-category-select))))) + (let ((buffer-read-only nil)) + (remove-overlays beg end) + (delete-region beg end) + (goto-char (point-min)) + ;; Put point after todo-categories sexp. + (forward-line) + (if (eobp) ; Aside from sexp, file is empty. + (progn + ;; Skip confirming killing the archive buffer. + (set-buffer-modified-p nil) + (delete-file todo-current-todo-file) + (kill-buffer) + (when (member todo-current-todo-file todo-files) + (todo-update-filelist-defcustoms))) + (setq todo-categories (delete (assoc cat todo-categories) + todo-categories)) + (todo-update-categories-sexp) + (when (> todo-category-number (length todo-categories)) + (setq todo-category-number 1)) + (todo-category-select)))))) (set-window-buffer (selected-window) (set-buffer (find-file-noselect nfile)))))) @@ -2314,7 +2314,6 @@ todo-edit-item--header ;; INC must be an integer, but users could pass it via ;; `todo-edit-item' as e.g. `-' or `C-u'. (inc (prefix-numeric-value inc)) - (buffer-read-only nil) ndate ntime year monthname month day) ;; dayname (when marked (todo--user-error-if-marked-done-item)) @@ -2477,13 +2476,14 @@ todo-edit-item--header (day day) (dayname nil)) ;; dayname (mapconcat #'eval calendar-date-display-form ""))))) - (when ndate (replace-match ndate nil nil nil 1)) - ;; Add new time string to the header, if it was supplied. - (when ntime - (if otime - (replace-match ntime nil nil nil 2) - (goto-char (match-end 1)) - (insert ntime))) + (let ((buffer-read-only nil)) + (when ndate (replace-match ndate nil nil nil 1)) + ;; Add new time string to the header, if it was supplied. + (when ntime + (if otime + (replace-match ntime nil nil nil 2) + (goto-char (match-end 1)) + (insert ntime)))) (setq todo-date-from-calendar nil) (setq first nil)) ;; Apply the changes to the first marked item header to the @@ -2650,8 +2650,7 @@ todo-set-item-priority (1- curnum)) ((and (eq arg 'lower) (<= curnum maxnum)) (1+ curnum)))) - candidate - buffer-read-only) + candidate) (unless (and priority (or (and (eq arg 'raise) (zerop priority)) (and (eq arg 'lower) (> priority maxnum)))) @@ -2703,31 +2702,31 @@ todo-set-item-priority (match-string-no-properties 1))))))) (when match (user-error (concat "Cannot reprioritize items from the same " - "category in this mode, only in Todo mode"))))) - ;; Interactively or with non-nil ARG, relocate the item within its - ;; category. - (when (or arg (called-interactively-p 'any)) - (todo-remove-item)) - (goto-char (point-min)) - (when priority - (unless (= priority 1) - (todo-forward-item (1- priority)) - ;; When called from todo-item-undone and the highest priority - ;; is chosen, this advances point to the first done item, so - ;; move it up to the empty line above the done items - ;; separator. - (when (looking-back (concat "^" - (regexp-quote todo-category-done) - "\n") - (line-beginning-position 0)) - (todo-backward-item)))) - (todo-insert-with-overlays item) - ;; If item was marked, restore the mark. - (and marked - (let* ((ov (todo-get-overlay 'prefix)) - (pref (overlay-get ov 'before-string))) - (overlay-put ov 'before-string - (concat todo-item-mark pref)))))))) + "category in this mode, only in Todo mode"))))) + (let ((buffer-read-only nil)) + ;; Interactively or with non-nil ARG, relocate the item within its + ;; category. + (when (or arg (called-interactively-p 'any)) + (todo-remove-item)) + (goto-char (point-min)) + (when priority + (unless (= priority 1) + (todo-forward-item (1- priority)) + ;; When called from todo-item-undone and the highest priority is + ;; chosen, this advances point to the first done item, so move + ;; it up to the empty line above the done items separator. + (when (looking-back (concat "^" + (regexp-quote todo-category-done) + "\n") + (line-beginning-position 0)) + (todo-backward-item)))) + (todo-insert-with-overlays item) + ;; If item was marked, restore the mark. + (and marked + (let* ((ov (todo-get-overlay 'prefix)) + (pref (overlay-get ov 'before-string))) + (overlay-put ov 'before-string + (concat todo-item-mark pref))))))))) (defun todo-raise-item-priority () "Raise priority of current item by moving it up by one item." @@ -2768,8 +2767,7 @@ todo-move-item (save-excursion (beginning-of-line) (looking-at todo-category-done))) (not marked)) - (let* ((buffer-read-only) - (file1 todo-current-todo-file) + (let* ((file1 todo-current-todo-file) (item (todo-item-string)) (done-item (and (todo-done-item-p) item)) (omark (save-excursion (todo-item-start) (point-marker))) @@ -2828,7 +2826,8 @@ todo-move-item (setq here (point)) (while todo-items (todo-forward-item) - (todo-insert-with-overlays (pop todo-items)))) + (let ((buffer-read-only nil)) + (todo-insert-with-overlays (pop todo-items))))) ;; Move done items en bloc to top of done items section. (when done-items (todo-category-number cat2) @@ -2842,7 +2841,8 @@ todo-move-item (forward-line) (unless here (setq here (point))) (while done-items - (todo-insert-with-overlays (pop done-items)) + (let ((buffer-read-only nil)) + (todo-insert-with-overlays (pop done-items))) (todo-forward-item))) ;; If only done items were moved, move point to the top ;; one, otherwise, move point to the top moved todo item. @@ -2881,12 +2881,14 @@ todo-move-item (goto-char beg) (while (< (point) end) (if (todo-marked-item-p) - (todo-remove-item) + (let ((buffer-read-only nil)) + (todo-remove-item)) (todo-forward-item))) (setq todo-categories-with-marks (assq-delete-all cat1 todo-categories-with-marks))) (if ov (delete-overlay ov)) - (todo-remove-item)))) + (let ((buffer-read-only nil)) + (todo-remove-item))))) (when todo (todo-update-count 'todo (- todo) cat1)) (when diary (todo-update-count 'diary (- diary) cat1)) (when done (todo-update-count 'done (- done) cat1)) @@ -3015,8 +3017,7 @@ todo-item-undone (marked (assoc cat todo-categories-with-marks)) (num (if (not marked) 1 (cdr marked)))) (when (or marked (todo-done-item-p)) - (let ((buffer-read-only) - (opoint (point)) + (let ((opoint (point)) (omark (point-marker)) (first 'first) (item-count 0) @@ -3078,19 +3079,20 @@ todo-item-undone (when ov (delete-overlay ov)) (if (not undone) (goto-char opoint) - (if marked - (progn - (setq item nil) - (re-search-forward - (concat "^" (regexp-quote todo-category-done)) nil t) - (while (not (eobp)) - (if (todo-marked-item-p) - (todo-remove-item) - (todo-forward-item))) - (setq todo-categories-with-marks - (assq-delete-all cat todo-categories-with-marks))) - (goto-char omark) - (todo-remove-item)) + (let ((buffer-read-only nil)) + (if marked + (progn + (setq item nil) + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (while (not (eobp)) + (if (todo-marked-item-p) + (todo-remove-item) + (todo-forward-item))) + (setq todo-categories-with-marks + (assq-delete-all cat todo-categories-with-marks))) + (goto-char omark) + (todo-remove-item))) (todo-update-count 'todo item-count) (todo-update-count 'done (- item-count)) (when diary-count (todo-update-count 'diary diary-count)) @@ -3175,8 +3177,7 @@ todo-archive-done-item (concat (todo-item-string) "\n"))) (count 0) (opoint (unless (todo-done-item-p) (point))) - marked-items beg end all-done - buffer-read-only) + marked-items beg end all-done) (cond (all (if (todo-y-or-n-p "Archive all done items in this category? ") @@ -3246,36 +3247,37 @@ todo-archive-done-item (todo-archive-mode)) (if headers-hidden (todo-toggle-item-header)))) (with-current-buffer tbuf - (cond - (all - (save-excursion - (save-restriction - ;; Make sure done items are accessible. - (widen) - (remove-overlays beg end) - (delete-region beg end) - (todo-update-count 'done (- count)) - (todo-update-count 'archived count)))) - ((or marked - ;; If we're archiving all done items, can't - ;; first archive item point was on, since - ;; that will short-circuit the rest. - (and item (not all))) - (and marked (goto-char (point-min))) - (catch 'done - (while (not (eobp)) - (if (or (and marked (todo-marked-item-p)) item) - (progn - (todo-remove-item) - (todo-update-count 'done -1) - (todo-update-count 'archived 1) - ;; Don't leave point below last item. - (and (or marked item) (bolp) (eolp) - (< (point-min) (point-max)) - (todo-backward-item)) - (when item - (throw 'done (setq item nil)))) - (todo-forward-item)))))) + (let ((buffer-read-only nil)) + (cond + (all + (save-excursion + (save-restriction + ;; Make sure done items are accessible. + (widen) + (remove-overlays beg end) + (delete-region beg end) + (todo-update-count 'done (- count)) + (todo-update-count 'archived count)))) + ((or marked + ;; If we're archiving all done items, can't + ;; first archive item point was on, since + ;; that will short-circuit the rest. + (and item (not all))) + (and marked (goto-char (point-min))) + (catch 'done + (while (not (eobp)) + (if (or (and marked (todo-marked-item-p)) item) + (progn + (todo-remove-item) + (todo-update-count 'done -1) + (todo-update-count 'archived 1) + ;; Don't leave point below last item. + (and (or marked item) (bolp) (eolp) + (< (point-min) (point-max)) + (todo-backward-item)) + (when item + (throw 'done (setq item nil)))) + (todo-forward-item))))))) (when marked (setq todo-categories-with-marks (assq-delete-all cat todo-categories-with-marks))) @@ -3524,7 +3526,6 @@ todo-set-category-number (let* ((maxnum (length todo-categories)) (prompt (format "Set category priority (1-%d): " maxnum)) (col (current-column)) - (buffer-read-only nil) (priority (cond ((and (eq arg 'raise) (> curnum 1)) (1- curnum)) ((and (eq arg 'lower) (< curnum maxnum)) @@ -3549,6 +3550,7 @@ todo-set-category-number ;; Category's name and items counts list. (catcons (nth (1- curnum) todo-categories)) (todo-categories (nconc head (list catcons) tail)) + (buffer-read-only nil) newcats) (when lower (setq todo-categories (nreverse todo-categories))) (setq todo-categories (delete-dups todo-categories)) commit 53332bdf625c5a92f2c33f9770cf34052a7c4d36 Author: Vladimir Sedach Date: Mon Jun 26 22:50:59 2023 -0600 ; * doc/lispref/variables.texi: Fix define-obsolete-variable-alias arglist The WHEN argument is not optional anymore (bug#64312) Copyright-paperwork-exempt: yes diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 755109aac1e..f7322e11365 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2589,7 +2589,7 @@ Variable Aliases You can make two variables synonyms and declare one obsolete at the same time using the macro @code{define-obsolete-variable-alias}. -@defmac define-obsolete-variable-alias obsolete-name current-name &optional when docstring +@defmac define-obsolete-variable-alias obsolete-name current-name when &optional docstring This macro marks the variable @var{obsolete-name} as obsolete and also makes it an alias for the variable @var{current-name}. It is equivalent to the following: commit 162c9c058eba104b3f2b73ac29533372c08977d8 Author: Eli Zaretskii Date: Mon Jun 26 18:41:06 2023 +0300 ; Document that 'named-let' needs lexical-binding * doc/lispref/variables.texi (Local Variables): Warn that 'named-let' only works under lexical-binding. (Bug#64290) diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 6dd935d8763..755109aac1e 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -350,6 +350,9 @@ Local Variables A function call is in the tail position if it's the very last thing done so that the value returned by the call is the value of @var{body} itself, as is the case in the recursive call to @code{sum} above. + +@strong{Warning:} @code{named-let} works as expected only when +lexical-binding is enabled. @xref{Lexical Binding}. @end defspec Here is a complete list of the other facilities that create local commit 68028f0fa3193159e1e51cd89fc8bfcc836da23e Author: Robert Pluim Date: Mon Jun 26 15:26:32 2023 +0200 ; * etc/PROBLEMS: Fix typo. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 80b3b9945c4..cdce8bbc774 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1693,7 +1693,7 @@ which can be carried out at the same time: forwarded X connection (ssh -XC remotehostname emacs ...). Keep in mind that this does not help with latency problems, only - andwidth ones. + bandwidth ones. 5) Use lbxproxy on the remote end of the connection. This is an interface to the low bandwidth X extension in some outdated X commit ac0a82ea987cf6831216b1b9202f221ddd350553 Author: Michael Albinus Date: Mon Jun 26 12:41:04 2023 +0200 Fix Tramp mount-spec (don't merge) * lisp/net/tramp-fuse.el (tramp-fuse-mounted-p): The mount-spec could contain an optional trailing slash. (Bug#64278) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index e1ad0c2e5d2..c10c715d70e 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -175,13 +175,24 @@ tramp-fuse-mounted-p (or (tramp-get-file-property vec "/" "mounted") (let* ((default-directory tramp-compat-temporary-file-directory) (command (format "mount -t fuse.%s" (tramp-file-name-method vec))) - (mount (shell-command-to-string command))) + (mount (shell-command-to-string command)) + (mount-spec (split-string (tramp-fuse-mount-spec vec) ":" 'omit))) (tramp-message vec 6 "%s\n%s" command mount) + ;; The mount-spec contains a trailing local file name part, + ;; which might not be visible, for example with rclone + ;; mounts of type "memory" or "gdrive". Make it optional. + (setq mount-spec + (if (cdr mount-spec) + (tramp-compat-rx + (literal (car mount-spec)) + ":" (? (literal (cadr mount-spec)))) + (car mount-spec))) (tramp-set-file-property vec "/" "mounted" (when (string-match (tramp-compat-rx - bol (group (literal (tramp-fuse-mount-spec vec))) blank) + bol (group (regexp mount-spec)) + " on " (group (+ (not blank))) blank) mount) (match-string 1 mount))))))) commit 4df510c7a7097641169ac8f088bf1923ea04c2cc Author: Daniel Semyonov Date: Fri Jun 23 08:40:57 2023 +0300 Fix VC package build when doc file isn't in a subdir * lisp/emacs-lisp/package-vc.el (package-vc--build-documentation): Expand 'file' before attempting to get its directory. (Bug#64242) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 17e93c430c9..b4c911015b5 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -347,7 +347,7 @@ package-vc--build-documentation otherwise it's assumed to be an Info file." (let* ((pkg-name (package-desc-name pkg-desc)) (default-directory (package-desc-dir pkg-desc)) - (docs-directory (expand-file-name (file-name-directory file))) + (docs-directory (file-name-directory (expand-file-name file))) (output (expand-file-name (format "%s.info" pkg-name))) clean-up) (when (string-match-p "\\.org\\'" file) commit 382f5fa81304724c8d708263bb17500a6da813a7 Author: Eli Zaretskii Date: Sun Jun 25 17:57:31 2023 +0300 ; * doc/emacs/package.texi (Fetching Package Sources): Fix typo (bug#64282). diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 0be60b2b70b..998956440b5 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -625,7 +625,7 @@ Fetching Package Sources using @code{package-vc-install-from-checkout}, which creates a symbolic link from the package directory (@pxref{Package Files}) to your checkout and initializes the code. Note that you might have to use -@code{package-vc-refresh} to repeat the initialization and update the +@code{package-vc-rebuild} to repeat the initialization and update the autoloads. @subsection Specifying Package Sources commit fc7e7c3fde37d2038b75b2e8c27cfbbd616c85fb Author: Michael Albinus Date: Sun Jun 25 14:31:23 2023 +0200 Fix type check in tramp-get-buffer-string * lisp/net/tramp.el (tramp-get-buffer-string): Check, that BUFFER is really a bufferp. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b46eeb8e374..20678ec8d1a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1960,8 +1960,11 @@ tramp-get-buffer-string "Return contents of BUFFER. If BUFFER is not a buffer or a buffer name, return the contents of `current-buffer'." - (with-current-buffer (or buffer (current-buffer)) - (substring-no-properties (buffer-string)))) + (or (let ((buf (or buffer (current-buffer)))) + (when (bufferp buf) + (with-current-buffer (or buffer (current-buffer)) + (substring-no-properties (buffer-string))))) + "")) (defun tramp-debug-buffer-name (vec) "A name for the debug buffer for VEC." commit 2aa57fe6cf973c4e7c5134958a17a478a6feb4a9 Author: Eshel Yaron Date: Sat Jun 24 23:31:44 2023 +0300 ; Fix typo in maintaining.texi (bug#64279) * doc/emacs/maintaining.texi (Log Buffer): Fix a typo. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 246e335cfe7..2dad70d3d13 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -716,7 +716,7 @@ Log Buffer (@code{log-edit-generate-changelog-from-diff}), to generate skeleton ChangeLog entries, listing all changed file and function names based on the diff of the VC fileset. Consecutive entries left empty will be -combined by @kbd{C-q} (@code{fill-paragraph}). By default the +combined by @kbd{M-q} (@code{fill-paragraph}). By default the skeleton will just include the file name, without any leading directories. If you wish to prepend the leading directories up to the VC root, customize @code{diff-add-log-use-relative-names}. commit 1d9200d9bbb6203368b151458d2283ea65ddab72 Author: Eli Zaretskii Date: Sun Jun 25 08:25:13 2023 +0300 ; * doc/lispintro/emacs-lisp-intro.texi (car & cdr): Fix typo. (cherry picked from commit 0ebedd0119c1bc3c1f55e873385a01e97f102766) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 90eb92ca7ea..fce7583fe91 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -6827,7 +6827,7 @@ car & cdr However, lists in Lisp are built using a lower-level structure known as ``cons cells'' (@pxref{List Implementation}), in which there is no -such thing as ``first'' or ``rest,''and the @sc{car} and the @sc{cdr} +such thing as ``first'' or ``rest'', and the @sc{car} and the @sc{cdr} are symmetrical. Lisp does not try to hide the existence of cons cells, and programs do use them for things other than lists. For this reason, the names are helpful for reminding programmers that commit 987b25d60ddb2c67c3434b6eef2bad08a0a0bfc5 Author: Richard M. Stallman Date: Sat Jun 24 19:19:53 2023 -0400 Clarify list terminology * doc/lispintro/emacs-lisp-intro.texi (Lists diagrammed): Mention "cons cell". Add index entries. (car & cdr): Simplify etymology of `car' and `cdr'. Explain why for some purposes they are better than `first' and `rest'. Mention cons cells. (cherry picked from commit 188c90c7c111dbbdc3edd29c23b59ade26f97bfd) diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 37ef6133fb4..90eb92ca7ea 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -6761,16 +6761,13 @@ Strange Names abbreviation of the word ``construct''. The origins of the names for @code{car} and @code{cdr}, on the other hand, are esoteric: @code{car} is an acronym from the phrase ``Contents of the Address part of the -Register''; and @code{cdr} (pronounced ``could-er'') is an acronym from -the phrase ``Contents of the Decrement part of the Register''. These -phrases refer to specific pieces of hardware on the very early -computer on which the original Lisp was developed. Besides being -obsolete, the phrases have been completely irrelevant for more than 25 -years to anyone thinking about Lisp. Nonetheless, although a few -brave scholars have begun to use more reasonable names for these -functions, the old terms are still in use. In particular, since the -terms are used in the Emacs Lisp source code, we will use them in this -introduction. +Register''; and @code{cdr} (pronounced ``could-er'') is an acronym +from the phrase ``Contents of the Decrement part of the Register''. +These phrases refer to the IBM 704 computer on which the original Lisp +was developed. + +The IBM 704 is a footnote in history, but these names are now beloved +traditions of Lisp. @node car & cdr @section @code{car} and @code{cdr} @@ -6791,9 +6788,6 @@ car & cdr After evaluating the expression, @code{rose} will appear in the echo area. -Clearly, a more reasonable name for the @code{car} function would be -@code{first} and this is often suggested. - @code{car} does not remove the first item from the list; it only reports what it is. After @code{car} has been applied to a list, the list is still the same as it was. In the jargon, @code{car} is @@ -6825,6 +6819,22 @@ car & cdr not, the Lisp interpreter would try to evaluate the list by calling @code{rose} as a function. In this example, we do not want to do that. +For operating on lists, the names @code{first} and @code{rest} would +make more sense than the names @code{car} and @code{cdr}. Indeed, +some programmers define @code{first} and @code{rest} as aliases for +@code{car} and @code{cdr}, then write @code{first} and @code{rest} in +their code. + +However, lists in Lisp are built using a lower-level structure known +as ``cons cells'' (@pxref{List Implementation}), in which there is no +such thing as ``first'' or ``rest,''and the @sc{car} and the @sc{cdr} +are symmetrical. Lisp does not try to hide the existence of cons +cells, and programs do use them for things other than lists. For this +reason, the names are helpful for reminding programmers that +@code{car} and @code{cdr} are in fact symmetrical, despite the +asymmetrical way they are used in lists. + +@ignore Clearly, a more reasonable name for @code{cdr} would be @code{rest}. (There is a lesson here: when you name new functions, consider very @@ -6834,6 +6844,7 @@ car & cdr not use them, you would have a hard time reading the code; but do, please, try to avoid using these terms yourself. The people who come after you will be grateful to you.) +@end ignore When @code{car} and @code{cdr} are applied to a list made up of symbols, such as the list @code{(pine fir oak maple)}, the element of the list @@ -9429,13 +9440,15 @@ Lists diagrammed @unnumberedsec Lists diagrammed @end ifnottex -For example, the list @code{(rose violet buttercup)} has three elements, -@samp{rose}, @samp{violet}, and @samp{buttercup}. In the computer, the -electronic address of @samp{rose} is recorded in a segment of computer -memory along with the address that gives the electronic address of where -the atom @samp{violet} is located; and that address (the one that tells -where @samp{violet} is located) is kept along with an address that tells -where the address for the atom @samp{buttercup} is located. +For example, the list @code{(rose violet buttercup)} has three +elements, @samp{rose}, @samp{violet}, and @samp{buttercup}. In the +computer, the electronic address of @samp{rose} is recorded in a +segment of computer memory called a @dfn{cons cell} (because it's what +the function @code{cons} actually creates). That cons cell also holds +the address of a second cons cell, whose @sc{car} is the atom +@samp{violet}; and that address (the one that tells where to find +@samp{violet}) is kept along with the address of a third cons cell +which holds the address for the atom @samp{buttercup}. @need 1200 This sounds more complicated than it is and is easier seen in a diagram: @@ -9652,6 +9665,8 @@ Lists diagrammed address-boxes, the first of which holds the address of @code{violet}, and the second of which holds the address of @code{buttercup}. +@cindex dotted pair +@cindex cons cell A pair of address-boxes is called a @dfn{cons cell} or @dfn{dotted pair}. @xref{Cons Cell Type, , Cons Cell and List Types, elisp, The GNU Emacs Lisp Reference Manual}, and @ref{Dotted Pair Notation, , Dotted Pair