[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 2baf2c5fd9a: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android 2baf2c5fd9a: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sat, 1 Jul 2023 20:30:45 -0400 (EDT) |
branch: feature/android
commit 2baf2c5fd9abe465a53e035131667e06ef553123
Merge: 3b75148a304 9b9dcc146ba
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
admin/notes/tree-sitter/treesit_record_change | 180 ++++++++++++-
doc/emacs/emacs.texi | 2 +-
doc/emacs/maintaining.texi | 2 +-
doc/emacs/package.texi | 2 +-
doc/emacs/regs.texi | 29 ++-
doc/lispref/parsing.texi | 6 +-
doc/lispref/text.texi | 64 +++--
doc/lispref/variables.texi | 5 +-
doc/misc/eshell.texi | 281 ++++++++++++---------
etc/ERC-NEWS | 6 +-
etc/NEWS.29 | 2 +-
etc/PROBLEMS | 17 +-
lisp/bookmark.el | 2 +-
lisp/calculator.el | 3 +-
lisp/calendar/todo-mode.el | 269 +++++++++++---------
lisp/emacs-lisp/package-vc.el | 2 +-
lisp/emacs-lisp/text-property-search.el | 35 +--
lisp/erc/erc-backend.el | 4 +-
lisp/erc/erc-match.el | 41 ++-
lisp/erc/erc-services.el | 121 +++++++++
lisp/erc/erc.el | 6 +-
lisp/eshell/em-rebind.el | 19 +-
lisp/faces.el | 32 ++-
lisp/mail/rmailsum.el | 3 +-
lisp/menu-bar.el | 66 ++++-
lisp/misc.el | 39 ++-
lisp/net/tramp-gvfs.el | 2 +
lisp/net/tramp-rclone.el | 24 +-
lisp/net/tramp.el | 7 +-
lisp/progmodes/cperl-mode.el | 84 +++---
lisp/progmodes/eglot.el | 90 +++----
lisp/progmodes/js.el | 61 +++--
lisp/progmodes/sh-script.el | 1 +
lisp/rect.el | 25 +-
lisp/register.el | 152 ++++++-----
lisp/treesit.el | 3 +-
src/editfns.c | 29 +++
test/lisp/erc/erc-scenarios-match.el | 120 +++++++++
test/lisp/erc/erc-scenarios-services-misc.el | 105 ++++++++
.../services/regain/reconnect-retry-again.eld | 56 ++++
.../resources/services/regain/reconnect-retry.eld | 53 ++++
.../erc/resources/services/regain/taken-ghost.eld | 42 +++
.../erc/resources/services/regain/taken-regain.eld | 42 +++
test/lisp/misc-tests.el | 97 ++++---
.../cperl-mode-resources/cperl-bug-11733.pl | 50 ++++
.../cperl-mode-resources/cperl-bug-64364.pl | 29 +++
.../cperl-mode-resources/proto-and-attrs.pl | 10 +-
test/lisp/progmodes/cperl-mode-tests.el | 26 +-
test/lisp/progmodes/js-tests.el | 51 ++++
49 files changed, 1814 insertions(+), 583 deletions(-)
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
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 766180c2e17..467a9ff0d82 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -351,7 +351,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.
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 @@ started editing (@pxref{Old Revisions}), type @kbd{C-c C-d}
(@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}.
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index f1f88ac7f58..b294e3d58bd 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -625,7 +625,7 @@ checkout instead of cloning a remote repository. You can
do this by
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
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index ec2367d71e3..e52f68dd18e 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -22,10 +22,11 @@ because these keys are reserved for quitting
(@pxref{Quitting}).
@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 @@ this chapter.
* 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 @@ previously documented in @ref{Text Registers}, inserts a
rectangle
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 @@ rather than a text string, if the register contains a
rectangle.
@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{Window 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 @@ puts the file name shown in register @samp{z}.
@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 @@ put that buffer into the @samp{m} register:
(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/parsing.texi b/doc/lispref/parsing.texi
index 3bb5071f02f..36b3c19df01 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -1969,7 +1969,7 @@ ts_node_field_name_for_child
treesit-node-field-name-for-child
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
@@ -1977,9 +1977,9 @@ ts_node_next_named_sibling
treesit-node-next-sibling
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
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 08e64980ee0..a61889fc508 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3398,37 +3398,43 @@ for @var{object} is the current buffer.
@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 @@ This will pick out all the words that use the @code{bold}
face.
@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 @@ This will give you a list of all those URLs.
@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
@@ -4642,20 +4649,25 @@ A rectangle is represented by a list of strings.
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/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 4eda035473e..55761ff75e2 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -350,6 +350,9 @@ 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
@@ -2599,7 +2602,7 @@ can be either @code{get} or @code{set}.
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:
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 4e2bddf42af..0e2f5e02973 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -586,14 +586,6 @@ the buffer is merely buried instead.
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 @@ the external @command{info} command, but uses Emacs's
internal Info
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 @@ Manual}. Otherwise call the external @command{make}
command.
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 @@ is required.
@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 @@ Source an Eshell file in a subshell environment. This is
not to be
confused with the command @command{.}, which sources a file in the
current environment.
-@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 @@ Show the time elapsed during a command's execution.
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
@@ -2019,66 +1945,95 @@ at the end of the command are excluded. This allows
input like this:
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:
+modules.@footnote{ERC provides a similar module facility.}
-@example
-(eval-when-compile
- (require 'cl-lib)
- (require 'esh-mode)
- (require 'eshell))
+@menu
+* Optional modules::
+* Writing a module::
+@end menu
-(require 'esh-util)
-@end example
+@node Optional modules
+@section Optional modules
+
+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
-* Writing a module::
-* Module testing::
-* Directory handling::
* Key rebinding::
* Smart scrolling::
-* Terminal emulation::
* Electric forward slash::
+* Tramp extensions::
+* Extra built-in commands::
@end menu
-@node Writing a module
-@section Writing a module
+@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}.
-@node Module testing
-@section Module testing
+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.
-This section is not yet written.
+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 Directory handling
-@section Directory handling
+@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}.
-@node Key rebinding
-@section Key rebinding
+@itemize @bullet
+@item
+When you invoke a command, it is assumed that you want to read the
+output of that command.
-This section is not yet written.
+@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.
-@node Smart scrolling
-@section Smart scrolling
+@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.
-This section is not yet written.
+@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.
-@node Terminal emulation
-@section Terminal emulation
+@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.
-This section is not yet written.
+@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
-@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 +2087,104 @@ when chaining commands with the operators @code{&&},
@code{||},
@code{|} and @code{;}, the electric forward slash is active only
within the first command.
+@node Tramp extensions
+@subsection Tramp extensions
+
+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}.
+
+@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}.
+
+@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
+
+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
+;;;###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
@@ -2158,8 +2211,6 @@ Below is a list of some known problems with Eshell
version 2.4.2,
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:
@@ -2227,8 +2278,6 @@ for running shells.
@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
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/etc/NEWS.29 b/etc/NEWS.29
index aa3b758a815..9e6f0c16bcd 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -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/etc/PROBLEMS b/etc/PROBLEMS
index 50f52534a26..6dc56dd9e81 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1707,7 +1707,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
@@ -2788,6 +2788,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
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 @@ confirmation first."
(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))))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index bf2ac9b6215..00afa2457fe 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -746,7 +746,8 @@ See the documentation for `calculator-mode' for more
information."
;; use 3 lines
(let* ((bx (face-attribute 'mode-line :box))
(lh (plist-get bx :line-width)))
- (and bx (or (not 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)))))))
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 35cac5d7310..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:
@@ -1205,7 +1206,9 @@ visiting the deleted files."
(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)))))
@@ -1294,15 +1297,15 @@ return the new category number."
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 +1462,7 @@ the archive of the file moved to, creating it if it does
not exist."
(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
@@ -1480,7 +1482,9 @@ the archive of the file moved to, creating it if it does
not exist."
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)
@@ -1520,25 +1524,26 @@ the archive of the file moved to, creating it if it
does not exist."
;; 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))))))
@@ -1706,11 +1711,19 @@ insertion provided it doesn't begin with
`todo-nondiary-marker'."
: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 <return> automatically inserts the
+current time.
+
+When this option is nil (the default), no time string is inserted
+either automatically or when typing <return> at the time
+prompt (and in the latter case, when editing an existing time
+string, typing <return> deletes it)."
:type 'boolean
:group 'todo-edit)
@@ -2314,7 +2327,6 @@ made in the number or names of categories."
;; 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 +2489,14 @@ made in the number or names of categories."
(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 +2663,7 @@ meaning to raise or lower the item's priority by one."
(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 +2715,31 @@ meaning to raise or lower the item's priority by one."
(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 +2780,7 @@ section in the category moved to."
(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 +2839,8 @@ section in the category moved to."
(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 +2854,8 @@ section in the category moved to."
(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 +2894,14 @@ section in the category moved to."
(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 +3030,7 @@ comments without asking."
(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 +3092,20 @@ comments without asking."
(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 +3190,7 @@ this category does not exist in the archive, it is
created."
(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 +3260,37 @@ this category does not exist in the archive, it is
created."
(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 +3539,6 @@ decreasing or increasing its 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 +3563,7 @@ decreasing or increasing its 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))
@@ -4875,7 +4890,9 @@ name in `todo-directory'. See also the documentation
string of
(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
@@ -5056,7 +5073,9 @@ With nil or omitted CATEGORY, default to the current
category."
(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)
@@ -5165,7 +5184,9 @@ but the categories sexp differs from the current value of
(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)))
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index f34cfb3120b..db8b41aee6a 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -386,7 +386,7 @@ FILE can be an Org file, indicated by its \".org\"
extension,
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)
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 @@ the buffer positions that limit the region, and
(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."
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 @@ This only has an effect if `erc-server-auto-reconnect' is
non-nil."
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-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 @@ for beeping to work."
(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 @@ In any of the following situations, MSG is directed at an
entry FOOL:
(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 @@ Use this defun with `erc-insert-modify-hook'."
'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/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 @@ Returns t if the identify message could be sent, nil
otherwise."
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 @@ E.g. \"Read error to Nick [user@some.host]: 110\" would
be shortened to
(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 @@ See also `erc-display-error-notice'."
;; 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/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))
diff --git a/lisp/faces.el b/lisp/faces.el
index dabe847698c..e3f7753bb8d 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -794,19 +794,25 @@ around them. If VALUE is nil, explicitly don't draw
boxes. If
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'
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 @@ message."
(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.
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 003e774bbcc..43087ec3cbe 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -227,10 +227,18 @@ in the tool bar will close the current window where
possible."
'(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 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)
@@ -355,6 +363,9 @@ in the tool bar will close the current window where
possible."
(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 belonging to current project"))
(bindings--define-key menu [separator-tag-search] menu-bar-separator)
(bindings--define-key menu [repeat-search-back]
@@ -406,6 +417,9 @@ in the tool bar will close the current window where
possible."
(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 belonging to current
project"))
(bindings--define-key menu [separator-replace-tags]
menu-bar-separator)
@@ -1759,8 +1773,12 @@ mail status in mode line"))
(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]
@@ -1778,6 +1796,31 @@ mail status in mode line"))
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 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 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"))
+ (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 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 ()
"Read mail using `read-mail-command'."
(interactive)
@@ -1864,6 +1907,9 @@ mail status in mode line"))
'(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
@@ -1873,9 +1919,13 @@ mail status in mode line"))
(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"
@@ -2369,7 +2419,17 @@ Buffers menu is regenerated."
'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 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 belonging to
current project"))
"Entries to be included at the end of the \"Buffers\" menu.")
(defvar menu-bar-select-buffer-function 'switch-to-buffer
diff --git a/lisp/misc.el b/lisp/misc.el
index dd4ebb4cde2..fad8d545e11 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -64,7 +64,7 @@ Also see the `duplicate-line' 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 `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.
@@ -105,7 +105,18 @@ Also see the `copy-from-above-command' command."
(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 @@ Also see the `copy-from-above-command' command."
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/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 @@ file names."
(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 @@ file names."
(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 @@ file names."
(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 @@ file names."
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)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 04fe0eed3bc..90ffa9a6ccd 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1955,8 +1955,11 @@ version, the function does nothing."
"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."
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index e47355680ea..8d1773701bd 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1330,7 +1330,9 @@ subsequent attributes. This regexp does not have capture
groups.")
`(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 "("
@@ -1347,11 +1349,22 @@ subsequent attributes. This regexp does not have
capture groups.")
(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
@@ -2853,10 +2866,13 @@ Will not look before LIM."
;; 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.
@@ -3116,7 +3132,8 @@ and closing parentheses and brackets."
;; 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
@@ -3539,7 +3556,7 @@ position of the end of the unsafe construct."
(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 +3625,6 @@ Should be called with the point before leading colon of
an attribute."
'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))))
@@ -5919,40 +5935,46 @@ default function."
;; 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/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index e2478f2dde3..897cf3bc93e 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -3196,49 +3196,51 @@ for which LSP on-type-formatting should be requested."
((:documentation sigdoc)) parameters activeParameter)
sig
(with-temp-buffer
- (save-excursion (insert siglabel))
+ (insert siglabel)
;; Ad-hoc attempt to parse label as <name>(<params>)
- (when (looking-at "\\([^(]*\\)(\\([^)]+\\))")
- (add-face-text-property (match-beginning 1) (match-end 1)
- 'font-lock-function-name-face))
- ;; 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
- ;; ...perhaps highlight it in the formals list
- (when (and (eq 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)))))
+ ;; 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)
@@ -3348,9 +3350,11 @@ for which LSP on-type-formatting should be requested."
(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
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 5b1984f215f..de1a820ba11 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1024,38 +1024,45 @@ Return the pitem of the function we went to the
beginning of."
"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
- "\\_<function\\_>" 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
+ "\\_<function\\_>" 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/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 @@ Return the name of the shell suitable for `sh-set-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
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 @@ Ignores `line-move-visual'."
(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 @@ Ignores `line-move-visual'."
(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/lisp/register.el b/lisp/register.el
index d30114bfbc7..56ab089efb7 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -69,10 +69,12 @@ A list of the form (file . FILE-NAME) represents the file
named FILE-NAME.
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."
@@ -90,7 +92,7 @@ of the marked text."
(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"
@@ -107,7 +109,7 @@ See the documentation of the variable `register-alist' for
possible VALUEs."
(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)))))
@@ -116,19 +118,19 @@ See the documentation of the variable `register-alist'
for possible VALUEs."
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
@@ -178,12 +180,12 @@ display such a window regardless."
(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.
+ "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: "
@@ -196,11 +198,11 @@ Interactively, reads the register using
`register-read-with-preview'."
(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))
@@ -213,11 +215,12 @@ Interactively, reads the register using
`register-read-with-preview'."
'(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))
@@ -233,18 +236,21 @@ Interactively, reads the register using
`register-read-with-preview'."
(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.
-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.)
-
-Interactively, reads the register using `register-read-with-preview'."
+\(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, 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)))
@@ -252,6 +258,7 @@ Interactively, reads the register using
`register-read-with-preview'."
(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"))
@@ -301,13 +308,13 @@ ARG is the value of the prefix argument or nil."
(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
@@ -320,8 +327,8 @@ Interactively, reads the register using
`register-read-with-preview'."
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.
@@ -329,7 +336,7 @@ PREFIX to it.
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)))
@@ -342,10 +349,10 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)
@@ -354,7 +361,7 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)))))
@@ -372,7 +379,10 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)))
@@ -467,13 +477,14 @@ Interactively, reads the register using
`register-read-with-preview'."
(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: ")
@@ -484,7 +495,7 @@ Interactively, reads the register using
`register-read-with-preview'."
(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))
@@ -507,14 +518,17 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)
@@ -530,12 +544,14 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)
@@ -554,12 +570,14 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)
@@ -578,14 +596,16 @@ Interactively, reads the register using
`register-read-with-preview'."
(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)
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 81920834329..9556b315eab 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1114,7 +1114,8 @@ parser notifying of the change."
(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
diff --git a/src/editfns.c b/src/editfns.c
index e72d86d84d0..8164316aabe 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -59,6 +59,11 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#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);
@@ -2399,6 +2404,14 @@ Both characters must have the same length of multi-byte
form. */)
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;
}
@@ -2598,6 +2611,15 @@ It returns the number of characters changed. */)
*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++;
}
@@ -4771,6 +4793,13 @@ ring. */)
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;
}
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 <https://www.gnu.org/licenses/>.
+
+;;; 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 "<bob> tester, welcome!"))
+ (should (funcall hiddenp))
+
+ ;; Alice's is the only one visible.
+ (should (funcall expect 10 "<alice> 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 "<bob> alice: But, as it seems"))
+ (should (funcall hiddenp))
+
+ (should (funcall expect 10 "<alice> bob: Well, this is the forest"))
+ (should (funcall hiddenp))
+
+ (should (funcall expect 10 "<alice> bob: And will you"))
+ (should (funcall hiddenp))
+
+ (should (funcall expect 10 "<bob> 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
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-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"))
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 @@
(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
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-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 @@ sub sub_4 :prototype($$$) ($foo,$bar,$baz) { ...; }
# 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
{
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 99d5a51b3ea..8162953cefb 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -184,11 +184,12 @@ attributes, prototypes 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 @@ attributes, prototypes 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 @@ issued by CPerl mode."
(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
@@ -852,6 +855,17 @@ under timeout control."
(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
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 @@ if (!/[ (:,='\"]/.test(value)) {
(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