From 2a41b6ba51457448b3937fbb1d9e06f62c3d5a9f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Apr 2024 09:24:58 +0300 Subject: [PATCH 001/149] ; * src/filelock.c (Flock_file): Doc fix (bug#70216). --- src/filelock.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/filelock.c b/src/filelock.c index 7acee1f8ddd..3dc5f6d68d6 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -772,8 +772,11 @@ unlock_all_files (void) } DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0, - doc: /* Lock FILE. -If the option `create-lockfiles' is nil, this does nothing. */) + doc: /* Check whether FILE was modified since it was visited, and lock it. +If user option `create-lockfiles' is nil, this does not create +a lock file for FILE, but it still checks whether FILE was modified +outside of the current Emacs session, and if so, asks the user +whether to modify FILE. */) (Lisp_Object file) { #ifndef MSDOS From 19cee16576ef09990ac14d1ec5f0ddcd4594f5ce Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Apr 2024 09:15:42 +0200 Subject: [PATCH 002/149] ; * doc/emacs/misc.texi (emacsclient Options): Fix typo. (Bug#70238) --- doc/emacs/misc.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 48bc69456ad..488f6de04ed 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2157,7 +2157,7 @@ running on a text terminal, it creates a new frame in the current text terminal. @item -T @var{tramp-prefix} -@itemx --tramp-prefix=@var{tramp-prefix} +@itemx --tramp=@var{tramp-prefix} Set the prefix to add to filenames for Emacs to locate files on remote machines (@pxref{Remote Files}) using TRAMP (@pxref{Top, The Tramp Manual,, tramp, The Tramp Manual}). This is mostly useful in From 55aab2d471024bda1878897e81e3b5695e242f09 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Apr 2024 10:32:47 +0300 Subject: [PATCH 003/149] ; * etc/PROBLEMS: An entry about focus issues with XFCE (bug#70046). --- etc/PROBLEMS | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 16521e257dd..36fee69351e 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1615,6 +1615,18 @@ underlying functionality in plasmashell gets fully disabled as well. At least a restart of plasmashell is required for the clipboard history to be cleared. +*** XFCE: Selected frame loses focus + +This can happen, e.g., in Ediff: when you move between the differences +by typing into the control frame, input focus unexpectedly switches to +the buffers where Emacs shows the differences, instead of being left +in the Ediff control frame. + +The reason is a bug in the window manager: it shifts input focus when +raising a frame. A workaround is to activate the "focus stealing +prevention" option of the window manager (in XFCE settings, under +"window manager tweaks", in the "focus" tab). + *** CDE: Frames may cover dialogs they created when using CDE. This can happen if you have "Allow Primary Windows On Top" enabled which From aca5064f128e20a495e9ddf254248ab77b613754 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Apr 2024 10:33:14 +0300 Subject: [PATCH 004/149] ; Fix last change. --- etc/PROBLEMS | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 36fee69351e..54dc23c0951 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1618,9 +1618,9 @@ history to be cleared. *** XFCE: Selected frame loses focus This can happen, e.g., in Ediff: when you move between the differences -by typing into the control frame, input focus unexpectedly switches to -the buffers where Emacs shows the differences, instead of being left -in the Ediff control frame. +by typing 'n' or 'p' into the control frame, input focus unexpectedly +switches to the buffers where Emacs shows the differences, instead of +being left in the Ediff control frame. The reason is a bug in the window manager: it shifts input focus when raising a frame. A workaround is to activate the "focus stealing From 407e85ce139c2f0ab8bc7f9643ee7506a4e561a1 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 8 Apr 2024 21:07:11 -0700 Subject: [PATCH 005/149] Fix c++-ts-mode defun navigation (bug#65885) * lisp/progmodes/c-ts-mode.el (c-ts-base-mode): Add BOL and EOL marker in the regexp. --- lisp/progmodes/c-ts-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e69856baecc..a7a416b94f4 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1155,7 +1155,9 @@ BEG and END are described in `treesit-range-rules'." "struct_specifier" "enum_specifier" "union_specifier" - "class_specifier" + ;; Make sure this doesn't match + ;; storage_class_specifier. + "^class_specifier$" "namespace_definition") (and c-ts-mode-emacs-sources-support '(;; DEFUN. From 859b4227e3de9f8e7bc26367540aa315cefc37dc Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 8 Apr 2024 20:20:25 -0700 Subject: [PATCH 006/149] Update go-ts-mode to support latest tree-sitter-go grammar tree-sitter-go changed method_spec to method_elem in https://github.com/tree-sitter/tree-sitter-go/commit/b82ab803d887002a0af11f6ce63d72884580bf33 * lisp/progmodes/go-ts-mode.el: (go-ts-mode--method-elem-supported-p): New function. (go-ts-mode--font-lock-settings): Conditionally use method_elem or method_spec in the query. --- lisp/progmodes/go-ts-mode.el | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index e8a176e3d9d..a5b49bd8313 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -112,6 +112,13 @@ (ignore-errors (or (treesit-query-string "" '((iota) @font-lock-constant-face) 'go) t))) +;; tree-sitter-go changed method_spec to method_elem in +;; https://github.com/tree-sitter/tree-sitter-go/commit/b82ab803d887002a0af11f6ce63d72884580bf33 +(defun go-ts-mode--method-elem-supported-p () + "Return t if Go grammar uses `method_elem' instead of `method_spec'." + (ignore-errors + (or (treesit-query-string "" '((method_elem) @cap) 'go) t))) + (defvar go-ts-mode--font-lock-settings (treesit-font-lock-rules :language 'go @@ -136,11 +143,13 @@ :language 'go :feature 'definition - '((function_declaration + `((function_declaration name: (identifier) @font-lock-function-name-face) (method_declaration name: (field_identifier) @font-lock-function-name-face) - (method_spec + (,(if (go-ts-mode--method-elem-supported-p) + 'method_elem + 'method_spec) name: (field_identifier) @font-lock-function-name-face) (field_declaration name: (field_identifier) @font-lock-property-name-face) From 6a0bb7beae3ed4e3d2b420b73abcfaada38f53ee Mon Sep 17 00:00:00 2001 From: Peter Oliver Date: Wed, 10 Apr 2024 10:42:39 +0200 Subject: [PATCH 007/149] * doc/emacs/misc.texi (emacsclient Options): Suggest forwarding sockets. (Bug#66667) --- doc/emacs/misc.texi | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 488f6de04ed..41e37fd094e 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2161,8 +2161,9 @@ terminal. Set the prefix to add to filenames for Emacs to locate files on remote machines (@pxref{Remote Files}) using TRAMP (@pxref{Top, The Tramp Manual,, tramp, The Tramp Manual}). This is mostly useful in -combination with using the Emacs server over TCP (@pxref{TCP Emacs -server}). By ssh-forwarding the listening port and making the +combination with using the Emacs server from a remote host. By +ssh-forwarding the listening socket, or ssh-forwarding the listening +port @pxref{TCP Emacs server} and making the @var{server-file} available on a remote machine, programs on the remote machine can use @command{emacsclient} as the value for the @env{EDITOR} and similar environment variables, but instead of talking @@ -2174,16 +2175,29 @@ Setting the environment variable @env{EMACSCLIENT_TRAMP} has the same effect as using the @samp{-T} option. If both are specified, the command-line option takes precedence. -For example, assume two hosts, @samp{local} and @samp{remote}, and -that the local Emacs listens on tcp port 12345. Assume further that +For example, assume two hosts, @samp{local} and @samp{remote}. + +@example +local$ ssh -R "/home/%r/.emacs.socket":"$@{XDG_RUNTIME_DIR:-$@{TMPDIR:-/tmp@}/emacs%i@}$@{XDG_RUNTIME_DIR:+/emacs@}/server" remote +remote$ export EMACS_SOCKET_NAME=$HOME/.emacs.socket +remote$ export EMACSCLIENT_TRAMP=/ssh:remote: +remote$ export EDITOR=emacsclient +remote$ $EDITOR /tmp/foo.txt #Should open in local emacs. +@end example + +If you are using a platform where @command{emacsclient} does not use +Unix domain sockets (i.e., MS-Windows), or your SSH implementation is +not able to forward them (e.g., OpenSSH before version 6.7), you can +forward a TCP port instead. In this example, assume that the local +Emacs listens on tcp port 12345. Assume further that @file{/home} is on a shared file system, so that the server file @file{~/.emacs.d/server/server} is readable on both hosts. @example local$ ssh -R12345:localhost:12345 remote -remote$ export EDITOR="emacsclient \ - --server-file=server \ - --tramp=/ssh:remote:" +remote$ export EMACS_SERVER_FILE=server +remote$ export EMACSCLIENT_TRAMP=/ssh:remote: +remote$ export EDITOR=emacsclient remote$ $EDITOR /tmp/foo.txt #Should open in local emacs. @end example From db7b571aaaf4aa16fc6a88a53a8740c3a102ce60 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 10 Apr 2024 16:52:21 +0300 Subject: [PATCH 008/149] ; Improve documentation of 'world-clock' * lisp/time.el (zoneinfo-style-world-list) (legacy-style-world-list): Doc fixes. --- lisp/time.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/time.el b/lisp/time.el index 6d95ae326c6..29c7f53ac1f 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -452,7 +452,11 @@ Each element has the form (TIMEZONE LABEL). TIMEZONE should be a string of the form AREA/LOCATION, where AREA is the name of a region -- a continent or ocean, and LOCATION is the name of a specific location, e.g., a city, within that region. -LABEL is a string to display as the label of that TIMEZONE's time." +LABEL is a string to display as the label of that TIMEZONE's time. + +This option has effect only on systems that support Posix-style +zoneinfo files specified as CONTINENT/CITY. In particular, +MS-Windows doesn't support that; use `legacy-style-world-list' instead." :type '(repeat (list string string)) :version "23.1") @@ -471,7 +475,10 @@ TIMEZONE should be a string of the form: See the documentation of the TZ environment variable on your system, for more details about the format of TIMEZONE. -LABEL is a string to display as the label of that TIMEZONE's time." +LABEL is a string to display as the label of that TIMEZONE's time + +This is the only option that has effect on MS-Windows, where you also +cannot specify the [offset][,date[/time],date[/time]] part." :type '(repeat (list string string)) :version "23.1") From 4cefa3c0b1f7270ca5317caa02101a0257595b9c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 10 Apr 2024 22:31:57 +0300 Subject: [PATCH 009/149] ; * doc/emacs/files.texi (Backup): Clarify "saving" (bug#70326). --- doc/emacs/files.texi | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index d074a55b762..393c4728422 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -569,9 +569,10 @@ Emacs carefully copies the old contents to another file, called the @dfn{backup} file, before actually saving. Emacs makes a backup for a file only the first time the file is -saved from a buffer. No matter how many times you subsequently save -the file, its backup remains unchanged. However, if you kill the -buffer and then visit the file again, a new backup file will be made. +saved from the buffer that visits it. No matter how many times you +subsequently save the file, its backup remains unchanged. However, if +you kill the buffer and then visit the file again, a new backup file +will be made. For most files, the variable @code{make-backup-files} determines whether to make backup files. On most operating systems, its default From ea62a14ea3b7f3f6feb0c7c803eeabe3c8499276 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 11 Apr 2024 18:34:53 +0300 Subject: [PATCH 010/149] Fix display of vscrolled windows * src/xdisp.c (redisplay_window): Fix condition for resetting the window's vscroll. (Bug#70038) --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 2d85a991e77..a9eb47720d0 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19811,7 +19811,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* The vscroll should be preserved in this case, since `pixel-scroll-precision-mode' must continue working normally when a mini-window is resized. (bug#55312) */ - if (!w->preserve_vscroll_p || !window_frozen_p (w)) + if (!w->preserve_vscroll_p && !window_frozen_p (w)) w->vscroll = 0; w->preserve_vscroll_p = false; From a69890eea946beb0858273a20d260a170485b79a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 12 Apr 2024 10:09:45 +0200 Subject: [PATCH 011/149] Improve D-Bus byte-array conversion * doc/misc/dbus.texi (Type Conversion): Adapt dbus-byte-array-to-string. * etc/NEWS: D-Bus byte array conversion works over raw UTF-8 bytes. Fix typos. * lisp/net/dbus.el (dbus-string-to-byte-array) (dbus-byte-array-to-string): BYTE-ARRAY must be an UTF-8 raw bytes sequence. Make optional argument MULTIBYTE obsolete. (Bug#70301) (dbus-call-method-handler, dbus-register-signal) (dbus-escape-as-identifier): Use `length=' and `length>'. * test/lisp/net/dbus-tests.el (dbus--test-method-handler) (dbus-test09-get-managed-objects): Use `length='. (dbus-test01-type-conversion): Extend test. * test/lisp/net/secrets-tests.el (secrets-test03-items): Extend test. --- doc/misc/dbus.texi | 5 ++- etc/NEWS | 59 ++++++++++++++++++---------------- lisp/net/dbus.el | 33 +++++++++++-------- test/lisp/net/dbus-tests.el | 37 ++++++++++++++------- test/lisp/net/secrets-tests.el | 4 +++ 5 files changed, 81 insertions(+), 57 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 28ee64d6b89..c0a478d6ff6 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1154,11 +1154,10 @@ The signal @code{PropertyModified}, discussed as an example in (@var{integer} ((@var{string} @var{bool} @var{bool}) (@var{string} @var{bool} @var{bool}) @dots{})) @end lisp -@defun dbus-byte-array-to-string byte-array &optional multibyte +@defun dbus-byte-array-to-string byte-array If a D-Bus method or signal returns an array of bytes, which are known to represent a UTF-8 string, this function converts @var{byte-array} -to the corresponding string. The string is unibyte encoded, unless -@var{multibyte} is non-@code{nil}. Example: +to the corresponding UTF-8 string. Example: @lisp (dbus-byte-array-to-string '(47 101 116 99 47 104 111 115 116 115)) diff --git a/etc/NEWS b/etc/NEWS index 62dd2da6b8c..c2c510f2f93 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -70,7 +70,7 @@ more details. ** Mouse wheel events should now always be 'wheel-up/down/left/right'. At those places where the old 'mouse-4/5/6/7' events could still occur -(i.e. X11 input in the absence of XInput2, and 'xterm-mouse-mode'), +(i.e., X11 input in the absence of XInput2, and 'xterm-mouse-mode'), we remap them to the corresponding 'wheel-up/down/left/right' event, according to the new variable 'mouse-wheel-buttons'. The old variables 'mouse-wheel-up-event', 'mouse-wheel-down-event', @@ -81,7 +81,7 @@ obsolete. In order to help the use of those Tree-Sitter modes, they are now declared to have the corresponding non-Tree-Sitter mode as an additional parent. -This way, things like `.dir-locals.el` settings, and YASnippet +This way, things like ".dir-locals.el" settings, and YASnippet collections of snippets automatically apply to the new Tree-Sitter modes. Note that those modes still do not inherit from the non-TS mode, so @@ -126,7 +126,7 @@ to your init: ** 'describe-function' now shows the type of the function object. The text used to say things like "car is is a built-in function" whereas it now says "car is a primitive-function" where "primitive-function" -is the symbol returned by `cl-type-of` and you can click on it to get +is the symbol returned by 'cl-type-of' and you can click on it to get information about that type. ** 'advice-remove' is now an interactive command. @@ -266,7 +266,7 @@ value when installing GNU coreutils using something like ports or Homebrew. +++ -** cl-print +** CL Print +++ *** You can expand the "..." truncation everywhere. @@ -499,7 +499,7 @@ By default this is disabled. --- *** Users in CJK locales can control width of some non-CJK characters. Some characters are considered by Unicode as "ambiguous" with respect -to their display width: either "full-width" (i.e. taking 2 columns on +to their display width: either "full-width" (i.e., taking 2 columns on display) or "narrow" (taking 1 column). The actual width depends on the fonts used for these characters by Emacs or (for text-mode frames) by the terminal emulator. Traditionally, font sets in CJK locales @@ -546,7 +546,7 @@ only to specify the 'mouse-4/5/6/7' events that might still happen to be generated by some old packages (or if 'mouse-wheel-buttons' has been set to nil). -** 'xterm-mouse-mode' +** Xterm Mouse mode This mode now emits 'wheel-up/down/right/left' events instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the new variable 'mouse-wheel-buttons' to decide which button @@ -568,7 +568,7 @@ This requires the 'lzip' program to be installed on your system. ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. -** gdb-mi +** GDB MI --- *** Variable order and truncation can now be configured in 'gdb-many-windows'. @@ -1112,7 +1112,7 @@ would add a duplicate entry to the end of the history list each time. This made it impossible to navigate to the "end" of the history list. Now, navigating through history in EWW simply changes your position in the history list, allowing you to reach the end as expected. In -addition, when browsing to a new page from a "historical" one (i.e. a +addition, when browsing to a new page from a "historical" one (i.e., a page loaded by navigating back through history), EWW deletes the history entries newer than the current page. To change the behavior when browsing from "historical" pages, you can customize @@ -1136,7 +1136,7 @@ display only the readable parts by default. For more details, see When non-nil (the default), calling 'eww-readable' adds a new entry to the EWW page history. -** go-ts-mode +** Go-ts mode +++ *** New command 'go-ts-mode-docstring'. @@ -1265,12 +1265,11 @@ This allows the user to specify command line arguments to the non interactive Python interpreter specified by 'python-interpreter'. ** Scheme mode - -Scheme mode now handles regular expression literal #/regexp/ that is +Scheme mode now handles regular expression literal '#/regexp/' that is available in some Scheme implementations. Also, it should now handle nested sexp-comments. -** use-package +** Use package +++ *** New ':vc' keyword. @@ -1434,13 +1433,13 @@ without specifying a file, like this: ** Image +++ -*** Image :map property is now recomputed when image is transformed. +*** Image ':map' property is now recomputed when image is transformed. Now images with clickable maps work as expected after you run commands -such as `image-increase-size', `image-decrease-size', `image-rotate', -`image-flip-horizontally', and `image-flip-vertically'. +such as 'image-increase-size', 'image-decrease-size', 'image-rotate', +'image-flip-horizontally', and 'image-flip-vertically'. +++ -*** New user option 'image-recompute-map-p' +*** New user option 'image-recompute-map-p'. Set this option to nil to prevent Emacs from recomputing image maps. ** Image Dired @@ -1575,7 +1574,7 @@ buffer method is the default, which preserves previous behavior. *** New user option 'xwidget-webkit-disable-javascript'. This allows disabling JavaScript in xwidget Webkit sessions. -** ls-lisp +** Ls Lisp --- *** 'ls-lisp--insert-directory' supports more long options of 'ls'. @@ -1775,6 +1774,11 @@ Use a float value for the first argument instead. Instead, use 'eshell-process-wait-time', which supports floating-point values. ++++ +** 'dbus-{string-to-byte-array,byte-array-to-string}' are strict UTF-8 conform. +Both work over UTF-8 raw bytes only. The optional parameter MULTIBYTE +of 'dbus-byte-array-to-string' is obsolete now. + * Lisp Changes in Emacs 30.1 @@ -1789,18 +1793,18 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. -** New functions `primitive-function-p` and `cl-functionp`. -`primitive-function-p` is like `subr-primitive-p` except that it returns +** New functions 'primitive-function-p' and 'cl-functionp'. +'primitive-function-p' is like 'subr-primitive-p' except that it returns t only if the argument is a function rather than a special-form, -and `cl-functionp` is like `functionp` except it return nil +and 'cl-functionp' is like 'functionp' except it returns nil for lists and symbols. ** Built-in types have now corresponding classes. -At the Lisp level, this means that things like (cl-find-class 'integer) +At the Lisp level, this means that things like '(cl-find-class 'integer)' will now return a class object, and at the UI level it means that things like 'C-h o integer RET' will show some information about that type. -** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. +** New variable 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. @@ -1934,7 +1938,7 @@ capabilities of the 'notifications-notify' function in a manner analogous to 'w32-notification-notify'. ** New variable 'haiku-pass-control-tab-to-system'. -This sets whether Emacs should pass C-TAB on to the system instead of +This sets whether Emacs should pass 'C-TAB' on to the system instead of handling it, fixing a problem where window switching would not activate if an Emacs frame had focus on the Haiku operation system. @@ -2011,7 +2015,6 @@ It returns the last position of a marker in its buffer even if that buffer has been killed. ('marker-position' would return nil in that case.) - ** Functions and variables to transpose sexps +++ @@ -2360,16 +2363,16 @@ is the value of the property to context menus shown when clicking on the text which as this property. --- -** Detecting the end of an iteration of a keyboard macro +** Detecting the end of an iteration of a keyboard macro. 'read-event', 'read-char', and 'read-char-exclusive' no longer return -1 -when called at the end of an iteration of a the execution of a keyboard +when called at the end of an iteration of the execution of a keyboard macro. Instead, they will transparently continue reading available input (e.g., from the keyboard). If you need to detect the end of a macro iteration, check the following condition before calling one of the aforementioned functions: (and (arrayp executing-kbd-macro) - (>= executing-kbd-macro-index (length executing-kbd-macro)))) + (>= executing-kbd-macro-index (length executing-kbd-macro))) +++ ** 'vtable-update-object' updates an existing object with just two arguments. @@ -2394,7 +2397,7 @@ It will now signal 'json-utf8-decode-error' for inputs that are not correctly UTF-8 encoded. --- -*** The parser and encoder now accept arbitarily large integers. +*** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. ** New tree-sitter functions and variables for defining and using "things" diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 46f85daba24..31a5eae5182 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -270,7 +270,7 @@ The result will be made available in `dbus-return-values-table'." (result (gethash key dbus-return-values-table))) (when (consp result) (setcar result :complete) - (setcdr result (if (= (length args) 1) (car args) args))))) + (setcdr result (if (length= args 1) (car args) args))))) (defun dbus-notice-synchronous-call-errors (ev er) "Detect errors resulting from pending synchronous calls." @@ -773,7 +773,7 @@ Example: ;; Signals are sent always with the unique name as sender. Note: ;; the unique name of `dbus-service-dbus' is that string itself. (if (and (stringp service) - (not (zerop (length service))) + (length> service 0) (not (string-equal service dbus-service-dbus)) (/= (string-to-char service) ?:)) (setq uname (dbus-get-name-owner bus service)) @@ -994,20 +994,25 @@ association to the service from D-Bus." (defun dbus-string-to-byte-array (string) "Transform STRING to list (:array :byte C1 :byte C2 ...). -STRING shall be UTF-8 coded." - (if (zerop (length string)) +The resulting byte array contains the raw bytes of the UTF-8 encoded +STRING.." + (if (length= string 0) '(:array :signature "y") - (cons :array (mapcan (lambda (c) (list :byte c)) string)))) + (cons :array + (mapcan (lambda (c) (list :byte c)) + (let (last-coding-system-used) + (encode-coding-string string 'utf-8 'nocopy)))))) -(defun dbus-byte-array-to-string (byte-array &optional multibyte) +(defun dbus-byte-array-to-string (byte-array &optional _multibyte) "Transform BYTE-ARRAY into UTF-8 coded string. -BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte -array as produced by `dbus-string-to-byte-array'. The resulting -string is unibyte encoded, unless MULTIBYTE is non-nil." - (apply - (if multibyte #'string #'unibyte-string) - (unless (equal byte-array '(:array :signature "y")) - (seq-filter #'characterp byte-array)))) +BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte array as +produced by `dbus-string-to-byte-array'." + (declare (advertised-calling-convention (byte-array) "30.1")) + (if-let ((bytes (seq-filter #'characterp byte-array)) + (string (apply #'unibyte-string bytes))) + (let (last-coding-system-used) + (decode-coding-string string 'utf-8 'nocopy)) + "")) (defun dbus-escape-as-identifier (string) "Escape an arbitrary STRING so it follows the rules for a C identifier. @@ -1026,7 +1031,7 @@ escaped to \"_\". Returns the escaped string. Algorithm taken from telepathy-glib's `tp_escape_as_identifier'." - (if (zerop (length string)) + (if (length= string 0) "_" (replace-regexp-in-string "\\`[0-9]\\|[^A-Za-z0-9]" diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index fec252e12dd..413901b0205 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -68,22 +68,35 @@ "Check type conversion functions." (skip-unless dbus--test-enabled-session-bus) - (let ((ustr "0123abc_xyz\x01\xff") - (mstr "Grüß Göttin")) + (let ((ustr (string-to-unibyte "0123abc_xyz\x01\xff")) + (mstr (string-to-multibyte "Grüß Göttin")) + (kstr (encode-coding-string "парола" 'koi8))) (should (string-equal (dbus-byte-array-to-string (dbus-string-to-byte-array "")) "")) (should (string-equal - (dbus-byte-array-to-string (dbus-string-to-byte-array ustr)) ustr)) + (dbus-byte-array-to-string (dbus-string-to-byte-array nil)) "")) (should (string-equal - (dbus-byte-array-to-string (dbus-string-to-byte-array mstr) 'multibyte) - mstr)) - ;; Should not work for multibyte strings. - (should-not + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte + (dbus-byte-array-to-string (dbus-string-to-byte-array ustr))) + ustr)) + (should + (string-equal + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte (dbus-byte-array-to-string (mapcar 'identity ustr))) + ustr)) + (should (string-equal (dbus-byte-array-to-string (dbus-string-to-byte-array mstr)) mstr)) + (should + (string-equal + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte + (dbus-byte-array-to-string (dbus-string-to-byte-array kstr))) + kstr)) (should (string-equal @@ -565,10 +578,10 @@ This includes initialization and closing the bus." ((null args) :ignore) ;; One argument. - ((= 1 (length args)) + ((length= args 1) (car args)) ;; Two arguments. - ((= 2 (length args)) + ((length= args 2) `(:error ,dbus-error-invalid-args ,(format-message "Wrong arguments %s" args))) ;; More than two arguments. @@ -1952,7 +1965,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." (let ((result (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path))) (should - (= 3 (length result))) + (length= result 3)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) @@ -1970,7 +1983,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." :session dbus--test-service (concat dbus--test-path "/obj0")))) (should - (= 2 (length result))) + (length= result 2)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) @@ -1989,7 +2002,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." :session dbus--test-service (concat dbus--test-path "/obj0/obj2")))) (should - (= 1 (length result))) + (length= result 1)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 9feba514413..1d9c1446e26 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -173,6 +173,10 @@ (should (secrets-create-item "session" "foo" "geheim")) (should (equal (secrets-list-items "session") '("foo" "foo"))) + ;; Create another item with a non-latin password. (Bug#70301) + (should (secrets-create-item "session" "parola" "парола")) + (string-equal (secrets-get-secret "session" "parola") "парола") + ;; Create an item with attributes. (should (setq item-path From 4ff852a5582be8d0ba16e598371ce359ba3d3cc6 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Thu, 11 Apr 2024 19:16:26 +0200 Subject: [PATCH 012/149] ; Optimize 'completion-preview--try-table' * lisp/completion-preview.el (completion-preview-completion-styles): New variable. Default to only include the 'basic' completion style. (completion-preview--try-table): Let-bind 'completion-styles' when calling 'completion-all-completions'. With the default value of 'completion-preview-completion-styles', this yields a significant performance improvement (up to 4 times faster compared to the 'substring' style when tested with 'elisp-completion-at-point'). Suggested by Ergus --- lisp/completion-preview.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 0bdc13bb8a5..4e52aa9b151 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -206,6 +206,15 @@ Completion Preview mode adds this function to #'completion-preview--window-selection-change t) (completion-preview-hide))) +(defvar completion-preview-completion-styles '(basic) + "List of completion styles that Completion Preview mode uses. + +Since Completion Preview mode shows prefix completion candidates, this +list should normally only include completion styles that perform prefix +completion, but other candidates are filtered out and cause no harm. + +See also `completion-styles'.") + (defun completion-preview--try-table (table beg end props) "Check TABLE for a completion matching the text between BEG and END. @@ -228,7 +237,11 @@ non-nil, return nil instead." (sort-fn (or (completion-metadata-get md 'cycle-sort-function) (completion-metadata-get md 'display-sort-function) completion-preview-sort-function)) - (all (let ((completion-lazy-hilit t)) + (all (let ((completion-lazy-hilit t) + ;; FIXME: This does not override styles prescribed + ;; by the completion category via + ;; e.g. `completion-category-defaults'. + (completion-styles completion-preview-completion-styles)) (completion-all-completions string table pred (- (point) beg) md))) (last (last all)) From f93df59e8c9038a10992b71bfd6beeda70f806dd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 Apr 2024 14:26:27 +0300 Subject: [PATCH 013/149] ; Fix documentation of a recent change in dbus.el (bug#70301) * lisp/net/dbus.el (dbus-string-to-byte-array) (dbus-byte-array-to-string): * etc/NEWS: * doc/misc/dbus.texi (Type Conversion): Fix documentation of these two D-Bus functions. --- doc/misc/dbus.texi | 9 +++++---- etc/NEWS | 12 +++++++++--- lisp/net/dbus.el | 7 ++++--- 3 files changed, 18 insertions(+), 10 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index c0a478d6ff6..e5d867acd40 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1083,8 +1083,8 @@ elements of this array. Example: @defun dbus-string-to-byte-array string Sometimes, D-Bus methods require as input parameter an array of bytes, -instead of a string. If it is guaranteed, that @var{string} is a -UTF-8 string, this function performs the conversion. Example: +instead of a string. This function converts @var{string} into an array +of bytes of the UTF-8 encoding of @var{string}. Example: @lisp (dbus-string-to-byte-array "/etc/hosts") @@ -1156,8 +1156,9 @@ The signal @code{PropertyModified}, discussed as an example in @defun dbus-byte-array-to-string byte-array If a D-Bus method or signal returns an array of bytes, which are known -to represent a UTF-8 string, this function converts @var{byte-array} -to the corresponding UTF-8 string. Example: +to represent a UTF-8 string, this function converts @var{byte-array} to +the corresponding Lisp string. The contents of @var{byte-array} should +be the byte sequence of a UTF-8 encoded string. Example: @lisp (dbus-byte-array-to-string '(47 101 116 99 47 104 111 115 116 115)) diff --git a/etc/NEWS b/etc/NEWS index c2c510f2f93..30b1cceb2cb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1775,9 +1775,15 @@ Instead, use 'eshell-process-wait-time', which supports floating-point values. +++ -** 'dbus-{string-to-byte-array,byte-array-to-string}' are strict UTF-8 conform. -Both work over UTF-8 raw bytes only. The optional parameter MULTIBYTE -of 'dbus-byte-array-to-string' is obsolete now. +** Conversion of strings to and from byte-arrays works with multibyte strings. +The functions 'dbus-string-to-byte-array' and +'dbus-byte-array-to-string}' now accept and return multibyte Lisp +strings, encoding to UTF-8 and decoding from UTF-8 internally. This +means that the argument to 'dbus-byte-array-to-string' must be a valid +UTF-8 byte sequence, and the optional parameter MULTIBYTE of +'dbus-byte-array-to-string' is now obsolete and unused. The argument of +'dbus-string-to-byte-array' should be a regular Lisp string, not a +unibyte string. * Lisp Changes in Emacs 30.1 diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 31a5eae5182..dd5f0e88859 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -995,7 +995,7 @@ association to the service from D-Bus." (defun dbus-string-to-byte-array (string) "Transform STRING to list (:array :byte C1 :byte C2 ...). The resulting byte array contains the raw bytes of the UTF-8 encoded -STRING.." +STRING." (if (length= string 0) '(:array :signature "y") (cons :array @@ -1004,9 +1004,10 @@ STRING.." (encode-coding-string string 'utf-8 'nocopy)))))) (defun dbus-byte-array-to-string (byte-array &optional _multibyte) - "Transform BYTE-ARRAY into UTF-8 coded string. + "Transform BYTE-ARRAY with UTF-8 byte sequence into a string. BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte array as -produced by `dbus-string-to-byte-array'." +produced by `dbus-string-to-byte-array', and the individual bytes must +be a valid UTF-8 byte sequence." (declare (advertised-calling-convention (byte-array) "30.1")) (if-let ((bytes (seq-filter #'characterp byte-array)) (string (apply #'unibyte-string bytes))) From 2fc7e21f5e75ea6b00d6f7344335f44f5663d955 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 12 Apr 2024 15:51:26 +0200 Subject: [PATCH 014/149] ; * etc/NEWS: Fix typo. --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 30b1cceb2cb..ed5db3a01a3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1777,7 +1777,7 @@ values. +++ ** Conversion of strings to and from byte-arrays works with multibyte strings. The functions 'dbus-string-to-byte-array' and -'dbus-byte-array-to-string}' now accept and return multibyte Lisp +'dbus-byte-array-to-string' now accept and return multibyte Lisp strings, encoding to UTF-8 and decoding from UTF-8 internally. This means that the argument to 'dbus-byte-array-to-string' must be a valid UTF-8 byte sequence, and the optional parameter MULTIBYTE of From 414f8d02c1a361fa780e55fcf0f260fe00a9a62d Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 12 Apr 2024 19:35:55 +0300 Subject: [PATCH 015/149] New user option 'tab-line-tabs-buffer-group-function' * lisp/tab-line.el (tab-line-tabs-buffer-group-function): Turn defvar into defcustom with the default value 'tab-line-tabs-buffer-group-by-mode'. (tab-line-tabs-buffer-group-by-mode): New function with body from 'tab-line-tabs-buffer-group-name'. (tab-line-tabs-buffer-group-by-project): New function. (tab-line-tabs-buffer-groups): Use fallback name "No group" instead of "All". --- etc/NEWS | 5 +++++ lisp/tab-line.el | 55 ++++++++++++++++++++++++++++++++++++------------ 2 files changed, 47 insertions(+), 13 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ed5db3a01a3..da809096d94 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -364,6 +364,11 @@ By default it contains a keybinding 'C-TAB' to switch tabs, but only when 'C-TAB' is not bound globally. You can unbind it if it conflicts with 'C-TAB' in other modes. +--- +*** New user option 'tab-line-tabs-buffer-group-function'. +It provides two choices to group tab buffers by major mode +and by project name. + +++ ** New optional argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and diff --git a/lisp/tab-line.el b/lisp/tab-line.el index fd18e7b7909..54e9ee16243 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -342,8 +342,7 @@ returns a list of buffers associated with the selected window. When `tab-line-tabs-mode-buffers', return a list of buffers with the same major mode as the current buffer. When `tab-line-tabs-buffer-groups', return a list of buffers -grouped either by `tab-line-tabs-buffer-group-function', when set, -or by `tab-line-tabs-buffer-groups'." +grouped by `tab-line-tabs-buffer-group-function'." :type '(choice (const :tag "Window buffers" tab-line-tabs-window-buffers) (const :tag "Same mode buffers" @@ -377,10 +376,29 @@ Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.") (derived-mode-p mode))) (funcall tab-line-tabs-buffer-list-function))))) -(defvar tab-line-tabs-buffer-group-function nil +(defcustom tab-line-tabs-buffer-group-function + #'tab-line-tabs-buffer-group-by-mode "Function to add a buffer to the appropriate group of tabs. Takes a buffer as arg and should return a group name as a string. -If the return value is nil, the buffer should be filtered out.") +If the return value is nil, the buffer has no group, so \"No group\" +is displayed instead of a group name and the buffer is not grouped +together with other buffers. +If the value is `tab-line-tabs-buffer-group-by-mode', +use mode-to-group mappings in `tab-line-tabs-buffer-groups' +to group by major mode. If the value is +`tab-line-tabs-buffer-group-by-project' use the project name +as a group name." + :type '(choice (const :tag "Group by mode" + tab-line-tabs-buffer-group-by-mode) + (const :tag "Group by project name" + tab-line-tabs-buffer-group-by-project) + (function :tag "Custom function")) + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (force-mode-line-update)) + :group 'tab-line + :version "30.1") (defvar tab-line-tabs-buffer-group-sort-function nil "Function to sort buffers in a group.") @@ -395,16 +413,27 @@ If the major mode's name matches REGEXP, it belongs to GROUPNAME. The default is for each major mode to have a separate group named the same as the mode.") +(defun tab-line-tabs-buffer-group-by-mode (&optional buffer) + "Group tab buffers by major mode." + (let ((mode (if buffer (with-current-buffer buffer + (format-mode-line mode-name)) + (format-mode-line mode-name)))) + (or (cdr (seq-find (lambda (group) + (string-match-p (car group) mode)) + tab-line-tabs-buffer-groups)) + mode))) + +(declare-function project-name "project" (project)) +(defun tab-line-tabs-buffer-group-by-project (&optional buffer) + "Group tab buffers by project name." + (with-current-buffer buffer + (if-let ((project (project-current))) + (project-name project) + "No project"))) + (defun tab-line-tabs-buffer-group-name (&optional buffer) (if (functionp tab-line-tabs-buffer-group-function) - (funcall tab-line-tabs-buffer-group-function buffer) - (let ((mode (if buffer (with-current-buffer buffer - (format-mode-line mode-name)) - (format-mode-line mode-name)))) - (or (cdr (seq-find (lambda (group) - (string-match-p (car group) mode)) - tab-line-tabs-buffer-groups)) - mode)))) + (funcall tab-line-tabs-buffer-group-function buffer))) (defun tab-line-tabs-buffer-groups () "Return a list of tabs that should be displayed in the tab line. @@ -436,7 +465,7 @@ generate the group name." (let* ((window-parameter (window-parameter nil 'tab-line-group)) (group-name (tab-line-tabs-buffer-group-name (current-buffer))) - (group (prog1 (or window-parameter group-name "All") + (group (prog1 (or window-parameter group-name "No group") (when (equal window-parameter group-name) (set-window-parameter nil 'tab-line-group nil)))) (group-tab `(tab From 5bd4d458676c458d6b534ea1c74cf6f0c1899ea6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 12 Apr 2024 19:39:49 +0300 Subject: [PATCH 016/149] * lisp/buff-menu.el: Improve 'Buffer-menu-group-by-mode' (bug#70150). (Buffer-menu-group-by): Replace function-item with const better suitable for Customization UI. (Buffer-menu-group-by-mode): Use 'mouse-buffer-menu-mode-groups' to group buffers by mode. --- lisp/buff-menu.el | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index ec5337e3fda..d59c5b6cf21 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -107,10 +107,10 @@ The default options can group by a mode, and by a root directory of a project or just `default-directory'. If this is nil, buffers are not divided into groups." :type '(choice (const :tag "No grouping" nil) - (function-item :tag "Group by mode" - Buffer-menu-group-by-mode) - (function-item :tag "Group by project root or directory" - Buffer-menu-group-by-root) + (const :tag "Group by mode" + Buffer-menu-group-by-mode) + (const :tag "Group by project root or directory" + Buffer-menu-group-by-root) (function :tag "Custom function")) :group 'Buffer-menu :version "30.1") @@ -798,7 +798,11 @@ See more at `Buffer-menu-filter-predicate'." (t ""))) (defun Buffer-menu-group-by-mode (entry) - (concat "* " (aref (cadr entry) 5))) + (let ((mode (aref (cadr entry) 5))) + (concat "* " (or (cdr (seq-find (lambda (group) + (string-match-p (car group) mode)) + mouse-buffer-menu-mode-groups)) + mode)))) (declare-function project-root "project" (project)) (defun Buffer-menu-group-by-root (entry) From 648b7bf7e22577c2f917e389694a76ce1f42dc0e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Apr 2024 13:28:45 -0400 Subject: [PATCH 017/149] (emacs-lisp-mode-syntax-table): Fix bug#24542 * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-syntax-table): Remove `p` from the flags of `@`. --- lisp/progmodes/elisp-mode.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 3383841391d..84814c9eaac 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -40,9 +40,10 @@ It has `lisp-mode-abbrev-table' as its parent." (defvar emacs-lisp-mode-syntax-table (let ((table (make-syntax-table lisp-data-mode-syntax-table))) - ;; These are redundant, now. - ;;(modify-syntax-entry ?\[ "(] " table) - ;;(modify-syntax-entry ?\] ")[ " table) + ;; Remove the "p" flag from the entry of `@' because we use instead + ;; `syntax-propertize' to take care of `,@', which is more precise. + ;; FIXME: We should maybe do the same in other Lisp modes? (bug#24542) + (modify-syntax-entry ?@ "_" table) table) "Syntax table used in `emacs-lisp-mode'.") From c26261c027ef7594427d477208b8126d6e4982bd Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 12 Apr 2024 13:14:29 -0700 Subject: [PATCH 018/149] rcs2log now groks add-log-time-zone rule * lib-src/rcs2log (extractTZ): Adjust to renaming of change-log-time-zone-rule to add-log-time-zone rule, by allowing either spelling. --- lib-src/rcs2log | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib-src/rcs2log b/lib-src/rcs2log index 61301e7246d..94234d01c98 100755 --- a/lib-src/rcs2log +++ b/lib-src/rcs2log @@ -261,10 +261,10 @@ case $rlogfile in if test -s "$changelog" then extractTZ=' - /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*"\([^"]*\)".*/{ + /^.*-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*"\([^"]*\)".*/{ s//\1/; p; q } - /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*t.*/{ + /^.*-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*t.*/{ s//UTC0/; p; q } ' From e8adb8cf5a51ef172fb07786b71e3140b9358764 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Apr 2024 21:54:53 -0400 Subject: [PATCH 019/149] (elisp-tests-syntax-propertize): New test for bug#24542 * test/lisp/progmodes/elisp-mode-tests.el (elisp-tests-syntax-propertize): New test. --- test/lisp/progmodes/elisp-mode-tests.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 1d1ef9981e5..591c32a8271 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1131,5 +1131,14 @@ evaluation of BODY." (emacs-lisp-mode) (indent-region (point-min) (point-max))))) +(ert-deftest elisp-tests-syntax-propertize () + (with-temp-buffer + (emacs-lisp-mode) + (insert "(a '@)") ;bug#24542 + (should (equal (scan-sexps (+ (point-min) 3) 1) (1- (point-max)))) + (erase-buffer) + (insert "(a ,@)") + (should-error (scan-sexps (+ (point-min) 3) 1)))) + (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here From 4fc37710788cdab9ebf4264636999ba999a59547 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Apr 2024 11:28:23 +0800 Subject: [PATCH 020/149] Fix task-switching failures on Android 2.3 * java/org/gnu/emacs/EmacsWindowManager.java (registerWindow): Don't specify F_A_MULTIPLE_TASK on Android 4.4 and earlier. --- java/org/gnu/emacs/EmacsWindowManager.java | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/java/org/gnu/emacs/EmacsWindowManager.java b/java/org/gnu/emacs/EmacsWindowManager.java index e41b4e068a7..a193d49d0ec 100644 --- a/java/org/gnu/emacs/EmacsWindowManager.java +++ b/java/org/gnu/emacs/EmacsWindowManager.java @@ -176,14 +176,20 @@ && isWindowEligible (consumer, window)) intent = new Intent (EmacsService.SERVICE, EmacsMultitaskActivity.class); - intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK - | Intent.FLAG_ACTIVITY_MULTIPLE_TASK); + /* FLAG_ACTIVITY_MULTIPLE_TASK would appear appropriate, but that + is not so: on Android 2.3 and earlier, this flag combined with + FLAG_ACTIVITY_NEW_TASK prompts the task switcher to create a + new instance of EmacsMultitaskActivity, rather than return to + an existing instance, and is entirely redundant, inasmuch as + only one multitasking task can exist at any given moment. */ + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK); /* Intent.FLAG_ACTIVITY_NEW_DOCUMENT is lamentably unavailable on older systems than Lolipop. */ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP) { - intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT); + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT + | Intent.FLAG_ACTIVITY_MULTIPLE_TASK); /* Bind this window to the activity in advance, i.e., before its creation, so that its ID will be recorded in the RecentTasks From 71f8b2c3242b9b9455e9c6f25ad99ea900a1422f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Apr 2024 10:52:55 +0300 Subject: [PATCH 021/149] Fix Icalendar export with ISO dates * lisp/calendar/icalendar.el (icalendar--datestring-to-isodate): Accept dashes in ISO-style numeric dates. Patch by Erwan Hingant . (Bug#69894) * test/lisp/calendar/icalendar-tests.el (icalendar--datestring-to-isodate): Add a test for dashes in ISO-style numeric dates. --- lisp/calendar/icalendar.el | 4 ++-- test/lisp/calendar/icalendar-tests.el | 3 +++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index d7e62e1baf3..95b04969075 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -895,8 +895,8 @@ it uses the current calendar date style." (save-match-data (cond ( ;; iso-style numeric date (string-match (concat "\\s-*" - "\\([0-9]\\{4\\}\\)[ \t/]\\s-*" - "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)[ \t/-]\\s-*" + "0?\\([1-9][0-9]?\\)[ \t/-]\\s-*" "0?\\([1-9][0-9]?\\)") datestring) (setq year (read (substring datestring (match-beginning 1) diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 39ad735a789..32c06cbc533 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -368,6 +368,9 @@ END:VTIMEZONE (icalendar--datestring-to-isodate "2008 05 31"))) (should (string= "20080602" (icalendar--datestring-to-isodate "2008 05 31" 2))) + ;; Bug#69894 + (should (string= "20240319" + (icalendar--datestring-to-isodate "2024-03-19"))) ;; numeric european (setq calendar-date-style 'european) From d5d61618c89899bd082cd29fd81dfb7cd88ea8b8 Mon Sep 17 00:00:00 2001 From: john muhl Date: Wed, 13 Mar 2024 08:35:08 -0500 Subject: [PATCH 022/149] Mark Flymake regions more accurately in 'lua-ts-mode' * lisp/progmodes/lua-ts-mode.el (lua-ts-flymake-luacheck): Use the end position provided by Luacheck rather than relying on 'thing-at-point' to guess where the end should be. (Bug#70167) --- lisp/progmodes/lua-ts-mode.el | 53 +++++++++++++++++------------------ 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 407ef230c32..45ea8ec9a81 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -35,7 +35,6 @@ (require 'treesit) (eval-when-compile - (require 'cl-lib) (require 'rx)) (declare-function treesit-induce-sparse-tree "treesit.c") @@ -544,32 +543,32 @@ Calls REPORT-FN directly." (eq proc lua-ts--flymake-process)) (with-current-buffer (process-buffer proc) (goto-char (point-min)) - (cl-loop - while (search-forward-regexp - (rx (seq bol - (0+ alnum) ":" - (group (1+ digit)) ":" - (group (1+ digit)) "-" - (group (1+ digit)) ": " - (group (0+ nonl)) - eol)) - nil t) - for (beg . end) = (flymake-diag-region - source - (string-to-number (match-string 1)) - (string-to-number (match-string 2))) - for msg = (match-string 4) - for type = (if (string-match "^(W" msg) - :warning - :error) - when (and beg end) - collect (flymake-make-diagnostic source - beg - end - type - msg) - into diags - finally (funcall report-fn diags))) + (let (diags) + (while (search-forward-regexp + (rx bol (0+ alnum) ":" + (group (1+ digit)) ":" + (group (1+ digit)) "-" + (group (1+ digit)) ": " + (group (0+ nonl)) eol) + nil t) + (let* ((beg + (car (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 2))))) + (end + (cdr (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 3))))) + (msg (match-string 4)) + (type (if (string-prefix-p "(W" msg) + :warning + :error))) + (push (flymake-make-diagnostic + source beg end type msg) + diags))) + (funcall report-fn diags))) (flymake-log :warning "Canceling obsolete check %s" proc)) (kill-buffer (process-buffer proc))))))) (process-send-region lua-ts--flymake-process (point-min) (point-max)) From 02e795738b8877f6cf07f5ad2105449d7eb41000 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Apr 2024 11:15:18 +0300 Subject: [PATCH 023/149] ; * src/alloc.c (process_mark_stack): Fix commentary. --- src/alloc.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/alloc.c b/src/alloc.c index 2ffd2415447..6779d0ca9ce 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7421,7 +7421,9 @@ process_mark_stack (ptrdiff_t base_sp) /* If the value is forwarded to a buffer or keyboard field, these are marked when we see the corresponding object. And if it's forwarded to a C variable, either it's not - a Lisp_Object var, or it's staticpro'd already. */ + a Lisp_Object var, or it's staticpro'd already, or it's + reachable from font_style_table which is also + staticpro'd. */ break; default: emacs_abort (); } From 5f6834ab9765943be07dfab6454c37375729f778 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 11 Apr 2024 08:44:46 +0200 Subject: [PATCH 024/149] ; Fix typo in 'help-quick-sections' docstring --- lisp/help.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/help.el b/lisp/help.el index 1ef46e394f3..e23dd8ce0ae 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -173,7 +173,7 @@ Value should be a list of elements, each element should of the form where GROUP-NAME is the name of the group of the commands, COMMAND is the symbol of a command and DESCRIPTION is its short -description, 10 to 15 char5acters at most.") +description, 10 to 15 characters at most.") (declare-function prop-match-value "text-property-search" (match)) From 6c721af9c8ee2229af57491cc2833f6743c8ddab Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 11 Apr 2024 09:00:50 +0200 Subject: [PATCH 025/149] Allow 'help-quick' to use a non-global keymap * lisp/help.el (help-quick-sections): Mention 'help-quick-use-map' in docstring. (help-quick-use-map): Add new variable, defaulting to the global-map. (help-quick): Use new variable. --- lisp/help.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index e23dd8ce0ae..d4e39f04e53 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -171,9 +171,15 @@ Value should be a list of elements, each element should of the form (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...) -where GROUP-NAME is the name of the group of the commands, -COMMAND is the symbol of a command and DESCRIPTION is its short -description, 10 to 15 characters at most.") +where GROUP-NAME is the name of the group of the commands, COMMAND is +the symbol of a command and DESCRIPTION is its short description, 10 to +15 characters at most. The bindings for COMMAND are looked up from the +keymap specified in `help-quick-use-map'.") + +(defvar help-quick-use-map global-map + "Keymap that `help-quick' should use to lookup bindings. +Avoid changing the global value of this variable. Instead bind a +different map dynamically.") (declare-function prop-match-value "text-property-search" (match)) @@ -193,7 +199,7 @@ the documentation of the command bound to that key sequence." (let ((max-key-len 0) (max-cmd-len 0) keys) (dolist (ent (reverse (cdr section))) (catch 'skip - (let* ((bind (where-is-internal (car ent) nil t)) + (let* ((bind (where-is-internal (car ent) help-quick-use-map t)) (key (if bind (propertize (key-description bind) From f0300fb0597225762ac6e62eeec4e223a7ad1df9 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 13 Apr 2024 10:36:50 +0200 Subject: [PATCH 026/149] ; Tweak "(emacs)Bug Reference" formatting/wording. --- doc/emacs/maintaining.texi | 51 ++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 14bdbc57f14..b22aa018292 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3333,29 +3333,30 @@ merge requests resulting in different URLs. @vindex bug-reference-auto-setup-functions If @code{bug-reference-mode} is activated, -@code{bug-reference-mode-hook} has been run and still -@code{bug-reference-bug-regexp}, and @code{bug-reference-url-format} -aren't both set, it'll try to setup suitable values for these two -variables itself by calling the functions in -@code{bug-reference-auto-setup-functions} one after the other until -one is able to set the variables. +@code{bug-reference-mode-hook} has been run, and either +@code{bug-reference-bug-regexp} or @code{bug-reference-url-format} is +still @code{nil}, the mode will try to automatically find a suitable +value for these two variables by calling the functions in +@code{bug-reference-auto-setup-functions} one by one until one +succeeds. @vindex bug-reference-setup-from-vc-alist @vindex bug-reference-forge-alist @vindex bug-reference-setup-from-mail-alist @vindex bug-reference-setup-from-irc-alist - Right now, there are three types of setup functions. +Right now, there are three types of setup functions. + @enumerate @item Setup for version-controlled files configurable by the variables @code{bug-reference-forge-alist}, and @code{bug-reference-setup-from-vc-alist}. The defaults are able to -setup GNU projects where @url{https://debbugs.gnu.org} is used as +set up GNU projects where @url{https://debbugs.gnu.org} is used as issue tracker and issues are usually referenced as @code{bug#13} (but -many different notations are considered, too), and several kinds of -modern software forges such as GitLab, Gitea, SourceHut, or GitHub. -If you deploy a self-hosted instance of such a forge, the easiest way -to tell bug-reference about it is through +many different notations are considered, too), as well as several +other kinds of software forges such as GitLab, Gitea, SourceHut, and +GitHub. If you deploy a self-hosted instance of such a forge, the +easiest way to tell bug-reference about it is through @code{bug-reference-forge-alist}. @item @@ -3372,7 +3373,7 @@ Rcirc, @xref{Top, Rcirc,, rcirc, The Rcirc Manual}, and ERC, @end enumerate For almost all of those modes, it's enough to simply enable -@code{bug-reference-mode}, only Rmail requires a slightly different +@code{bug-reference-mode}; only Rmail requires a slightly different setup. @smallexample @@ -3403,33 +3404,35 @@ to be performed whenever another messages is displayed. @heading Adding support for third-party packages @vindex bug-reference-auto-setup-functions -Adding support for bug-reference' auto-setup is usually quite -straight-forward: write a setup function of zero arguments which +Adding support for bug-reference auto-setup is usually quite +straightforward: write a setup function of zero arguments which gathers the required information (e.g., List-Id/To/From/Cc mail header values in the case of a MUA), and then calls one of the following helper functions: + @itemize @bullet @item -@code{bug-reference-maybe-setup-from-vc} which does the setup -according to @code{bug-reference-setup-from-vc-alist}, +@code{bug-reference-maybe-setup-from-vc}, which does the setup +according to @code{bug-reference-setup-from-vc-alist}; @item -@code{bug-reference-maybe-setup-from-mail} which does the setup -according to @code{bug-reference-setup-from-mail-alist}, +@code{bug-reference-maybe-setup-from-mail}, which does the setup +according to @code{bug-reference-setup-from-mail-alist}; and @item -and @code{bug-reference-maybe-setup-from-irc} which does the setup +@code{bug-reference-maybe-setup-from-irc}, which does the setup according to @code{bug-reference-setup-from-irc-alist}. @end itemize -A setup function should return non-@code{nil} if it could setup bug-reference -mode which is the case if the last thing the function does is calling -one of the helper functions above. + +A setup function should return non-@code{nil} if it could set up +bug-reference mode, which is the case if the last thing the function +does is call one of the helper functions above. Finally, the setup function has to be added to @code{bug-reference-auto-setup-functions}. Note that these auto-setup functions should check as a first step if -they are applicable, e.g., by checking the @code{major-mode} value. +they are applicable, e.g., by checking the value of @code{major-mode}. @heading Integration with the debbugs package From 8b210a636fe426f47bccdb111af61d6310755dde Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Apr 2024 11:52:57 +0300 Subject: [PATCH 027/149] ; Improve documentation of tree-sitter "things" * doc/lispref/parsing.texi (User-defined Things): Fix text, punctuation, and markup. (Tree-sitter Major Modes): Add the missing "things" reference. * etc/NEWS: Fix "thing"-related entries. --- doc/lispref/parsing.texi | 142 +++++++++++++++++++++------------------ etc/NEWS | 34 +++++----- 2 files changed, 96 insertions(+), 80 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 49db6585e88..55ba10bb41b 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1522,43 +1522,46 @@ pattern-matching, which can be found at @node User-defined Things @section User-defined ``Things'' and Navigation -It's often useful to be able to identify and find certain ``things'' in +@cindex user-defined things, with tree-sitter parsing + +It's often useful to be able to identify and find certain @dfn{things} in a buffer, like function and class definitions, statements, code blocks, strings, comments, etc. Emacs allows users to define what kind of -tree-sitter node are what ``thing''. This enables handy features like -jumping to the next function, marking the code block at point, or -transposing two function arguments. +tree-sitter node corresponds to a ``thing''. This enables handy +features like jumping to the next function, marking the code block at +point, or transposing two function arguments. The ``things'' feature in Emacs is independent of the pattern matching -feature of tree-sitter, comparatively less powerful, but more suitable -for navigation and traversing the parse tree. +feature of tree-sitter, and comparatively less powerful, but more +suitable for navigation and traversing the parse tree. -Users can define things with @var{treesit-thing-settings}. +You can define things with @var{treesit-thing-settings}. @defvar treesit-thing-settings This is an alist of thing definitions for each language. The key of each entry is a language symbol, and the value is a list of thing -definitions of the form @w{@code{(@var{thing} @var{pred})}}. - +definitions of the form @w{@code{(@var{thing} @var{pred})}}, where @var{thing} is a symbol representing the thing, like @code{defun}, -@code{sexp}, or @code{sentence}; @var{pred} specifies what kind of -tree-sitter node is the @var{thing}. +@code{sexp}, or @code{sentence}; and @var{pred} specifies what kind of +tree-sitter node is this @var{thing}. @var{pred} can be a regexp string that matches the type of the node; it can be a function that takes a node as the argument and returns a -boolean that indicates whether the node qualifies as the thing; it can +boolean that indicates whether the node qualifies as the thing; or it can be a cons @w{@code{(@var{regexp} . @var{fn})}}, which is a combination -of a regexp and a function---the node has to match both to qualify as the -thing. +of a regular expression @var{regexp} and a function @var{fn}---the node +has to match both the @var{regexp} and to satisfy @var{fn} to qualify as +the thing. @var{pred} can also be recursively defined. It can be @w{@code{(or -@var{pred}...)}}, meaning satisfying any one of the @var{pred}s +@var{pred}@dots{})}}, meaning that satisfying any one of the @var{pred}s qualifies the node as the thing. It can be @w{@code{(not @var{pred})}}, -meaning not satisfying @var{pred} qualifies the node. +meaning that not satisfying @var{pred} qualifies the node. Finally, @var{pred} can refer to other @var{thing}s defined in this list. For example, @w{@code{(or sexp sentence)}} defines something -that's either a @code{sexp} or a @code{sentence}. +that's either a @code{sexp} thing or a @code{sentence} thing, as defined +by some other rule in the alist. Here's an example @var{treesit-thing-settings} for C and C++: @@ -1577,73 +1580,74 @@ Here's an example @var{treesit-thing-settings} for C and C++: @end group @end example -Note that this example is modified for demonstration and isn't exactly -how C and C++ mode define things. +@noindent +Note that this example is modified for didactical purposes, and isn't +exactly how C and C@t{++} modes define things. @end defvar -The next section lists a few functions that take advantage of the thing -definitions. Besides these functions, some other functions listed -elsewhere also utilizes the thing feature, e.g., tree-traversing -functions like @code{treesit-search-forward}, -@code{treesit-induce-sparse-tree}, etc. +The rest of this section lists a few functions that take advantage of +the thing definitions. Besides the functions below, some other +functions listed elsewhere also utilize the thing feature, e.g., +tree-traversing functions like @code{treesit-search-forward}, +@code{treesit-induce-sparse-tree}, etc. @xref{Retrieving Nodes}. -@defun treesit-thing-prev pos thing -This function returns the first node before @var{pos} that's a -@var{thing}. If no such node exists, it returns @code{nil}. It's -guaranteed that, if a node is returned, the node's end position is less -or equal to @var{pos}. In other words, this function never return a -node that encloses @var{pos}. +@defun treesit-thing-prev position thing +This function returns the first node before @var{position} that is the +specified @var{thing}. If no such node exists, it returns @code{nil}. +It's guaranteed that, if a node is returned, the node's end position is +less or equal to @var{position}. In other words, this function never +returns a node that encloses @var{position}. @var{thing} can be either a thing symbol like @code{defun}, or simply a thing definition like @code{"function_definition"}. @end defun -@defun treesit-thing-next pos thing -This function is similar to @code{treesit-thing-prev}, only that it -returns the first node @emph{after} @var{pos} that's a @var{thing}. And -it guarantees that if a node is returned, the node's start position is -be greater or equal to @var{pos}. +@defun treesit-thing-next position thing +This function is similar to @code{treesit-thing-prev}, only it returns +the first node @emph{after} @var{position} that's the @var{thing}. It +also guarantees that if a node is returned, the node's start position is +greater or equal to @var{position}. @end defun -@defun treesit-navigate-thing pos arg side thing &optional tactic +@defun treesit-navigate-thing position arg side thing &optional tactic This function builds upon @code{treesit-thing-prev} and @code{treesit-thing-next} and provides functionality that a navigation -command would find useful. +command would find useful. It returns the position after moving across +@var{arg} instances of @var{thing} from @var{position}. If +there aren't enough things to navigate across, it returns nil. The +function doesn't move point. -It returns the position after navigating @var{arg} steps from @var{pos}, -without actually moving point. If there aren't enough things to -navigate across, it returns nil. - -A positive @var{arg} means moving forward that many steps; negative -means moving backward. If @var{side} is @code{beg}, this function stops -at the beginning of the thing; if @code{end}, stop at the end. +A positive @var{arg} means moving forward that many instances of +@var{thing}; negative @var{arg} means moving backward. If @var{side} is +@code{beg}, this function stops at the beginning of @var{thing}; if +@code{end}, stop at the end of @var{thing}. Like in @code{treesit-thing-prev}, @var{thing} can be a thing symbol defined in @var{treesit-thing-settings}, or a thing definition. -@var{tactic} determines how does this function move between things. -@var{tactic} can be @code{nested}, @code{top-level}, @code{restricted}, -or @code{nil}. @code{nested} or @code{nil} means normal nested -navigation: first try to move across siblings; if there aren't any -siblings left in the current level, move to the parent, then it's -siblings, and so on. @code{top-level} means only navigate across -top-level things and ignore nested things. @code{restricted} means -movement is restricted within the thing that encloses @var{pos}, if -there is one such thing. This tactic is useful for the commands that -want to stop at the current nest level and not move up. +@var{tactic} determines how this function moves between things. It can +be @code{nested}, @code{top-level}, @code{restricted}, or @code{nil}. +@code{nested} or @code{nil} means normal nested navigation: first try to +move across siblings; if there aren't any siblings left in the current +level, move to the parent, then its siblings, and so on. +@code{top-level} means only navigate across top-level things and ignore +nested things. @code{restricted} means movement is restricted within +the thing that encloses @var{position}, if there is such a thing. This +tactic is useful for commands that want to stop at the current nesting +level and not move up. @end defun -@defun treesit-thing-at pos thing &optional strict -This function returns the smallest node that's a @var{thing} and -encloses @var{pos}; if there's no such node, return nil. +@defun treesit-thing-at position thing &optional strict +This function returns the smallest node that's the @var{thing} and +encloses @var{position}; if there's no such node, it returns @code{nil}. -The returned node must enclose @var{pos}, i.e., its start position is -less or equal to @var{pos}, and it's end position is greater or equal to -@var{pos}. +The returned node must enclose @var{position}, i.e., its start position is +less or equal to @var{position}, and it's end position is greater or equal to +@var{position}. If @var{strict} is non-@code{nil}, this function uses strict comparison, -i.e., start position must be strictly greater than @var{pos}, and end -position must be strictly less than @var{pos}. +i.e., start position must be strictly greater than @var{position}, and end +position must be strictly less than @var{position}. @var{thing} can be either a thing symbol defined in @var{treesit-thing-settings}, or a thing definition. @@ -1654,14 +1658,15 @@ position must be strictly less than @var{pos}. @findex treesit-thing-at-point There are also some convenient wrapper functions. @code{treesit-beginning-of-thing} moves point to the beginning of a -thing, @code{treesit-beginning-of-thing} to the end of a thing. +thing, @code{treesit-end-of-thing} moves to the end of a thing, and @code{treesit-thing-at-point} returns the thing at point. -There are defun commands that specifically use the @code{defun} +There are also defun commands that specifically use the @code{defun} definition, like @code{treesit-beginning-of-defun}, @code{treesit-end-of-defun}, and @code{treesit-defun-at-point}. In addition, these functions use @var{treesit-defun-tactic} as the -navigation tactic. They are described in more detail in other sections. +navigation tactic. They are described in more detail in other sections +(@pxref{Tree-sitter Major Modes}). @node Multiple Languages @section Parsing Text in Multiple Languages @@ -2056,6 +2061,13 @@ non-@code{nil}, it sets up Imenu. @item If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is non-@code{nil}, it sets up Outline minor mode. + +@item +If @code{sexp} and/or @code{sentence} are defined in +@code{treesit-thing-settings} (@pxref{User-defined Things}), it enables +navigation commands that move, respectively, by sexps and sentences by +defining variables such as @code{forward-sexp-function} and +@code{forward-sentence-function}. @end itemize @c TODO: Add treesit-thing-settings stuff once we finalize it. diff --git a/etc/NEWS b/etc/NEWS index da809096d94..e90c439d26c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2411,34 +2411,38 @@ correctly UTF-8 encoded. *** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. -** New tree-sitter functions and variables for defining and using "things" +** New tree-sitter functions and variables for defining and using "things". +++ *** New variable 'treesit-thing-settings'. - -New variable that allows users to define "things" like 'defun', 'text', -'sexp', for navigation commands and tree-traversal functions. +It allows modes to define "things" like 'defun', 'text', 'sexp', and +'sentence' for navigation commands and tree-traversal functions. +++ -*** New navigation functions 'treesit-thing-prev', 'treesit-thing-next', 'treesit-navigate-thing', 'treesit-beginning-of-thing', 'treesit-end-of-thing'. +*** New functions for navigating "things". +There are new navigation functions 'treesit-thing-prev', +'treesit-thing-next', 'treesit-navigate-thing', +'treesit-beginning-of-thing', and 'treesit-end-of-thing'. +++ *** New functions 'treesit-thing-at', 'treesit-thing-at-point'. +++ -*** Tree-tarversing functions 'treesit-search-subtree', 'treesit-search-forward', 'treesit-search-forward-goto', 'treesit-induce-sparse-tree' now accepts more kinds of predicates. - -Now users can use thing symbols (defined in 'treesit-thing-settings'), -and any thing definitions for the predicate argument. +*** Tree-traversing functions. +The functions 'treesit-search-subtree', 'treesit-search-forward', +'treesit-search-forward-goto', and 'treesit-induce-sparse-tree' now +accept more kinds of predicates. Lisp programs can now use thing +symbols (defined in 'treesit-thing-settings') and any thing definitions +for the predicate argument. -** Other tree-sitter function and variable changes +** Other tree-sitter function and variable changes. +++ -*** 'treesit-parser-list' now takes additional optional arguments, LANGUAGE and TAG. - -If LANGUAGE is given, only return parsers for that language. If TAG is -given, only return parsers with that tag. Note that passing nil as tag -doesn't mean return all parsers, but rather "all parsers with no tags". +*** 'treesit-parser-list' now takes additional optional arguments. +The additional arguments are LANGUAGE and TAG. If LANGUAGE is given, +only return parsers for that language. If TAG is given, only return +parsers with that tag. Note that passing nil as tag doesn't mean return +all parsers, but rather "all parsers with no tags". * Changes in Emacs 30.1 on Non-Free Operating Systems From 5734047b812639c06c90eb3baf82ff502db59fb5 Mon Sep 17 00:00:00 2001 From: Vladimir Kazanov Date: Sun, 24 Dec 2023 11:13:10 +0000 Subject: [PATCH 028/149] Support tooltips for fringe indicators * src/xdisp.c (note_fringe_highlight): New function. (note_mouse_highlight): Call it when the mouse is on the fringes. * src/frame.c (syms_of_frame) : DEFSYM them. * etc/NEWS: * doc/lispref/text.texi (Special Properties): * doc/lispref/display.texi (Other Display Specs): Document the new properties. * etc/TODO: Remove the todo item about this. --- doc/lispref/display.texi | 4 +++ doc/lispref/text.texi | 9 ++++++ etc/NEWS | 6 ++++ etc/TODO | 4 --- src/frame.c | 2 ++ src/xdisp.c | 61 ++++++++++++++++++++++++++++++++++++++-- 6 files changed, 80 insertions(+), 6 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index f82c2fad14d..fd083083fd2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5501,6 +5501,10 @@ specification. The optional @var{face} specifies the face whose colors are to be used for the bitmap display. @xref{Fringe Bitmaps}, for the details. +It also possible to add context help for fringe bitmaps through the +@code{show-help-function} mechanism by using @code{left-fringe-help} or +@code{right-fringe-help} text properties (@pxref{Special Properties}). + @item (space-width @var{factor}) This display specification affects all the space characters within the text that has the specification. It displays all of these spaces diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 18f0ee88fe5..3db82df49b3 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3663,6 +3663,15 @@ non-@code{nil} @code{help-echo-inhibit-substitution} property, then it is displayed as-is by @code{show-help-function}, without being passed through @code{substitute-command-keys}. +@item left-fringe-help +@itemx right-fringe-help +@cindex help-echo text on fringes +If any visible text of a buffer line has @code{left-fringe-help} or +@code{right-fringe-help} string text property defined on it, then the +string will be displayed for a corresponding line's fringe through +@code{show-help-function} (@pxref{Help display}). This is useful when +used together with fringe cursors and bitmaps (@pxref{Fringes}). + @item keymap @cindex keymap of character @kindex keymap @r{(text property)} diff --git a/etc/NEWS b/etc/NEWS index e90c439d26c..97cac373750 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1847,6 +1847,12 @@ the handler code without unwinding the stack, such that we can record the backtrace and other dynamic state at the point of the error. See the Info node "(elisp) Handling Errors". ++++ +** Tooltips on fringes. +It is now possible to provide tooltips on fringes by adding special text +properties. See the "Special Properties" Info node in the Emacs Lisp +Reference Manual. + +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes diff --git a/etc/TODO b/etc/TODO index 52c77ccc28d..21b504ad18b 100644 --- a/etc/TODO +++ b/etc/TODO @@ -172,10 +172,6 @@ Change them to use report-emacs-bug. **** lm-report-bug **** tramp-bug **** c-submit-bug-report - -** Allow fringe indicators to display a tooltip -Provide a help-echo property? - ** Add a defcustom that supplies a function to name numeric backup files Like 'make-backup-file-name-function' for non-numeric backup files. diff --git a/src/frame.c b/src/frame.c index abd6ef00901..ff99b0353af 100644 --- a/src/frame.c +++ b/src/frame.c @@ -6383,6 +6383,7 @@ syms_of_frame (void) DEFSYM (Qchild_frame_border_width, "child-frame-border-width"); DEFSYM (Qinternal_border_width, "internal-border-width"); DEFSYM (Qleft_fringe, "left-fringe"); + DEFSYM (Qleft_fringe_help, "left-fringe-help"); DEFSYM (Qline_spacing, "line-spacing"); DEFSYM (Qmenu_bar_lines, "menu-bar-lines"); DEFSYM (Qtab_bar_lines, "tab-bar-lines"); @@ -6390,6 +6391,7 @@ syms_of_frame (void) DEFSYM (Qname, "name"); DEFSYM (Qright_divider_width, "right-divider-width"); DEFSYM (Qright_fringe, "right-fringe"); + DEFSYM (Qright_fringe_help, "right-fringe-help"); DEFSYM (Qscreen_gamma, "screen-gamma"); DEFSYM (Qscroll_bar_background, "scroll-bar-background"); DEFSYM (Qscroll_bar_foreground, "scroll-bar-foreground"); diff --git a/src/xdisp.c b/src/xdisp.c index 140d71129f3..b4d57b5b6f2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35730,6 +35730,59 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, } +/* Take proper action when mouse has moved to the window WINDOW, with + window-local x-position X and y-position Y. This is only used for + displaying user-defined fringe indicator help-echo messages. */ + +static void +note_fringe_highlight (Lisp_Object window, int x, int y, + enum window_part part) +{ + if (!NILP (help_echo_string)) + return; + + /* Find a message to display through the help-echo mechanism whenever + the mouse hovers over a fringe indicator. Both text properties and + overlays have to be checked. */ + + /* Check the text property symbol to use. */ + Lisp_Object sym; + if (part == ON_LEFT_FRINGE) + sym = Qleft_fringe_help; + else + sym = Qright_fringe_help; + + /* Translate windows coordinates into a vertical window position. */ + int hpos, vpos, area; + struct window *w = XWINDOW (window); + x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area); + + /* Get to the first glyph of a text row based on the vertical position + of the fringe. */ + struct glyph *glyph = MATRIX_ROW_GLYPH_START(w->current_matrix, vpos); + int glyph_num = MATRIX_ROW_USED(w->current_matrix, vpos); + + /* Check all glyphs while looking for fringe tooltips. */ + + /* NOTE: iterating over glyphs can only find text properties coming + from visible text. This means that zero-length overlays and + invisibile text are NOT inspected. */ + for (;glyph_num; glyph_num--, glyph++) + { + Lisp_Object pos = make_fixnum(glyph->charpos); + Lisp_Object help_echo = Qnil; + + if (STRINGP(glyph->object) || BUFFERP(glyph->object)) + help_echo = get_char_property_and_overlay (pos, sym, glyph->object, NULL); + + if (STRINGP (help_echo)) + { + help_echo_string = help_echo; + break; + } + } +} + /* EXPORT: Take proper action when the mouse has moved to position X, Y on frame F with regards to highlighting portions of display that have @@ -35957,8 +36010,12 @@ note_mouse_highlight (struct frame *f, int x, int y) } else cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; - else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE - || part == ON_VERTICAL_SCROLL_BAR + else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE) + { + cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; + note_fringe_highlight (window, x, y, part); + } + else if (part == ON_VERTICAL_SCROLL_BAR || part == ON_HORIZONTAL_SCROLL_BAR) cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; else From 952f20fabe76c087aa96645389cfd4786fc95380 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Apr 2024 14:20:16 +0300 Subject: [PATCH 029/149] ; Fix documentation of last change. * etc/NEWS: * doc/lispref/display.texi (Other Display Specs): * doc/lispref/text.texi (Special Properties): Fix last changes. --- doc/lispref/display.texi | 2 +- doc/lispref/text.texi | 11 ++++++----- etc/NEWS | 5 +++-- src/window.c | 2 +- 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index fd083083fd2..fba15578f4f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5502,7 +5502,7 @@ colors are to be used for the bitmap display. @xref{Fringe Bitmaps}, for the details. It also possible to add context help for fringe bitmaps through the -@code{show-help-function} mechanism by using @code{left-fringe-help} or +@code{show-help-function} mechanism by using @code{left-fringe-help} and @code{right-fringe-help} text properties (@pxref{Special Properties}). @item (space-width @var{factor}) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 3db82df49b3..0d247cd9a07 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3666,11 +3666,12 @@ through @code{substitute-command-keys}. @item left-fringe-help @itemx right-fringe-help @cindex help-echo text on fringes -If any visible text of a buffer line has @code{left-fringe-help} or -@code{right-fringe-help} string text property defined on it, then the -string will be displayed for a corresponding line's fringe through -@code{show-help-function} (@pxref{Help display}). This is useful when -used together with fringe cursors and bitmaps (@pxref{Fringes}). +If any visible text of a screen line has the @code{left-fringe-help} or +@code{right-fringe-help} text property whose value is a string, then +that string will be displayed when the mouse pointer hovers over the +corresponding line's fringe through @code{show-help-function} +(@pxref{Help display}). This is useful when used together with fringe +cursors and bitmaps (@pxref{Fringes}). @item keymap @cindex keymap of character diff --git a/etc/NEWS b/etc/NEWS index 97cac373750..51ecd886593 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1850,8 +1850,9 @@ the Info node "(elisp) Handling Errors". +++ ** Tooltips on fringes. It is now possible to provide tooltips on fringes by adding special text -properties. See the "Special Properties" Info node in the Emacs Lisp -Reference Manual. +properties 'left-fringe-help' and 'right-fringe-help'. See the "Special +Properties" Info node in the Emacs Lisp Reference Manual for more +details. +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. diff --git a/src/window.c b/src/window.c index fe26311fbb2..0945b244319 100644 --- a/src/window.c +++ b/src/window.c @@ -5407,13 +5407,13 @@ shrink_mini_window (struct window *w) eassert (MINI_WINDOW_P (w)); + FRAME_WINDOWS_FROZEN (f) = false; if (delta > 0) { Lisp_Object root = FRAME_ROOT_WINDOW (f); struct window *r = XWINDOW (root); Lisp_Object grow; - FRAME_WINDOWS_FROZEN (f) = false; grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (delta), Qt); From 9fc698479feef6fa660ff13e21619ea50bd404df Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Apr 2024 19:43:40 +0800 Subject: [PATCH 030/149] Fix crash upon call to Fset_fontset_font after X server disconnect * src/image.c (free_image): * src/xfaces.c (free_realized_face): Handle scenarios where free_frame_faces is called with the display connection cut. * src/xterm.c (x_free_frame_resources): Call free_frame_faces unconditionally, lest fontsets for this dead frame contaminate Vfontset_list and produce crashes afterwards. (bug#66151) --- src/image.c | 26 +++++++++++++++++++------- src/xfaces.c | 9 +++++++++ src/xterm.c | 15 +++++++++++---- 3 files changed, 39 insertions(+), 11 deletions(-) diff --git a/src/image.c b/src/image.c index 216bdc1ee66..3968145728f 100644 --- a/src/image.c +++ b/src/image.c @@ -1699,14 +1699,26 @@ free_image (struct frame *f, struct image *img) c->images[img->id] = NULL; #if !defined USE_CAIRO && defined HAVE_XRENDER - if (img->picture) - XRenderFreePicture (FRAME_X_DISPLAY (f), img->picture); - if (img->mask_picture) - XRenderFreePicture (FRAME_X_DISPLAY (f), img->mask_picture); -#endif + /* FRAME_X_DISPLAY (f) could be NULL if this is being called from + the display IO error handler.*/ + + if (FRAME_X_DISPLAY (f)) + { + if (img->picture) + XRenderFreePicture (FRAME_X_DISPLAY (f), + img->picture); + if (img->mask_picture) + XRenderFreePicture (FRAME_X_DISPLAY (f), + img->mask_picture); + } +#endif /* !USE_CAIRO && HAVE_XRENDER */ + +#ifdef HAVE_X_WINDOWS + if (FRAME_X_DISPLAY (f)) +#endif /* HAVE_X_WINDOWS */ + /* Free resources, then free IMG. */ + img->type->free_img (f, img); - /* Free resources, then free IMG. */ - img->type->free_img (f, img); xfree (img->face_font_family); xfree (img); } diff --git a/src/xfaces.c b/src/xfaces.c index a558e7328c0..d4583e1a78f 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4569,6 +4569,15 @@ free_realized_face (struct frame *f, struct face *face) /* Free fontset of FACE if it is ASCII face. */ if (face->fontset >= 0 && face == face->ascii_face) free_face_fontset (f, face); + +#ifdef HAVE_X_WINDOWS + /* This function might be called with the frame's display + connection deleted, in which event the callbacks below + should not be executed, as they generate X requests. */ + if (FRAME_X_DISPLAY (f)) + return; +#endif /* HAVE_X_WINDOWS */ + if (face->gc) { block_input (); diff --git a/src/xterm.c b/src/xterm.c index 5e5eb6269e4..e08ffd15b18 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -29428,6 +29428,17 @@ x_free_frame_resources (struct frame *f) xi_unlink_touch_points (f); #endif + /* We must free faces before destroying windows because some + font-driver (e.g. xft) access a window while finishing a face. + + This function must be called to remove this frame's fontsets from + Vfontset_list, and is itself responsible for not issuing X requests + if the connection has already been terminated. Otherwise, a future + call to a function that iterates over all existing fontsets might + crash, as they are not prepared to receive dead frames. + (bug#66151) */ + free_frame_faces (f); + /* If a display connection is dead, don't try sending more commands to the X server. */ if (dpyinfo->display) @@ -29437,10 +29448,6 @@ x_free_frame_resources (struct frame *f) if (f->pointer_invisible) XTtoggle_invisible_pointer (f, 0); - /* We must free faces before destroying windows because some - font-driver (e.g. xft) access a window while finishing a - face. */ - free_frame_faces (f); tear_down_x_back_buffer (f); if (f->output_data.x->icon_desc) From 199351125a4b17081c5ae8056e61aeb3c33650d2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 Apr 2024 14:45:15 +0300 Subject: [PATCH 031/149] ; * src/window.c (shrink_mini_window): Revert inadvertent change. --- src/window.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 0945b244319..fe26311fbb2 100644 --- a/src/window.c +++ b/src/window.c @@ -5407,13 +5407,13 @@ shrink_mini_window (struct window *w) eassert (MINI_WINDOW_P (w)); - FRAME_WINDOWS_FROZEN (f) = false; if (delta > 0) { Lisp_Object root = FRAME_ROOT_WINDOW (f); struct window *r = XWINDOW (root); Lisp_Object grow; + FRAME_WINDOWS_FROZEN (f) = false; grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (delta), Qt); From 66c44c3cd7b37712d5a923966f71a06bbf1fcdb8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 Apr 2024 20:07:17 +0800 Subject: [PATCH 032/149] ; Fix coding style of last change to xdisp.c * src/xdisp.c (note_fringe_highlight): Stylistic edits. --- src/xdisp.c | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 2bc943c88cd..452adee1d31 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35759,21 +35759,22 @@ note_fringe_highlight (Lisp_Object window, int x, int y, /* Get to the first glyph of a text row based on the vertical position of the fringe. */ - struct glyph *glyph = MATRIX_ROW_GLYPH_START(w->current_matrix, vpos); - int glyph_num = MATRIX_ROW_USED(w->current_matrix, vpos); + struct glyph *glyph = MATRIX_ROW_GLYPH_START (w->current_matrix, vpos); + int glyph_num = MATRIX_ROW_USED (w->current_matrix, vpos); /* Check all glyphs while looking for fringe tooltips. */ /* NOTE: iterating over glyphs can only find text properties coming from visible text. This means that zero-length overlays and invisibile text are NOT inspected. */ - for (;glyph_num; glyph_num--, glyph++) + for (; glyph_num; glyph_num--, glyph++) { - Lisp_Object pos = make_fixnum(glyph->charpos); + Lisp_Object pos = make_fixnum (glyph->charpos); Lisp_Object help_echo = Qnil; - if (STRINGP(glyph->object) || BUFFERP(glyph->object)) - help_echo = get_char_property_and_overlay (pos, sym, glyph->object, NULL); + if (STRINGP (glyph->object) || BUFFERP (glyph->object)) + help_echo = get_char_property_and_overlay (pos, sym, + glyph->object, NULL); if (STRINGP (help_echo)) { From f950621e6a177fc3110f3dec7c92b7d499fd25d6 Mon Sep 17 00:00:00 2001 From: Phil Sainty Date: Sun, 14 Apr 2024 00:49:56 +1200 Subject: [PATCH 033/149] ; Additional fixup for truncation of long lines in compilation buffers * lisp/progmodes/compile.el (compilation--insert-abbreviated-line): Handle long lines that end in a newline. (Bug#70236) The fix in commit 8f93cba324e4d4022a9422b8c56186213ba2de8d resulted in the previous "Don't hide the final newline" code causing an off-by-one error. With the new code the value of point is what is wanted in both cases. --- lisp/progmodes/compile.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index d7690b7fa74..b18eb81fee1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2661,10 +2661,7 @@ and runs `compilation-filter-hook'." (line-end-position)) (text-properties-at start))))) (put-text-property - start (if ends-in-nl - ;; Don't hide the final newline. - (1- (point)) - (point)) + start (point) 'display (if (char-displayable-p ?…) "[…]" "[...]")))) (if ends-in-nl (forward-char))))) From d7a83e23d47ca9e3e6ca70078e956e31301e5e6d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 5 Apr 2024 17:37:32 -0400 Subject: [PATCH 034/149] lisp/emacs-lisp/track-changes.el: New file (bug#70077) This new package provides an API that is easier to use right than our `*-change-functions` hooks. The patch includes changes to `diff-mode.el` and `eglot.el` to make use of this new package. * lisp/emacs-lisp/track-changes.el: New file. * test/lisp/emacs-lisp/track-changes-tests.el: New file. * doc/lispref/text.texi (Tracking changes): New subsection. * lisp/progmodes/eglot.el: Require `track-changes`. (eglot--virtual-pos-to-lsp-position): New function. (eglot--track-changes): New var. (eglot--managed-mode): Use `track-changes-register` i.s.o `after/before-change-functions` when available. (eglot--track-changes-signal): New function, partly extracted from `eglot--after-change`. (eglot--after-change): Use it. (eglot--track-changes-fetch): New function. (eglot--signal-textDocument/didChange): Use it. * lisp/vc/diff-mode.el: Require `track-changes`. Also require `easy-mmode` before the `eval-when-compile`s. (diff-unhandled-changes): Delete variable. (diff-after-change-function): Delete function. (diff--track-changes-function): Rename from `diff-post-command-hook` and adjust to new calling convention. (diff--track-changes): New variable. (diff--track-changes-signal): New function. (diff-mode, diff-minor-mode): Use it with `track-changes-register`. --- doc/lispref/text.texi | 148 +++++ etc/NEWS | 18 + lisp/emacs-lisp/track-changes.el | 624 ++++++++++++++++++++ lisp/progmodes/eglot.el | 64 +- lisp/vc/diff-mode.el | 89 ++- test/lisp/emacs-lisp/track-changes-tests.el | 156 +++++ 6 files changed, 1046 insertions(+), 53 deletions(-) create mode 100644 lisp/emacs-lisp/track-changes.el create mode 100644 test/lisp/emacs-lisp/track-changes-tests.el diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 18f0ee88fe5..8774801f41f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -6375,3 +6375,151 @@ hooks during a series of changes (typically for performance reasons), use @code{combine-change-calls} or @code{combine-after-change-calls} instead. @end defvar + +@node Tracking changes +@subsection Tracking changes +@cindex track-changes +@cindex change tracker + +Using @code{before-change-functions} and @code{after-change-functions} +can be difficult in practice because of a number of pitfalls, such as +the fact that the two calls are not always properly paired, or some +calls may be missing, either because some Emacs primitives failed to +properly pair them or because of incorrect use of +@code{inhibit-modification-hooks}. Furthermore, +many restrictions apply to those hook functions, such as the fact that +they basically should never modify the current buffer, nor use an +operation that may block, and they proceed quickly because +some commands may call these hooks a large number of times. + +The Track-Changes library fundamentally provides an alternative API, +built on top of those hooks. Compared to @code{after-change-functions}, +the first important difference is that, instead of providing the bounds +of the change and the previous length, it provides the bounds of the +change and the actual previous content of that region. The need to +extract information from the original contents of the buffer is one of +the main reasons why some packages need to use both +@code{before-change-functions} and @code{after-change-functions} and +then try to match them up. + +The second difference is that it decouples the notification of a change +from the act of processing it, and it automatically combines into +a single change operation all the changes that occur between the first +change and the actual processing. This makes it natural and easy to +process the changes at a larger granularity, such as once per command, +and eliminates most of the restrictions that apply to the usual change +hook functions, making it possible to use blocking operations or to +modify the buffer. + +To start tracking changes, you have to call +@code{track-changes-register}, passing it a @var{signal} function as +argument. This returns a tracker @var{id} which is used to identify +your change tracker to the other functions of the library. +When the buffer is modified, the library calls the @var{signal} +function to inform you of that change and immediately starts +accumulating subsequent changes into a single combined change. +The @var{signal} function serves only to warn that a modification +occurred but does not receive a description of the change. Also the +library will not call it again until after you retrieved the change. + +To retrieve changes, you need to call @code{track-changes-fetch}, which +provides you with the bounds of the changes accumulated since the +last call, as well as the previous content of that region. It also +``re-arms'' the @var{signal} function so that the library will call it +again after the next buffer modification. + +@defun track-changes-register signal &key nobefore disjoint immediate +This function creates a new @dfn{change tracker}. Change trackers are kept +abstract, so we refer to them as mere identities, and the function thus +returns the tracker's @var{id}. + +@var{signal} is a function that the library will call to notify of +a change. It will sometimes call it with a single argument and +sometimes with two. Upon the first change to the buffer since this +tracker last called @code{track-changes-fetch}, the library calls this +@var{signal} function with a single argument holding the @var{id} of +the tracker. + +By default, the call to the @var{signal} function does not happen +immediately, but is instead postponed with a 0 seconds timer +(@pxref{Timers}). This is usually desired to make sure the @var{signal} +function is not called too frequently and runs in a permissive context, +freeing the client from performance concerns or worries about which +operations might be problematic. If a client wants to have more +control, they can provide a non-@code{nil} value as the @var{immediate} +argument in which case the library calls the @var{signal} function +directly from @code{after-change-functions}. Beware that it means that +the @var{signal} function has to be careful not to modify the buffer or +use operations that may block. + +If you're not interested in the actual previous content of the buffer, +but are using this library only for its ability to combine many small +changes into a larger one and to delay the processing to a more +convenient time, you can specify a non-@code{nil} value for the +@var{nobefore} argument. In that case, @code{track-change-fetch} +provides you only with the length of the previous content, just like +@code{after-change-functions}. It also allows the library to save +some work. + +While you may like to accumulate many small changes into larger ones, +you may not want to do that if the changes are too far apart. If you +specify a non-@code{nil} value for the @var{disjoint} argument, the library +will let you know when a change is about to occur ``far'' from the +currently pending ones by calling the @var{signal} function right away, +passing it two arguments this time: the @var{id} of the tracker, and the +number of characters that separates the upcoming change from the +already pending changes. This in itself does not prevent combining this +new change with the previous ones, so if you think the upcoming change +is indeed too far, you need to call @code{track-change-fetch} +right away. +Beware that when the @var{signal} function is called because of +a disjoint change, this happens directly from +@code{before-change-functions}, so the usual restrictions apply about +modifying the buffer or using operations that may block. +@end defun + +@defun track-changes-fetch id func +This is the function that lets you find out what has changed in the +buffer. By providing the tracker @var{id} you let the library figure +out which changes have already been seen by your tracker. Instead of +returning a description of the changes, @code{track-changes-fetch} calls +the @var{func} function with that description in the form of +3 arguments: @var{beg}, @var{end}, and @var{before}, where +@code{@var{beg}..@var{end}} delimit the region that was modified and +@var{before} describes the previous content of that region. +Usually @var{before} is a string containing the previous text of the +modified region, but if you specified a non-@code{nil} @var{nobefore} argument +to @code{track-changes-register}, then it is replaced by the number of +characters of that previous text. + +In case no changes occurred since the last call, +@code{track-changes-fetch} simply does not call @var{func} and returns +@code{nil}. If changes did occur, it calls @var{func} and returns the value +returned by @var{func}. But note that @var{func} is called just once +regardless of how many changes occurred: those are summarized into +a single @var{beg}/@var{end}/@var{before} triplet. + +In some cases, the library is not properly notified of all changes, +for example because of a bug in the low-level C code or because of an +improper use of @code{inhibit-modification-hooks}. When it detects such +a problem, @var{func} receives a @code{@var{beg}..@var{end}} region +which covers the whole buffer and the @var{before} argument is the +symbol @code{error} to indicate that the library was unable to determine +what was changed. + +Once @var{func} finishes, @code{track-changes-fetch} re-enables the +@var{signal} function so that it will be called the next time a change +occurs. This is the reason why it calls @var{func} instead of returning +a description: it lets you process the change without worrying about the +risk that the @var{signal} function gets triggered in the middle of it, +because the @var{signal} is re-enabled only after @var{func} finishes. +@end defun + +@defun track-changes-unregister id +This function tells the library that the tracker @var{id} does not need +to know about buffer changes any more. Most clients will never want to +stop tracking changes, but for clients such as minor modes, it is +important to call this function when the minor mode is disabled, +otherwise the tracker will keep accumulating changes and consume more +and more resources. +@end defun diff --git a/etc/NEWS b/etc/NEWS index a2a3fe494cb..2cf6477ba99 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,12 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. +Temporary note: ++++ indicates that all relevant manuals in doc/ have been updated. +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it +applies, and please also update docstrings as needed. + * Installation Changes in Emacs 30.1 @@ -1586,6 +1592,18 @@ options of GNU 'ls'. * New Modes and Packages in Emacs 30.1 ++++ +** New package Track-Changes. +This library is a layer of abstraction above 'before-change-functions' +and 'after-change-functions' which provides a superset of +the functionality of 'after-change-functions': +- It provides the actual previous text rather than only its length. +- It takes care of accumulating and bundling changes until a time when + its client finds it convenient to react to them. +- It detects most cases where some changes were not properly + reported (calls to 'before/after-change-functions' that are + incorrectly paired, missing, etc...) and reports them adequately. + ** New major modes based on the tree-sitter library +++ diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el new file mode 100644 index 00000000000..1bab7ca38fd --- /dev/null +++ b/lisp/emacs-lisp/track-changes.el @@ -0,0 +1,624 @@ +;;; track-changes.el --- API to react to buffer modifications -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Author: Stefan Monnier + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library is a layer of abstraction above `before-change-functions' +;; and `after-change-functions' which takes care of accumulating changes +;; until a time when its client finds it convenient to react to them. +;; +;; It provides an API that is easier to use correctly than our +;; `*-change-functions' hooks. Problems that it claims to solve: +;; +;; - Before and after calls are not necessarily paired. +;; - The beg/end values don't always match. +;; - There's usually only one call to the hooks per command but +;; there can be thousands of calls from within a single command, +;; so naive users will tend to write code that performs poorly +;; in those rare cases. +;; - The hooks are run at a fairly low-level so there are things they +;; really shouldn't do, such as modify the buffer or wait. +;; - The after call doesn't get enough info to rebuild the before-change state, +;; so some callers need to use both before-c-f and after-c-f (and then +;; deal with the first two points above). +;; +;; The new API is almost like `after-change-functions' except that: +;; - It provides the "before string" (i.e. the previous content of +;; the changed area) rather than only its length. +;; - It can combine several changes into larger ones. +;; - Clients do not have to process changes right away, instead they +;; can let changes accumulate (by combining them into a larger change) +;; until it is convenient for them to process them. +;; - By default, changes are signaled at most once per command. + +;; The API consists in the following functions: +;; +;; (track-changes-register SIGNAL &key NOBEFORE DISJOINT IMMEDIATE) +;; (track-changes-fetch ID FUNC) +;; (track-changes-unregister ID) +;; +;; A typical use case might look like: +;; +;; (defvar my-foo--change-tracker nil) +;; (define-minor-mode my-foo-mode +;; "Fooing like there's no tomorrow." +;; (if (null my-foo-mode) +;; (when my-foo--change-tracker +;; (track-changes-unregister my-foo--change-tracker) +;; (setq my-foo--change-tracker nil)) +;; (unless my-foo--change-tracker +;; (setq my-foo--change-tracker +;; (track-changes-register +;; (lambda (id) +;; (track-changes-fetch +;; id (lambda (beg end before) +;; ..DO THE THING..)))))))) + +;;; Code: + +;; Random ideas: +;; - We could let trackers specify a function to record auxiliary info +;; about a state. This would be called from the first before-c-f +;; and then provided to FUNC. TeXpresso could use it to avoid needing +;; the BEFORE string: it could record the total number of bytes +;; in the "before" state so that from `track-changes-fetch' it could +;; compute the number of bytes that used to be in BEG/END. +;; - We could also let them provide another function to run in +;; before-c-f to signal errors if the change is not acceptable, +;; but contrary to before-c-f it would be called only when we +;; move t-c--before-beg/end so it scales better when there are +;; many small changes. + +(require 'cl-lib) + +;;;; Internal types and variables. + +(cl-defstruct (track-changes--tracker + (:noinline t) + (:constructor nil) + (:constructor track-changes--tracker ( signal state + &optional + nobefore immediate))) + signal state nobefore immediate) + +(cl-defstruct (track-changes--state + (:noinline t) + (:constructor nil) + (:constructor track-changes--state ())) + "Object holding a description of a buffer state. +A buffer state is described by a BEG/END/BEFORE triplet which say how to +recover that state from the next state. I.e. if the buffer's contents +reflects the next state, you can recover the previous state by replacing +the BEG..END region with the BEFORE string. + +NEXT is the next state object (i.e. a more recent state). +If NEXT is nil it means it's the most recent state and it may be incomplete +\(BEG/END/BEFORE may be nil), in which case those fields will take their +values from `track-changes--before-(beg|end|before)' when the next +state is created." + (beg (point-max)) + (end (point-min)) + (before nil) + (next nil)) + +(defvar-local track-changes--trackers () + "List of trackers currently registered in the buffer.") +(defvar-local track-changes--clean-trackers () + "List of trackers that are clean. +Those are the trackers that get signaled when a change is made.") + +(defvar-local track-changes--disjoint-trackers () + "List of trackers that want to react to disjoint changes. +These trackers are signaled every time track-changes notices +that some upcoming changes touch another \"distant\" part of the buffer.") + +(defvar-local track-changes--state nil) + +;; `track-changes--before-*' keep track of the content of the +;; buffer when `track-changes--state' was cleaned. +(defvar-local track-changes--before-beg 0 + "Beginning position of the remembered \"before string\".") +(defvar-local track-changes--before-end 0 + "End position of the text replacing the \"before string\".") +(defvar-local track-changes--before-string "" + "String holding some contents of the buffer before the current change. +This string is supposed to cover all the already modified areas plus +the upcoming modifications announced via `before-change-functions'. +If all trackers are `nobefore', then this holds the `buffer-size' before +the current change.") +(defvar-local track-changes--before-no t + "If non-nil, all the trackers are `nobefore'. +Should be equal to (memq #\\='track-changes--before before-change-functions).") + +(defvar-local track-changes--before-clean 'unset + "Status of `track-changes--before-*' vars. +More specifically it indicates which \"before\" they hold. +- nil: The vars hold the \"before\" info of the current state. +- `unset': The vars hold the \"before\" info of some older state. + This is what it is set to right after creating a fresh new state. +- `set': Like nil but the state is still clean because the buffer has not + been modified yet. This is what it is set to after the first + `before-change-functions' but before an `after-change-functions'.") + +(defvar-local track-changes--buffer-size nil + "Current size of the buffer, as far as this library knows. +This is used to try and detect cases where buffer modifications are \"lost\".") + +;;;; Exposed API. + +(cl-defun track-changes-register ( signal &key nobefore disjoint immediate) + "Register a new tracker whose change-tracking function is SIGNAL. +Return the ID of the new tracker. + +SIGNAL is a function that will be called with one argument (the tracker ID) +after the current buffer is modified, so that it can react to the change. +Once called, SIGNAL is not called again until `track-changes-fetch' +is called with the corresponding tracker ID. + +If optional argument NOBEFORE is non-nil, it means that this tracker does +not need the BEFORE strings (it will receive their size instead). + +If optional argument DISJOINT is non-nil, SIGNAL is called every time just +before combining changes from \"distant\" parts of the buffer. +This is needed when combining disjoint changes into one bigger change +is unacceptable, typically for performance reasons. +These calls are distinguished from normal calls by calling SIGNAL with +a second argument which is the distance between the upcoming change and +the previous changes. +BEWARE: In that case SIGNAL is called directly from `before-change-functions' +and should thus be extra careful: don't modify the buffer, don't call a function +that may block, ... +In order to prevent the upcoming change from being combined with the previous +changes, SIGNAL needs to call `track-changes-fetch' before it returns. + +By default SIGNAL is called after a change via a 0 seconds timer. +If optional argument IMMEDIATE is non-nil it means SIGNAL should be called +as soon as a change is detected, +BEWARE: In that case SIGNAL is called directly from `after-change-functions' +and should thus be extra careful: don't modify the buffer, don't call a function +that may block, do as little work as possible, ... +When IMMEDIATE is non-nil, the SIGNAL should probably not always call +`track-changes-fetch', since that would defeat the purpose of this library." + (when (and nobefore disjoint) + ;; FIXME: Without `before-change-functions', we can discover + ;; a disjoint change only after the fact, which is not good enough. + ;; But we could use a stripped down before-change-function, + (error "`disjoint' not supported for `nobefore' trackers")) + (track-changes--clean-state) + (unless nobefore + (setq track-changes--before-no nil) + (add-hook 'before-change-functions #'track-changes--before nil t)) + (add-hook 'after-change-functions #'track-changes--after nil t) + (let ((tracker (track-changes--tracker signal track-changes--state + nobefore immediate))) + (push tracker track-changes--trackers) + (push tracker track-changes--clean-trackers) + (when disjoint + (push tracker track-changes--disjoint-trackers)) + tracker)) + +(defun track-changes-unregister (id) + "Remove the tracker denoted by ID. +Trackers can consume resources (especially if `track-changes-fetch' is +not called), so it is good practice to unregister them when you don't +need them any more." + (unless (memq id track-changes--trackers) + (error "Unregistering a non-registered tracker: %S" id)) + (setq track-changes--trackers (delq id track-changes--trackers)) + (setq track-changes--clean-trackers (delq id track-changes--clean-trackers)) + (setq track-changes--disjoint-trackers + (delq id track-changes--disjoint-trackers)) + (when (cl-every #'track-changes--tracker-nobefore track-changes--trackers) + (setq track-changes--before-no t) + (remove-hook 'before-change-functions #'track-changes--before t)) + (when (null track-changes--trackers) + (mapc #'kill-local-variable + '(track-changes--before-beg + track-changes--before-end + track-changes--before-string + track-changes--buffer-size + track-changes--before-clean + track-changes--state)) + (remove-hook 'after-change-functions #'track-changes--after t))) + +(defun track-changes-fetch (id func) + "Fetch the pending changes for tracker ID pass them to FUNC. +ID is the tracker ID returned by a previous `track-changes-register'. +FUNC is a function. It is called with 3 arguments (BEGIN END BEFORE) +where BEGIN..END delimit the region that was changed since the last +time `track-changes-fetch' was called and BEFORE is a string containing +the previous content of that region (or just its length as an integer +if the tracker ID was registered with the `nobefore' option). +If track-changes detected that some changes were missed, then BEFORE will +be the symbol `error' to indicate that the buffer got out of sync. +This reflects a bug somewhere, so please report it when it happens. + +If no changes occurred since the last time, it doesn't call FUNC and +returns nil, otherwise it returns the value returned by FUNC +and re-enable the TRACKER corresponding to ID." + (cl-assert (memq id track-changes--trackers)) + (unless (equal track-changes--buffer-size (buffer-size)) + (track-changes--recover-from-error)) + (let ((beg nil) + (end nil) + (before t) + (lenbefore 0) + (states ())) + ;; Transfer the data from `track-changes--before-string' + ;; to the tracker's state object, if needed. + (track-changes--clean-state) + ;; We want to combine the states from most recent to oldest, + ;; so reverse them. + (let ((state (track-changes--tracker-state id))) + (while state + (push state states) + (setq state (track-changes--state-next state)))) + + (cond + ((eq (car states) track-changes--state) + (cl-assert (null (track-changes--state-before (car states)))) + (setq states (cdr states))) + (t + ;; The states are disconnected from the latest state because + ;; we got out of sync! + (cl-assert (eq (track-changes--state-before (car states)) 'error)) + (setq beg (point-min)) + (setq end (point-max)) + (setq before 'error) + (setq states nil))) + + (dolist (state states) + (let ((prevbeg (track-changes--state-beg state)) + (prevend (track-changes--state-end state)) + (prevbefore (track-changes--state-before state))) + (if (eq before t) + (progn + ;; This is the most recent change. Just initialize the vars. + (setq beg prevbeg) + (setq end prevend) + (setq lenbefore + (if (stringp prevbefore) (length prevbefore) prevbefore)) + (setq before + (unless (track-changes--tracker-nobefore id) prevbefore))) + (let ((endb (+ beg lenbefore))) + (when (< prevbeg beg) + (if (not before) + (setq lenbefore (+ (- beg prevbeg) lenbefore)) + (setq before + (concat (buffer-substring-no-properties + prevbeg beg) + before)) + (setq lenbefore (length before))) + (setq beg prevbeg) + (cl-assert (= endb (+ beg lenbefore)))) + (when (< endb prevend) + (let ((new-end (+ end (- prevend endb)))) + (if (not before) + (setq lenbefore (+ lenbefore (- new-end end))) + (setq before + (concat before + (buffer-substring-no-properties + end new-end))) + (setq lenbefore (length before))) + (setq end new-end) + (cl-assert (= prevend (+ beg lenbefore))) + (setq endb (+ beg lenbefore)))) + (cl-assert (<= beg prevbeg prevend endb)) + ;; The `prevbefore' is covered by the new one. + (if (not before) + (setq lenbefore + (+ (- prevbeg beg) + (if (stringp prevbefore) + (length prevbefore) prevbefore) + (- endb prevend))) + (setq before + (concat (substring before 0 (- prevbeg beg)) + prevbefore + (substring before (- (length before) + (- endb prevend))))) + (setq lenbefore (length before))))))) + (if (null beg) + (progn + (cl-assert (null states)) + (cl-assert (memq id track-changes--clean-trackers)) + (cl-assert (eq (track-changes--tracker-state id) + track-changes--state)) + ;; Nothing to do. + nil) + (cl-assert (not (memq id track-changes--clean-trackers))) + (cl-assert (<= (point-min) beg end (point-max))) + ;; Update the tracker's state *before* running `func' so we don't risk + ;; mistakenly replaying the changes in case `func' exits non-locally. + (setf (track-changes--tracker-state id) track-changes--state) + (unwind-protect (funcall func beg end (or before lenbefore)) + ;; Re-enable the tracker's signal only after running `func', so + ;; as to avoid recursive invocations. + (cl-pushnew id track-changes--clean-trackers))))) + +;;;; Auxiliary functions. + +(defun track-changes--clean-state () + (cond + ((null track-changes--state) + (cl-assert track-changes--before-clean) + (cl-assert (null track-changes--buffer-size)) + ;; No state has been created yet. Do it now. + (setq track-changes--buffer-size (buffer-size)) + (when track-changes--before-no + (setq track-changes--before-string (buffer-size))) + (setq track-changes--state (track-changes--state))) + (track-changes--before-clean + ;; If the state is already clean, there's nothing to do. + nil) + (t + (cl-assert (<= (track-changes--state-beg track-changes--state) + (track-changes--state-end track-changes--state))) + (let ((actual-beg (track-changes--state-beg track-changes--state)) + (actual-end (track-changes--state-end track-changes--state))) + (if track-changes--before-no + (progn + (cl-assert (integerp track-changes--before-string)) + (setf (track-changes--state-before track-changes--state) + (- track-changes--before-string + (- (buffer-size) (- actual-end actual-beg)))) + (setq track-changes--before-string (buffer-size))) + (cl-assert (<= track-changes--before-beg + actual-beg actual-end + track-changes--before-end)) + (cl-assert (null (track-changes--state-before track-changes--state))) + ;; The `track-changes--before-*' vars can cover more text than the + ;; actually modified area, so trim it down now to the relevant part. + (unless (= (- track-changes--before-end track-changes--before-beg) + (- actual-end actual-beg)) + (setq track-changes--before-string + (substring track-changes--before-string + (- actual-beg track-changes--before-beg) + (- (length track-changes--before-string) + (- track-changes--before-end actual-end)))) + (setq track-changes--before-beg actual-beg) + (setq track-changes--before-end actual-end)) + (setf (track-changes--state-before track-changes--state) + track-changes--before-string))) + ;; Note: We preserve `track-changes--before-*' because they may still + ;; be needed, in case `after-change-functions' are run before the next + ;; `before-change-functions'. + ;; Instead, we set `track-changes--before-clean' to `unset' to mean that + ;; `track-changes--before-*' can be reset at the next + ;; `before-change-functions'. + (setq track-changes--before-clean 'unset) + (let ((new (track-changes--state))) + (setf (track-changes--state-next track-changes--state) new) + (setq track-changes--state new))))) + +(defvar track-changes--disjoint-threshold 100 + "Number of chars below which changes are not considered disjoint.") + +(defvar track-changes--error-log () + "List of errors encountered. +Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).") + +(defun track-changes--recover-from-error () + ;; We somehow got out of sync. This is usually the result of a bug + ;; elsewhere that causes the before-c-f and after-c-f to be improperly + ;; paired, or to be skipped altogether. + ;; Not much we can do, other than force a full re-synchronization. + (warn "Missing/incorrect calls to `before/after-change-functions'!! +Details logged to `track-changes--error-log'") + (push (list (buffer-name) + (backtrace-frames 'track-changes--recover-from-error) + (recent-keys 'include-cmds)) + track-changes--error-log) + (setq track-changes--before-clean 'unset) + (setq track-changes--buffer-size (buffer-size)) + ;; Create a new state disconnected from the previous ones! + ;; Mark the previous one as junk, just to be clear. + (setf (track-changes--state-before track-changes--state) 'error) + (setq track-changes--state (track-changes--state))) + +(defun track-changes--before (beg end) + (cl-assert track-changes--state) + (cl-assert (<= beg end)) + (let* ((size (- end beg)) + (reset (lambda () + (cl-assert track-changes--before-clean) + (setq track-changes--before-clean 'set) + (setf track-changes--before-string + (buffer-substring-no-properties beg end)) + (setf track-changes--before-beg beg) + (setf track-changes--before-end end))) + + (signal-if-disjoint + (lambda (pos1 pos2) + (let ((distance (- pos2 pos1))) + (when (> distance + (max track-changes--disjoint-threshold + ;; If the distance is smaller than the size of the + ;; current change, then we may as well consider it + ;; as "near". + (length track-changes--before-string) + size + (- track-changes--before-end + track-changes--before-beg))) + (dolist (tracker track-changes--disjoint-trackers) + (funcall (track-changes--tracker-signal tracker) + tracker distance)) + ;; Return non-nil if the state was cleaned along the way. + track-changes--before-clean))))) + + (if track-changes--before-clean + (progn + ;; Detect disjointness with previous changes here as well, + ;; so that if a client calls `track-changes-fetch' all the time, + ;; it doesn't prevent others from getting a disjointness signal. + (when (and track-changes--before-beg + (let ((found nil)) + (dolist (tracker track-changes--disjoint-trackers) + (unless (memq tracker track-changes--clean-trackers) + (setq found t))) + found)) + ;; There's at least one `tracker' that wants to know about disjoint + ;; changes *and* it has unseen pending changes. + ;; FIXME: This can occasionally signal a tracker that's clean. + (if (< beg track-changes--before-beg) + (funcall signal-if-disjoint end track-changes--before-beg) + (funcall signal-if-disjoint track-changes--before-end beg))) + (funcall reset)) + (cl-assert (save-restriction + (widen) + (<= (point-min) + track-changes--before-beg + track-changes--before-end + (point-max)))) + (when (< beg track-changes--before-beg) + (if (and track-changes--disjoint-trackers + (funcall signal-if-disjoint end track-changes--before-beg)) + (funcall reset) + (let* ((old-bbeg track-changes--before-beg) + ;; To avoid O(N²) behavior when faced with many small changes, + ;; we copy more than needed. + (new-bbeg (min (max (point-min) + (- old-bbeg + (length track-changes--before-string))) + beg))) + (setf track-changes--before-beg new-bbeg) + (cl-callf (lambda (old new) (concat new old)) + track-changes--before-string + (buffer-substring-no-properties new-bbeg old-bbeg))))) + + (when (< track-changes--before-end end) + (if (and track-changes--disjoint-trackers + (funcall signal-if-disjoint track-changes--before-end beg)) + (funcall reset) + (let* ((old-bend track-changes--before-end) + ;; To avoid O(N²) behavior when faced with many small changes, + ;; we copy more than needed. + (new-bend (max (min (point-max) + (+ old-bend + (length track-changes--before-string))) + end))) + (setf track-changes--before-end new-bend) + (cl-callf concat track-changes--before-string + (buffer-substring-no-properties old-bend new-bend)))))))) + +(defun track-changes--after (beg end len) + (cl-assert track-changes--state) + (and (eq track-changes--before-clean 'unset) + (not track-changes--before-no) + ;; This can be a sign that a `before-change-functions' went missing, + ;; or that we called `track-changes--clean-state' between + ;; a `before-change-functions' and `after-change-functions'. + (track-changes--before beg end)) + (setq track-changes--before-clean nil) + (let ((offset (- (- end beg) len))) + (cl-incf track-changes--before-end offset) + (cl-incf track-changes--buffer-size offset) + (if (not (or track-changes--before-no + (save-restriction + (widen) + (<= (point-min) + track-changes--before-beg + beg end + track-changes--before-end + (point-max))))) + ;; BEG..END is not covered by previous `before-change-functions'!! + (track-changes--recover-from-error) + ;; Note the new changes. + (when (< beg (track-changes--state-beg track-changes--state)) + (setf (track-changes--state-beg track-changes--state) beg)) + (cl-callf (lambda (old-end) (max end (+ old-end offset))) + (track-changes--state-end track-changes--state)) + (cl-assert (or track-changes--before-no + (<= track-changes--before-beg + (track-changes--state-beg track-changes--state) + beg end + (track-changes--state-end track-changes--state) + track-changes--before-end))))) + (while track-changes--clean-trackers + (let ((tracker (pop track-changes--clean-trackers))) + (if (track-changes--tracker-immediate tracker) + (funcall (track-changes--tracker-signal tracker) tracker) + (run-with-timer 0 nil #'track-changes--call-signal + (current-buffer) tracker))))) + +(defun track-changes--call-signal (buf tracker) + (when (buffer-live-p buf) + (with-current-buffer buf + ;; Silence ourselves if `track-changes-fetch' was called in the mean time. + (unless (memq tracker track-changes--clean-trackers) + (funcall (track-changes--tracker-signal tracker) tracker))))) + +;;;; Extra candidates for the API. + +;; The functions below came up during the design of this library, but +;; I'm not sure if they're worth the trouble or not, so for now I keep +;; them here (with a "--" in the name) for documentation. --Stef + +;; This could be a good alternative to using a temp-buffer like in +;; `eglot--virtual-pos-to-lsp-position': since presumably we've just +;; been changing this very area of the buffer, the gap should be +;; ready nearby, so the operation should be fairly cheap, while +;; giving you the comfort of having access to the *full* buffer text. +;; +;; It may seem silly to go back to the previous state, since we could have +;; used `before-change-functions' to run FUNC right then when we were in +;; that state. The advantage is that with track-changes we get to decide +;; retroactively which state is the one for which we want to call FUNC and +;; which BEG..END to use: when that state was current we may have known +;; then that it would be "the one" but we didn't know what BEG and END +;; should be because those depend on the changes that came afterwards. +(defun track-changes--in-revert (beg end before func) + "Call FUNC with the buffer contents temporarily reverted to BEFORE. +FUNC is called with no arguments and with point right after BEFORE. +FUNC is not allowed to modify the buffer and it should refrain from using +operations that use a cache populated from the buffer's content, +such as `syntax-ppss'." + (catch 'track-changes--exit + (with-silent-modifications ;; This has to be outside `atomic-change-group'. + (atomic-change-group + (goto-char end) + (insert-before-markers before) + (delete-region beg end) + (throw 'track-changes--exit + (let ((inhibit-read-only nil) + (buffer-read-only t)) + (funcall func))))))) + +;; This one is a cheaper version of (track-changes-fetch id #'ignore), +;; e.g. for clients that don't want to see their own changes. +(defun track-changes--reset (id) + "Mark all past changes as handled for tracker ID. +Re-arms ID's signal." + (track-changes--clean-state) + (setf (track-changes--tracker-state id) track-changes--state) + (cl-pushnew id track-changes--clean-trackers) + (cl-assert (not (track-changes--pending-p id)))) + +(defun track-changes--pending-p (id) + "Return non-nil if there are pending changes for tracker ID." + (or (not track-changes--before-clean) + (track-changes--state-next id))) + +(defmacro with--track-changes (id vars &rest body) + (declare (indent 2) (debug (form sexp body))) + `(track-changes-fetch ,id (lambda ,vars ,@body))) + +(provide 'track-changes) +;;; track-changes.el end here. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 7f4284bf09d..478e7687bb3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -110,6 +110,7 @@ (require 'text-property-search nil t) (require 'diff-mode) (require 'diff) +(require 'track-changes nil t) ;; These dependencies are also GNU ELPA core packages. Because of ;; bug#62576, since there is a risk that M-x package-install, despite @@ -1732,6 +1733,9 @@ return value is fed through the corresponding inverse function "Calculate number of UTF-16 code units from position given by LBP. LBP defaults to `eglot--bol'." (/ (- (length (encode-coding-region (or lbp (eglot--bol)) + ;; FIXME: How could `point' ever be + ;; larger than `point-max' (sounds like + ;; a bug in Emacs). ;; Fix github#860 (min (point) (point-max)) 'utf-16 t)) 2) @@ -1749,6 +1753,24 @@ LBP defaults to `eglot--bol'." :character (progn (when pos (goto-char pos)) (funcall eglot-current-linepos-function))))) +(defun eglot--virtual-pos-to-lsp-position (pos string) + "Return the LSP position at the end of STRING if it were inserted at POS." + (eglot--widening + (goto-char pos) + (forward-line 0) + ;; LSP line is zero-origin; Emacs is one-origin. + (let ((posline (1- (line-number-at-pos nil t))) + (linebeg (buffer-substring (point) pos)) + (colfun eglot-current-linepos-function)) + ;; Use a temp buffer because: + ;; - I don't know of a fast way to count newlines in a string. + ;; - We currently don't have `eglot-current-linepos-function' for strings. + (with-temp-buffer + (insert linebeg string) + (goto-char (point-max)) + (list :line (+ posline (1- (line-number-at-pos nil t))) + :character (funcall colfun)))))) + (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos "Function to move to a position within a line reported by the LSP server. @@ -1946,6 +1968,8 @@ For example, to keep your Company customization, add the symbol "A hook run by Eglot after it started/stopped managing a buffer. Use `eglot-managed-p' to determine if current buffer is managed.") +(defvar-local eglot--track-changes nil) + (define-minor-mode eglot--managed-mode "Mode for source buffers managed by some Eglot project." :init-value nil :lighter nil :keymap eglot-mode-map @@ -1959,8 +1983,13 @@ Use `eglot-managed-p' to determine if current buffer is managed.") ("utf-8" (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos) (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos))) - (add-hook 'after-change-functions #'eglot--after-change nil t) - (add-hook 'before-change-functions #'eglot--before-change nil t) + (if (fboundp 'track-changes-register) + (unless eglot--track-changes + (setq eglot--track-changes + (track-changes-register + #'eglot--track-changes-signal :disjoint t))) + (add-hook 'after-change-functions #'eglot--after-change nil t) + (add-hook 'before-change-functions #'eglot--before-change nil t)) (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) ;; Prepend "didClose" to the hook after the "nonoff", so it will run first (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t) @@ -1998,6 +2027,9 @@ Use `eglot-managed-p' to determine if current buffer is managed.") buffer (eglot--managed-buffers (eglot-current-server))))) (t + (when eglot--track-changes + (track-changes-unregister eglot--track-changes) + (setq eglot--track-changes nil)) (remove-hook 'after-change-functions #'eglot--after-change t) (remove-hook 'before-change-functions #'eglot--before-change t) (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t) @@ -2588,7 +2620,6 @@ buffer." (defun eglot--after-change (beg end pre-change-length) "Hook onto `after-change-functions'. Records BEG, END and PRE-CHANGE-LENGTH locally." - (cl-incf eglot--versioned-identifier) (pcase (car-safe eglot--recent-changes) (`(,lsp-beg ,lsp-end (,b-beg . ,b-beg-marker) @@ -2616,6 +2647,29 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." `(,lsp-beg ,lsp-end ,pre-change-length ,(buffer-substring-no-properties beg end))))) (_ (setf eglot--recent-changes :emacs-messup))) + (eglot--track-changes-signal nil)) + +(defun eglot--track-changes-fetch (id) + (if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil)) + (track-changes-fetch + id (lambda (beg end before) + (cond + ((eq eglot--recent-changes :emacs-messup) nil) + ((eq before 'error) (setf eglot--recent-changes :emacs-messup)) + (t (push `(,(eglot--pos-to-lsp-position beg) + ,(eglot--virtual-pos-to-lsp-position beg before) + ,(length before) + ,(buffer-substring-no-properties beg end)) + eglot--recent-changes)))))) + +(defun eglot--track-changes-signal (id &optional distance) + (cl-incf eglot--versioned-identifier) + (cond + (distance (eglot--track-changes-fetch id)) + (eglot--recent-changes nil) + ;; Note that there are pending changes, for the benefit of those + ;; who check it as a boolean. + (t (setq eglot--recent-changes :pending))) (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer)) (let ((buf (current-buffer))) (setq eglot--change-idle-timer @@ -2729,6 +2783,8 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didChange () "Send textDocument/didChange to server." (when eglot--recent-changes + (when eglot--track-changes + (eglot--track-changes-fetch eglot--track-changes)) (let* ((server (eglot--current-server-or-lose)) (sync-capability (eglot-server-capable :textDocumentSync)) (sync-kind (if (numberp sync-capability) sync-capability @@ -2750,7 +2806,7 @@ When called interactively, use the currently active server" ;; empty entries in `eglot--before-change' calls ;; without an `eglot--after-change' reciprocal. ;; Weed them out here. - when (numberp len) + when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) (setq eglot--recent-changes nil) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 66043059d14..e1837eab12a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -53,9 +53,10 @@ ;; - Handle `diff -b' output in context->unified. ;;; Code: +(require 'easy-mmode) +(require 'track-changes) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) -(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-find-revision-no-save "vc") @@ -1431,38 +1432,23 @@ else cover the whole buffer." (if (buffer-modified-p) (diff-fixup-modifs (point-min) (point-max))) nil) -;; It turns out that making changes in the buffer from within an -;; *-change-function is asking for trouble, whereas making them -;; from a post-command-hook doesn't pose much problems -(defvar diff-unhandled-changes nil) -(defun diff-after-change-function (beg end _len) - "Remember to fixup the hunk header. -See `after-change-functions' for the meaning of BEG, END and LEN." - ;; Ignoring changes when inhibit-read-only is set is strictly speaking - ;; incorrect, but it turns out that inhibit-read-only is normally not set - ;; inside editing commands, while it tends to be set when the buffer gets - ;; updated by an async process or by a conversion function, both of which - ;; would rather not be uselessly slowed down by this hook. - (when (and (not undo-in-progress) (not inhibit-read-only)) - (if diff-unhandled-changes - (setq diff-unhandled-changes - (cons (min beg (car diff-unhandled-changes)) - (max end (cdr diff-unhandled-changes)))) - (setq diff-unhandled-changes (cons beg end))))) - -(defun diff-post-command-hook () - "Fixup hunk headers if necessary." - (when (consp diff-unhandled-changes) - (ignore-errors - (save-excursion - (goto-char (car diff-unhandled-changes)) - ;; Maybe we've cut the end of the hunk before point. - (if (and (bolp) (not (bobp))) (backward-char 1)) - ;; We used to fixup modifs on all the changes, but it turns out that - ;; it's safer not to do it on big changes, e.g. when yanking a big - ;; diff, or when the user edits the header, since we might then - ;; screw up perfectly correct values. --Stef - (diff-beginning-of-hunk t) +(defvar-local diff--track-changes nil) + +(defun diff--track-changes-signal (tracker) + (cl-assert (eq tracker diff--track-changes)) + (track-changes-fetch tracker #'diff--track-changes-function)) + +(defun diff--track-changes-function (beg end _before) + (with-demoted-errors "%S" + (save-excursion + (goto-char beg) + ;; Maybe we've cut the end of the hunk before point. + (if (and (bolp) (not (bobp))) (backward-char 1)) + ;; We used to fixup modifs on all the changes, but it turns out that + ;; it's safer not to do it on big changes, e.g. when yanking a big + ;; diff, or when the user edits the header, since we might then + ;; screw up perfectly correct values. --Stef + (when (ignore-errors (diff-beginning-of-hunk t)) (let* ((style (if (looking-at "\\*\\*\\*") 'context)) (start (line-beginning-position (if (eq style 'context) 3 2))) (mid (if (eq style 'context) @@ -1470,17 +1456,20 @@ See `after-change-functions' for the meaning of BEG, END and LEN." (re-search-forward diff-context-mid-hunk-header-re nil t))))) (when (and ;; Don't try to fixup changes in the hunk header. - (>= (car diff-unhandled-changes) start) + (>= beg start) ;; Don't try to fixup changes in the mid-hunk header either. (or (not mid) - (< (cdr diff-unhandled-changes) (match-beginning 0)) - (> (car diff-unhandled-changes) (match-end 0))) + (< end (match-beginning 0)) + (> beg (match-end 0))) (save-excursion - (diff-end-of-hunk nil 'donttrustheader) + (diff-end-of-hunk nil 'donttrustheader) ;; Don't try to fixup changes past the end of the hunk. - (>= (point) (cdr diff-unhandled-changes)))) - (diff-fixup-modifs (point) (cdr diff-unhandled-changes))))) - (setq diff-unhandled-changes nil)))) + (>= (point) end))) + (diff-fixup-modifs (point) end) + ;; Ignore the changes we just made ourselves. + ;; This is not indispensable since the above `when' skips + ;; changes like the ones we make anyway, but it's good practice. + (track-changes-fetch diff--track-changes #'ignore))))))) (defun diff-next-error (arg reset) ;; Select a window that displays the current buffer so that point @@ -1560,9 +1549,8 @@ a diff with \\[diff-reverse-direction]. ;; setup change hooks (if (not diff-update-on-the-fly) (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) - (make-local-variable 'diff-unhandled-changes) - (add-hook 'after-change-functions #'diff-after-change-function nil t) - (add-hook 'post-command-hook #'diff-post-command-hook nil t)) + (setq diff--track-changes + (track-changes-register #'diff--track-changes-signal :nobefore t))) ;; add-log support (setq-local add-log-current-defun-function #'diff-current-defun) @@ -1581,12 +1569,15 @@ a diff with \\[diff-reverse-direction]. \\{diff-minor-mode-map}" :group 'diff-mode :lighter " Diff" ;; FIXME: setup font-lock - ;; setup change hooks - (if (not diff-update-on-the-fly) - (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) - (make-local-variable 'diff-unhandled-changes) - (add-hook 'after-change-functions #'diff-after-change-function nil t) - (add-hook 'post-command-hook #'diff-post-command-hook nil t))) + (when diff--track-changes (track-changes-unregister diff--track-changes)) + (remove-hook 'write-contents-functions #'diff-write-contents-hooks t) + (when diff-minor-mode + (if (not diff-update-on-the-fly) + (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) + (unless diff--track-changes + (setq diff--track-changes + (track-changes-register #'diff--track-changes-signal + :nobefore t)))))) ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/test/lisp/emacs-lisp/track-changes-tests.el b/test/lisp/emacs-lisp/track-changes-tests.el new file mode 100644 index 00000000000..ed35477cafd --- /dev/null +++ b/test/lisp/emacs-lisp/track-changes-tests.el @@ -0,0 +1,156 @@ +;;; track-changes-tests.el --- tests for emacs-lisp/track-changes.el -*- lexical-binding:t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'track-changes) +(require 'cl-lib) +(require 'ert) + +(defun track-changes-tests--random-word () + (let ((chars ())) + (dotimes (_ (1+ (random 12))) + (push (+ ?A (random (1+ (- ?z ?A)))) chars)) + (apply #'string chars))) + +(defvar track-changes-tests--random-verbose nil) + +(defun track-changes-tests--message (&rest args) + (when track-changes-tests--random-verbose (apply #'message args))) + +(defvar track-changes-tests--random-seed + (let ((seed (number-to-string (random (expt 2 24))))) + (message "Random seed = %S" seed) + seed)) + +(ert-deftest track-changes-tests--random () + ;; Keep 2 buffers in sync with a third one as we make random + ;; changes to that 3rd one. + ;; We have 3 trackers: a "normal" one which we sync + ;; at random intervals, one which syncs via the "disjoint" signal, + ;; plus a third one which verifies that "nobefore" gets + ;; information consistent with the "normal" tracker. + (with-temp-buffer + (random track-changes-tests--random-seed) + (dotimes (_ 100) + (insert (track-changes-tests--random-word) "\n")) + (let* ((buf1 (generate-new-buffer " *tc1*")) + (buf2 (generate-new-buffer " *tc2*")) + (char-counts (make-vector 2 0)) + (sync-counts (make-vector 2 0)) + (print-escape-newlines t) + (file (make-temp-file "tc")) + (id1 (track-changes-register #'ignore)) + (id3 (track-changes-register #'ignore :nobefore t)) + (sync + (lambda (id buf n) + (track-changes-tests--message "!! SYNC %d !!" n) + (track-changes-fetch + id (lambda (beg end before) + (when (eq n 1) + (track-changes-fetch + id3 (lambda (beg3 end3 before3) + (should (eq beg3 beg)) + (should (eq end3 end)) + (should (eq before3 + (if (symbolp before) + before (length before))))))) + (cl-incf (aref sync-counts (1- n))) + (cl-incf (aref char-counts (1- n)) (- end beg)) + (let ((after (buffer-substring beg end))) + (track-changes-tests--message + "Sync:\n %S\n=> %S\nat %d .. %d" + before after beg end) + (with-current-buffer buf + (if (eq before 'error) + (erase-buffer) + (should (equal before + (buffer-substring + beg (+ beg (length before))))) + (delete-region beg (+ beg (length before)))) + (goto-char beg) + (insert after))) + (should (equal (buffer-string) + (with-current-buffer buf + (buffer-string)))))))) + (id2 (track-changes-register + (lambda (id2 &optional distance) + (when distance + (track-changes-tests--message "Disjoint distance: %d" + distance) + (funcall sync id2 buf2 2))) + :disjoint t))) + (write-region (point-min) (point-max) file) + (insert-into-buffer buf1) + (insert-into-buffer buf2) + (should (equal (buffer-hash) (buffer-hash buf1))) + (should (equal (buffer-hash) (buffer-hash buf2))) + (message "seeding with: %S" track-changes-tests--random-seed) + (dotimes (_ 1000) + (pcase (random 15) + (0 + (track-changes-tests--message "Manual sync1") + (funcall sync id1 buf1 1)) + (1 + (track-changes-tests--message "Manual sync2") + (funcall sync id2 buf2 2)) + ((pred (< _ 5)) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 100))) (point-max)))) + (track-changes-tests--message "Fill %d .. %d" beg end) + (fill-region-as-paragraph beg end))) + ((pred (< _ 8)) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 12))) (point-max)))) + (track-changes-tests--message "Delete %S at %d .. %d" + (buffer-substring beg end) beg end) + (delete-region beg end))) + ((and 8 (guard (= (random 50) 0))) + (track-changes-tests--message "Silent insertion") + (let ((inhibit-modification-hooks t)) + (insert "a"))) + ((and 8 (guard (= (random 10) 0))) + (track-changes-tests--message "Revert") + (insert-file-contents file nil nil nil 'replace)) + ((and 8 (guard (= (random 3) 0))) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 12))) (point-max))) + (after (eq (random 2) 0))) + (track-changes-tests--message "Bogus %S %d .. %d" + (if after 'after 'before) beg end) + (if after + (run-hook-with-args 'after-change-functions + beg end (- end beg)) + (run-hook-with-args 'before-change-functions beg end)))) + (_ + (goto-char (+ (point-min) (random (1+ (buffer-size))))) + (let ((word (track-changes-tests--random-word))) + (track-changes-tests--message "insert %S at %d" word (point)) + (insert word "\n"))))) + (message "SCOREs: default: %d/%d=%d disjoint: %d/%d=%d" + (aref char-counts 0) (aref sync-counts 0) + (/ (aref char-counts 0) (aref sync-counts 0)) + (aref char-counts 1) (aref sync-counts 1) + (/ (aref char-counts 1) (aref sync-counts 1)))))) + + + +;;; track-changes-tests.el ends here From 3f7e26e2bed4ee7adab3a5d2bfa289517499e4c8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Apr 2024 10:10:19 -0400 Subject: [PATCH 035/149] (define-globalized-minor-mode): Fix bug#58888 * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode) : Try and detect well-behaved modes so they're not affected by those which require the cmhh hack. --- lisp/emacs-lisp/easy-mmode.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 095bd5faa03..b09466d79fc 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -661,8 +661,12 @@ list." ;; The function that catches kill-all-local-variables. (defun ,MODE-cmhh () - (add-to-list ',MODE-buffers (current-buffer)) - (add-hook 'post-command-hook #',MODE-check-buffers)) + ;; If `delay-mode-hooks' is set, it indicates that the current + ;; buffer's mode will run `run-mode-hooks' afterwards anyway, + ;; so we don't need to keep this buffer in MODE-buffers. + (unless delay-mode-hooks + (add-to-list ',MODE-buffers (current-buffer)) + (add-hook 'post-command-hook #',MODE-check-buffers))) (put ',MODE-cmhh 'definition-name ',global-mode)))) (defun easy-mmode--globalized-predicate-p (predicate) From 17e26cf57e18c5df2172a7049591d89fc53b3fb6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Apr 2024 10:31:28 -0400 Subject: [PATCH 036/149] (define-globalized-minor-mode): Require the use of `run-mode-hooks` When `define-globalized-minor-mode` was introduced (Emacs-22), `run-mode-hooks` was brand new, so we could not expect all major modes to use it and we had to rely on brittle workarounds to try and approximate `after-change-major-mode-hook`. These workarounds have undesirable side effects, and (we hope) they're not needed any more now that virtually all major modes have been changed to use `run-mode-hooks` (or `define-derived-mode`). * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Rely only on `after-change-major-mode-hook`, remove the "cmhh" [typo for the intended "cmmh", BTW] workaround. * doc/lispref/modes.texi (Mode Hooks): Clarify the importance of `after-change-major-mode-hook` w.r.t `define-globalized-minor-mode`. (Defining Minor Modes): Rewrite the explanation of which buffers are affected, including adjusting it to the fact that `fundamental-mode` has used run `run-mode-hooks` for last 10 years. --- doc/lispref/modes.texi | 13 +++++--- etc/NEWS | 8 +++++ lisp/emacs-lisp/easy-mmode.el | 62 +++-------------------------------- 3 files changed, 20 insertions(+), 63 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index b034fecd77b..ffede9e86f5 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1109,7 +1109,10 @@ Versions before 24 did not have @code{change-major-mode-after-body-hook}. When user-implemented major modes do not use @code{run-mode-hooks} and have not been updated to use these newer features, they won't entirely follow these conventions: they may run the parent's mode hook too early, -or fail to run @code{after-change-major-mode-hook}. If you encounter +or fail to run @code{after-change-major-mode-hook}. This will +have undesirable effects such as preventing minor modes defined +with @code{define-globalized-minor-mode} from being enabled in +buffers using these major modes. If you encounter such a major mode, please correct it to follow these conventions. When you define a major mode using @code{define-derived-mode}, it @@ -1985,10 +1988,10 @@ turn on the minor mode in a buffer, it uses the function function so it could determine whether to enable the minor mode or not when it is not a priori clear that it should always be enabled.) -Globally enabling the mode also affects buffers subsequently created -by visiting files, and buffers that use a major mode other than -Fundamental mode; but it does not detect the creation of a new buffer -in Fundamental mode. +Globally enabling the mode affects only those buffers subsequently +created that use a major mode which follows the convention to run +@code{run-mode-hooks}. The minor mode will not be enabled in those +major modes which fail to follow this convention. This macro defines the customization option @var{global-mode} (@pxref{Customization}), which can be toggled via the Customize diff --git a/etc/NEWS b/etc/NEWS index 933ca15b39c..7a73815179c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1680,6 +1680,14 @@ documentation and examples. * Incompatible Lisp Changes in Emacs 30.1 ++++ +** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'. +Minor modes defined with 'define-globalized-minor-mode', such as +'global-font-lock-mode', will not be enabled any more in those buffers +whose major modes fails to use 'run-mode-hooks'. Major modes defined +with 'define-derived-mode' are not affected. `run-mode-hooks` has been the +recommended way to run major mode hooks since Emacs-22. + --- ** Old derived.el functions removed. The following functions have been deleted because they were only used diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index b09466d79fc..eaad9646985 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -495,11 +495,6 @@ on if the hook has explicitly disabled it. (MODE-buffers (intern (concat global-mode-name "-buffers"))) (MODE-enable-in-buffer (intern (concat global-mode-name "-enable-in-buffer"))) - (MODE-enable-in-buffers - (intern (concat global-mode-name "-enable-in-buffers"))) - (MODE-check-buffers - (intern (concat global-mode-name "-check-buffers"))) - (MODE-cmhh (intern (concat global-mode-name "-cmhh"))) (minor-MODE-hook (intern (concat mode-name "-hook"))) (MODE-set-explicitly (intern (concat mode-name "-set-explicitly"))) (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))) @@ -559,14 +554,9 @@ Disable the mode if ARG is a negative number.\n\n" ;; Setup hook to handle future mode changes and new buffers. (if ,global-mode - (progn - (add-hook 'after-change-major-mode-hook - #',MODE-enable-in-buffer) - (add-hook 'find-file-hook #',MODE-check-buffers) - (add-hook 'change-major-mode-hook #',MODE-cmhh)) - (remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffer) - (remove-hook 'find-file-hook #',MODE-check-buffers) - (remove-hook 'change-major-mode-hook #',MODE-cmhh)) + (add-hook 'after-change-major-mode-hook + #',MODE-enable-in-buffer) + (remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffer)) ;; Go through existing buffers. (dolist (buf (buffer-list)) @@ -623,51 +613,7 @@ list." (funcall ,turn-on-function)) (funcall ,turn-on-function)))) (setq ,MODE-major-mode major-mode)) - (put ',MODE-enable-in-buffer 'definition-name ',global-mode) - - ;; In the normal case, major modes run `after-change-major-mode-hook' - ;; which will have called `MODE-enable-in-buffer' for us. But some - ;; major modes don't use `run-mode-hooks' (customarily used via - ;; `define-derived-mode') and thus fail to run - ;; `after-change-major-mode-hook'. - ;; The functions below try to handle those major modes, with - ;; a combination of ugly hacks to try and catch those corner - ;; cases by listening to `change-major-mode-hook' to discover - ;; potential candidates and then checking in `post-command-hook' - ;; and `find-file-hook' if some of those still haven't run - ;; `after-change-major-mode-hook'. FIXME: We should try and get - ;; rid of this ugly hack and rely purely on - ;; `after-change-major-mode-hook' because they can (and do) end - ;; up running `MODE-enable-in-buffer' too early (when the major - ;; isn't yet fully setup) in some cases (see bug#58888). - - ;; The function that calls TURN-ON in each buffer. - (defun ,MODE-enable-in-buffers () - (let ((buffers ,MODE-buffers)) - ;; Clear MODE-buffers to avoid scanning the same list of - ;; buffers in recursive calls to MODE-enable-in-buffers. - ;; Otherwise it could lead to infinite recursion. - (setq ,MODE-buffers nil) - (dolist (buf buffers) - (when (buffer-live-p buf) - (with-current-buffer buf - (,MODE-enable-in-buffer)))))) - (put ',MODE-enable-in-buffers 'definition-name ',global-mode) - - (defun ,MODE-check-buffers () - (,MODE-enable-in-buffers) - (remove-hook 'post-command-hook #',MODE-check-buffers)) - (put ',MODE-check-buffers 'definition-name ',global-mode) - - ;; The function that catches kill-all-local-variables. - (defun ,MODE-cmhh () - ;; If `delay-mode-hooks' is set, it indicates that the current - ;; buffer's mode will run `run-mode-hooks' afterwards anyway, - ;; so we don't need to keep this buffer in MODE-buffers. - (unless delay-mode-hooks - (add-to-list ',MODE-buffers (current-buffer)) - (add-hook 'post-command-hook #',MODE-check-buffers))) - (put ',MODE-cmhh 'definition-name ',global-mode)))) + (put ',MODE-enable-in-buffer 'definition-name ',global-mode)))) (defun easy-mmode--globalized-predicate-p (predicate) (cond From 7b94c6b00b287d2b69d466380a05de7e0ec21ee9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 13 Apr 2024 15:35:46 -0400 Subject: [PATCH 037/149] peg-tests.el: Fix test failures * lisp/progmodes/peg.el (peg-parse): Refine heuristic since unknown terminals are resolved at run-time rather than compile-time now. (peg--macroexpand) : Avoid generating a `let` with an empty body. (peg--translate-rule-body): Adjust to name change of `macroexp-warn-and-return` and the fact that it's always available. * test/lisp/progmodes/peg-tests.el (peg-parse-string): Add `indent` declaration. (peg-test): Check that the compiler emits the warnings we expect. --- lisp/progmodes/peg.el | 14 ++++++------- test/lisp/progmodes/peg-tests.el | 35 ++++++++++++++++++++++++-------- 2 files changed, 33 insertions(+), 16 deletions(-) diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index 2eb4a7384d0..bb57650d883 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -1,6 +1,6 @@ ;;; peg.el --- Parsing Expression Grammars in Emacs Lisp -*- lexical-binding:t -*- -;; Copyright (C) 2008-2023 Free Software Foundation, Inc. +;; Copyright (C) 2008-2024 Free Software Foundation, Inc. ;; ;; Author: Helmut Eller ;; Maintainer: Stefan Monnier @@ -320,7 +320,8 @@ moving point along the way. PEXS can also be a list of PEG rules, in which case the first rule is used." (if (and (consp (car pexs)) (symbolp (caar pexs)) - (not (ignore-errors (peg-normalize (car pexs))))) + (not (ignore-errors + (not (eq 'call (car (peg-normalize (car pexs)))))))) ;; `pexs' is a list of rules: use the first rule as entry point. `(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure)) `(peg-run (peg ,@pexs) #'peg-signal-failure))) @@ -544,7 +545,8 @@ rulesets defined previously with `define-peg-ruleset'." (let ((args (cdr (member '-- (reverse form)))) (values (cdr (member '-- form)))) (let ((form `(let ,(mapcar (lambda (var) `(,var (pop peg--stack))) args) - ,@(mapcar (lambda (val) `(push ,val peg--stack)) values)))) + ,@(or (mapcar (lambda (val) `(push ,val peg--stack)) values) + '(nil))))) `(action ,form)))) (defvar peg-char-classes @@ -642,11 +644,7 @@ rulesets defined previously with `define-peg-ruleset'." (code (peg-translate-exp exp))) (cond ((null msg) code) - ((fboundp 'macroexp--warn-and-return) - (macroexp--warn-and-return msg code)) - (t - (message "%s" msg) - code)))) + (t (macroexp-warn-and-return msg code))))) ;; This is the main translation function. (defun peg-translate-exp (exp) diff --git a/test/lisp/progmodes/peg-tests.el b/test/lisp/progmodes/peg-tests.el index 864e09b4200..e666e6f19d2 100644 --- a/test/lisp/progmodes/peg-tests.el +++ b/test/lisp/progmodes/peg-tests.el @@ -1,6 +1,6 @@ ;;; peg-tests.el --- Tests of PEG parsers -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2023 Free Software Foundation, Inc. +;; Copyright (C) 2008-2024 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -30,6 +30,7 @@ "Parse STRING according to PEX. If NOERROR is non-nil, push nil resp. t if the parse failed resp. succeeded instead of signaling an error." + (declare (indent 1)) (let ((oldstyle (consp (car-safe pex)))) ;PEX is really a list of rules. `(with-temp-buffer (insert ,string) @@ -105,15 +106,33 @@ resp. succeeded instead of signaling an error." (substring [0-9])))) "ab0cd1ef2gh") '("2"))) - ;; The PEG rule `other' doesn't exist, which will cause a byte-compiler + ;; The PEG rule `doesntexist' doesn't exist, which will cause a byte-compiler ;; warning, but not an error at run time because the rule is not actually ;; used in this particular case. - (should (equal (peg-parse-string ((s (substring (or "a" other))) - ;; Unused left-recursive rule, should - ;; cause a byte-compiler warning. - (r (* "a") r)) - "af") - '("a"))) + (let* ((testfun '(lambda () + (peg-parse-string ((s (substring (or "a" doesntexist))) + ;; Unused left-recursive rule, should + ;; cause a byte-compiler warning. + (r (* "a") r)) + "af"))) + (compiledfun + (progn + (with-current-buffer (get-buffer-create "*Compile-Log*") + (let ((inhibit-read-only t)) (erase-buffer))) + (let ((lexical-binding t)) (byte-compile testfun))))) + (with-current-buffer (get-buffer-create "*Compile-Log*") + (goto-char (point-min)) + (should + ;; FIXME: The byte-compiler emits "not known to be defined" + ;; warnings when compiling a file but not from `byte-compile'. + ;; Instead, we have to dig it out of the mess it leaves behind. 🙂 + (or (assq 'peg-rule\ doesntexist byte-compile-unresolved-functions) + (should (re-search-forward + "peg-rule.? doesntexist.*not known to be defined" nil t)))) + (goto-char (point-min)) + (should (re-search-forward "left recursion.*r -> r" nil t))) + + (should (equal (funcall compiledfun) '("a")))) (should (equal (peg-parse-string ((s (list x y)) (x `(-- 1)) (y `(-- 2))) From 845246093f8ae88db1061a9beaff04184685f8f4 Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Sat, 13 Apr 2024 22:31:25 +0200 Subject: [PATCH 038/149] Recognize multicite macros from biblatex * lisp/textmodes/reftex-cite.el (reftex-all-used-citation-keys): Match the citation keys used with multicite macros provided by biblatex. (bug#38249) * test/lisp/textmodes/reftex-tests.el (reftex-all-used-citation-keys): Adjust test accordingly. --- lisp/textmodes/reftex-cite.el | 45 +++++++++++++++++++++++++++-- test/lisp/textmodes/reftex-tests.el | 22 ++++++++++++++ 2 files changed, 64 insertions(+), 3 deletions(-) diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index f7b155874de..34f40ba689f 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -1144,8 +1144,6 @@ recommended for follow mode. It works OK for individual lookups." (defun reftex-all-used-citation-keys () "Return a list of all citation keys used in document." (reftex-access-scan-info) - ;; FIXME: multicites macros provided by biblatex - ;; are not covered in this function. (let ((files (reftex-all-document-files)) (re (concat "\\\\" "\\(?:" @@ -1170,6 +1168,25 @@ recommended for follow mode. It works OK for individual lookups." "\\)" ;; Now match the key: "{\\([^}]+\\)}")) + ;; Multicites: Match \MACRONAME(Global Pre)(Global Post) + (re2 (concat "\\\\" + (regexp-opt '("cites" "Cites" + "parencites" "Parencites" + "footcites" "footcitetexts" + "smartcites" "Smartcites" + "textcites" "Textcites" + "supercites" + "autocites" "Autocites" + "volcites" "Volcites" + "pvolcites" "Pvolcites" + "fvolcites" "Fvolcites" + "svolcites" "Svolcites" + "tvolcites" "Tvolcites" + "avolcites" "Avolcites")) + "\\(?:([^)]*)\\)\\{0,2\\}")) + ;; For each key in list [prenote][postnote]{key} + (re3 (concat "\\(?:\\[[^]]*\\]\\)\\{0,2\\}" + "{\\([^}]+\\)}")) file keys kk k) (save-current-buffer (while (setq file (pop files)) @@ -1188,7 +1205,29 @@ recommended for follow mode. It works OK for individual lookups." (setq kk (split-string kk "[, \t\r\n]+")) (while (setq k (pop kk)) (or (member k keys) - (setq keys (cons k keys)))))))))) + (setq keys (cons k keys)))))) + ;; And now search for citation lists: + (goto-char (point-min)) + (while (re-search-forward re2 nil t) + ;; Make sure we're not inside a comment: + (unless (save-match-data + (nth 4 (syntax-ppss))) + (while (progn + ;; Ignore the value of + ;; `reftex-allow-detached-macro-args' since we + ;; expect a bigger number of args and detaching + ;; them seems natural for line breaks: + (while (looking-at "[ \t\r\n]+\\|%.*\n") + (goto-char (match-end 0))) + (and (looking-at re3) + (goto-char (match-end 0)))) + (setq kk (match-string-no-properties 1)) + (while (string-match "%.*\n?" kk) + (setq kk (replace-match "" t t kk))) + (setq kk (split-string kk "[, \t\r\n]+")) + (while (setq k (pop kk)) + (or (member k keys) + (setq keys (cons k keys))))))))))) (reftex-kill-temporary-buffers) keys)) diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el index 7f7c99a40a4..456ee458865 100644 --- a/test/lisp/textmodes/reftex-tests.el +++ b/test/lisp/textmodes/reftex-tests.el @@ -285,6 +285,20 @@ Natbib compatibility commands: \\Citep[pre][pos]{Citep:2022} \\Citep*[pre][pos]{Citep*:2022} +Qualified Citation Lists: +\\cites(Global Prenote)(Global Postnote)[pre][post]{cites:1}[pre][post]{cites:2} +\\Cites(Global Prenote)(Global Postnote)[pre][post]{Cites:1}[pre][post]{Cites:2} +\\parencites(Global Prenote)(Global Postnote)[pre][post]{parencites:1} + [pre][post]{parencites:2} +\\Parencites(Global Prenote)(Global Postnote)[pre][post]{Parencites:1}{Parencites:2} +\\footcites[pre][post]{footcites:1}[pre][post]{footcites:2} +\\footcitetexts{footcitetexts:1}{footcitetexts:2} +\\smartcites{smartcites:1} +% This is comment about \\smartcites{smartcites:2} +[pre][post]{smartcites:2} +% And this should be ignored \\smartcites{smartcites:3}{smartcites:4} + + Test for bug#56655: There was a few \\% of increase in budget \\Citep*{bug:56655}. @@ -331,6 +345,14 @@ And this should be % \\cite{ignored}. "citealp:2022" "citealp*:2022" "Citet:2022" "Citet*:2022" "Citep:2022" "Citep*:2022" + ;; Qualified Citation Lists + "cites:1" "cites:2" + "Cites:1" "Cites:2" + "parencites:1" "parencites:2" + "Parencites:1" "Parencites:2" + "footcites:1" "footcites:2" + "footcitetexts:1" "footcitetexts:2" + "smartcites:1" "smartcites:2" "bug:56655") #'string<))) (kill-buffer (file-name-nondirectory tex-file))))) From bbc5204a0f3ebea32429bd01207284eead23bf22 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 13 Apr 2024 23:45:28 +0200 Subject: [PATCH 039/149] * doc/misc/calc.texi: Improve indexing. --- doc/misc/calc.texi | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index ccc7b95ceec..75f88efe259 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -31447,6 +31447,7 @@ newline so that mode annotations will appear on lines by themselves. @node Programming @chapter Programming +@cindex Programming Calc @noindent There are several ways to ``program'' the Emacs Calculator, depending on the nature of the problem you need to solve. @@ -31575,7 +31576,7 @@ following sections. @noindent @kindex X -@cindex Programming with keyboard macros +@cindex Programming Calc, with keyboard macros @cindex Keyboard macros The easiest way to ``program'' the Emacs Calculator is to use standard keyboard macros. Press @w{@kbd{C-x (}} to begin recording a macro. From @@ -31976,7 +31977,7 @@ The @kbd{m m} command saves the last invocation macro defined by @noindent @kindex Z F @pindex calc-user-define-formula -@cindex Programming with algebraic formulas +@cindex Programming Calc, with algebraic formulas Another way to create a new Calculator command uses algebraic formulas. The @kbd{Z F} (@code{calc-user-define-formula}) command stores the formula at the top of the stack as the definition for a key. This @@ -32085,6 +32086,7 @@ in symbolic form without ever activating the @code{deriv} function. Press @node Lisp Definitions @section Programming with Lisp +@section Programming Calc, with Lisp @noindent The Calculator can be programmed quite extensively in Lisp. All you do is write a normal Lisp function definition, but with @code{defmath} @@ -32830,6 +32832,7 @@ a large argument, a simpler program like the first one shown is fine. @node Calling Calc from Your Programs @subsection Calling Calc from Your Lisp Programs +@cindex Calling Calc from Lisp @noindent A later section (@pxref{Internals}) gives a full description of Calc's internal Lisp functions. It's not hard to call Calc from From 2823eae0b7cb3bd3f2472fde9e13016a8d406a9a Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 14 Apr 2024 10:36:50 +0800 Subject: [PATCH 040/149] Remove leftover tasks from previous Emacs sessions on startup * java/org/gnu/emacs/EmacsService.java (onCreate): Call removeOldTasks. * java/org/gnu/emacs/EmacsWindowManager.java (removeOldTasks): New function. * java/proguard.conf: Optimize optimizer configuration. --- java/org/gnu/emacs/EmacsService.java | 12 +++++-- java/org/gnu/emacs/EmacsWindowManager.java | 41 ++++++++++++++++++++++ java/proguard.conf | 32 ++++++++--------- 3 files changed, 66 insertions(+), 19 deletions(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index b8ff98e79a7..fd052653087 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -234,6 +234,8 @@ public final class EmacsService extends Service final double scaledDensity; double tempScaledDensity; + super.onCreate (); + SERVICE = this; handler = new Handler (Looper.getMainLooper ()); manager = getAssets (); @@ -247,9 +249,9 @@ public final class EmacsService extends Service resolver = getContentResolver (); mainThread = Thread.currentThread (); - /* If the density used to compute the text size is lesser than - 160, there's likely a bug with display density computation. - Reset it to 160 in that case. + /* If the density used to compute the text size is smaller than 160, + there's likely a bug with display density computation. Reset it + to 160 in that case. Note that Android uses 160 ``dpi'' as the density where 1 point corresponds to 1 pixel, not 72 or 96 as used elsewhere. This @@ -262,6 +264,10 @@ public final class EmacsService extends Service the nested function below. */ scaledDensity = tempScaledDensity; + /* Remove all tasks from previous Emacs sessions but the task + created by the system at startup. */ + EmacsWindowManager.MANAGER.removeOldTasks (this); + try { /* Configure Emacs with the asset manager and other necessary diff --git a/java/org/gnu/emacs/EmacsWindowManager.java b/java/org/gnu/emacs/EmacsWindowManager.java index a193d49d0ec..49f0ebd5841 100644 --- a/java/org/gnu/emacs/EmacsWindowManager.java +++ b/java/org/gnu/emacs/EmacsWindowManager.java @@ -27,6 +27,7 @@ import android.app.ActivityManager; import android.app.ActivityOptions; +import android.content.ComponentName; import android.content.Context; import android.content.Intent; @@ -385,4 +386,44 @@ && isWindowEligible (consumer, window)) window.onActivityDetached (); } } + + /* Iterate over each of Emacs's tasks to delete such as belong to a + previous Emacs session, i.e., tasks created for a previous + session's non-initial frames. CONTEXT should be a context from + which to obtain a reference to the activity manager. */ + + public void + removeOldTasks (Context context) + { + List appTasks; + RecentTaskInfo info; + ComponentName name; + String target; + Object object; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.LOLLIPOP) + return; + + if (activityManager == null) + { + object = context.getSystemService (Context.ACTIVITY_SERVICE); + activityManager = (ActivityManager) object; + } + + appTasks = activityManager.getAppTasks (); + target = ".EmacsMultitaskActivity"; + + for (AppTask task : appTasks) + { + info = task.getTaskInfo (); + + /* Test whether info is a reference to + EmacsMultitaskActivity. */ + if (info.baseIntent != null + && (name = info.baseIntent.getComponent ()) != null + && name.getShortClassName ().equals (target)) + /* Delete the task. */ + task.finishAndRemoveTask (); + } + } }; diff --git a/java/proguard.conf b/java/proguard.conf index e6b08f76fe4..5da402946bb 100644 --- a/java/proguard.conf +++ b/java/proguard.conf @@ -20,22 +20,22 @@ # The effect of the following lines is to inhibit the removal of variable or # method symbol names from symbols referenced from C. --keep,allowoptimization class org.gnu.emacs.EmacsClipboard { ; } --keep,allowoptimization class org.gnu.emacs.EmacsContextMenu { ; } --keep,allowoptimization class org.gnu.emacs.EmacsCursor { ; } --keep,allowoptimization class org.gnu.emacs.EmacsDesktopNotification { ; } --keep,allowoptimization class org.gnu.emacs.EmacsDialog { ; } --keep,allowoptimization class org.gnu.emacs.EmacsDirectoryEntry { ; } --keep,allowoptimization class org.gnu.emacs.EmacsFontDriver { ; } --keep,allowoptimization class org.gnu.emacs.EmacsFontDriver$* { ; } --keep,allowoptimization class org.gnu.emacs.EmacsGC { ; ; } --keep,allowoptimization class org.gnu.emacs.EmacsHandleObject { ; } --keep,allowoptimization class org.gnu.emacs.EmacsPixmap { ; } --keep,allowoptimization class org.gnu.emacs.EmacsService { ; } --keep,allowoptimization class org.gnu.emacs.EmacsWindow { ; } --keep,allowoptimization class org.gnu.emacs.EmacsNative { ; } --keep,allowoptimization class org.gnu.emacs.EmacsNoninteractive { ; } --keep,allowoptimization interface org.gnu.emacs.EmacsDrawable { ; } +-keep,allowoptimization class org.gnu.emacs.EmacsClipboard { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsContextMenu { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsCursor { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsDesktopNotification { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsDialog { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsDirectoryEntry { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsFontDriver { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsFontDriver$* { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsGC { public ; public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsHandleObject { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsPixmap { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsService { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsWindow { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsNative { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsNoninteractive { public ; } +-keep,allowoptimization interface org.gnu.emacs.EmacsDrawable { public ; } # And these lines inhibit the deletion of symbols that are referenced by # the operating system while enabling the compiler to minify or delete From b2842b25bf7fc934cf86b82d1053db55fd55c00b Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 14 Apr 2024 08:21:56 +0000 Subject: [PATCH 041/149] CC Mode: Don't start fontifying in the middle of an identifier This fixes bug#70367. * lisp/progmodes/cc-mode.el (c-fl-decl-start): After searching backwards for the end of the previous statement, check whether or not we found it. --- lisp/progmodes/cc-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 1a9d0907bd0..5f11622733f 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2463,7 +2463,7 @@ with // and /*, not more generic line and block comments." (backward-char) (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state))))))) (goto-char pseudo)) - t) + (or pseudo (> (point) bod-lim))) ;; Move forward to the start of the next declaration. (progn (c-forward-syntactic-ws) ;; Have we got stuck in a comment at EOB? From 7add47337b62064998a5b80f357acc39b1253e98 Mon Sep 17 00:00:00 2001 From: Earl Hyatt Date: Sun, 24 Mar 2024 11:49:21 -0400 Subject: [PATCH 042/149] Add command 'list-keyboard-macros' that works like 'list-buffers'. The command 'list-keyboard-macros' allows editing and re-arranging macros using 'tabulated-list-mode'. Existing keyboard macros can be duplicated or deleted. Macro counters and counter formats can take new values read from the minibuffer. Macro keys can be edited using 'edit-kbd-macro'. * doc/emacs/kmacro.texi (Kmacro Menu): Document the new command and the menu's commands. * etc/NEWS (Kmacro Menu Mode): Mention the new mode and command. * lisp/kmacro.el (kmacro-menu-mark, kmacro-menu-marked) (kmacro-menu-flagged): Add faces for marks and flags. * lisp/kmacro.el (kmacro-menu-mode-map, kmacro-menu-mode): Add mode and map. * lisp/kmacro.el (list-keyboard-macros, kmacro-menu): Add command. * lisp/kmacro.el (kmacro-menu--deletion-flags, kmacro-menu--marks) (kmacro-menu--id-kmacro, kmacro-menu--id-position, kmacro-menu--kmacros) (kmacro-menu--refresh, kmacro-menu--map-ids, kmacro-menu--replace-all) (kmacro-menu--replace-at, kmacro-menu--query-revert, kmacro-menu--assert-row) (kmacro-menu--propertize-keys, kmacro-menu--do-region) (kmacro-menu--marks-exist-p): Add utility functions of mode and commands. * lisp/kmacro.el (kmacro-menu-mark, kmacro-menu-flag-for-deletion) (kmacro-menu-unmark, kmacro-menu-unmark-backward) (kmacro-menu-unmark-all): Add commands for marks and flags. * lisp/kmacro.el (kmacro-menu-do-flagged-delete, kmacro-menu-do-copy) (kmacro-menu-do-delete): Add commands that modify the ring. * lisp/kmacro.el (kmacro-menu-edit-position, kmacro-menu-transpose) (kmacro-menu-edit-format, kmacro-menu-edit-counter) (kmacro-menu-edit-keys, kmacro-menu-edit-column): Add commands that modify a keyboard macro. --- doc/emacs/kmacro.texi | 162 ++++++++++++ etc/NEWS | 10 + lisp/kmacro.el | 558 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 730 insertions(+) diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi index e30def34475..4a8d4d4f093 100644 --- a/doc/emacs/kmacro.texi +++ b/doc/emacs/kmacro.texi @@ -42,6 +42,8 @@ intelligent or general. For such things, Lisp must be used. * Edit Keyboard Macro:: Editing keyboard macros. * Keyboard Macro Step-Edit:: Interactively executing and editing a keyboard macro. +* Kmacro Menu:: An interface for listing and editing + keyboard macros and the keyboard macro ring. @end menu @node Basic Keyboard Macro @@ -616,3 +618,163 @@ including the final @kbd{C-j}), and appends them at the end of the keyboard macro; it then terminates the step-editing and replaces the original keyboard macro with the edited macro. @end itemize + +@node Kmacro Menu +@section Listing and Editing Keyboard Macros +@cindex Kmacro Menu + +@cindex listing current keyboard macros +@kindex M-x list-keyboard-macros @key{RET} +@findex kmacro-menu +@findex list-keyboard-macros + To display a list of existing keyboard macros, type @kbd{M-x +list-keyboard-macros @key{RET}}. This pops up the @dfn{Kmacro Menu} in +a buffer named @file{*Keyboard Macro List*}. Each line in the list +shows one macro's position, counter value, counter format, that counter +value using that format, and macro keys. Here is an example of a macro +list: + +@smallexample +Position Counter Format Formatted Keys +0 8 %02d 08 N : SPC RET +1 0 %d 0 l o n g SPC p h r a s e +@end smallexample + +@noindent +The macros are listed with the current macro at the top in position +number zero and the older macros in the order in which they are found in +the keyboard macro ring (@pxref{Keyboard Macro Ring}). Using the Kmacro +Menu, you can change the order of the macros and change their counters, +counter formats, and keys. The Kmacro Menu is a read-only buffer, and +can be changed only through the special commands described in this +section. After a command is run, the Kmacro Menu displays changes to +reflect the new values of the macro properties and the macro ring. You +can use the usual cursor motion commands in this buffer, as well as +special motion commands for navigating the table. To view a list of the +special commands, type @kbd{C-h m} or @kbd{?} (@code{describe-mode}) in +the Kmacro Menu. + + You can use the following commands to change a macro's properties: + +@table @kbd +@item # +@findex kmacro-menu-edit-position +@kindex # @r{(Kmacro Menu)} +Change the position of the macro on the current line +(@pxref{Keyboard Macro Ring}). + +@item C-x C-t +@findex kmacro-menu-transpose +@kindex C-x C-t @r{(Kmacro Menu)} +Move the macro on the current line to the line above, like in +@code{transpose-lines}. + +@item c +@findex kmacro-menu-edit-counter +@kindex c @r{(Kmacro Menu)} +Change the counter value of the macro on the current line +(@pxref{Keyboard Macro Counter}). + +@item f +@findex kmacro-menu-edit-format +@kindex f @r{(Kmacro Menu)} +Change the counter format of the macro on the current line. + +@item e +@findex kmacro-menu-edit-keys +@kindex e @r{(Kmacro Menu)} +Change the keys of the macro on the current line using +@code{edit-kbd-macro} (@pxref{Edit Keyboard Macro}). + +@item @key{RET} +@findex kmacro-menu-edit-column +@kindex @key{RET} @r{(Kmacro Menu)} +Change the value in the current column of the macro on the current line +using commands above. +@end table + + The following commands delete or duplicate macros in the list: + +@table @kbd +@item d +@findex kmacro-menu-flag-for-deletion +@item d @r{(Kmacro Menu)} +Flag the macro on the current line for deletion, then move point to the +next line (@code{kmacro-menu-flag-for-deletion}). The deletion flag is +indicated by the character @samp{D} at the start of line. The deletion +occurs only when you type the @kbd{x} command (see below). + + If the region is active, this command flags all of the macros in the +region. + +@item x +@findex kmacro-menu-do-flagged-delete +@item x @r{(Kmacro Menu)} +Delete the macros in the list that have been flagged for deletion +(@code{kmacro-menu-do-flagged-delete}). + +@item m +@findex kmacro-menu-mark +@item m @r{(Kmacro Menu)} +Mark the macro on the current line, then move point to the next line +(@code{kmacro-menu-mark}). Marked macros are indicated by the character +@samp{*} at the start of line. Marked macros can be operated on by the +@kbd{C} and @kbd{D} commands (see below). + + If the region is active, this command marks all of the macros in the +region. + +@item C +@findex kmacro-menu-do-copy +@item C @r{(Kmacro Menu)} +This command copies macros by duplicating them at their current +positions in the list (@code{kmacro-menu-do-copy}). For example, +running this command on the macro at position number zero will insert a +copy of that macro into position number one and move the remaining +macros down. + + If the region is active, this command duplicates the macros in the +region. Otherwise, if there are marked macros, this command duplicates +the marked macros. If there is no region nor are there marked macros, +this command duplicates the macro on the current line. In the first two +cases, the command prompts for confirmation before duplication. + +@item D +@findex kmacro-menu-do-delete +@item D @r{(Kmacro Menu)} +This command deletes macros, removing them from the ring +(@code{kmacro-menu-do-delete}). For example, running this command on +the macro at position number zero will delete the current macro and then +make the first macro in the macro ring (previously at position number +one) the new current macro, popping it from the ring. + + If the region is active, this command deletes the macros in the +region. Otherwise, if there are marked macros, this command deletes the +marked macros. If there is no region nor are there marked macros, this +command deletes the macro on the current line. In all cases, the +command prompts for confirmation before deletion. + + This command is an alternative to the @kbd{d} and @kbd{x} commands +(see above). + +@item u +@findex kmacro-menu-unmark +@item u @r{(Kmacro Menu)} +Unmark and unflag the macro on the current line, then move point down +to the next line (@code{kmacro-menu-unmark}). If there is an active +region, this command unmarks and unflags all of the macros in the +region. + +@item @key{DEL} +@findex kmacro-menu-unmark-backward +@item @key{DEL} @r{(Kmacro Menu)} +Like the @kbd{u} command (see above), but move point up to the previous +line when there is no active region +(@code{kmacro-menu-unmark-backward}). + +@item U +@findex kmacro-menu-unmark-all +@item U @r{(Kmacro Menu)} +Unmark and unflag all macros in the list +(@code{kmacro-menu-unmark-all}). +@end table diff --git a/etc/NEWS b/etc/NEWS index 7a73815179c..bc8be557711 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1510,6 +1510,16 @@ macros with many lines, such as from 'kmacro-edit-lossage'. The user option 'proced-auto-update-flag' can now be set to 2 additional values, which control automatic updates of Proced buffers that are not displayed in some window. +** Kmacro Menu Mode + ++++ +*** New mode 'kmacro-menu-mode' and new command 'list-keyboard-macros'. +The new command 'list-keyboard-macros' is the keyboard-macro version +of commands like 'list-buffers' and 'list-processes', creating a listing +of the currently existing keyboards macros using the new mode +'kmacro-menu-mode'. It allows rearranging the macros in the ring, +duplicating them, deleting them, and editing their counters, formats, +and keys. ** Miscellaneous diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 897ebf14330..a16f70105c1 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -1388,6 +1388,564 @@ To customize possible responses, change the \"bindings\" in (let ((executing-kbd-macro nil)) (redisplay)))) +;;; Mode and commands for working with the ring in a table + +(defface kmacro-menu-mark '((t (:inherit font-lock-constant-face))) + "Face used for the Keyboard Macro Menu marks." + :group 'kmacro + :version "30.1") + +(defface kmacro-menu-flagged '((t (:inherit error))) + "Face used for keyboard macros flagged for deletion." + :group 'kmacro + :version "30.1") + +(defface kmacro-menu-marked '((t (:inherit warning))) + "Face used for keyboard macros marked for duplication." + :group 'kmacro + :version "30.1") + +(defvar-keymap kmacro-menu-mode-map + :doc "Keymap for `kmacro-menu-mode'." + :parent tabulated-list-mode-map + "#" #'kmacro-menu-edit-position + "c" #'kmacro-menu-edit-counter + "e" #'kmacro-menu-edit-keys + "f" #'kmacro-menu-edit-format + "RET" #'kmacro-menu-edit-column + + "C" #'kmacro-menu-do-copy + "D" #'kmacro-menu-do-delete + "m" #'kmacro-menu-mark + + "d" #'kmacro-menu-flag-for-deletion + "x" #'kmacro-menu-do-flagged-delete + + "u" #'kmacro-menu-unmark + "U" #'kmacro-menu-unmark-all + "DEL"#'kmacro-menu-unmark-backward + + " " #'kmacro-menu-transpose) + +(define-derived-mode kmacro-menu-mode tabulated-list-mode + "Keyboard Macro Menu" + "Major mode for listing and editing keyboard macros." + (make-local-variable 'kmacro-menu--marks) + (make-local-variable 'kmacro-menu--deletion-flags) + (setq-local tabulated-list-format + [("Position" 8 nil) + ("Counter" 8 nil :right-align t :pad-right 2) + ("Format" 8 nil) + ("Formatted" 10 nil) + ("Keys" 1 nil)]) + (setq-local tabulated-list-padding 2) + (add-hook 'tabulated-list-revert-hook #'kmacro-menu--refresh nil t) + (tabulated-list-init-header) + (unless (kmacro-ring-empty-p) + (kmacro-menu--refresh) + (tabulated-list-print))) + +;;;###autoload +(defalias 'kmacro-menu #'list-keyboard-macros) +;;;###autoload +(defun list-keyboard-macros () + "List the keyboard macros." + (interactive) + (let ((buf (get-buffer-create "*Keyboard Macro List*"))) + (with-current-buffer buf + (kmacro-menu-mode)) + (pop-to-buffer buf))) + +;;;; Utility functions and mode data + +(defvar kmacro-menu--deletion-flags nil + "Alist of entries flagged for deletion.") + +(defvar kmacro-menu--marks nil + "Alist of entries marked for copying and duplication.") + +(defun kmacro-menu--id-kmacro (entry-id) + "Return the keyboard macro that is part of the ENTRY-ID." + (car entry-id)) + +(defun kmacro-menu--id-position (entry-id) + "Return the ordinal position that is part of the ENTRY-ID." + (cdr entry-id)) + +(defun kmacro-menu--kmacros () + "Return the list of the existing keyboard macros or nil, if none are defined." + (when last-kbd-macro + (cons (kmacro-ring-head) + kmacro-ring))) + +(defun kmacro-menu--refresh () + "Reset the list of keyboard macros." + (setq-local tabulated-list-entries + (seq-map-indexed (lambda (km idx) + (let ((cnt (kmacro--counter km)) + (fmt (kmacro--format km))) + `((,km . ,idx) + [,(format "%d" idx) + ,(format "%d" cnt) + ,fmt + ,(format fmt cnt) + ,(format-kbd-macro (kmacro--keys km))]))) + (kmacro-menu--kmacros)) + kmacro-menu--deletion-flags nil + kmacro-menu--marks nil) + (tabulated-list-clear-all-tags)) + +(defun kmacro-menu--map-ids (function) + "Apply FUNCTION to the current table's entry IDs in order. + +Return a list of the output of FUNCTION." + (mapcar function + (mapcar #'car + (seq-sort-by #'cdar #'< tabulated-list-entries)))) + +(defun kmacro-menu--replace-all (kmacros) + "Replace the existing keyboard macros with those in KMACROS. + +The first element in the list overwrites the values of `last-kbd-macro', +`kmacro-counter', and `kmacro-counter-format'. The remaining elements +become the value of `kmacro-ring'. + +KMACROS is a list of `kmacro' objects." + (if (null kmacros) + (setq last-kbd-macro nil + kmacro-counter-format kmacro-default-counter-format + kmacro-counter 0 + kmacro-ring nil) + (if (not (seq-every-p #'kmacro-p kmacros)) + (error "All elements must satisfy `kmacro-p'") + (kmacro-split-ring-element (car kmacros)) + (setq kmacro-ring (cdr kmacros))))) + +(defun kmacro-menu--replace-at (kmacro n) + "Replace the keyboard macro at position N with KMACRO. + +This function replaces all of the existing keyboard macros via +`kmacro-menu--replace-all'. Except for the macro at position N, which will +be KMACRO, the replacement macros are the existing macros identified in +the table." + (kmacro-menu--replace-all + (kmacro-menu--map-ids (lambda (id) + (if (= n (kmacro-menu--id-position id)) + kmacro + (kmacro-menu--id-kmacro id)))))) + +(defun kmacro-menu--query-revert () + "If the table differs from the existing macros, ask whether to revert table." + (when (and (not (equal (kmacro-menu--kmacros) + (kmacro-menu--map-ids #'kmacro-menu--id-kmacro))) + (yes-or-no-p "Table does not match existing keyboard macros. Stop and revert table?")) + (tabulated-list-revert) + (signal 'quit nil))) + +(defun kmacro-menu--assert-row (&optional id) + "Signal an error if point is not on a table row. + +ID is the tabulated list id of the supposed entry at point." + (unless (or id (tabulated-list-get-id)) + (user-error "Not on a table row"))) + +(defun kmacro-menu--propertize-keys (face) + "Redisplay the macro keys on the current line with FACE." + (tabulated-list-set-col 4 (propertize (aref (tabulated-list-get-entry) 4) + 'face face))) + +(defun kmacro-menu--do-region (function) + "Run FUNCTION on macros in the region or on the current line at the line start. + +If there is an active region, for each line in the region, move to the +beginning of the line and apply FUNCTION to the table entry ID of the +line. If there is no region, apply FUNCTION only to the table entry ID +of the current line. + +When there is no active region, advance to the beginning of the next +line after applying FUNCTION." + (if (use-region-p) + (save-excursion + (let* ((reg-beg (region-beginning)) + (reg-end (region-end)) + (line-beg (progn + (goto-char reg-beg) + (pos-bol))) + (line-end (progn + (goto-char reg-end) + (if (bolp) + reg-end + (pos-bol 2))))) + (goto-char line-beg) + (let ((id)) + (while (and (< (point) line-end) + (setq id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (funcall function id) + (forward-line 1))))) + (let ((id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (goto-char (pos-bol)) + (funcall function id) + (forward-line 1)))) + +(defun kmacro-menu--marks-exist-p () + "Return non-nil if markers exist for any table entries." + (let ((tag (gensym))) + (catch tag + (kmacro-menu--map-ids (lambda (id) + (when (alist-get (kmacro-menu--id-position id) + kmacro-menu--marks) + (throw tag t)))) + nil))) + +;;;; Commands for Marks and Flags + +(defun kmacro-menu-mark () + "Mark macros in the region or on the current line. + +If there's an active region, mark macros in the region; otherwise mark +the macro on the current line. If marking the current line, move point +to the next line when done. + +Marked macros can be operated on by `kmacro-menu-do-copy' and +`kmacro-menu-do-delete'." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (kmacro-menu--do-region + (lambda (id) + (setf (alist-get (kmacro-menu--id-position id) + kmacro-menu--marks) + t) + (kmacro-menu--propertize-keys 'kmacro-menu-marked) + (tabulated-list-put-tag #("*" 0 1 (face kmacro-menu-mark)))))) + +(defun kmacro-menu-flag-for-deletion () + "Flag macros in the region or on the current line. + +If there's an active region, flag macros in the region; otherwise flag +the macro on the current line. If there is no active region, move point +to the next line when done. + +Flagged macros can be deleted via `kmacro-menu-do-flagged-delete'." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (kmacro-menu--do-region + (lambda (id) + (setf (alist-get (kmacro-menu--id-position id) + kmacro-menu--deletion-flags) + t) + (kmacro-menu--propertize-keys 'kmacro-menu-flagged) + (tabulated-list-put-tag #("D" 0 1 (face kmacro-menu-mark)))))) + +(defun kmacro-menu-unmark () + "Unmark and unflag macros in the region or on the current line. + +If there's an active region, unmark and unflag macros in the region; +otherwise unmark and unflag the macro on the current line. If there is +no active region, move point to the next line when done." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (kmacro-menu--do-region + (lambda (id) + (let ((pos (kmacro-menu--id-position id))) + (setf (alist-get pos kmacro-menu--deletion-flags) nil + (alist-get pos kmacro-menu--marks) nil)) + (kmacro-menu--propertize-keys 'default) + (tabulated-list-put-tag " ")))) + +(defun kmacro-menu-unmark-backward () + "Like `kmacro-menu-unmark', but move backwards instead of forwards." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (let ((go-back (not (use-region-p)))) + (kmacro-menu-unmark) + (when go-back + (forward-line -2)))) + +(defun kmacro-menu-unmark-all () + "Unmark and unflag all listed keyboard macros." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (setq-local kmacro-menu--deletion-flags nil + kmacro-menu--marks nil) + (save-excursion + (goto-char (point-min)) + (while (tabulated-list-get-id) + (kmacro-menu--propertize-keys 'default) + (forward-line 1)) + (tabulated-list-clear-all-tags))) + +;;;; Commands that Modify the Ring + +(defun kmacro-menu-do-flagged-delete () + "Delete keyboard macros flagged via `kmacro-menu-flag-for-deletion'." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (let ((res) + (num-deletes 0)) + (kmacro-menu--map-ids (lambda (id) + (if (alist-get (kmacro-menu--id-position id) + kmacro-menu--deletion-flags) + (setq num-deletes (1+ num-deletes)) + (push (kmacro-menu--id-kmacro id) res)))) + (when (yes-or-no-p (if (= 1 num-deletes) + "Delete 1 flagged keyboard macro?" + (format "Delete %d flagged keyboard macros?" + num-deletes))) + (kmacro-menu--replace-all + (nreverse res)) + (tabulated-list-revert)))) + +(defun kmacro-menu-do-copy () + "Duplicate macros in the region, those with markers, or the one at point. + +Macros are duplicated at their current position in the macro ring. + +If there's an active region, duplicate macros in the region; otherwise +duplicate the marked macros or, if there are no marks, the macro on the +current line." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (let* ((region-exists (use-region-p)) + (mark-exists (kmacro-menu--marks-exist-p)) + (id-alist (if (or region-exists + (not mark-exists)) + (let ((region-alist)) + (kmacro-menu--do-region + (lambda (id) + (push (cons (kmacro-menu--id-position id) + t) + region-alist))) + region-alist) + kmacro-menu--marks)) + (num-duplicates 0)) + (let ((res)) + (kmacro-menu--map-ids (lambda (id) + (let ((pos (kmacro-menu--id-position id)) + (km (kmacro-menu--id-kmacro id))) + (push km res) + (when (alist-get pos id-alist) + (push km res) + (setq num-duplicates (1+ num-duplicates)))))) + ;; Confirm the action if we operated on marks or the region, but + ;; don't confirm if operating on a single line without a region. + (when (if (or mark-exists region-exists) + (yes-or-no-p (if (= 1 num-duplicates) + "Copy (duplicate) 1 keyboard macro?" + (format "Copy (duplicate) %d keyboard macros?" + num-duplicates))) + t) + (kmacro-menu--replace-all (nreverse res)) + (tabulated-list-revert))))) + +(defun kmacro-menu-do-delete () + "Delete macros in the region, those with markers, or the one at point. + +If there's an active region, delete macros in the region; otherwise +delete the marked macros or, if there are no marks, the macro on the +current line." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--query-revert) + (let ((num-deletes 0) + (id-alist (if (or (use-region-p) + (not (kmacro-menu--marks-exist-p))) + (let ((region-alist)) + (kmacro-menu--do-region + (lambda (id) + (push (cons (kmacro-menu--id-position id) + t) + region-alist))) + region-alist) + kmacro-menu--marks))) + (let ((res)) + (kmacro-menu--map-ids (lambda (id) + (if (alist-get (kmacro-menu--id-position id) + id-alist) + (setq num-deletes (1+ num-deletes)) + (push (kmacro-menu--id-kmacro id) res)))) + (when (yes-or-no-p (if (= 1 num-deletes) + "Delete 1 keyboard macro?" + (format "Delete %d keyboard macros?" + num-deletes))) + (kmacro-menu--replace-all (nreverse res)) + (tabulated-list-revert))))) + +;;;; Commands that Modify a Keyboard Macro + +(defun kmacro-menu-edit-position () + "Move the keyboard macro at point to a new position. + +See the Info node `(emacs) Keyboard Macro Ring' for more information." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (let ((id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (kmacro-menu--query-revert) + (let* ((new-position (min (length tabulated-list-entries) + (max 0 + (read-number "New position: " 0)))) + (old-km (kmacro-menu--id-kmacro id)) + (old-pos (kmacro-menu--id-position id))) + (unless (= old-pos new-position) + (kmacro-menu--replace-all + (let ((res) + (true-new-pos (if (> new-position old-pos) + (1+ new-position) + new-position))) + (kmacro-menu--map-ids (lambda (this-id) + (let ((this-km (kmacro-menu--id-kmacro this-id)) + (this-pos (kmacro-menu--id-position this-id))) + (unless (= old-pos this-pos) + (when (= this-pos true-new-pos) + (push old-km res)) + (push this-km res))))) + (when (>= true-new-pos + (length tabulated-list-entries)) + (push old-km res)) + (nreverse res))) + (tabulated-list-revert))))) + +(defun kmacro-menu-transpose () + "Swap the keyboard macro at point with the one above, then move to the next line. + +If point is on the first line (position number 0), then swap the macros +at position numbers 0 and 1, then move point to the third line. + +Note that this is the earlier position in the ring, not the sorted +table." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (let ((id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (kmacro-menu--query-revert) + (let* ((old-pos (kmacro-menu--id-position id)) + (first-line (= 0 old-pos)) + (end-lines-forward (if first-line + 2 + (+ 3 old-pos)))) + ;; When transposing the first two macros, we don't use + ;; `kmacro-swap-ring' here because it is possible for the user to + ;; choose to not refresh the table when it is out of date. + (kmacro-menu--replace-all + (let ((res)) + (kmacro-menu--map-ids + (if first-line + (let ((old-km (kmacro-menu--id-kmacro id))) + (lambda (this-id) + (let ((this-pos (kmacro-menu--id-position this-id))) + (unless (= 0 this-pos) + (push (kmacro-menu--id-kmacro this-id) res) + (when (= 1 this-pos) + (push old-km res)))))) + (let ((new-pos (1- old-pos))) + (lambda (this-id) + (let ((this-pos (kmacro-menu--id-position this-id))) + (unless (= old-pos this-pos) + (when (= new-pos this-pos) + (push (kmacro-menu--id-kmacro id) res)) + (push (kmacro-menu--id-kmacro this-id) res))))))) + (nreverse res))) + (tabulated-list-revert) + (goto-char (point-min)) + (forward-line end-lines-forward)))) + +(defun kmacro-menu-edit-format () + "Edit the counter format of the keyboard macro at point. + +Valid counter formats are those for integers accepted by the function +`format'. + +See the command `kmacro-set-format' and the Info node `(emacs) Keyboard +Macro Counter' for more information." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (let ((id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (kmacro-menu--query-revert) + (let ((km (kmacro-menu--id-kmacro id))) + (kmacro-menu--replace-at + (kmacro (kmacro--keys km) + (kmacro--counter km) + (read-string "New format: " nil nil + (list kmacro-default-counter-format + (kmacro--format km)))) + (kmacro-menu--id-position id)) + (tabulated-list-revert)))) + +(defun kmacro-menu-edit-counter () + "Edit the counter of the keyboard macro at point. + +See Info node `(emacs) Keyboard Macro Counter' for more +information." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (let ((id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (kmacro-menu--query-revert) + (let ((km (kmacro-menu--id-kmacro id))) + (kmacro-menu--replace-at + (kmacro (kmacro--keys km) + (read-number "New counter: " + (list 0 + (kmacro--counter + (kmacro-menu--id-kmacro id)))) + (kmacro--format km)) + (kmacro-menu--id-position id)) + (tabulated-list-revert)))) + +(defun kmacro-menu-edit-keys () + "Edit the keys of the keyboard macro at point via `edmacro-mode'. + +See Info node `(emacs) Edit Keyboard Macro' for more +information." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (let ((id (tabulated-list-get-id))) + (kmacro-menu--assert-row id) + (kmacro-menu--query-revert) + (let* ((old-km (kmacro-menu--id-kmacro id))) + (edit-kbd-macro (kmacro--keys old-km) + nil + nil + (lambda (mac) + (kmacro-menu--replace-at + (kmacro mac + (kmacro--counter old-km) + (kmacro--format old-km)) + (kmacro-menu--id-position id)) + (tabulated-list-revert)))))) + +(defun kmacro-menu-edit-column () + "Edit the value in the current column of the keyboard macro at point." + (declare (modes kmacro-menu-mode)) + (interactive nil kmacro-menu-mode) + (kmacro-menu--assert-row) + (kmacro-menu--query-revert) + (pcase (get-text-property (point) 'tabulated-list-column-name) + ('nil (let ((pos (point))) + ;; If we didn't find a column, try moving forwards or + ;; backwards to the nearest column. + (tabulated-list-next-column 1) + (when (= pos (point)) + (tabulated-list-previous-column 1)) + (if (null (get-text-property (point) 'tabulated-list-column-name)) + (user-error "No column at point") + (kmacro-menu-edit-column)))) + ("Position" (call-interactively #'kmacro-menu-edit-position)) + ("Counter" (call-interactively #'kmacro-menu-edit-counter)) + ("Format" (call-interactively #'kmacro-menu-edit-format)) + ("Formatted" (user-error "Formatted counter is not editable")) + ("Keys" (call-interactively #'kmacro-menu-edit-keys)))) + (provide 'kmacro) ;;; kmacro.el ends here From 616af565796f8c690dd9c7d1b2fa7607f2e2fa1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 13 Apr 2024 17:43:34 +0200 Subject: [PATCH 043/149] ; * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): less consing --- lisp/emacs-lisp/macroexp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index b87b749dd76..bb4797cac8b 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -351,7 +351,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (let ((default-tail nil) (n 0) (rest clauses)) - (while rest + (while (cdr rest) (let ((c (car-safe (car rest)))) (when (cond ((consp c) (and (memq (car c) '(quote function)) (cadr c))) From 5971aa1fd32583a8d50b67a56cf1b40f1665fca0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 14 Apr 2024 13:16:29 +0300 Subject: [PATCH 044/149] * lisp/dnd.el (dnd-handle-movement): Avoid errors (bug#70311). --- lisp/dnd.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/dnd.el b/lisp/dnd.el index 89652d32abf..b68dc269354 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -149,8 +149,13 @@ Windows." (with-selected-window window (scroll-down 1)))))))) (when dnd-indicate-insertion-point - (ignore-errors - (goto-char (posn-point posn))))))) + (let ((pos (posn-point posn))) + ;; We avoid errors here, since on some systems this runs + ;; when waiting_for_input is non-zero, and that aborts on + ;; error. + (if (and pos (<= (point-min) pos (point-max))) + (goto-char pos) + pos)))))) (defun dnd-handle-one-url (window action url) "Handle one dropped url by calling the appropriate handler. From 85ece8b494429b5ae36e79d7b4ad85a993f73543 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 14 Apr 2024 12:47:43 +0200 Subject: [PATCH 045/149] ; * src/eval.c (funcall_lambda): Sink specpdl load out of fast path. --- src/eval.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/eval.c b/src/eval.c index f48d7b0682f..7f7a70b15ae 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3158,13 +3158,9 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) or a module function. */ static Lisp_Object -funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, - register Lisp_Object *arg_vector) +funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) { - Lisp_Object val, syms_left, next, lexenv; - specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t i; - bool optional, rest; + Lisp_Object syms_left, lexenv; if (CONSP (fun)) { @@ -3211,13 +3207,16 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else emacs_abort (); - i = optional = rest = 0; + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t i = 0; + bool optional = false; + bool rest = false; bool previous_rest = false; for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { maybe_quit (); - next = XCAR (syms_left); + Lisp_Object next = XCAR (syms_left); if (!SYMBOLP (next)) xsignal1 (Qinvalid_function, fun); @@ -3269,6 +3268,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, /* Instantiate a new lexical environment. */ specbind (Qinternal_interpreter_environment, lexenv); + Lisp_Object val; if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); else if (SUBR_NATIVE_COMPILEDP (fun)) From cd113d8c45ccf3bfa8b687c06a5d03618adf7a2c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 14 Apr 2024 12:07:23 -0400 Subject: [PATCH 046/149] text.texi (Tracking changes): Fix warning * doc/lispref/text.texi (Change Hooks): Add a menu to silence warnings. (Tracking changes): Improve the title. --- doc/lispref/text.texi | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 0cd4e2c614e..07fb730f0f1 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -6386,8 +6386,12 @@ use @code{combine-change-calls} or @code{combine-after-change-calls} instead. @end defvar +@menu +* Tracking changes:: Keeping track of buffer modifications. +@end menu + @node Tracking changes -@subsection Tracking changes +@subsection Keeping track of buffer modifications @cindex track-changes @cindex change tracker From 568c1741352a4932508fbbd474b9fd9ebe90ddfb Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 14 Apr 2024 19:18:31 +0300 Subject: [PATCH 047/149] Add 'forward-sexp-default-function' to be used by 'treesit-forward-sexp' * lisp/emacs-lisp/lisp.el (forward-sexp-default-function): New function with body from 'forward-sexp' (bug#68993). (forward-sexp-function): Change the default value from nil to 'forward-sexp-default-function'. (forward-sexp): Use either 'forward-sexp-function' or 'forward-sexp-default-function'. * lisp/treesit.el (treesit-forward-sexp): In nodes of type 'text' fall back to 'forward-sexp-default-function'. Improve docstring. * doc/lispref/positions.texi (List Motion): Fix pxref. --- doc/lispref/positions.texi | 4 ++-- etc/NEWS | 4 ++++ lisp/emacs-lisp/lisp.el | 14 +++++++++----- lisp/treesit.el | 20 +++++++++++++++----- 4 files changed, 30 insertions(+), 12 deletions(-) diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 5e0143c7131..9193c1063d1 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -892,8 +892,8 @@ parser information to move across syntax constructs. Since what exactly is considered a sexp varies between languages, a major mode should set @code{treesit-thing-settings} to determine that. Then the mode can get navigation-by-sexp functionality for free, by using -@code{forward-sexp} and @code{backward-sexp}(@pxref{Moving by -Sentences,,, emacs, The extensible self-documenting text editor}). +@code{forward-sexp} and @code{backward-sexp}(@pxref{Expressions, +,, emacs, The extensible self-documenting text editor}). @node Skipping Characters @subsection Skipping Characters diff --git a/etc/NEWS b/etc/NEWS index bc8be557711..99f33a7b8dd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2103,6 +2103,10 @@ All tree-sitter enabled modes that define 'sentence' in ** Functions and variables to move by program sexps +*** New function 'forward-sexp-default-function'. +The previous implementation of 'forward-sexp' is moved into its +own function, to be bound by 'forward-sexp-function'. + *** New function 'treesit-forward-sexp'. Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index c57b1357f63..bd0b38db7ea 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -45,7 +45,12 @@ This affects `insert-parentheses' and `insert-pair'." :type 'boolean :group 'lisp) -(defvar forward-sexp-function nil +(defun forward-sexp-default-function (&optional arg) + "Default function for `forward-sexp-function'." + (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) + (if (< arg 0) (backward-prefix-chars))) + +(defvar forward-sexp-function #'forward-sexp-default-function ;; FIXME: ;; - for some uses, we may want a "sexp-only" version, which only ;; jumps over a well-formed sexp, rather than some dwimish thing @@ -74,10 +79,9 @@ report errors as appropriate for this kind of usage." "No next sexp" "No previous sexp")))) (or arg (setq arg 1)) - (if forward-sexp-function - (funcall forward-sexp-function arg) - (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) - (if (< arg 0) (backward-prefix-chars))))) + (funcall (or forward-sexp-function + #'forward-sexp-default-function) + arg))) (defun backward-sexp (&optional arg interactive) "Move backward across one balanced expression (sexp). diff --git a/lisp/treesit.el b/lisp/treesit.el index 1443162f79c..2973aba771c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2138,14 +2138,24 @@ however, smaller in scope than sentences. This is used by (defun treesit-forward-sexp (&optional arg) "Tree-sitter implementation for `forward-sexp-function'. -ARG is described in the docstring of `forward-sexp-function'. If -there are no further sexps to move across, signal `scan-error' -like `forward-sexp' does. If point is already at top-level, -return nil without moving point." +ARG is described in the docstring of `forward-sexp-function'. + +If point is inside a text environment where tree-sitter is not +supported, go forward a sexp using `forward-sexp-default-function'. +If point is inside code, use tree-sitter functions with the +following behavior. If there are no further sexps to move across, +signal `scan-error' like `forward-sexp' does. If point is already +at top-level, return nil without moving point. + +What constitutes as text and source code sexp is determined +by `text' and `sexp' in `treesit-thing-settings'." (interactive "^p") (let ((arg (or arg 1)) (pred (or treesit-sexp-type-regexp 'sexp))) - (or (if (> arg 0) + (or (when (treesit-node-match-p (treesit-node-at (point)) 'text t) + (funcall #'forward-sexp-default-function arg) + t) + (if (> arg 0) (treesit-end-of-thing pred (abs arg) 'restricted) (treesit-beginning-of-thing pred (abs arg) 'restricted)) ;; If we couldn't move, we should signal an error and report From 3d3602055264ca3095b7f28ca7e27a6f2782649a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 14 Apr 2024 18:20:47 +0200 Subject: [PATCH 048/149] GC-mark temporary key values created when sorting (bug#69709) Bug reported and fix proposed by Aris Spathis. * src/sort.c (merge_markmem): Mark heap-allocated temporary key values. (tim_sort): Delay key function calls to after marking function has been registered. * test/src/fns-tests.el (fns-tests-sort-gc): New test. --- src/sort.c | 23 +++++++++++++++++------ test/src/fns-tests.el | 21 +++++++++++++++++++++ 2 files changed, 38 insertions(+), 6 deletions(-) diff --git a/src/sort.c b/src/sort.c index 527d5550342..808cd187dcf 100644 --- a/src/sort.c +++ b/src/sort.c @@ -532,6 +532,9 @@ merge_markmem (void *arg) merge_state *ms = arg; eassume (ms != NULL); + if (ms->allocated_keys != NULL) + mark_objects (ms->allocated_keys, ms->listlen); + if (ms->reloc.size != NULL && *ms->reloc.size > 0) { Lisp_Object *src = (ms->reloc.src->values @@ -1107,21 +1110,29 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, if (length < MERGESTATE_TEMP_SIZE / 2) keys = &ms.temparray[length + 1]; else - keys = allocated_keys = xmalloc (length * word_size); - - for (ptrdiff_t i = 0; i < length; i++) - keys[i] = call1 (keyfunc, seq[i]); + { + /* Fill with valid Lisp values in case a GC occurs before all + keys have been computed. */ + verify (NIL_IS_ZERO); + keys = allocated_keys = xzalloc (length * word_size); + } lo.keys = keys; lo.values = seq; } + merge_init (&ms, length, allocated_keys, &lo, predicate); + + /* Compute keys after merge_markmem has been registered by merge_init + (any call to keyfunc might trigger a GC). */ + if (!NILP (keyfunc)) + for (ptrdiff_t i = 0; i < length; i++) + keys[i] = call1 (keyfunc, seq[i]); + /* FIXME: This is where we would check the keys for interesting properties for more optimised comparison (such as all being fixnums etc). */ - merge_init (&ms, length, allocated_keys, &lo, predicate); - /* March over the array once, left to right, finding natural runs, and extending short natural runs to minrun elements. */ const ptrdiff_t minrun = merge_compute_minrun (length); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 1b13785a9fc..5ba7e49324a 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -418,6 +418,27 @@ (should-not (and (> size 0) (eq res seq))) (should (equal seq input)))))))))))) +(ert-deftest fns-tests-sort-gc () + ;; Make sure our temporary storage is traversed by the GC. + (let* ((n 1000) + (a (mapcar #'number-to-string (number-sequence 1 n))) + (i 0) + ;; Force frequent GCs in both the :key and :lessp functions. + (s (sort a + :key (lambda (x) + (setq i (1+ i)) + (when (> i 300) + (garbage-collect) + (setq i 0)) + (copy-sequence x)) + :lessp (lambda (a b) + (setq i (1+ i)) + (when (> i 300) + (garbage-collect) + (setq i 0)) + (string< a b))))) + (should (equal (length s) (length a))))) + (defvar w32-collate-ignore-punctuation) (ert-deftest fns-tests-collate-sort () From e8c6e3fa477e69b4cecfee354af313ccb60e8c97 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 15 Apr 2024 09:21:17 +0800 Subject: [PATCH 049/149] Fix bug#70385 * src/xdisp.c (note_fringe_highlight): Don't proceed if popup_activated, window is outdated, or when row beneath pointer does not display text. (bug#70385) --- src/xdisp.c | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 452adee1d31..d984c12d1aa 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35731,16 +35731,28 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, /* Take proper action when mouse has moved to the window WINDOW, with - window-local x-position X and y-position Y. This is only used for + window-local x-position X and y-position Y. This is only used for displaying user-defined fringe indicator help-echo messages. */ static void -note_fringe_highlight (Lisp_Object window, int x, int y, +note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, enum window_part part) { - if (!NILP (help_echo_string)) + if (!NILP (help_echo_string) || !f->glyphs_initialized_p) return; + /* When a menu is active, don't highlight because this looks odd. */ +#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS) || defined (MSDOS) \ + || defined (HAVE_ANDROID) + if (popup_activated ()) + return; +#endif /* HAVE_X_WINDOWS || HAVE_NS || MSDOS || HAVE_ANDROID */ + +#if defined HAVE_HAIKU + if (popup_activated_p) + return; +#endif /* HAVE_HAIKU */ + /* Find a message to display through the help-echo mechanism whenever the mouse hovers over a fringe indicator. Both text properties and overlays have to be checked. */ @@ -35757,6 +35769,13 @@ note_fringe_highlight (Lisp_Object window, int x, int y, struct window *w = XWINDOW (window); x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area); + /* Don't access the TEXT_AREA of a row that does not display text, or + when the window is outdated. (bug#70385) */ + if (window_outdated (w) + || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, + vpos))) + return; + /* Get to the first glyph of a text row based on the vertical position of the fringe. */ struct glyph *glyph = MATRIX_ROW_GLYPH_START (w->current_matrix, vpos); @@ -36014,7 +36033,7 @@ note_mouse_highlight (struct frame *f, int x, int y) else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE) { cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; - note_fringe_highlight (window, x, y, part); + note_fringe_highlight (f, window, x, y, part); } else if (part == ON_VERTICAL_SCROLL_BAR || part == ON_HORIZONTAL_SCROLL_BAR) From 55a200d7071320311365787b60f311c7c91922d8 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sun, 14 Apr 2024 04:22:14 +0300 Subject: [PATCH 050/149] ; Capitalize 'project' in project-name's docstring --- lisp/progmodes/project.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index da211566a3b..000a05804a8 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -291,7 +291,7 @@ headers search path, load path, class path, and so on." nil) (cl-defgeneric project-name (project) - "A human-readable name for the project. + "A human-readable name for the PROJECT. Nominally unique, but not enforced." (file-name-nondirectory (directory-file-name (project-root project)))) From 9a79db506e39c02daa81629f0b224a86fad2b3c6 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 15 Apr 2024 11:17:51 +0200 Subject: [PATCH 051/149] Make 'buffer-last-name' work better after 'find-alternate-file' (Bug#68235) * lisp/files.el (find-alternate-file): Before killing the previous buffer, try to restore its name and filenames (Bug#68235). --- lisp/files.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/files.el b/lisp/files.el index 20d63d33fef..1e11dd44bad 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2113,6 +2113,15 @@ killed." (rename-buffer oname))) (unless (eq (current-buffer) obuf) (with-current-buffer obuf + (unless (get-buffer oname) + ;; Restore original's buffer name so 'kill-buffer' can use it + ;; to assign its last name (Bug#68235). + (rename-buffer oname)) + ;; Restore original buffer's file names so they can be still + ;; used when referencing the now defunct buffer (Bug#68235). + (setq buffer-file-name ofile) + (setq buffer-file-number onum) + (setq buffer-file-truename otrue) ;; We already ran these; don't run them again. (let (kill-buffer-query-functions kill-buffer-hook) (kill-buffer obuf)))))) From ecb80e0e8aa6411b1e14334c2e4701208fdb238d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 15 Apr 2024 14:52:03 +0300 Subject: [PATCH 052/149] ; Improve wording in documentation of 'not and 'null' * doc/lispref/control.texi (Combining Conditions): * doc/lispref/lists.texi (List-related Predicates): Clarify wording of 'not' vs 'null'. (Bug#70392) --- doc/lispref/control.texi | 3 ++- doc/lispref/lists.texi | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 292086ee4e0..a944dad9307 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -349,7 +349,8 @@ kinds of multiple conditional constructs. This function tests for the falsehood of @var{condition}. It returns @code{t} if @var{condition} is @code{nil}, and @code{nil} otherwise. The function @code{not} is identical to @code{null}, and we recommend -using the name @code{null} if you are testing for an empty list. +using the name @code{null} if you are testing for an empty list or +@code{nil} value. @end defun @defspec and conditions@dots{} diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 6ad6c487d0b..2ae755a2f3b 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -143,9 +143,9 @@ This function is the opposite of @code{listp}: it returns @code{t} if @defun null object This function returns @code{t} if @var{object} is @code{nil}, and returns @code{nil} otherwise. This function is identical to @code{not}, -but as a matter of clarity we use @code{null} when @var{object} is -considered a list and @code{not} when it is considered a truth value -(see @code{not} in @ref{Combining Conditions}). +but as a matter of clarity we use @code{not} when @var{object} is +considered a truth value (see @code{not} in @ref{Combining +Conditions}) and @code{null} otherwise. @example @group From deef12c15d8c9444a583fffa9254cc4fc44ebfa3 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 15 Apr 2024 19:54:20 +0800 Subject: [PATCH 053/149] Rewrite Android description of Android window management * doc/emacs/android.texi (Android Environment): Rewrite several paragraphs to better reflect recent changes and emphasize behavior on modern OS releases. --- doc/emacs/android.texi | 120 +++++++++++++++++++++-------------------- 1 file changed, 62 insertions(+), 58 deletions(-) diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 3f784bc9637..15c5fbcce3a 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -823,69 +823,73 @@ example, the permission to access contacts may be useful for EUDC. @node Android Windowing @section The Android Window System - Android's window system is unusual, in that all windows are -maximized or full-screen, and only one window can be displayed at a -time. On larger devices, the system permits simultaneously tiling up -to four windows on the screen. - - Windows on Android do not exist indefinitely after they are created. -Instead, the system may choose to close windows that are not on screen -in order to conserve memory, with the assumption that the program will -save its contents to disk and restore them later, when the user asks -for it to be opened again. As this is obviously not possible with -Emacs, Emacs separates the resources associated with a frame from its -system window. - - Each system window created (including the initial window created -during Emacs startup) is appended to a list of windows that do not -have associated frames. When a frame is created, Emacs looks up any -window within that list, and displays the contents of the frame -within; if there is no window at all, then one is created. Likewise, -when a new window is created by the system, Emacs places the contents -of any frame that is not already displayed within a window inside. -When a frame is closed, the corresponding system window is also -closed. Upon startup, the system creates a window itself (within -which Emacs displays the first window system frame shortly -thereafter.) Emacs differentiates between that window and windows -created on behalf of other frames to determine what to do when the -system window associated with a frame is closed: + Android's window system is unusual in that all windows are reported to +applications as maximized or full-screen, and, in the general case, only +one window can be displayed at a time. On larger devices, the system +permits simultaneously tiling up to four windows on the screen, though +in emulators or installations configured for ``desktop'' system stacks +freely resizable windows as other desktop window managers do. + + Windows, or, in system nomenclature, activities, do not exist +indefinitely after creation, as the system may choose to pause windows +that are not visible in order to conserve memory, on the assumption that +the program will save its contents to disk, to be restored when the user +selects those windows from the task switcher. Furthermore, a window is +created by the operating system at Emacs startup that is afforded +special treatment, which Emacs is expected to adopt. + + Emacs approaches window management with the general objective of +minimizing differences in frame behavior exposed to Lisp from that of +frames on ordinary window systems, such as X Windows; the degree to +which this goal is actually attained varies by the availability of +facilities for window management in the version of Android where it is +installed, and operating system policy towards inactive windows. When +it is unavoidable that concessions should be made to such policy, Emacs +prefers destroying frames to retaining ones with no activities to +display them, unless such a frame is the initial frame and therefore +displayed in the activity created at startup, which it is possible to +open and identify so long as Emacs is yet executing. + +@cindex frames and windows, Android 5.0 + Android 5.0 and later support an accurate implementation of window +management where frames hold a one-to-one relation to the activities in +which they are displayed, enabling deletion of activities in the task +switcher to directly affect the frames concerned, and vice versa. There +are just two exceptions: @itemize @bullet @item -When the system closes the window created during application startup -in order to save memory, Emacs retains the frame for when that window -is created later. - -@item -When the user closes the window created during application startup, -and the window was not previously closed by the system in order to -save resources, Emacs deletes any frame displayed within that window. - -However, on Android 7.0 and later, such frames are not deleted if the -window is closed four or more hours after the window moves into the -background, as the system automatically removes open windows once a -certain period of inactivity elapses when the number of windows retained -by the window manager surpasses a specific threshold, and window -deletion by this mechanism is indistinguishable from window deletion by -the user. Emacs begins to ignore window deletion after two hours less -than the default value of this threshold both to err on the side of -caution, in case the system's record of inactivity and Emacs's disagree, -and for the reason that this threshold is open to customization by OS -distributors. - -@item -When the user or the system closes any window created by Emacs on behalf -of a specific frame, Emacs deletes the frame displayed within that -window, unless the system is Android 5.0 or later, where such windows -are treated identically to the window created at startup, albeit with no -proviso regarding window inactivity. +After the system pauses an activity that remains in the task switcher in +response to inactivity, removing it from the task switcher while it +remains in its inactive state will not delete the frame inside, as Emacs +is not notified of the deletion of its activities in such circumstances. +The frame will be deleted upon the next window management operation that +prompts an examination of the list of live windows. Likewise, an +inactive activity displaying a frame will not be immediately deleted +with its frame, but will be if it is selected from the window list or +upon another examination of the window list. + +@item +Any frame besides the initial frame might be deleted after 4 to 6 hours +of inactivity in the background, if it is removed by the system in +``trimming'' the task switcher of excess, and presumably unwanted, +tasks; the initial frame is exempt from this treatment because it can be +reopened otherwise than from the task switcher, but as deletion by this +mechanism is indistinguishable from legitimate user action to remove +activities from the task switcher, the latter will also be ignored by +the initial frame after a 4-hour interval elapses from the time of last +activity. @end itemize - When the system predates Android 5.0, the window manager will not -accept more than one user-created Emacs window. If frame creation gives -rise to windows in excess of this limit, the window manager will -arbitrarily select one of their number to display, with the rest -remaining invisible until that window is destroyed with its frame. +@cindex frames and windows, Android 4.4 +@cindex frames and windows, Android 2.2 + Android 4.4 and earlier provide considerably inferior interfaces +inadequate for a complete implementation of window management. On such +systems, Emacs substitutes a fairly primitive mechanism where all but +the initial frame are deleted when their activities are paused, only a +single activity (not counting the activity created at startup) is +visible at a time, and unattached frames are displayed in the first +unoccupied activity available. @cindex windowing limitations, android @cindex frame parameters, android From a80a5d42d3a5f095c9d52ef5f5fe18d2e500d875 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 15 Apr 2024 15:47:39 +0300 Subject: [PATCH 054/149] Fix display of @xref documentation in Info * lisp/info.el (Info--dont-hide-references): New variable. (Info-fontify-node): Use 'Info--dont-hide-references' to disable hiding "*Note" or showing "See" instead of it in select nodes. (Bug#70382) --- lisp/info.el | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/lisp/info.el b/lisp/info.el index b459406959e..b1b9d48855a 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4876,6 +4876,19 @@ first line or header line, and for breadcrumb links.") ;; 'font-lock-face 'header-line line) line)) +(defvar Info--dont-hide-references + '(("texinfo" "Cross Reference Commands")) + "Manuals and nodes where `Info-hide-note-references' should be ignored. +This is an alist whose elements should be of the form + + (MANUAL NODE...) + +where MANUAL is the basename of an Info manual's main file, and NODEs +are one or more nodes in MANUAL where info.el should not hide +cross-references even in `Info-hide-note-references' is non-nil. +This is because some rare nodes describe how cross-references work, +and so should be rendered as makeinfo produced them.") + (defun Info-fontify-node () "Fontify the node." (save-excursion @@ -4893,6 +4906,16 @@ first line or header line, and for breadcrumb links.") (or (eq Info-fontify-maximum-menu-size t) (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))) + ;; Disable Info-hide-note-references in nodes that are + ;; incompatible with that feature. + (Info-hide-note-references + (if (member Info-current-node + (assoc-string + (file-name-sans-extension + (file-name-nondirectory Info-current-file)) + Info--dont-hide-references)) + nil + Info-hide-note-references)) rbeg rend) ;; Fontify header line From 9b755244bf0b9cd5f820ae45a4db14913a587c7b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 15 Apr 2024 16:50:59 +0300 Subject: [PATCH 055/149] Fix resetting the frame's 'frozen_window_starts' flag * src/window.c (grow_mini_window, shrink_mini_window): Reimplement how the frame's 'frozen_window_starts' flag is set and reset, to make sure it is always reset when the mini-window gets to its normal one-line height. Patch by Martin Rudalics (Bug#70038) --- src/window.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/window.c b/src/window.c index fe26311fbb2..6c0fce4119f 100644 --- a/src/window.c +++ b/src/window.c @@ -5376,7 +5376,6 @@ grow_mini_window (struct window *w, int delta) struct window *r = XWINDOW (root); Lisp_Object grow; - FRAME_WINDOWS_FROZEN (f) = true; grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (- delta), Qt); @@ -5390,6 +5389,8 @@ grow_mini_window (struct window *w, int delta) && window_resize_check (r, false)) resize_mini_window_apply (w, -XFIXNUM (grow)); } + FRAME_WINDOWS_FROZEN (f) + = window_body_height (w, WINDOW_BODY_IN_PIXELS) > FRAME_LINE_HEIGHT (f); } /** @@ -5413,7 +5414,6 @@ shrink_mini_window (struct window *w) struct window *r = XWINDOW (root); Lisp_Object grow; - FRAME_WINDOWS_FROZEN (f) = false; grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (delta), Qt); @@ -5425,6 +5425,8 @@ shrink_mini_window (struct window *w) bar. */ grow_mini_window (w, -delta); + FRAME_WINDOWS_FROZEN (f) + = window_body_height (w, WINDOW_BODY_IN_PIXELS) > FRAME_LINE_HEIGHT (f); } DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, From 5fda398fb3bbda43dab37a0c187c90ad4bc4d1b0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Apr 2024 15:53:48 -0400 Subject: [PATCH 056/149] (track-changes--before): Fix bug#70396 * lisp/emacs-lisp/track-changes.el (track-changes--before): Widen the buffer before accessing it with positions potentially outside the beg..end region. --- lisp/emacs-lisp/track-changes.el | 68 ++++++++++++++++---------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 1bab7ca38fd..df4aad0d596 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -481,42 +481,42 @@ Details logged to `track-changes--error-log'") (funcall signal-if-disjoint end track-changes--before-beg) (funcall signal-if-disjoint track-changes--before-end beg))) (funcall reset)) - (cl-assert (save-restriction - (widen) - (<= (point-min) + (save-restriction + (widen) + (cl-assert (<= (point-min) track-changes--before-beg track-changes--before-end - (point-max)))) - (when (< beg track-changes--before-beg) - (if (and track-changes--disjoint-trackers - (funcall signal-if-disjoint end track-changes--before-beg)) - (funcall reset) - (let* ((old-bbeg track-changes--before-beg) - ;; To avoid O(N²) behavior when faced with many small changes, - ;; we copy more than needed. - (new-bbeg (min (max (point-min) - (- old-bbeg - (length track-changes--before-string))) - beg))) - (setf track-changes--before-beg new-bbeg) - (cl-callf (lambda (old new) (concat new old)) - track-changes--before-string - (buffer-substring-no-properties new-bbeg old-bbeg))))) - - (when (< track-changes--before-end end) - (if (and track-changes--disjoint-trackers - (funcall signal-if-disjoint track-changes--before-end beg)) - (funcall reset) - (let* ((old-bend track-changes--before-end) - ;; To avoid O(N²) behavior when faced with many small changes, - ;; we copy more than needed. - (new-bend (max (min (point-max) - (+ old-bend - (length track-changes--before-string))) - end))) - (setf track-changes--before-end new-bend) - (cl-callf concat track-changes--before-string - (buffer-substring-no-properties old-bend new-bend)))))))) + (point-max))) + (when (< beg track-changes--before-beg) + (if (and track-changes--disjoint-trackers + (funcall signal-if-disjoint end track-changes--before-beg)) + (funcall reset) + (let* ((old-bbeg track-changes--before-beg) + ;; To avoid O(N²) behavior when faced with many small + ;; changes, we copy more than needed. + (new-bbeg + (min beg (max (point-min) + (- old-bbeg + (length track-changes--before-string)))))) + (setf track-changes--before-beg new-bbeg) + (cl-callf (lambda (old new) (concat new old)) + track-changes--before-string + (buffer-substring-no-properties new-bbeg old-bbeg))))) + + (when (< track-changes--before-end end) + (if (and track-changes--disjoint-trackers + (funcall signal-if-disjoint track-changes--before-end beg)) + (funcall reset) + (let* ((old-bend track-changes--before-end) + ;; To avoid O(N²) behavior when faced with many small + ;; changes, we copy more than needed. + (new-bend + (max end (min (point-max) + (+ old-bend + (length track-changes--before-string)))))) + (setf track-changes--before-end new-bend) + (cl-callf concat track-changes--before-string + (buffer-substring-no-properties old-bend new-bend))))))))) (defun track-changes--after (beg end len) (cl-assert track-changes--state) From 3ac1a7b6fe6d324339ca5c36ffdce3985f6c55a1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 15 Apr 2024 16:06:54 -0400 Subject: [PATCH 057/149] (track-changes-fetch): Fix nested use case * lisp/emacs-lisp/track-changes.el (track-changes-fetch): Don't presume that if there's nothing to do we're on `track-changes--clean-trackers`. --- lisp/emacs-lisp/track-changes.el | 38 ++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index df4aad0d596..9e62b8bdf30 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -335,23 +335,27 @@ and re-enable the TRACKER corresponding to ID." (substring before (- (length before) (- endb prevend))))) (setq lenbefore (length before))))))) - (if (null beg) - (progn - (cl-assert (null states)) - (cl-assert (memq id track-changes--clean-trackers)) - (cl-assert (eq (track-changes--tracker-state id) - track-changes--state)) - ;; Nothing to do. - nil) - (cl-assert (not (memq id track-changes--clean-trackers))) - (cl-assert (<= (point-min) beg end (point-max))) - ;; Update the tracker's state *before* running `func' so we don't risk - ;; mistakenly replaying the changes in case `func' exits non-locally. - (setf (track-changes--tracker-state id) track-changes--state) - (unwind-protect (funcall func beg end (or before lenbefore)) - ;; Re-enable the tracker's signal only after running `func', so - ;; as to avoid recursive invocations. - (cl-pushnew id track-changes--clean-trackers))))) + (unwind-protect + (if (null beg) + (progn + (cl-assert (null states)) + ;; We may have been called in the middle of another + ;; `track-changes-fetch', in which case we may be in a clean + ;; state but not yet on `track-changes--clean-trackers' + ;;(cl-assert (memq id track-changes--clean-trackers)) + (cl-assert (eq (track-changes--tracker-state id) + track-changes--state)) + ;; Nothing to do. + nil) + (cl-assert (not (memq id track-changes--clean-trackers))) + (cl-assert (<= (point-min) beg end (point-max))) + ;; Update the tracker's state *before* running `func' so we don't risk + ;; mistakenly replaying the changes in case `func' exits non-locally. + (setf (track-changes--tracker-state id) track-changes--state) + (funcall func beg end (or before lenbefore))) + ;; Re-enable the tracker's signal only after running `func', so + ;; as to avoid recursive invocations. + (cl-pushnew id track-changes--clean-trackers)))) ;;;; Auxiliary functions. From 98b90fc853f05e3d94545c48851e59ace33b50cb Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 15 Apr 2024 23:56:00 +0200 Subject: [PATCH 058/149] ; Fix last change to secrets-tests.el. --- test/lisp/net/secrets-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 1d9c1446e26..b7dd0b8f7ef 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -175,7 +175,7 @@ ;; Create another item with a non-latin password. (Bug#70301) (should (secrets-create-item "session" "parola" "парола")) - (string-equal (secrets-get-secret "session" "parola") "парола") + (should (string-equal (secrets-get-secret "session" "parola") "парола")) ;; Create an item with attributes. (should From 930c578c1042e6372e5433e31b2ea801315c01c9 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Mon, 15 Apr 2024 20:14:50 -0700 Subject: [PATCH 059/149] ; Improvements to PEG documentation * doc/lispref/peg.texi: Make more use of defmac/defmacro, and try to clarify the relationships between the various macros and functions. * lisp/progmodes/peg.el (peg-parse): Remove claim that PEXS can also be a single list of rules. --- doc/lispref/peg.texi | 128 +++++++++++++++--------------------------- lisp/progmodes/peg.el | 7 ++- 2 files changed, 48 insertions(+), 87 deletions(-) diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi index fbf57852ee0..90aa76988db 100644 --- a/doc/lispref/peg.texi +++ b/doc/lispref/peg.texi @@ -1,78 +1,31 @@ -@c -*-texinfo-*- -@c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--1999, 2001--2023 Free Software -@c Foundation, Inc. -@c See the file elisp.texi for copying conditions. -@node Parsing Expression Grammars -@chapter Parsing Expression Grammars -@cindex text parsing -@cindex parsing expression grammar -@cindex PEG - - Emacs Lisp provides several tools for parsing and matching text, -from regular expressions (@pxref{Regular Expressions}) to full -left-to-right (a.k.a.@: @acronym{LL}) grammar parsers (@pxref{Top,, -Bovine parser development,bovine}). @dfn{Parsing Expression Grammars} -(@acronym{PEG}) are another approach to text parsing that offer more -structure and composibility than regular expressions, but less -complexity than context-free grammars. - -A Parsing Expression Grammar (@acronym{PEG}) describes a formal language -in terms of a set of rules for recognizing strings in the language. In -Emacs, a @acronym{PEG} parser is defined as a list of named rules, each -of which matches text patterns and/or contains references to other -rules. Parsing is initiated with the function @code{peg-run} or the -macro @code{peg-parse} (see below), and parses text after point in the -current buffer, using a given set of rules. - -@cindex parsing expression -@cindex root, of parsing expression grammar -@cindex entry-point, of parsing expression grammar -Each rule in a @acronym{PEG} is referred to as a @dfn{parsing -expression} (@acronym{PEX}), and can be specified a a literal string, a -regexp-like character range or set, a peg-specific construct resembling -an Emacs Lisp function call, a reference to another rule, or a -combination of any of these. A grammar is expressed as a tree of rules -in which one rule is typically treated as a ``root'' or ``entry-point'' -rule. For instance: - -@example -@group -((number sign digit (* digit)) - (sign (or "+" "-" "")) - (digit [0-9])) -@end group -@end example - -Once defined, grammars can be used to parse text after point in the -current buffer, in the following ways: - -@defmac peg-parse &rest pexs -Match @var{pexs} at point. If @var{pexs} is a list of PEG rules, the -first rule is considered the ``entry-point'': +struct makes a set of rules available within its +body. The actual parsing is initiated with @code{peg-run}: + +@defun peg-run peg-matcher &optional failure-function success-function +This function accepts a single @var{peg-matcher}, which is the result of +calling @code{peg} (see below) on a named rule, usually the entry-point +of a larger grammar. + +At the end of parsing, one of @var{failure-function} or +@var{success-function} is called, depending on whether the parsing +succeeded or not. If @var{success-function} is called, it is passed a +lambda form that runs all the actions collected on the stack during +parsing -- by default this lambda form is simply executed. If parsing +fails, the @var{failure-function} is called with a list of @acronym{PEG} +expressions that failed during parsing; by default this list is +discarded. +@end defun + +The @var{peg-matcher} passed to @code{peg-run} is produced by a call to +@code{peg}: + +@defmac peg &rest pexs +Convert @var{pexs} into a single peg-matcher suitable for passing to +@code{peg-run}. @end defmac -@example -@group -(peg-parse - ((number sign digit (* digit)) - (sign (or "+" "-" "")) - (digit [0-9]))) -@end group -@end example - -@c FIXME: These two should be formally defined using @defmac and @defun. -@findex with-peg-rules -@findex peg-run -The @code{peg-parse} macro represents the simplest use of the -@acronym{PEG} library, but also the least flexible, as the rules must be -written directly into the source code. A more flexible approach -involves use of three macros in conjunction: @code{with-peg-rules}, a -@code{let}-like construct that makes a set of rules available within the -macro body; @code{peg-run}, which initiates parsing given a single rule; -and @code{peg}, which is used to wrap the entry-point rule name. In -fact, a call to @code{peg-parse} expands to just this set of calls. The -above example could be written as: +The @code{peg-parse} example above expands to just this set of calls, +and could be written as: @example @group @@ -84,14 +37,19 @@ above example could be written as: @end group @end example -This allows more explicit control over the ``entry-point'' of parsing, -and allows the combination of rules from different sources. +This approach allows more explicit control over the ``entry-point'' of +parsing, and allows the combination of rules from different sources. -@c FIXME: Use @defmac. -@findex define-peg-rule Individual rules can also be defined using a more @code{defun}-like syntax, using the macro @code{define-peg-rule}: +@defmac define-peg-rule name args &rest pexs +Define @var{name} as a PEG rule that accepts @var{args} and matches +@var{pexs} at point. +@end defmac + +For instance: + @example @group (define-peg-rule digit () @@ -99,14 +57,16 @@ syntax, using the macro @code{define-peg-rule}: @end group @end example -This also allows for rules that accept an argument (supplied by the -@code{funcall} PEG rule, @pxref{PEX Definitions}). +Arguments can be supplied to rules by the @code{funcall} PEG rule +(@pxref{PEX Definitions}). -@c FIXME: Use @defmac. -@findex define-peg-ruleset Another possibility is to define a named set of rules with @code{define-peg-ruleset}: +@defmac define-peg-ruleset name &rest rules +Define @var{name} as an identifier for @var{rules}. +@end defmac + @example @group (define-peg-ruleset number-grammar @@ -240,10 +200,10 @@ Returns non-@code{nil} if parsing @acronym{PEX} @var{e} from point fails Treats the value of the Lisp expression @var{exp} as a boolean. @end table -@c FIXME: peg-char-classes should be mentioned in the text below. @vindex peg-char-classes -Character class matching can use the same named character classes as -in regular expressions (@pxref{Top,, Character Classes,elisp}) +Character-class matching can refer to the classes named in +@code{peg-char-classes}, equivalent to character classes in regular +expressions (@pxref{Top,, Character Classes,elisp}) @node Parsing Actions @section Parsing Actions diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index bb57650d883..938f8da910d 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -316,13 +316,14 @@ EXPS is a list of rules/expressions that failed.") "Match PEXS at point. PEXS is a sequence of PEG expressions, implicitly combined with `and'. Returns STACK if the match succeed and signals an error on failure, -moving point along the way. -PEXS can also be a list of PEG rules, in which case the first rule is used." +moving point along the way." (if (and (consp (car pexs)) (symbolp (caar pexs)) (not (ignore-errors (not (eq 'call (car (peg-normalize (car pexs)))))))) - ;; `pexs' is a list of rules: use the first rule as entry point. + ;; The first of `pexs' has not been defined as a rule, so assume + ;; that none of them have been and they should be fed to + ;; `with-peg-rules' `(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure)) `(peg-run (peg ,@pexs) #'peg-signal-failure))) From b33fb3b69cb9d4bce3a8cd12771649b3c3945fb0 Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Fri, 12 Apr 2024 22:09:17 -0700 Subject: [PATCH 060/149] Add font-locking for operators in go-ts-mode (bug#70361) * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): Add font-locking rule for Go operators. --- lisp/progmodes/go-ts-mode.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index ad4b6baf205..b82bc2364dc 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -142,6 +142,10 @@ :feature 'delimiter '((["," "." ";" ":"]) @font-lock-delimiter-face) + :language 'go + :feature 'operator + `([,@go-ts-mode--operators] @font-lock-operator-face) + :language 'go :feature 'definition `((function_declaration From cdd37ba4e853dcb31d8a85e12526b509720b37cd Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 16 Apr 2024 09:40:15 +0300 Subject: [PATCH 061/149] Support prefix argument for switching tabs in tab-line-mode * lisp/tab-line.el (tab-line-select-tab-buffer): Optimize. (tab-line-switch-cycling): Enable by default like in tab-bar-mode. (tab-line-switch-to-prev-tab, tab-line-switch-to-next-tab): Add a prefix argument ARG and support it for switching tabs. Improve docstring. --- lisp/tab-line.el | 113 ++++++++++++++++++++++++++--------------------- 1 file changed, 63 insertions(+), 50 deletions(-) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 54e9ee16243..48272b7b4b3 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -843,29 +843,27 @@ using the `previous-buffer' command." (force-mode-line-update)))))))) (defun tab-line-select-tab-buffer (buffer &optional window) - (let* ((window-buffer (window-buffer window)) - (next-buffers (seq-remove (lambda (b) (eq b window-buffer)) - (window-next-buffers window))) - (prev-buffers (seq-remove (lambda (b) (eq b window-buffer)) - (mapcar #'car (window-prev-buffers window)))) - ;; Remove next-buffers from prev-buffers - (prev-buffers (seq-difference prev-buffers next-buffers))) - (cond - ((and (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) - (memq buffer next-buffers)) - (dotimes (_ (1+ (seq-position next-buffers buffer))) - (switch-to-next-buffer window))) - ((and (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) - (memq buffer prev-buffers)) - (dotimes (_ (1+ (seq-position prev-buffers buffer))) - (switch-to-prev-buffer window))) - (t - (with-selected-window window - (let ((switch-to-buffer-obey-display-actions nil)) - (switch-to-buffer buffer))))))) - -(defcustom tab-line-switch-cycling nil - "Enable cycling tab switch. + (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (let* ((window-buffer (window-buffer window)) + (next-buffers (seq-remove (lambda (b) (eq b window-buffer)) + (window-next-buffers window))) + (prev-buffers (seq-remove (lambda (b) (eq b window-buffer)) + (mapcar #'car (window-prev-buffers window)))) + ;; Remove next-buffers from prev-buffers + (prev-buffers (seq-difference prev-buffers next-buffers))) + (cond + ((memq buffer next-buffers) + (dotimes (_ (1+ (seq-position next-buffers buffer))) + (switch-to-next-buffer window))) + ((memq buffer prev-buffers) + (dotimes (_ (1+ (seq-position prev-buffers buffer))) + (switch-to-prev-buffer window))))) + (with-selected-window window + (let ((switch-to-buffer-obey-display-actions nil)) + (switch-to-buffer buffer))))) + +(defcustom tab-line-switch-cycling t + "Wrap tabs on tab switch while cycling. If non-nil, `tab-line-switch-to-prev-tab' in the first tab switches to the last tab and `tab-line-switch-to-next-tab' in the last tab switches to the first tab. This variable is not consulted @@ -874,47 +872,62 @@ when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'." :group 'tab-line :version "28.1") -(defun tab-line-switch-to-prev-tab (&optional event) - "Switch to the previous tab's buffer. -Its effect is the same as using the `previous-buffer' command -(\\[previous-buffer])." - (interactive (list last-nonmenu-event)) +(defun tab-line-switch-to-prev-tab (&optional event arg) + "Switch to the ARGth previous tab's buffer. +When `tab-line-tabs-function' is `tab-line-tabs-window-buffers', +its effect is the same as using the `previous-buffer' command +\(\\[previous-buffer]). +For other values of `tab-line-tabs-function' this command +switches to the previous buffer in the sequence defined by +`tab-line-tabs-function'. To wrap buffer cycling in this case +is possible when `tab-line-switch-cycling' is non-nil." + (interactive (list last-nonmenu-event + (prefix-numeric-value current-prefix-arg))) (let ((window (and (listp event) (posn-window (event-start event))))) - (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) - (switch-to-prev-buffer window) - (with-selected-window (or window (selected-window)) + (with-selected-window (or window (selected-window)) + (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (previous-buffer arg t) (let* ((buffers (seq-keep (lambda (tab) (or (and (bufferp tab) tab) (alist-get 'buffer tab))) (funcall tab-line-tabs-function))) - (pos (seq-position buffers (current-buffer))) - (buffer (when pos - (if (and tab-line-switch-cycling (<= pos 0)) - (nth (1- (length buffers)) buffers) - (nth (1- pos) buffers))))) + (old-pos (seq-position buffers (current-buffer))) + (new-pos (when old-pos (- old-pos (or arg 1)))) + (new-pos (when new-pos + (if tab-line-switch-cycling + (mod new-pos (length buffers)) + (max new-pos 0)))) + (buffer (when new-pos (nth new-pos buffers)))) (when (bufferp buffer) (let ((switch-to-buffer-obey-display-actions nil)) (switch-to-buffer buffer)))))))) -(defun tab-line-switch-to-next-tab (&optional event) - "Switch to the next tab's buffer. -Its effect is the same as using the `next-buffer' command -(\\[next-buffer])." - (interactive (list last-nonmenu-event)) +(defun tab-line-switch-to-next-tab (&optional event arg) + "Switch to the next ARGth tab's buffer. +When `tab-line-tabs-function' is `tab-line-tabs-window-buffers', +its effect is the same as using the `next-buffer' command +\(\\[next-buffer]). +For other values of `tab-line-tabs-function' this command +switches to the next buffer in the sequence defined by +`tab-line-tabs-function'. To wrap buffer cycling in this case +is possible when `tab-line-switch-cycling' is non-nil." + (interactive (list last-nonmenu-event + (prefix-numeric-value current-prefix-arg))) (let ((window (and (listp event) (posn-window (event-start event))))) - (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) - (switch-to-next-buffer window) - (with-selected-window (or window (selected-window)) + (with-selected-window (or window (selected-window)) + (if (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (next-buffer arg t) (let* ((buffers (seq-keep (lambda (tab) (or (and (bufferp tab) tab) (alist-get 'buffer tab))) (funcall tab-line-tabs-function))) - (pos (seq-position buffers (current-buffer))) - (buffer (when pos - (if (and tab-line-switch-cycling - (<= (length buffers) (1+ pos))) - (car buffers) - (nth (1+ pos) buffers))))) + (old-pos (seq-position buffers (current-buffer))) + (new-pos (when old-pos (+ old-pos (or arg 1)))) + (new-pos (when new-pos + (if tab-line-switch-cycling + (mod new-pos (length buffers)) + (min new-pos (1- (length buffers)))))) + (buffer (when new-pos (nth new-pos buffers)))) (when (bufferp buffer) (let ((switch-to-buffer-obey-display-actions nil)) (switch-to-buffer buffer)))))))) From c59e67a41c512467a54cc92ed0fdb6c3b9e9ace8 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Apr 2024 14:54:32 +0800 Subject: [PATCH 062/149] Another fix for bug#70385 * src/xdisp.c (note_fringe_highlight): Test that vpos falls within W->current_matrix. (bug#70385) --- src/xdisp.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index d984c12d1aa..b154211cc3c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35769,9 +35769,11 @@ note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, struct window *w = XWINDOW (window); x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area); - /* Don't access the TEXT_AREA of a row that does not display text, or - when the window is outdated. (bug#70385) */ + /* Don't access the TEXT_AREA of a row that does not display text, + when the window is outdated, or when vpos overflows the current + matrix. (bug#70385) */ if (window_outdated (w) + || (vpos >= w->current_matrix->nrows) || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, vpos))) return; From f5e0fb11dbf4d2cc5d7ceabcec7600556fb12843 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 16 Apr 2024 15:38:53 +0800 Subject: [PATCH 063/149] Fix touch screen hscroll when initiated from widgets * lisp/wid-edit.el (widget-button--check-and-call-button): Return to the position of point during the tracking loop if a touch event is canceled. --- lisp/wid-edit.el | 157 ++++++++++++++++++++++++++--------------------- 1 file changed, 86 insertions(+), 71 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 172da3db1e0..4bc1ebc406a 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1093,77 +1093,92 @@ If nothing was called, return non-nil." (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) (pos (widget-event-point event)) newpoint) - (catch 'button-press-cancelled - ;; Mouse click on a widget button. Do the following - ;; in a save-excursion so that the click on the button - ;; doesn't change point. - (save-selected-window - (select-window (posn-window (event-start event))) - (save-excursion - (goto-char (posn-point (event-start event))) - (let* ((overlay (widget-get button :button-overlay)) - (pressed-face (or (widget-get button :pressed-face) - widget-button-pressed-face)) - (face (overlay-get overlay 'face)) - (mouse-face (overlay-get overlay 'mouse-face))) - (unwind-protect - ;; Read events, including mouse-movement events, - ;; waiting for a release event. If we began with a - ;; mouse-1 event and receive a movement event, that - ;; means the user wants to perform drag-selection, so - ;; cancel the button press and do the default mouse-1 - ;; action. For mouse-2, just highlight/ unhighlight - ;; the button the mouse was initially on when we move - ;; over it. - ;; - ;; If this function was called in response to a - ;; touchscreen event, then wait for a corresponding - ;; touchscreen-end event instead. - (save-excursion - (when face ; avoid changing around image - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (if (eq (car event) 'touchscreen-begin) - ;; This a touchscreen event and must be handled - ;; specially through `touch-screen-track-tap'. - (progn - (unless (touch-screen-track-tap event nil nil t) - (throw 'button-press-cancelled t))) - (unless (widget-apply button :mouse-down-action event) - (let ((track-mouse t)) - (while (not (widget-button-release-event-p event)) - (setq event (read--potential-mouse-event)) - (when (and mouse-1 (mouse-movement-p event)) - (push event unread-command-events) - (setq event oevent) - (throw 'button-press-cancelled t)) - (unless (or (integerp event) - (memq (car event) - '(switch-frame select-window)) - (eq (car event) 'scroll-bar-movement)) - (setq pos (widget-event-point event)) - (if (and pos - (eq (get-char-property pos 'button) - button)) - (when face - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face))))))) - - ;; When mouse is released over the button, run - ;; its action function. - (when (and pos (eq (get-char-property pos 'button) button)) - (goto-char pos) - (widget-apply-action button event) - (if widget-button-click-moves-point - (setq newpoint (point))))) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))) - - (when newpoint - (goto-char newpoint))) - nil))) + (setq newpoint + (catch 'button-press-cancelled + ;; Mouse click on a widget button. Do the following + ;; in a save-excursion so that the click on the button + ;; doesn't change point. + (save-selected-window + (select-window (posn-window (event-start event))) + (save-excursion + (goto-char (posn-point (event-start event))) + (let* ((overlay (widget-get button :button-overlay)) + (pressed-face (or (widget-get button :pressed-face) + widget-button-pressed-face)) + (face (overlay-get overlay 'face)) + (mouse-face (overlay-get overlay 'mouse-face))) + (unwind-protect + ;; Read events, including mouse-movement events, + ;; waiting for a release event. If we began with + ;; a mouse-1 event and receive a movement event, + ;; that means the user wants to perform + ;; drag-selection, so cancel the button press and + ;; do the default mouse-1 action. For mouse-2, + ;; just highlight/ unhighlight the button the + ;; mouse was initially on when we move over it. + ;; + ;; If this function was called in response to a + ;; touchscreen event, then wait for a + ;; corresponding touchscreen-end event instead. + (save-excursion + (when face ; avoid changing around image + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (if (eq (car event) 'touchscreen-begin) + ;; This a touchscreen event and must be + ;; handled specially through + ;; `touch-screen-track-tap'. + (progn + (unless (touch-screen-track-tap event nil nil t) + ;; Report the current position of point + ;; to the catch block. + (throw 'button-press-cancelled (point)))) + (unless (widget-apply button :mouse-down-action event) + (let ((track-mouse t)) + (while (not (widget-button-release-event-p event)) + (setq event (read--potential-mouse-event)) + (when (and mouse-1 (mouse-movement-p event)) + (push event unread-command-events) + (setq event oevent) + (throw 'button-press-cancelled t)) + (unless (or (integerp event) + (memq (car event) + '(switch-frame select-window)) + (eq (car event) + 'scroll-bar-movement)) + (setq pos (widget-event-point event)) + (if (and pos + (eq (get-char-property pos 'button) + button)) + (when face + (overlay-put overlay + 'face pressed-face) + (overlay-put overlay + 'mouse-face pressed-face)) + (overlay-put overlay + 'face face) + (overlay-put overlay + 'mouse-face mouse-face))))))) + + ;; When mouse is released over the button, run + ;; its action function. + (when (and pos (eq (get-char-property pos 'button) + button)) + (goto-char pos) + (widget-apply-action button event) + (if widget-button-click-moves-point + (setq newpoint (point))))) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))) + (when newpoint + (goto-char newpoint))) + nil)) + ;; Return to the position of point as it existed during the + ;; button-tracking loop if the event being tracked is a touch screen + ;; event, to prevent hscroll from being disturbed by movement of + ;; point to any previous location outside the visible confines of + ;; the window. + (when newpoint (goto-char newpoint)))) (defun widget-button-click (event) "Invoke the button that the mouse is pointing at." From b47b8159d88a9bef5a6bfd72e5c81ba2f6df95b5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 16 Apr 2024 10:55:37 +0200 Subject: [PATCH 064/149] Adapt tree-sitter job on EMBA * test/infra/gitlab-ci.yml (.tree-sitter-template) (test-tree-sitter): Adapt tree-sitter job. --- test/infra/gitlab-ci.yml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 5299aee746b..4c44ba6c55c 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -183,9 +183,15 @@ default: changes: - "**.in" - lisp/progmodes/*-ts-mode.el + - lisp/progmodes/js.el + - lisp/progmodes/python.el + - src/treesit.{h,c} - test/infra/* - test/lisp/progmodes/*-ts-mode-resources/** - test/lisp/progmodes/*-ts-mode-tests.el + - test/lisp/progmodes/js-tests.el + - test/lisp/progmodes/python-tests.el + - test/src/treesit-tests.el .native-comp-template: rules: @@ -282,7 +288,7 @@ test-tree-sitter: variables: target: emacs-tree-sitter # This is needed in order to get a JUnit test report. - make_params: '-k -C test check-expensive TEST_HOME=/root LOGFILES="$tree_sitter_files"' + make_params: '-k -C test SELECTOR=\(and\ \$\{SELECTOR_EXPENSIVE\}\ \\\"-ts-\\\"\) TEST_HOME=/root LOGFILES="$tree_sitter_files"' build-image-gnustep: stage: platform-images From 9a673c6914d4ab39139a91e892089dac70206cd2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 16 Apr 2024 11:59:20 +0200 Subject: [PATCH 065/149] Revert "; Improvements to PEG documentation" This reverts commit 930c578c1042e6372e5433e31b2ea801315c01c9. Looks like an editing mistake ate a large part of the text. --- doc/lispref/peg.texi | 128 +++++++++++++++++++++++++++--------------- lisp/progmodes/peg.el | 7 +-- 2 files changed, 87 insertions(+), 48 deletions(-) diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi index 90aa76988db..fbf57852ee0 100644 --- a/doc/lispref/peg.texi +++ b/doc/lispref/peg.texi @@ -1,31 +1,78 @@ -struct makes a set of rules available within its -body. The actual parsing is initiated with @code{peg-run}: - -@defun peg-run peg-matcher &optional failure-function success-function -This function accepts a single @var{peg-matcher}, which is the result of -calling @code{peg} (see below) on a named rule, usually the entry-point -of a larger grammar. - -At the end of parsing, one of @var{failure-function} or -@var{success-function} is called, depending on whether the parsing -succeeded or not. If @var{success-function} is called, it is passed a -lambda form that runs all the actions collected on the stack during -parsing -- by default this lambda form is simply executed. If parsing -fails, the @var{failure-function} is called with a list of @acronym{PEG} -expressions that failed during parsing; by default this list is -discarded. -@end defun - -The @var{peg-matcher} passed to @code{peg-run} is produced by a call to -@code{peg}: - -@defmac peg &rest pexs -Convert @var{pexs} into a single peg-matcher suitable for passing to -@code{peg-run}. +@c -*-texinfo-*- +@c This is part of the GNU Emacs Lisp Reference Manual. +@c Copyright (C) 1990--1995, 1998--1999, 2001--2023 Free Software +@c Foundation, Inc. +@c See the file elisp.texi for copying conditions. +@node Parsing Expression Grammars +@chapter Parsing Expression Grammars +@cindex text parsing +@cindex parsing expression grammar +@cindex PEG + + Emacs Lisp provides several tools for parsing and matching text, +from regular expressions (@pxref{Regular Expressions}) to full +left-to-right (a.k.a.@: @acronym{LL}) grammar parsers (@pxref{Top,, +Bovine parser development,bovine}). @dfn{Parsing Expression Grammars} +(@acronym{PEG}) are another approach to text parsing that offer more +structure and composibility than regular expressions, but less +complexity than context-free grammars. + +A Parsing Expression Grammar (@acronym{PEG}) describes a formal language +in terms of a set of rules for recognizing strings in the language. In +Emacs, a @acronym{PEG} parser is defined as a list of named rules, each +of which matches text patterns and/or contains references to other +rules. Parsing is initiated with the function @code{peg-run} or the +macro @code{peg-parse} (see below), and parses text after point in the +current buffer, using a given set of rules. + +@cindex parsing expression +@cindex root, of parsing expression grammar +@cindex entry-point, of parsing expression grammar +Each rule in a @acronym{PEG} is referred to as a @dfn{parsing +expression} (@acronym{PEX}), and can be specified a a literal string, a +regexp-like character range or set, a peg-specific construct resembling +an Emacs Lisp function call, a reference to another rule, or a +combination of any of these. A grammar is expressed as a tree of rules +in which one rule is typically treated as a ``root'' or ``entry-point'' +rule. For instance: + +@example +@group +((number sign digit (* digit)) + (sign (or "+" "-" "")) + (digit [0-9])) +@end group +@end example + +Once defined, grammars can be used to parse text after point in the +current buffer, in the following ways: + +@defmac peg-parse &rest pexs +Match @var{pexs} at point. If @var{pexs} is a list of PEG rules, the +first rule is considered the ``entry-point'': @end defmac -The @code{peg-parse} example above expands to just this set of calls, -and could be written as: +@example +@group +(peg-parse + ((number sign digit (* digit)) + (sign (or "+" "-" "")) + (digit [0-9]))) +@end group +@end example + +@c FIXME: These two should be formally defined using @defmac and @defun. +@findex with-peg-rules +@findex peg-run +The @code{peg-parse} macro represents the simplest use of the +@acronym{PEG} library, but also the least flexible, as the rules must be +written directly into the source code. A more flexible approach +involves use of three macros in conjunction: @code{with-peg-rules}, a +@code{let}-like construct that makes a set of rules available within the +macro body; @code{peg-run}, which initiates parsing given a single rule; +and @code{peg}, which is used to wrap the entry-point rule name. In +fact, a call to @code{peg-parse} expands to just this set of calls. The +above example could be written as: @example @group @@ -37,19 +84,14 @@ and could be written as: @end group @end example -This approach allows more explicit control over the ``entry-point'' of -parsing, and allows the combination of rules from different sources. +This allows more explicit control over the ``entry-point'' of parsing, +and allows the combination of rules from different sources. +@c FIXME: Use @defmac. +@findex define-peg-rule Individual rules can also be defined using a more @code{defun}-like syntax, using the macro @code{define-peg-rule}: -@defmac define-peg-rule name args &rest pexs -Define @var{name} as a PEG rule that accepts @var{args} and matches -@var{pexs} at point. -@end defmac - -For instance: - @example @group (define-peg-rule digit () @@ -57,16 +99,14 @@ For instance: @end group @end example -Arguments can be supplied to rules by the @code{funcall} PEG rule -(@pxref{PEX Definitions}). +This also allows for rules that accept an argument (supplied by the +@code{funcall} PEG rule, @pxref{PEX Definitions}). +@c FIXME: Use @defmac. +@findex define-peg-ruleset Another possibility is to define a named set of rules with @code{define-peg-ruleset}: -@defmac define-peg-ruleset name &rest rules -Define @var{name} as an identifier for @var{rules}. -@end defmac - @example @group (define-peg-ruleset number-grammar @@ -200,10 +240,10 @@ Returns non-@code{nil} if parsing @acronym{PEX} @var{e} from point fails Treats the value of the Lisp expression @var{exp} as a boolean. @end table +@c FIXME: peg-char-classes should be mentioned in the text below. @vindex peg-char-classes -Character-class matching can refer to the classes named in -@code{peg-char-classes}, equivalent to character classes in regular -expressions (@pxref{Top,, Character Classes,elisp}) +Character class matching can use the same named character classes as +in regular expressions (@pxref{Top,, Character Classes,elisp}) @node Parsing Actions @section Parsing Actions diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index 938f8da910d..bb57650d883 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -316,14 +316,13 @@ EXPS is a list of rules/expressions that failed.") "Match PEXS at point. PEXS is a sequence of PEG expressions, implicitly combined with `and'. Returns STACK if the match succeed and signals an error on failure, -moving point along the way." +moving point along the way. +PEXS can also be a list of PEG rules, in which case the first rule is used." (if (and (consp (car pexs)) (symbolp (caar pexs)) (not (ignore-errors (not (eq 'call (car (peg-normalize (car pexs)))))))) - ;; The first of `pexs' has not been defined as a rule, so assume - ;; that none of them have been and they should be fed to - ;; `with-peg-rules' + ;; `pexs' is a list of rules: use the first rule as entry point. `(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure)) `(peg-run (peg ,@pexs) #'peg-signal-failure))) From 1be21dd95388037cfb71474a1fbd2a7d3583a80a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Apr 2024 15:12:42 +0300 Subject: [PATCH 066/149] Minor fix in detecting recursive redisplay invocations * src/xdisp.c (redisplay_internal): Detect recursive invocations earlier. (Bug#66416) --- src/xdisp.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index b154211cc3c..f8c8d763c5b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16863,6 +16863,13 @@ redisplay_internal (void) redisplay_trace ("redisplay_internal %d\n", redisplaying_p); + /* I don't think this happens but let's be paranoid. In particular, + this was observed happening when Emacs shuits down to to losing X + connection, in which case accessing SELECTED_FRAME and the frame + structure is likely to barf. */ + if (redisplaying_p) + return; + /* No redisplay if running in batch mode or frame is not yet fully initialized, or redisplay is explicitly turned off by setting Vinhibit_redisplay. */ @@ -16890,10 +16897,6 @@ redisplay_internal (void) return; #endif - /* I don't think this happens but let's be paranoid. */ - if (redisplaying_p) - return; - /* Record a function that clears redisplaying_p when we leave this function. */ specpdl_ref count = SPECPDL_INDEX (); From d39f0a165a7f87336990e3304f1a8fa455a61600 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Apr 2024 21:23:37 +0300 Subject: [PATCH 067/149] * src/xdisp.c (note_fringe_highlight): Another attempt to fix bug#70385. --- src/xdisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index f8c8d763c5b..3db8d64f731 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35775,7 +35775,8 @@ note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, /* Don't access the TEXT_AREA of a row that does not display text, when the window is outdated, or when vpos overflows the current matrix. (bug#70385) */ - if (window_outdated (w) + if (!w->window_end_valid + || window_outdated (w) || (vpos >= w->current_matrix->nrows) || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, vpos))) From 2141caca30860ee04cad44ae2ad32744c1c11987 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Mon, 15 Apr 2024 20:14:50 -0700 Subject: [PATCH 068/149] ; Improvements to PEG documentation (second attempt) * doc/lispref/peg.texi: Make more use of defmac/defmacro, and try to clarify the relationships between the various macros and functions. * lisp/progmodes/peg.el (peg-parse): Remove claim that PEXS can also be a single list of rules. --- doc/lispref/peg.texi | 90 ++++++++++++++++++++++++++++--------------- lisp/progmodes/peg.el | 7 ++-- 2 files changed, 64 insertions(+), 33 deletions(-) diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi index fbf57852ee0..72a7cacac20 100644 --- a/doc/lispref/peg.texi +++ b/doc/lispref/peg.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--1999, 2001--2023 Free Software +@c Copyright (C) 1990--1995, 1998--1999, 2001--2024 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Parsing Expression Grammars @@ -45,34 +45,57 @@ rule. For instance: @end example Once defined, grammars can be used to parse text after point in the -current buffer, in the following ways: +current buffer, in a number of ways. The @code{peg-parse} macro is the +simplest: @defmac peg-parse &rest pexs -Match @var{pexs} at point. If @var{pexs} is a list of PEG rules, the -first rule is considered the ``entry-point'': +Match @var{pexs} at point. @end defmac @example @group (peg-parse - ((number sign digit (* digit)) - (sign (or "+" "-" "")) - (digit [0-9]))) + (number sign digit (* digit)) + (sign (or "+" "-" "")) + (digit [0-9])) @end group @end example -@c FIXME: These two should be formally defined using @defmac and @defun. -@findex with-peg-rules -@findex peg-run -The @code{peg-parse} macro represents the simplest use of the -@acronym{PEG} library, but also the least flexible, as the rules must be -written directly into the source code. A more flexible approach -involves use of three macros in conjunction: @code{with-peg-rules}, a -@code{let}-like construct that makes a set of rules available within the -macro body; @code{peg-run}, which initiates parsing given a single rule; -and @code{peg}, which is used to wrap the entry-point rule name. In -fact, a call to @code{peg-parse} expands to just this set of calls. The -above example could be written as: +While this macro is simple it is also inflexible, as the rules must be +written directly into the source code. More flexibility can be gained +by using a combination of other functions and macros. + +@defmac with-peg-rules rules &rest body +Execute @var{body} with @var{rules}, a list of @acronym{PEX}s, in +effect. Within @var{BODY}, parsing is initiated with a call to +@code{peg-run}. +@end defmac + +@defun peg-run peg-matcher &optional failure-function success-function +This function accepts a single @var{peg-matcher}, which is the result of +calling @code{peg} (see below) on a named rule, usually the entry-point +of a larger grammar. + +At the end of parsing, one of @var{failure-function} or +@var{success-function} is called, depending on whether the parsing +succeeded or not. If @var{success-function} is called, it is passed a +lambda form that runs all the actions collected on the stack during +parsing -- by default this lambda form is simply executed. If parsing +fails, the @var{failure-function} is called with a list of @acronym{PEG} +expressions that failed during parsing; by default this list is +discarded. +@end defun + +The @var{peg-matcher} passed to @code{peg-run} is produced by a call to +@code{peg}: + +@defmac peg &rest pexs +Convert @var{pexs} into a single peg-matcher suitable for passing to +@code{peg-run}. +@end defmac + +The @code{peg-parse} example above expands to a set of calls to these +functions, and could be written in full as: @example @group @@ -84,14 +107,19 @@ above example could be written as: @end group @end example -This allows more explicit control over the ``entry-point'' of parsing, -and allows the combination of rules from different sources. +This approach allows more explicit control over the ``entry-point'' of +parsing, and allows the combination of rules from different sources. -@c FIXME: Use @defmac. -@findex define-peg-rule Individual rules can also be defined using a more @code{defun}-like syntax, using the macro @code{define-peg-rule}: +@defmac define-peg-rule name args &rest pexs +Define @var{name} as a PEG rule that accepts @var{args} and matches +@var{pexs} at point. +@end defmac + +For instance: + @example @group (define-peg-rule digit () @@ -99,14 +127,16 @@ syntax, using the macro @code{define-peg-rule}: @end group @end example -This also allows for rules that accept an argument (supplied by the -@code{funcall} PEG rule, @pxref{PEX Definitions}). +Arguments can be supplied to rules by the @code{funcall} PEG rule +(@pxref{PEX Definitions}). -@c FIXME: Use @defmac. -@findex define-peg-ruleset Another possibility is to define a named set of rules with @code{define-peg-ruleset}: +@defmac define-peg-ruleset name &rest rules +Define @var{name} as an identifier for @var{rules}. +@end defmac + @example @group (define-peg-ruleset number-grammar @@ -240,10 +270,10 @@ Returns non-@code{nil} if parsing @acronym{PEX} @var{e} from point fails Treats the value of the Lisp expression @var{exp} as a boolean. @end table -@c FIXME: peg-char-classes should be mentioned in the text below. @vindex peg-char-classes -Character class matching can use the same named character classes as -in regular expressions (@pxref{Top,, Character Classes,elisp}) +Character-class matching can refer to the classes named in +@code{peg-char-classes}, equivalent to character classes in regular +expressions (@pxref{Top,, Character Classes,elisp}) @node Parsing Actions @section Parsing Actions diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index bb57650d883..938f8da910d 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -316,13 +316,14 @@ EXPS is a list of rules/expressions that failed.") "Match PEXS at point. PEXS is a sequence of PEG expressions, implicitly combined with `and'. Returns STACK if the match succeed and signals an error on failure, -moving point along the way. -PEXS can also be a list of PEG rules, in which case the first rule is used." +moving point along the way." (if (and (consp (car pexs)) (symbolp (caar pexs)) (not (ignore-errors (not (eq 'call (car (peg-normalize (car pexs)))))))) - ;; `pexs' is a list of rules: use the first rule as entry point. + ;; The first of `pexs' has not been defined as a rule, so assume + ;; that none of them have been and they should be fed to + ;; `with-peg-rules' `(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure)) `(peg-run (peg ,@pexs) #'peg-signal-failure))) From 484b0979099d91e286c248e32b2f693111fac2ad Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 16 Apr 2024 21:17:47 -0400 Subject: [PATCH 069/149] (cl-defstruct): Improve handling of unknown options Until now `cl-defstruct` signaled an error when encountering an unknown option. It's easy to code and it does the job, but it doesn't give good location info in the compiler's output, and it makes it more painful to use not-yet-supported options. So just signal a warning instead. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Warn about unknown options, instead of signaling an error. --- lisp/emacs-lisp/cl-macs.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 1350e474d6a..2e501005bf7 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3010,6 +3010,7 @@ To see the documentation for a defined struct type, use ;; All the above is for the following def-form. &rest &or symbolp (symbolp &optional def-form &rest sexp)))) (let* ((name (if (consp struct) (car struct) struct)) + (warning nil) (opts (cdr-safe struct)) (slots nil) (defaults nil) @@ -3094,7 +3095,10 @@ To see the documentation for a defined struct type, use (setq descs (nconc (make-list (car args) '(cl-skip-slot)) descs))) (t - (error "Structure option %s unrecognized" opt))))) + (setq warning + (macroexp-warn-and-return + (format "Structure option %S unrecognized" opt) + warning nil nil (list opt struct))))))) (unless (or include-name type ;; Don't create a bogus parent to `cl-structure-object' ;; while compiling the (cl-defstruct cl-structure-object ..) @@ -3333,6 +3337,7 @@ To see the documentation for a defined struct type, use (cl-struct-define ',name ,docstring ',include-name ',(or type 'record) ,(eq named t) ',descs ',tag-symbol ',tag ',print-auto)) + ,warning ',name))) ;;; Add cl-struct support to pcase From a33ab7565e20d9c04731491f6ae38a8d35be729f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 16 Apr 2024 21:57:05 -0400 Subject: [PATCH 070/149] track-changes.el: Minor changes for version 1.0 Arrange for the library to be usable on older Emacsen, which includes reducing the noise when `before/after-change-functions` are badly paired or missing. Also, since the signal function receives the distance (for `:disjoint`), we don't need `track-changes--disjoint-threshold`: the signal function can simply do nothing when the distance is smaller than the threshold it wants to use. * lisp/emacs-lisp/track-changes.el: Prepare header for ELPA. (track-changes--tracker, track-changes--state): Don't use `:noinline`, so as to be compatible with Emacs<27. (track-changes-record-errors): New variable. (track-changes--recover-from-error): Use it. Record only the last 20 keys and the last 50 stack frames in the error log. (track-changes--disjoint-threshold): Delete variable. (track-changes--before): Don't use it any more. * lisp/progmodes/eglot.el (eglot--track-changes-signal): Coalesce disjoint changes nearer than what used to be coalesced because of `track-changes--disjoint-threshold`. --- lisp/emacs-lisp/track-changes.el | 43 +++++++++++++++++++++----------- lisp/progmodes/eglot.el | 7 +++++- 2 files changed, 34 insertions(+), 16 deletions(-) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 9e62b8bdf30..6e4440b7771 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -3,6 +3,8 @@ ;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Stefan Monnier +;; Version: 1.0 +;; Package-Requires: ((emacs "24")) ;; This file is part of GNU Emacs. @@ -92,7 +94,7 @@ ;;;; Internal types and variables. (cl-defstruct (track-changes--tracker - (:noinline t) + ;; (:noinline t) ;Requires Emacs≥27 (:constructor nil) (:constructor track-changes--tracker ( signal state &optional @@ -100,7 +102,7 @@ signal state nobefore immediate) (cl-defstruct (track-changes--state - (:noinline t) + ;; (:noinline t) ;Requires Emacs≥27 (:constructor nil) (:constructor track-changes--state ())) "Object holding a description of a buffer state. @@ -164,6 +166,14 @@ This is used to try and detect cases where buffer modifications are \"lost\".") ;;;; Exposed API. +(defvar track-changes-record-errors + ;; By default, record errors only for non-release versions, because we + ;; presume that these might be too old to receive fixes, so better not + ;; annoy the user too much about errors. + (string-match "\\..*\\." emacs-version) + "If non-nil, keep track of errors in `before/after-chage-functions' calls. +The errors are kept in `track-changes--error-log'.") + (cl-defun track-changes-register ( signal &key nobefore disjoint immediate) "Register a new tracker whose change-tracking function is SIGNAL. Return the ID of the new tracker. @@ -412,9 +422,6 @@ and re-enable the TRACKER corresponding to ID." (setf (track-changes--state-next track-changes--state) new) (setq track-changes--state new))))) -(defvar track-changes--disjoint-threshold 100 - "Number of chars below which changes are not considered disjoint.") - (defvar track-changes--error-log () "List of errors encountered. Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).") @@ -424,12 +431,19 @@ Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).") ;; elsewhere that causes the before-c-f and after-c-f to be improperly ;; paired, or to be skipped altogether. ;; Not much we can do, other than force a full re-synchronization. - (warn "Missing/incorrect calls to `before/after-change-functions'!! + (if (not track-changes-record-errors) + (message "Recovering from confusing calls to `before/after-change-functions'!") + (warn "Missing/incorrect calls to `before/after-change-functions'!! Details logged to `track-changes--error-log'") - (push (list (buffer-name) - (backtrace-frames 'track-changes--recover-from-error) - (recent-keys 'include-cmds)) - track-changes--error-log) + (push (list (buffer-name) + (let* ((bf (backtrace-frames + #'track-changes--recover-from-error)) + (tail (nthcdr 50 bf))) + (when tail (setcdr tail '...)) + bf) + (let ((rk (recent-keys 'include-cmds))) + (substring rk -20))) + track-changes--error-log)) (setq track-changes--before-clean 'unset) (setq track-changes--buffer-size (buffer-size)) ;; Create a new state disconnected from the previous ones! @@ -453,11 +467,10 @@ Details logged to `track-changes--error-log'") (lambda (pos1 pos2) (let ((distance (- pos2 pos1))) (when (> distance - (max track-changes--disjoint-threshold - ;; If the distance is smaller than the size of the - ;; current change, then we may as well consider it - ;; as "near". - (length track-changes--before-string) + ;; If the distance is smaller than the size of the + ;; current change, then we may as well consider it + ;; as "near". + (max (length track-changes--before-string) size (- track-changes--before-end track-changes--before-beg))) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 478e7687bb3..5e4f7bba679 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2665,7 +2665,9 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." (defun eglot--track-changes-signal (id &optional distance) (cl-incf eglot--versioned-identifier) (cond - (distance (eglot--track-changes-fetch id)) + (distance + ;; When distance is <100, we may as well coalesce the changes. + (when (> distance 100) (eglot--track-changes-fetch id))) (eglot--recent-changes nil) ;; Note that there are pending changes, for the benefit of those ;; who check it as a boolean. @@ -2796,6 +2798,7 @@ When called interactively, use the currently active server" (list :textDocument (eglot--VersionedTextDocumentIdentifier) :contentChanges + (let ((changes (if full-sync-p (vector `(:text ,(eglot--widening (buffer-substring-no-properties (point-min) @@ -2809,6 +2812,8 @@ When called interactively, use the currently active server" when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) + (message "Sending changes: %S" changes) + changes))) (setq eglot--recent-changes nil) (jsonrpc--call-deferred server)))) From ada429c375235c4d8bd3bf5e6bb2507fb44f63dd Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 17 Apr 2024 09:53:02 +0300 Subject: [PATCH 071/149] * lisp/emacs-lisp/lisp.el (forward-sexp-function): Set back to nil. (forward-sexp): Revert back to checking 'forward-sexp-function' for nil (bug#70426). --- etc/NEWS | 4 ---- lisp/emacs-lisp/lisp.el | 8 ++++---- lisp/treesit.el | 2 +- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 99f33a7b8dd..bc8be557711 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2103,10 +2103,6 @@ All tree-sitter enabled modes that define 'sentence' in ** Functions and variables to move by program sexps -*** New function 'forward-sexp-default-function'. -The previous implementation of 'forward-sexp' is moved into its -own function, to be bound by 'forward-sexp-function'. - *** New function 'treesit-forward-sexp'. Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index bd0b38db7ea..7e6db51b1d5 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -50,7 +50,7 @@ This affects `insert-parentheses' and `insert-pair'." (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) (if (< arg 0) (backward-prefix-chars))) -(defvar forward-sexp-function #'forward-sexp-default-function +(defvar forward-sexp-function nil ;; FIXME: ;; - for some uses, we may want a "sexp-only" version, which only ;; jumps over a well-formed sexp, rather than some dwimish thing @@ -79,9 +79,9 @@ report errors as appropriate for this kind of usage." "No next sexp" "No previous sexp")))) (or arg (setq arg 1)) - (funcall (or forward-sexp-function - #'forward-sexp-default-function) - arg))) + (if forward-sexp-function + (funcall forward-sexp-function arg) + (forward-sexp-default-function arg)))) (defun backward-sexp (&optional arg interactive) "Move backward across one balanced expression (sexp). diff --git a/lisp/treesit.el b/lisp/treesit.el index 2973aba771c..2b899a84183 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2153,7 +2153,7 @@ by `text' and `sexp' in `treesit-thing-settings'." (let ((arg (or arg 1)) (pred (or treesit-sexp-type-regexp 'sexp))) (or (when (treesit-node-match-p (treesit-node-at (point)) 'text t) - (funcall #'forward-sexp-default-function arg) + (forward-sexp-default-function arg) t) (if (> arg 0) (treesit-end-of-thing pred (abs arg) 'restricted) From 1606e14c6f1fb5c524dd21ac1b1187b5230f683e Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Wed, 17 Apr 2024 09:04:18 +0200 Subject: [PATCH 072/149] ; * src/xdisp.c (redisplay_internal): Typo fix in comment --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 3db8d64f731..5073af3e04f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16864,7 +16864,7 @@ redisplay_internal (void) redisplay_trace ("redisplay_internal %d\n", redisplaying_p); /* I don't think this happens but let's be paranoid. In particular, - this was observed happening when Emacs shuits down to to losing X + this was observed happening when Emacs shuts down due to losing X connection, in which case accessing SELECTED_FRAME and the frame structure is likely to barf. */ if (redisplaying_p) From 42b3024ca8e2d844084d2e8c78f58f530e1b18b3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 17 Apr 2024 14:50:38 +0300 Subject: [PATCH 073/149] Another fix for bug#70385 * src/xdisp.c (note_fringe_highlight): Check value of x_y_to_hpos_vpos. --- src/xdisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 5073af3e04f..5fe16ab9536 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35770,7 +35770,8 @@ note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, /* Translate windows coordinates into a vertical window position. */ int hpos, vpos, area; struct window *w = XWINDOW (window); - x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area); + if (x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area) == NULL) + return; /* not all glyph rows between 0 and Y are enabled */ /* Don't access the TEXT_AREA of a row that does not display text, when the window is outdated, or when vpos overflows the current From 3660c51736072816b65265e60e0b7475375e2a73 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 17 Apr 2024 09:04:12 -0400 Subject: [PATCH 074/149] track-changes.el: Fix last change for early use * lisp/emacs-lisp/track-changes.el (track-changes--recover-from-error): Don't burp if there have been fewer than 20 keystrokes since Emacs start. --- lisp/emacs-lisp/track-changes.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 6e4440b7771..03d031deb4d 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -442,7 +442,7 @@ Details logged to `track-changes--error-log'") (when tail (setcdr tail '...)) bf) (let ((rk (recent-keys 'include-cmds))) - (substring rk -20))) + (if (< (length rk) 20) rk (substring rk -20)))) track-changes--error-log)) (setq track-changes--before-clean 'unset) (setq track-changes--buffer-size (buffer-size)) From 523aca13a45159711d7d9d7561e69d38acdac12a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 17 Apr 2024 10:57:11 -0400 Subject: [PATCH 075/149] * lisp/emacs-lisp/track-changes.el: Fix trailer --- lisp/emacs-lisp/track-changes.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 03d031deb4d..c11c976312b 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Version: 1.0 +;; Version: 1.1 ;; Package-Requires: ((emacs "24")) ;; This file is part of GNU Emacs. @@ -638,4 +638,4 @@ Re-arms ID's signal." `(track-changes-fetch ,id (lambda ,vars ,@body))) (provide 'track-changes) -;;; track-changes.el end here. +;;; track-changes.el ends here From 91333dacfa1b9f1041ceeebb3d46e8e04048c4c9 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Wed, 17 Apr 2024 19:33:24 +0200 Subject: [PATCH 076/149] Allow tabbing between widgets to skip inactive widgets (bug#70413) * doc/misc/widget.texi (Widgets and the Buffer, Customization): Document it. * etc/NEWS: Announce it. * lisp/wid-edit.el (widget-skip-inactive): New user option. (widget-tabable-at): Use it. --- doc/misc/widget.texi | 14 ++++++++++++++ etc/NEWS | 7 +++++++ lisp/wid-edit.el | 13 +++++++++++-- 3 files changed, 32 insertions(+), 2 deletions(-) diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index cfb9d2211cf..f74605c92c0 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -795,6 +795,11 @@ Move point @var{count} buttons or editing fields backward. @end deffn @end table +@noindent +By default, tabbing can put point on an inactive widget. To skip over +inactive widgets when tabbing, set the user option +@code{widget-skip-inactive} to a non-@code{nil} value. +@xref{Customization}. When editing an @code{editable-field} widget, the following commands are available: @@ -3321,6 +3326,15 @@ If non-@code{nil}, toggle when there are just two options. By default, its value is @code{nil}. @end defopt +@defopt widget-skip-inactive +If non-@code{nil}, skip over inactive widgets when using @kbd{@key{TAB}} +(@code{widget-forward}) or @kbd{S-@key{TAB}} (@code{widget-backward}, +also bound to @kbd{M-@key{TAB}}) to navigate between widgets. + +By default, its value is @code{nil} and tabbing does not skip over +inactive widgets. +@end defopt + @defopt widget-documentation-links If non-@code{nil}, add hyperlinks to documentation strings. @end defopt diff --git a/etc/NEWS b/etc/NEWS index bc8be557711..e6f8eb5ba46 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1603,6 +1603,13 @@ This allows disabling JavaScript in xwidget Webkit sessions. 'insert-directory', now supports the '--time=TIME' and '--sort=time' options of GNU 'ls'. +** Widget + ++++ +*** New user option 'widget-skip-inactive'. +If non-nil, moving point forward or backward between widgets by typing +TAB or S-TAB skips over inactive widgets. The default value is nil. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4bc1ebc406a..cb6d8ebc2c4 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1234,11 +1234,20 @@ If nothing was called, return non-nil." (when (commandp command) (call-interactively command)))))) +(defcustom widget-skip-inactive nil + "If non-nil, skip inactive widgets when tabbing through buffer." + :version "30.1" + :group 'widgets + :type 'boolean) + (defun widget-tabable-at (&optional pos) "Return the tabable widget at POS, or nil. -POS defaults to the value of (point)." +POS defaults to the value of (point). If user option +`widget-skip-inactive' is non-nil, inactive widgets are not tabable." (let ((widget (widget-at pos))) - (if widget + (if (and widget (if widget-skip-inactive + (widget-apply widget :active) + t)) (let ((order (widget-get widget :tab-order))) (if order (if (>= order 0) From 230eecf12a688f87354ed2d360a7dfcd7e2dae6a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 17 Apr 2024 20:55:45 +0300 Subject: [PATCH 077/149] New keymap tab-line-mode-map and new tab order on tab-line (bug#69993) * lisp/tab-line.el (tab-line-new-button-functions): New variable. (tab-line-tabs-function): Change the default value from 'tab-line-tabs-window-buffers' to the new option 'tab-line-tabs-fixed-window-buffers'. (tab-line-tabs-buffer-group-sort-function): Change the default value from nil to 'tab-line-tabs-buffer-group-sort-by-name'. (tab-line-tabs-buffer-group-sort-by-name): New function. (tab-line-tabs-fixed-window-buffers): New function. (tab-line-format-template): Use 'tab-line-new-button-functions'. (tab-line-mode-map, tab-line-switch-repeat-map): New keymaps. --- etc/NEWS | 22 ++++++++++++++++++++ lisp/tab-line.el | 52 ++++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 68 insertions(+), 6 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index e6f8eb5ba46..2f90a3067f7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -370,11 +370,33 @@ By default it contains a keybinding 'C-TAB' to switch tabs, but only when 'C-TAB' is not bound globally. You can unbind it if it conflicts with 'C-TAB' in other modes. +--- +*** New keymap 'tab-line-mode-map'. +By default it contains keybindings for switching tabs: +'C-x ', 'C-x ', 'C-x C-', 'C-x C-'. +You can unbind them if you want to use these keys for the +commands 'previous-buffer' and 'next-buffer'. + +--- +*** Default list of tabs is changed to support a fixed order. +This means that the new default tabs function +'tab-line-tabs-fixed-window-buffers' is like the previous +'tab-line-tabs-window-buffers' where both of them show +only buffers that were previously displayed in the window. +But the difference is that the new function always keeps +the original order of buffers on the tab line, even after +switching between these buffers. + --- *** New user option 'tab-line-tabs-buffer-group-function'. It provides two choices to group tab buffers by major mode and by project name. +--- +*** Now buffers on group tabs are sorted alphabetically. +This will keep the fixed order of tabs, even after +switching between them. + +++ ** New optional argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 48272b7b4b3..09081501705 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -210,6 +210,11 @@ If the value is a function, call it with no arguments." 'help-echo "Click to add tab") "Button for creating a new tab.") +(defvar tab-line-new-button-functions + '(tab-line-tabs-window-buffers + tab-line-tabs-fixed-window-buffers) + "Functions of `tab-line-tabs-function' for which to show a new button.") + (defcustom tab-line-close-button-show t "Defines where to show the close tab button. If t, show the close tab button on all tabs. @@ -333,18 +338,21 @@ If truncated, append ellipsis per `tab-line-tab-name-ellipsis'." 'help-echo tab-name)))) -(defcustom tab-line-tabs-function #'tab-line-tabs-window-buffers +(defcustom tab-line-tabs-function #'tab-line-tabs-fixed-window-buffers "Function to get a list of tabs to display in the tab line. This function should return either a list of buffers whose names will be displayed, or just a list of strings to display in the tab line. -By default, use function `tab-line-tabs-window-buffers' that -returns a list of buffers associated with the selected window. +By default, use function `tab-line-tabs-fixed-window-buffers' that +returns a list of buffers associated with the selected window where +buffers always keep the original order after switching buffers. When `tab-line-tabs-mode-buffers', return a list of buffers with the same major mode as the current buffer. When `tab-line-tabs-buffer-groups', return a list of buffers grouped by `tab-line-tabs-buffer-group-function'." :type '(choice (const :tag "Window buffers" tab-line-tabs-window-buffers) + (const :tag "Window buffers with fixed order" + tab-line-tabs-fixed-window-buffers) (const :tag "Same mode buffers" tab-line-tabs-mode-buffers) (const :tag "Grouped buffers" @@ -400,9 +408,13 @@ as a group name." :group 'tab-line :version "30.1") -(defvar tab-line-tabs-buffer-group-sort-function nil +(defvar tab-line-tabs-buffer-group-sort-function + #'tab-line-tabs-buffer-group-sort-by-name "Function to sort buffers in a group.") +(defun tab-line-tabs-buffer-group-sort-by-name (a b) + (string< (buffer-name a) (buffer-name b))) + (defvar tab-line-tabs-buffer-groups-sort-function #'string< "Function to sort group names.") @@ -515,6 +527,21 @@ variable `tab-line-tabs-function'." (list buffer) next-buffers))) +(defun tab-line-tabs-fixed-window-buffers () + "Like `tab-line-tabs-window-buffers' but keep stable sorting order. +This means that switching to a buffer previously shown in the same +window will keep the same order of tabs that was before switching. +And newly displayed buffers are added to the end of the tab line." + (let* ((old-buffers (window-parameter nil 'tab-line-fixed-window-buffers)) + (new-buffers (sort (tab-line-tabs-window-buffers) + (lambda (a b) + (< (or (seq-position old-buffers a) + most-positive-fixnum) + (or (seq-position old-buffers b) + most-positive-fixnum)))))) + (set-window-parameter nil 'tab-line-fixed-window-buffers new-buffers) + new-buffers)) + (defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default "Function to format a tab name. @@ -599,7 +626,7 @@ This is used by `tab-line-format'." tab-line-right-button))) (if hscroll (nthcdr (truncate hscroll) strings) strings) (list separator) - (when (and (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (when (and (memq tab-line-tabs-function tab-line-new-button-functions) tab-line-new-button-show tab-line-new-button) (list tab-line-new-button))))) @@ -940,7 +967,7 @@ buffers, which effectively hides the buffer's tab from the tab line. If `kill-buffer', kills the tab's buffer. When a function, it is called with the tab as its argument. This option is useful when `tab-line-tabs-function' has the value -`tab-line-tabs-window-buffers'." +`tab-line-tabs-window-buffers' or `tab-line-tabs-fixed-window-buffers'." :type '(choice (const :tag "Bury buffer" bury-buffer) (const :tag "Kill buffer" kill-buffer) (function :tag "Function")) @@ -1033,6 +1060,19 @@ However, return the correct mouse position list if EVENT is a (event-start event))) +(defvar-keymap tab-line-mode-map + :doc "Keymap for keys of `tab-line-mode'." + "C-x " #'tab-line-switch-to-prev-tab + "C-x C-" #'tab-line-switch-to-prev-tab + "C-x " #'tab-line-switch-to-next-tab + "C-x C-" #'tab-line-switch-to-next-tab) + +(defvar-keymap tab-line-switch-repeat-map + :doc "Keymap to repeat tab/buffer cycling. Used in `repeat-mode'." + :repeat t + "" #'tab-line-switch-to-prev-tab + "" #'tab-line-switch-to-next-tab) + ;;;###autoload (define-minor-mode tab-line-mode "Toggle display of tab line in the windows displaying the current buffer." From 4dd3288569c30414abf0be4fd357d66e4dfeb8fb Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 17 Apr 2024 21:01:14 +0300 Subject: [PATCH 078/149] * lisp/emacs-lisp/icons.el (define-icon): Add 'doc-string' to 'declare'. --- lisp/emacs-lisp/icons.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index f9591661688..847ef53a1cb 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -73,7 +73,7 @@ inferred if not present. `:help-echo': Informational text that explains what happens if the icon is used as a button and you click it." - (declare (indent 2)) + (declare (doc-string 4) (indent 2)) (unless (symbolp name) (error "NAME must be a symbol: %S" name)) (unless (plist-get keywords :version) From fcee1bf07bb807c568f0155f94ebd69636691de9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 17 Apr 2024 13:58:40 -0400 Subject: [PATCH 079/149] eglot.el: Remove accidentally included debugging code * lisp/progmodes/eglot.el (eglot--signal-textDocument/didChange): Remove leftover debug message. --- lisp/progmodes/eglot.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5e4f7bba679..bff273338c4 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2798,7 +2798,6 @@ When called interactively, use the currently active server" (list :textDocument (eglot--VersionedTextDocumentIdentifier) :contentChanges - (let ((changes (if full-sync-p (vector `(:text ,(eglot--widening (buffer-substring-no-properties (point-min) @@ -2812,8 +2811,6 @@ When called interactively, use the currently active server" when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) - (message "Sending changes: %S" changes) - changes))) (setq eglot--recent-changes nil) (jsonrpc--call-deferred server)))) From c15c9f4de62b5bf06d6ccdb5bbada4f542108a38 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 17 Apr 2024 14:30:10 -0400 Subject: [PATCH 080/149] (conf-toml-recognize-section): Fix bug#70383 * lisp/textmodes/conf-mode.el (conf-toml-recognize-section): Move point, like font-lock matchers are expected to do. --- lisp/textmodes/conf-mode.el | 41 ++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 5e1636033f6..e74409128df 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -613,27 +613,26 @@ For details see `conf-mode'. Example: "Font-lock helper function for `conf-toml-mode'. Handles recognizing TOML section names, like [section], \[[section]], or [something.\"else\".section]." - (save-excursion - ;; Skip any number of "[" to handle things like [[section]]. - (when (re-search-forward "^\\s-*\\[+" limit t) - (let ((start (point))) - (backward-char) - (let ((end (min limit - (condition-case nil - (progn - (forward-list) - (1- (point))) - (scan-error - (end-of-line) - (point)))))) - ;; If there is a comma in the text, then we assume this is - ;; an array and not a section. (This could be refined to - ;; look only for unquoted commas if necessary.) - (save-excursion - (goto-char start) - (unless (search-forward "," end t) - (set-match-data (list start end)) - t))))))) + ;; Skip any number of "[" to handle things like [[section]]. + (when (re-search-forward "^\\s-*\\[+" limit t) + (let ((start (point))) + (backward-char) + (let ((end (min limit + (condition-case nil + (progn + (forward-list) + (1- (point))) + (scan-error + (end-of-line) + (point)))))) + ;; If there is a comma in the text, then we assume this is + ;; an array and not a section. (This could be refined to + ;; look only for unquoted commas if necessary.) + (save-excursion + (goto-char start) + (unless (search-forward "," end t) + (set-match-data (list start end)) + t)))))) ;;;###autoload (define-derived-mode conf-toml-mode conf-mode "Conf[TOML]" From 0dbd9ed04660152276696e462359204a45ca933d Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Wed, 17 Apr 2024 20:27:35 +0200 Subject: [PATCH 081/149] Document earlier change in eglot-report-progress * lisp/progmodes/eglot.el (eglot-report-progress): Document the changed behavior. * etc/EGLOT-NEWS (https): Mention the change. --- etc/EGLOT-NEWS | 6 ++++++ lisp/progmodes/eglot.el | 5 ++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 12e7d3f6b9b..0e3e4b7aff8 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,12 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot +** Disable workDoneProgress if eglot-report-progress is nil + +Eglot will now try to not register $/progress messages from the server +when the defcustom is set to nil. This requires a restart of the server +for the change to take effect. + * Changes in Eglot 1.17 (25/1/2024) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index bff273338c4..c395efd9f55 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -517,7 +517,10 @@ ACTION is the default value for commands not in the alist." (defcustom eglot-report-progress t "If non-nil, show progress of long running LSP server work. If set to `messages', use *Messages* buffer, else use Eglot's -mode line indicator." +mode line indicator. + +For changes on this variable to take effect, you need to restart +the LSP connection. That can be done by `eglot-reconnect'." :type '(choice (const :tag "Don't show progress" nil) (const :tag "Show progress in *Messages*" messages) (const :tag "Show progress in Eglot's mode line indicator" t)) From 3cdd86b8affa6d58de8f6d07b4e117676fedd58c Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Sun, 14 Apr 2024 09:36:05 +0200 Subject: [PATCH 082/149] Propagate 'lexical-binding' value to pp buffers See bug#70137. * lisp/emacs-lisp/pp.el (pp-display-expression): Set lexical-binding to match the value in the calling buffer. --- lisp/emacs-lisp/pp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index d586fc59939..f89807c37be 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -327,7 +327,8 @@ If LISP, format with `pp-emacs-lisp-code'; use `pp' otherwise. If a temporary buffer is needed for representation, it will be named after OUT-BUFFER-NAME." - (let* ((old-show-function temp-buffer-show-function) + (let* ((lexical lexical-binding) + (old-show-function temp-buffer-show-function) ;; Use this function to display the buffer. ;; This function either decides not to display it at all ;; or displays it in the usual way. @@ -357,6 +358,7 @@ after OUT-BUFFER-NAME." (pp expression)) (with-current-buffer standard-output (emacs-lisp-mode) + (setq lexical-binding lexical) (setq buffer-read-only nil) (setq-local font-lock-verbose nil))))) From c19b988c2967f13597b7a3ceafb7c3cd40d83458 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 18 Apr 2024 10:37:31 +0800 Subject: [PATCH 083/149] Correctly verify availability of Android content URIs * java/org/gnu/emacs/EmacsService.java (checkContentUri): Call checkUriPermission with IPC-effective PID and UID rather than checkCallingUriPermission, which never considers permissions of Emacs itself, and delete the now-redundant workaround. --- java/org/gnu/emacs/EmacsService.java | 54 +++++++--------------------- 1 file changed, 13 insertions(+), 41 deletions(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index fd052653087..b1ec397bc41 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -70,15 +70,16 @@ import android.net.Uri; import android.os.BatteryManager; +import android.os.Binder; import android.os.Build; import android.os.Environment; -import android.os.Looper; -import android.os.IBinder; import android.os.Handler; +import android.os.IBinder; +import android.os.Looper; import android.os.ParcelFileDescriptor; +import android.os.VibrationEffect; import android.os.Vibrator; import android.os.VibratorManager; -import android.os.VibrationEffect; import android.provider.DocumentsContract; import android.provider.DocumentsContract.Document; @@ -1027,11 +1028,8 @@ invocation of app_process (through android-emacs) can public boolean checkContentUri (String name, boolean readable, boolean writable) { - String mode; - ParcelFileDescriptor fd; Uri uri; int rc, flags; - ParcelFileDescriptor descriptor; uri = Uri.parse (name); flags = 0; @@ -1042,47 +1040,21 @@ invocation of app_process (through android-emacs) can if (writable) flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; - rc = checkCallingUriPermission (uri, flags); - - if (rc == PackageManager.PERMISSION_GRANTED) - return true; - - /* In the event checkCallingUriPermission fails and only read - permissions are being verified, attempt to query the URI. This - enables ascertaining whether drag and drop URIs can be - accessed, something otherwise not provided for. */ - - descriptor = null; - - try - { - descriptor = resolver.openFileDescriptor (uri, "r"); - return true; - } - catch (Exception exception) - { - /* Ignored. */ - } - finally - { - try - { - if (descriptor != null) - descriptor.close (); - } - catch (IOException exception) - { - /* Ignored. */ - } - } + /* checkCallingUriPermission deals with permissions held by callers + of functions over the Binder IPC mechanism as contrasted with + Emacs itself, while getCallingPid and getCallingUid, despite the + class where they reside, return the process credentials against + which the system will actually test URIs being opened. */ - return false; + rc = checkUriPermission (uri, Binder.getCallingPid (), + Binder.getCallingUid (), flags); + return rc == PackageManager.PERMISSION_GRANTED; } /* Return a 8 character checksum for the string STRING, after encoding as UTF-8 data. */ - public static String + private static String getDisplayNameHash (String string) { byte[] encoded; From b585fb8171dd139f178c398c64c584565deacfb1 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Apr 2024 09:36:18 +0300 Subject: [PATCH 084/149] * lisp/tab-line.el: Use the new keyword :key for 'sort'. (tab-line-tabs-fixed-window-buffers): Use :key for 'sort'. Rename the window parameter 'tab-line-fixed-window-buffers' to shorter 'tab-line-buffers'. Add '(tab-line-buffers . writable) to window-persistent-parameters. --- lisp/tab-line.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 09081501705..2eb97012262 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -532,16 +532,16 @@ variable `tab-line-tabs-function'." This means that switching to a buffer previously shown in the same window will keep the same order of tabs that was before switching. And newly displayed buffers are added to the end of the tab line." - (let* ((old-buffers (window-parameter nil 'tab-line-fixed-window-buffers)) + (let* ((old-buffers (window-parameter nil 'tab-line-buffers)) (new-buffers (sort (tab-line-tabs-window-buffers) - (lambda (a b) - (< (or (seq-position old-buffers a) - most-positive-fixnum) - (or (seq-position old-buffers b) - most-positive-fixnum)))))) - (set-window-parameter nil 'tab-line-fixed-window-buffers new-buffers) + :key (lambda (buffer) + (or (seq-position old-buffers buffer) + most-positive-fixnum))))) + (set-window-parameter nil 'tab-line-buffers new-buffers) new-buffers)) +(add-to-list 'window-persistent-parameters '(tab-line-buffers . writable)) + (defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default "Function to format a tab name. From b993c1b2752dcfe8bf6c17e58430a90b3dda5952 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Apr 2024 11:45:47 +0300 Subject: [PATCH 085/149] ; * etc/NEWS: Reindent and refill recently added entries. --- etc/NEWS | 49 ++++++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 25 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 2f90a3067f7..7a4e1281639 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -351,51 +351,50 @@ points after switching back to that tab. --- *** New user option 'tab-bar-select-restore-windows'. -It defines what to do with windows whose buffer was killed -since the tab was last selected. By default it displays -a placeholder buffer that provides information about the name -of the killed buffer that was displayed in that window. +It defines what to do with windows whose buffer was killed since the tab +was last selected. By default it displays a placeholder buffer that +provides information about the name of the killed buffer that was +displayed in that window. --- *** New user option 'tab-bar-tab-name-format-functions'. -It can be used to add, remove and reorder functions that change -the appearance of every tab on the tab bar. +It can be used to add, remove and reorder functions that change the +appearance of every tab on the tab bar. --- *** New hook 'tab-bar-tab-post-select-functions'. --- *** New keymap 'tab-bar-mode-map'. -By default it contains a keybinding 'C-TAB' to switch tabs, -but only when 'C-TAB' is not bound globally. You can unbind it -if it conflicts with 'C-TAB' in other modes. +By default it contains a keybinding 'C-TAB' to switch tabs, but only +when 'C-TAB' is not bound globally. You can unbind it if it conflicts +with 'C-TAB' in other modes. --- *** New keymap 'tab-line-mode-map'. -By default it contains keybindings for switching tabs: -'C-x ', 'C-x ', 'C-x C-', 'C-x C-'. -You can unbind them if you want to use these keys for the -commands 'previous-buffer' and 'next-buffer'. +By default it contains keybindings for switching tabs: 'C-x ', +'C-x ', 'C-x C-', 'C-x C-'. You can unbind them if +you want to use these keys for the commands 'previous-buffer' and +'next-buffer'. --- *** Default list of tabs is changed to support a fixed order. -This means that the new default tabs function -'tab-line-tabs-fixed-window-buffers' is like the previous -'tab-line-tabs-window-buffers' where both of them show -only buffers that were previously displayed in the window. -But the difference is that the new function always keeps -the original order of buffers on the tab line, even after -switching between these buffers. +This means that 'tab-line-tabs-fixed-window-buffers', the new default +tabs function, is like the previous 'tab-line-tabs-window-buffers' where +both of them show only buffers that were previously displayed in the +window. But the difference is that the new function always keeps the +original order of buffers on the tab line, even after switching between +these buffers. --- *** New user option 'tab-line-tabs-buffer-group-function'. -It provides two choices to group tab buffers by major mode -and by project name. +It provides two choices to group tab buffers by major mode and by +project name. --- -*** Now buffers on group tabs are sorted alphabetically. -This will keep the fixed order of tabs, even after -switching between them. +*** Buffers on group tabs are now sorted alphabetically. +This will keep the fixed order of tabs, even after switching between +them. +++ ** New optional argument for modifying directory-local variables. From bb9d81d5144ae497809c416eef91d126f8ac5df5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Apr 2024 11:53:26 +0300 Subject: [PATCH 086/149] Fix sending input to SQL when point is not at EOB * lisp/progmodes/sql.el (sql-send-string): Move point to EOB before sending input to the SQL process. Suggested by Gary Hollis . (Bug#69420) --- lisp/progmodes/sql.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 604f04a3d57..5273ba2bee1 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3721,6 +3721,8 @@ prompts (`sql-output-newline-count' is positive). In this case: (save-excursion ;; Set product context (with-current-buffer sql-buffer + ;; Make sure point is at EOB before sending input to SQL. + (goto-char (point-max)) (when sql-debug-send (message ">>SQL> %S" s)) (insert "\n") From 3c4f6c78b4b2ae0b1efadf5e664fa180e663037e Mon Sep 17 00:00:00 2001 From: "Elias G. B. Perez" Date: Sat, 6 Apr 2024 13:57:30 -0600 Subject: [PATCH 087/149] Flymake support for indicating errors in margin Add optional support for display flymake error in margin, this allow displaying error indicators in both graphical and terminal frames. * doc/misc/flymake.texi (Customizable variables) (Flymake error types): Document new margin indicator. * etc/NEWS: Announce the new Flymake user option for margin indicators. * lisp/progmodes/flymake.el (flymake-indicator-type) (flymake-margin-indicators-string, flymake-autoresize-margins) (flymake-margin-indicator-position): New user options. (flymake--original-margin-width): Add buffer-local variable for store original buffer margin width. (flymake-error, flymake-warning, flymake-note): Use new margin value. (flymake--indicator-overlay-spec): Rework and Rename from flymake--fringe-overlay-spec. (flymake--resize-margins): Add new function for resize margin width. (flymake--highlight-line, flymake-mode): Rework. --- doc/misc/flymake.texi | 26 ++++++++ etc/NEWS | 22 +++++++ lisp/progmodes/flymake.el | 134 +++++++++++++++++++++++++++++++++----- 3 files changed, 167 insertions(+), 15 deletions(-) diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 84a74a9d6ab..7019f4b2ca0 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -309,6 +309,12 @@ reported. A custom face for highlighting regions for which a note has been reported. +@item flymake-indicator-type +The indicator type which Flymake should use to indicate lines with +errors or warnings. +Depending on your preference, this can either use @code{fringes} or +@code{margins} for indicating errors. + @item flymake-error-bitmap A bitmap used in the fringe to mark lines for which an error has been reported. @@ -320,6 +326,18 @@ been reported. @item flymake-fringe-indicator-position Which fringe (if any) should show the warning/error bitmaps. +@item flymake-margin-indicators-string +Specifies the string and face to use for the margin indicators, for +each error type. + +@item flymake-margin-indicator-position +Which margin (if any) should show the warning/error strings. + +@item flymake-autoresize-margins +If non-@code{nil}, Flymake will resize the margins when +@code{flymake-mode} is turned on or off. +Only relevant if @code{flymake-indicator-type} is set to @code{margins}. + @item flymake-wrap-around If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and @code{flymake-goto-prev-error} wraps around buffer boundaries. @@ -387,6 +405,14 @@ the syntax of @code{flymake-error-bitmap} (@pxref{Customizable variables}). It is overridden by any @code{before-string} overlay property. +@item +@cindex margin of diagnostic +@code{flymake-margin-string}, a string displayed in the margin +according to @code{flymake-margin-indicator-position}. +The value actually follows the syntax of @code{flymake-margin-indicators-string} +(@pxref{Customizable variables}). It is overridden by any +@code{before-string} overlay property. + @item @code{flymake-overlay-control}, an alist ((@var{OVPROP} . @var{VALUE}) @var{...}) of further properties used to affect the appearance of diff --git a/etc/NEWS b/etc/NEWS index 7a4e1281639..78a1307b6a4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1248,6 +1248,28 @@ in a clean environment. ** Flymake ++++ +*** New user option 'flymake-indicator-type'. +This user option controls which error indicator type Flymake should use +in current buffer. Depending on your preference, this can either use +fringes or margins for indicating errors. + ++++ +*** New user option 'flymake-margin-indicators-string'. +It controls, for each error type, the string and its face to display as +the margin indicator. + ++++ +*** New user option 'flymake-autoresize-margins'. +If non-nil, Flymake will resize the margins when 'flymake-mode' is +turned on or off. +Only relevant if `flymake-indicator-type` is set to `margins`. + ++++ +*** New user option 'flymake-margin-indicator-position'. +It controls which margin (left or right) is used for margin +indicators. + +++ *** New user option 'flymake-show-diagnostics-at-end-of-line'. When non-nil, Flymake shows summarized descriptions of diagnostics at diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f2750a026ce..22a139d3045 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -180,6 +180,59 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'." (const right-fringe) (const :tag "No fringe indicators" nil))) +(defcustom flymake-indicator-type (if (display-graphic-p) + 'fringes + 'margins) + "Indicate which indicator type to use for display errors. + +The value can be nil (don't indicate errors but just highlight them), +fringes (use fringes) or margins (use margins) + +Difference between fringes and margin is that fringes support diplaying +bitmaps on graphical displays and margins display text in a blank area +from current buffer that works in both graphical and text displays. + +See Info node `Fringes' and Info node `(elisp)Display Margins'." + :version "30.1" + :type '(choice (const :tag "Use Fringes" fringes) + (const :tag "Use Margins "margins) + (const :tag "No indicators" nil))) + +(defcustom flymake-margin-indicators-string + '((error "!!" compilation-error) + (warning "!" compilation-warning) + (note "!" compilation-info)) + "Strings used for margins indicators. +The value of each list may be a list of 3 elements where specifies the +error type, the string to use and its face, +or a list of 2 elements specifying only the error type and +the corresponding string. + +The option `flymake-margin-indicator-position' controls how and where +this is used." + :version "30.1" + :type '(repeat :tag "Error types lists" + (list :tag "String and face for error types" + (symbol :tag "Error type") + (string :tag "String") + (face :tag "Face")))) + +(defcustom flymake-autoresize-margins t + "If non-nil, automatically resize margin-width calling flymake--resize-margins. + +Only relevant if `flymake-indicator-type' is set to margins." + :version "30.1" + :type 'boolean) + +(defcustom flymake-margin-indicator-position 'left-margin + "The position to put Flymake margin indicator. +The value can be nil (do not use indicators), `left-margin' or `right-margin'. +See `flymake-margin-indicators-string'." + :version "30.1" + :type '(choice (const left-margin) + (const right-margin) + (const :tag "No margin indicators" nil))) + (make-obsolete-variable 'flymake-start-syntax-check-on-newline "can check on newline in post-self-insert-hook" "27.1") @@ -258,6 +311,11 @@ If set to nil, don't suppress any zero counters." (defvar-local flymake-check-start-time nil "Time at which syntax check was started.") +(defvar-local flymake--original-margin-width nil + "Store original margin width. +Used by `flymake--resize-margins' for restoring original margin width +when flymake is turned off.") + (defun flymake--log-1 (level sublog msg &rest args) "Do actual work for `flymake-log'." (let (;; never popup the log buffer @@ -630,6 +688,7 @@ Node `(Flymake)Flymake error types'" (put 'flymake-error 'face 'flymake-error) (put 'flymake-error 'flymake-bitmap 'flymake-error-bitmap) +(put 'flymake-error 'flymake-margin-string (alist-get 'error flymake-margin-indicators-string)) (put 'flymake-error 'severity (warning-numeric-level :error)) (put 'flymake-error 'mode-line-face 'flymake-error-echo) (put 'flymake-error 'echo-face 'flymake-error-echo) @@ -638,6 +697,7 @@ Node `(Flymake)Flymake error types'" (put 'flymake-warning 'face 'flymake-warning) (put 'flymake-warning 'flymake-bitmap 'flymake-warning-bitmap) +(put 'flymake-warning 'flymake-margin-string (alist-get 'warning flymake-margin-indicators-string)) (put 'flymake-warning 'severity (warning-numeric-level :warning)) (put 'flymake-warning 'mode-line-face 'flymake-warning-echo) (put 'flymake-warning 'echo-face 'flymake-warning-echo) @@ -646,6 +706,7 @@ Node `(Flymake)Flymake error types'" (put 'flymake-note 'face 'flymake-note) (put 'flymake-note 'flymake-bitmap 'flymake-note-bitmap) +(put 'flymake-note 'flymake-margin-string (alist-get 'note flymake-margin-indicators-string)) (put 'flymake-note 'severity (warning-numeric-level :debug)) (put 'flymake-note 'mode-line-face 'flymake-note-echo) (put 'flymake-note 'echo-face 'flymake-note-echo) @@ -682,19 +743,53 @@ associated `flymake-category' return DEFAULT." (flymake--lookup-type-property type 'severity (warning-numeric-level :error))) -(defun flymake--fringe-overlay-spec (bitmap &optional recursed) - (if (and (symbolp bitmap) - (boundp bitmap) - (not recursed)) - (flymake--fringe-overlay-spec - (symbol-value bitmap) t) - (and flymake-fringe-indicator-position - bitmap - (propertize "!" 'display - (cons flymake-fringe-indicator-position - (if (listp bitmap) - bitmap - (list bitmap))))))) +(defun flymake--indicator-overlay-spec (indicator) + "Return INDICATOR as propertized string to use in error indicators." + (let* ((value (if (symbolp indicator) + (symbol-value indicator) + indicator)) + (indicator-car (if (listp value) + (car value) + value)) + (indicator-cdr (if (listp value) + (cdr value)))) + (cond + ((symbolp indicator-car) + (propertize "!" 'display + (cons flymake-fringe-indicator-position + (if (listp value) + value + (list value))))) + ((stringp indicator-car) + (propertize "!" + 'display + `((margin ,flymake-margin-indicator-position) + ,(propertize + indicator-car + 'face + `(:inherit (,indicator-cdr + default))))))))) + +(defun flymake--resize-margins (&optional orig-width) + "Resize current window margins according to `flymake-margin-indicator-position'. +Return to original margin width if ORIG-WIDTH is non-nil." + (when (and (eq flymake-indicator-type 'margins) + flymake-autoresize-margins) + (cond + ((and orig-width flymake--original-margin-width) + (if (eq flymake-margin-indicator-position 'left-margin) + (setq-local left-margin-width flymake--original-margin-width) + (setq-local right-margin-width flymake--original-margin-width))) + (t + (if (eq flymake-margin-indicator-position 'left-margin) + (setq-local flymake--original-margin-width left-margin-width + left-margin-width 2) + (setq-local flymake--original-margin-width right-margin-width + right-margin-width 2)))) + ;; Apply margin to all windows avalaibles + (mapc (lambda (x) + (set-window-buffer x (window-buffer x))) + (get-buffer-window-list nil nil 'visible)))) (defun flymake--equal-diagnostic-p (a b) "Tell if A and B are equivalent `flymake--diag' objects." @@ -840,10 +935,13 @@ Return nil or the overlay created." type prop value))))) (default-maybe 'face 'flymake-error) (default-maybe 'before-string - (flymake--fringe-overlay-spec + (flymake--indicator-overlay-spec (flymake--lookup-type-property type - 'flymake-bitmap + (cond ((eq flymake-indicator-type 'fringes) + 'flymake-bitmap) + ((eq flymake-indicator-type 'margins) + 'flymake-margin-string)) (alist-get 'bitmap (alist-get type ; backward compat flymake-diagnostic-types-alist))))) ;; (default-maybe 'after-string @@ -1285,6 +1383,9 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t) + ;; AutoResize margins. + (flymake--resize-margins) + ;; If Flymake happened to be already ON, we must cleanup ;; existing diagnostic overlays, lest we forget them by blindly ;; reinitializing `flymake--state' in the next line. @@ -1333,6 +1434,9 @@ special *Flymake log* buffer." :group 'flymake :lighter ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) (remove-hook 'eldoc-documentation-functions 'flymake-eldoc-function t) + ;; return margin to original size + (flymake--resize-margins t) + (when flymake-timer (cancel-timer flymake-timer) (setq flymake-timer nil)) From 40629706b1ff1a2a596420dd2ac388b7e5fc656c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= Date: Tue, 9 Apr 2024 15:02:45 +0100 Subject: [PATCH 088/149] Avoid unnecessary escaping in 'url-build-query-string' * lisp/url/url-util.el (url-query-key-value-allowed-chars): New defconst. (url-build-query-string): Use it to escape only those characters that need it in keys and values. * test/lisp/url/url-util-tests.el (url-util-tests): Add new test cases. (Bug#70312) --- lisp/url/url-util.el | 12 +++++++++++- test/lisp/url/url-util-tests.el | 6 +++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 5f45b98c7a5..f063efe18a6 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -268,7 +268,8 @@ instead of just \"key\" as in the example above." (lambda (key-vals) (let ((escaped (mapcar (lambda (sym) - (url-hexify-string (format "%s" sym))) key-vals))) + (url-hexify-string (format "%s" sym) url-query-key-value-allowed-chars)) + key-vals))) (mapconcat (lambda (val) (let ((vprint (format "%s" val)) (eprint (format "%s" (car escaped)))) @@ -410,6 +411,15 @@ These characters are specified in RFC 3986, Appendix A.") "Allowed-character byte mask for the query segment of a URI. These characters are specified in RFC 3986, Appendix A.") +(defconst url-query-key-value-allowed-chars + (let ((vec (copy-sequence url-query-allowed-chars))) + (aset vec ?= nil) + (aset vec ?& nil) + (aset vec ?\; nil) + vec) + "Allowed-charcter byte mask for keys and values in the query segment of a URI. +url-query-allowed-chars minus '=', '&', and ';'.") + ;;;###autoload (defun url-encode-url (url) "Return a properly URI-encoded version of URL. diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el index 133aa0ffd88..c6246d69a2a 100644 --- a/test/lisp/url/url-util-tests.el +++ b/test/lisp/url/url-util-tests.el @@ -32,7 +32,11 @@ ("key1=val1;key2=val2;key3=val1;key3=val2;key4;key5" ((key1 "val1") (key2 val2) (key3 val1 val2) ("key4") (key5 "")) t) ("key1=val1;key2=val2;key3=val1;key3=val2;key4=;key5=" - ((key1 val1) (key2 val2) ("key3" val1 val2) (key4) (key5 "")) t t))) + ((key1 val1) (key2 val2) ("key3" val1 val2) (key4) (key5 "")) t t) + ("key1=val/slash;key2=val%3Bsemi;key3=val%26amp;key4=val%3Deq" + ((key1 "val/slash") (key2 "val;semi") (key3 "val&") (key4 "val=eq")) t) + ("key%3Deq=val1;key%3Bsemi=val2;key%26amp=val3" + (("key=eq" val1) ("key;semi" val2) ("key&" val3)) t))) test) (while tests (setq test (car tests) From f6c20ed5d5c22ce95df752f482df03209c7c8c42 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Apr 2024 13:08:23 +0300 Subject: [PATCH 089/149] ; Fix last change * lisp/url/url-util.el (url-build-query-string): Move to after the definition of 'url-query-key-value-allowed-chars'. --- lisp/url/url-util.el | 81 ++++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 40 deletions(-) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index f063efe18a6..4d2609cbb95 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -242,46 +242,6 @@ Will not do anything if `url-show-status' is nil." (setq retval (cons (list key val) retval))))) retval)) -;;;###autoload -(defun url-build-query-string (query &optional semicolons keep-empty) - "Build a query-string. - -Given a QUERY in the form: - ((key1 val1) - (key2 val2) - (key3 val1 val2) - (key4) - (key5 \"\")) - -\(This is the same format as produced by `url-parse-query-string') - -This will return a string -\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may -be strings or symbols; if they are symbols, the symbol name will -be used. - -When SEMICOLONS is given, the separator will be \";\". - -When KEEP-EMPTY is given, empty values will show as \"key=\" -instead of just \"key\" as in the example above." - (mapconcat - (lambda (key-vals) - (let ((escaped - (mapcar (lambda (sym) - (url-hexify-string (format "%s" sym) url-query-key-value-allowed-chars)) - key-vals))) - (mapconcat (lambda (val) - (let ((vprint (format "%s" val)) - (eprint (format "%s" (car escaped)))) - (concat eprint - (if (or keep-empty - (and val (not (zerop (length vprint))))) - "=" - "") - vprint))) - (or (cdr escaped) '("")) (if semicolons ";" "&")))) - query (if semicolons ";" "&"))) - (defun url-unhex (x) (if (> x ?9) (if (>= x ?a) @@ -449,6 +409,47 @@ should return it unchanged." (url-hexify-string frag url-query-allowed-chars))) (url-recreate-url obj))) +;;;###autoload +(defun url-build-query-string (query &optional semicolons keep-empty) + "Build a query-string. + +Given a QUERY in the form: + ((key1 val1) + (key2 val2) + (key3 val1 val2) + (key4) + (key5 \"\")) + +\(This is the same format as produced by `url-parse-query-string') + +This will return a string +\"key1=val1&key2=val2&key3=val1&key3=val2&key4&key5\". Keys may +be strings or symbols; if they are symbols, the symbol name will +be used. + +When SEMICOLONS is given, the separator will be \";\". + +When KEEP-EMPTY is given, empty values will show as \"key=\" +instead of just \"key\" as in the example above." + (mapconcat + (lambda (key-vals) + (let ((escaped + (mapcar (lambda (sym) + (url-hexify-string (format "%s" sym) + url-query-key-value-allowed-chars)) + key-vals))) + (mapconcat (lambda (val) + (let ((vprint (format "%s" val)) + (eprint (format "%s" (car escaped)))) + (concat eprint + (if (or keep-empty + (and val (not (zerop (length vprint))))) + "=" + "") + vprint))) + (or (cdr escaped) '("")) (if semicolons ";" "&")))) + query (if semicolons ";" "&"))) + ;;;###autoload (defun url-file-extension (fname &optional x) "Return the filename extension of FNAME. From 9055dad65d722850eaec049acbce15829638fd61 Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Fri, 12 Apr 2024 22:38:28 -0700 Subject: [PATCH 090/149] Add font-locking for Go built-in functions in go-ts-mode * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): Add font-locking for Go built-in functions to 'go-ts-mode'. (Bug#70362) --- lisp/progmodes/go-ts-mode.el | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index b82bc2364dc..83e15301854 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -108,6 +108,11 @@ ">>" "%=" ">>=" "--" "!" "..." "&^" "&^=" "~") "Go operators for tree-sitter font-locking.") +(defvar go-ts-mode--builtin-functions + '("append" "cap" "clear" "close" "complex" "copy" "delete" "imag" "len" "make" + "max" "min" "new" "panic" "print" "println" "real" "recover") + "Go built-in functions for tree-sitter font-locking.") + (defun go-ts-mode--iota-query-supported-p () "Return t if the iota query is supported by the tree-sitter-go grammar." (ignore-errors @@ -167,6 +172,16 @@ (var_spec name: (identifier) @font-lock-variable-name-face ("," name: (identifier) @font-lock-variable-name-face)*)) + :language 'go + :feature 'builtin + `((call_expression + function: ((identifier) @font-lock-builtin-face + (:match ,(rx-to-string + `(seq bol + (or ,@go-ts-mode--builtin-functions) + eol)) + @font-lock-builtin-face)))) + :language 'go :feature 'function '((call_expression @@ -269,7 +284,7 @@ (setq-local treesit-font-lock-feature-list '(( comment definition) ( keyword string type) - ( constant escape-sequence label number) + ( constant escape-sequence label number builtin) ( bracket delimiter error function operator property variable))) (treesit-major-mode-setup))) From c7bcda4ac54f31ae2724cdc3b3c884c37b667b22 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Apr 2024 13:30:20 +0300 Subject: [PATCH 091/149] ; Minor change in last commit * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): Rearrange features to keep alphabetical order. (Bug#70362) --- lisp/progmodes/go-ts-mode.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 83e15301854..f2b586dfb43 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -135,6 +135,16 @@ :feature 'comment '((comment) @font-lock-comment-face) + :language 'go + :feature 'builtin + `((call_expression + function: ((identifier) @font-lock-builtin-face + (:match ,(rx-to-string + `(seq bol + (or ,@go-ts-mode--builtin-functions) + eol)) + @font-lock-builtin-face)))) + :language 'go :feature 'constant `([(false) (nil) (true)] @font-lock-constant-face @@ -172,16 +182,6 @@ (var_spec name: (identifier) @font-lock-variable-name-face ("," name: (identifier) @font-lock-variable-name-face)*)) - :language 'go - :feature 'builtin - `((call_expression - function: ((identifier) @font-lock-builtin-face - (:match ,(rx-to-string - `(seq bol - (or ,@go-ts-mode--builtin-functions) - eol)) - @font-lock-builtin-face)))) - :language 'go :feature 'function '((call_expression From f66820d8771ca857fb4edd7300823a2cea6120be Mon Sep 17 00:00:00 2001 From: Siddharth Sharma Date: Fri, 12 Apr 2024 18:11:58 +0200 Subject: [PATCH 092/149] Add YANG LSP support to Eglot * lisp/progmodes/eglot.el (eglot-server-programs): Add 'yang-language-server' and 'json-ts-mode'. (Bug#70364) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index c395efd9f55..2ea3ecc76cf 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -242,7 +242,7 @@ automatically)." '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) - ((js-json-mode json-mode json-ts-mode) + ((js-json-mode json-mode json-ts-mode jsonc-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("vscode-json-languageserver" "--stdio") ("json-languageserver" "--stdio")))) @@ -302,6 +302,7 @@ automatically)." (futhark-mode . ("futhark" "lsp")) ((lua-mode lua-ts-mode) . ,(eglot-alternatives '("lua-language-server" "lua-lsp"))) + (yang-mode . ("yang-language-server")) (zig-mode . ("zls")) ((css-mode css-ts-mode) . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") From 11b1610c72a09950140cdf2284e9960af0f4a574 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Sun, 14 Apr 2024 09:43:27 +0200 Subject: [PATCH 093/149] Obsolete comint-osc symbols moved to ansi-osc.el * lisp/comint.el (comint-osc-handlers) (comint-osc-directory-tracker, comint-osc-hyperlink-handler) (comint-osc-hyperlink, comint-osc-hyperlink-map): Mark as obsolete. (Bug#70375) --- lisp/comint.el | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index a8fe095e99c..bae89beb76b 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3961,18 +3961,22 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;;; OSC escape sequences (Operating System Commands) ;;============================================================================ ;; Adding `comint-osc-process-output' to -;; `comint-output-filter-functions' enables the interpretation of OSC -;; escape sequences. By default, OSC 7 and 8 (for current directory -;; and hyperlinks respectively) are acted upon. Adding more entries -;; to `comint-osc-handlers' allows a customized treatment of further -;; sequences. +;; `comint-output-filter-functions' enables the interpreting of OSC +;; escape sequences. See `ansi-osc-handlers' for a list of OSC +;; sequences which are interpreted by default and information on how to +;; handle new sequences. ;; Aliases defined for reverse compatibility -(defvaralias 'comint-osc-handlers 'ansi-osc-handlers) -(defalias 'comint-osc-directory-tracker 'ansi-osc-directory-tracker) -(defalias 'comint-osc-hyperlink-handler 'ansi-osc-hyperlink-handler) -(defalias 'comint-osc-hyperlink 'ansi-osc-hyperlink) -(defvaralias 'comint-osc-hyperlink-map 'ansi-osc-hyperlink-map) +(define-obsolete-variable-alias + 'comint-osc-handlers 'ansi-osc-handlers "30.1") +(define-obsolete-function-alias + 'comint-osc-directory-tracker 'ansi-osc-directory-tracker "30.1") +(define-obsolete-function-alias + 'comint-osc-hyperlink-handler 'ansi-osc-hyperlink-handler "30.1") +(define-obsolete-function-alias + 'comint-osc-hyperlink 'ansi-osc-hyperlink "30.1") +(define-obsolete-variable-alias + 'comint-osc-hyperlink-map 'ansi-osc-hyperlink-map "30.1") (defun comint-osc-process-output (_) "Interpret OSC escape sequences in comint output. @@ -3985,7 +3989,7 @@ sequences of the forms Specifically, every occurrence of such escape sequences is removed from the buffer. Then, if `command' is a key of the -`comint-osc-handlers' alist, the corresponding value, which +`ansi-osc-handlers' alist, the corresponding value, which should be a function, is called with `command' and `text' as arguments, with point where the escape sequence was located." (let ((start (1- comint-last-output-start)) From d29d4a1d7b07806291b95792a821f8937746a467 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Apr 2024 13:45:22 +0300 Subject: [PATCH 094/149] ; * lisp/comint.el: Fix wording of last change. --- lisp/comint.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/comint.el b/lisp/comint.el index bae89beb76b..e856038b0f7 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3961,7 +3961,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;;; OSC escape sequences (Operating System Commands) ;;============================================================================ ;; Adding `comint-osc-process-output' to -;; `comint-output-filter-functions' enables the interpreting of OSC +;; `comint-output-filter-functions' enables interpreting of OSC ;; escape sequences. See `ansi-osc-handlers' for a list of OSC ;; sequences which are interpreted by default and information on how to ;; handle new sequences. From dba115d6bcbc955858526740254bd9a169830d7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Apr 2024 12:26:10 +0200 Subject: [PATCH 095/149] Drop unnecessary type check in varref and varset byte ops * src/bytecode.c (exec_byte_code): We can safely assume that the immediate argument to varref and varset is a bare symbol; the byte-compiler should guarantee that. --- src/bytecode.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index 8d7240b9966..de25069d94a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -625,8 +625,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, varref: { Lisp_Object v1 = vectorp[op], v2; - if (!BARE_SYMBOL_P (v1) - || XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL + if (XBARE_SYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL || (v2 = XBARE_SYMBOL (v1)->u.s.val.value, BASE_EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); @@ -700,8 +699,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object val = POP; /* Inline the most common case. */ - if (BARE_SYMBOL_P (sym) - && !BASE_EQ (val, Qunbound) + if (!BASE_EQ (val, Qunbound) && XBARE_SYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL && !XBARE_SYMBOL (sym)->u.s.trapped_write) SET_SYMBOL_VAL (XBARE_SYMBOL (sym), val); From 0a57dfcff8d0abcf4427cfbfd886264bb3b8eaab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Apr 2024 12:59:35 +0200 Subject: [PATCH 096/149] Ensure that specbind arg is always bare symbol, and drop check * src/eval.c (FletX, Flet, internal_lisp_condition_case) (funcall_lambda): Ensure that the first argument to `specbind` is a bare symbol in the few cases where this isn't statically guaranteed. (specbind): Drop the symbol argument type check on the fast path. --- src/eval.c | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/eval.c b/src/eval.c index 7f7a70b15ae..c5b8a375af4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -948,8 +948,9 @@ usage: (let* VARLIST BODY...) */) val = eval_sub (Fcar (XCDR (elt))); } - if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->u.s.declared_special + var = maybe_remove_pos_from_symbol (var); + if (!NILP (lexenv) && BARE_SYMBOL_P (var) + && !XBARE_SYMBOL (var)->u.s.declared_special && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the interpreter's binding alist. */ @@ -1016,11 +1017,10 @@ usage: (let VARLIST BODY...) */) varlist = XCAR (args); for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++) { - Lisp_Object var; - elt = XCAR (varlist); varlist = XCDR (varlist); - var = SYMBOLP (elt) ? elt : Fcar (elt); + Lisp_Object var = maybe_remove_pos_from_symbol (SYMBOLP (elt) ? elt + : Fcar (elt)); tem = temps[argnum]; if (!NILP (lexenv) && SYMBOLP (var) @@ -1416,6 +1416,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, struct handler *oldhandlerlist = handlerlist; ptrdiff_t CACHEABLE clausenb = 0; + var = maybe_remove_pos_from_symbol (var); CHECK_SYMBOL (var); Lisp_Object success_handler = Qnil; @@ -3254,7 +3255,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) lexenv = Fcons (Fcons (next, arg), lexenv); else /* Dynamically bind NEXT. */ - specbind (next, arg); + specbind (maybe_remove_pos_from_symbol (next), arg); previous_rest = false; } } @@ -3466,10 +3467,8 @@ do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, void specbind (Lisp_Object symbol, Lisp_Object value) { - struct Lisp_Symbol *sym; - - CHECK_SYMBOL (symbol); - sym = XSYMBOL (symbol); + /* The caller must ensure that the SYMBOL argument is a bare symbol. */ + struct Lisp_Symbol *sym = XBARE_SYMBOL (symbol); start: switch (sym->u.s.redirect) From 94dec95317994f36f1355b972850d9565b61c433 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Thu, 18 Apr 2024 15:35:49 +0200 Subject: [PATCH 097/149] Don't error on tabbing to a widget at BOB (bug#69943) * lisp/wid-edit.el (widget-move): Don't move backward when at beginning of buffer, and keep point on widget's left side. * test/lisp/wid-edit-tests.el (widget-test-widget-move): Test that moving to a widget at beginning of buffer does not signal a beginning-of-buffer error. --- lisp/wid-edit.el | 4 ++-- test/lisp/wid-edit-tests.el | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index cb6d8ebc2c4..dc481d4d0a5 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1300,9 +1300,9 @@ nothing is shown in the echo area." (unless (eq new old) (setq arg (1+ arg)))))) (let ((new (widget-tabable-at))) - (while (eq (widget-tabable-at) new) + (while (and (eq (widget-tabable-at) new) (not (bobp))) (backward-char))) - (forward-char)) + (unless (bobp) (forward-char))) (unless suppress-echo (widget-echo-help (point))) (run-hooks 'widget-move-hook)) diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index 4b049478b29..d416eb99022 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el @@ -336,7 +336,13 @@ return nil, even with a non-nil bubblep argument." (widget-forward 2) (forward-char) (widget-backward 1) - (should (string= "Second" (widget-value (widget-at)))))) + (should (string= "Second" (widget-value (widget-at)))) + ;; Check that moving to a widget at beginning of buffer does not + ;; signal a beginning-of-buffer error (bug#69943). + (widget-backward 1) ; Should not signal beginning-of-buffer error. + (widget-forward 2) + (should (string= "Third" (widget-value (widget-at)))) + (widget-forward 1))) ; Should not signal beginning-of-buffer error. (ert-deftest widget-test-color-match () "Test that the :match function for the color widget works." From c308f5687060423938a0a72ab39505451f223e8a Mon Sep 17 00:00:00 2001 From: Randy Taylor Date: Thu, 18 Apr 2024 09:38:28 -0400 Subject: [PATCH 098/149] ; Alphabetize go-ts-mode's treesit-font-lock-feature-list * lisp/progmodes/go-ts-mode.el (go-ts-mode): Rearrange features to keep alphabetical order. (Bug#70362) --- lisp/progmodes/go-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index f2b586dfb43..aef224ab3fa 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -284,7 +284,7 @@ (setq-local treesit-font-lock-feature-list '(( comment definition) ( keyword string type) - ( constant escape-sequence label number builtin) + ( builtin constant escape-sequence label number) ( bracket delimiter error function operator property variable))) (treesit-major-mode-setup))) From 306feb7d967ecea9c916dd6e25b2e84a3f1c714e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 18 Apr 2024 03:55:17 -0500 Subject: [PATCH 099/149] Revert "Don't use file-truepath in Eglot (bug#70036)" This reverts commit 08c80c45ddea17df87fc768a39dff353ccc13d3b. It introduces bugs when a project contains symlinked files. The server will be informed of duplicate documents which are really the same and it frequently has no means to deduplicate such information. This leads to bugs such as excessive textDocument/references to a function. * lisp/progmodes/eglot.el (eglot-lsp-server): Revert change. (eglot-uri-to-path): Revert change. (eglot--on-shutdown): Revert change. (eglot--managed-mode): Revert change. (eglot-handle-notification textDocument/publishDiagnostics): Revert change. --- lisp/progmodes/eglot.el | 42 ++++++++++++++++++----------------------- 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 2ea3ecc76cf..00f69b2ca83 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1058,8 +1058,8 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." :documentation "Map (DIR -> (WATCH ID1 ID2...)) for `didChangeWatchedFiles'." :initform (make-hash-table :test #'equal) :accessor eglot--file-watches) (managed-buffers - :documentation "Map (PATH -> BUFFER) for buffers managed by server." - :initform (make-hash-table :test #'equal) + :initform nil + :documentation "List of buffers managed by server." :accessor eglot--managed-buffers) (saved-initargs :documentation "Saved initargs for reconnection purposes." @@ -1090,12 +1090,12 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." (defun eglot-path-to-uri (path) "Convert PATH, a file name, to LSP URI string and return it." - (let ((expanded-path (expand-file-name path))) + (let ((truepath (file-truename path))) (if (and (url-type (url-generic-parse-url path)) ;; It might be MS Windows path which includes a drive ;; letter that looks like a URL scheme (bug#59338) (not (and (eq system-type 'windows-nt) - (file-name-absolute-p expanded-path)))) + (file-name-absolute-p truepath)))) ;; Path is already a URI, so forward it to the LSP server ;; untouched. The server should be able to handle it, since ;; it provided this URI to clients in the first place. @@ -1103,11 +1103,11 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." (concat "file://" ;; Add a leading "/" for local MS Windows-style paths. (if (and (eq system-type 'windows-nt) - (not (file-remote-p expanded-path))) + (not (file-remote-p truepath))) "/") (url-hexify-string ;; Again watch out for trampy paths. - (directory-file-name (file-local-name expanded-path)) + (directory-file-name (file-local-name truepath)) eglot--uri-path-allowed-chars))))) (defun eglot-range-region (range &optional markers) @@ -1192,7 +1192,7 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see." (defun eglot--on-shutdown (server) "Called by jsonrpc.el when SERVER is already dead." ;; Turn off `eglot--managed-mode' where appropriate. - (dolist (buffer (map-values (eglot--managed-buffers server))) + (dolist (buffer (eglot--managed-buffers server)) (let (;; Avoid duplicate shutdowns (github#389) (eglot-autoshutdown nil)) (eglot--when-live-buffer buffer (eglot--managed-mode-off)))) @@ -2025,11 +2025,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (add-hook 'eldoc-documentation-functions #'eglot-signature-eldoc-function nil t) (eldoc-mode 1)) - - (let ((buffer (current-buffer))) - (puthash (expand-file-name (buffer-file-name buffer)) - buffer - (eglot--managed-buffers (eglot-current-server))))) + (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server)))) (t (when eglot--track-changes (track-changes-unregister eglot--track-changes) @@ -2060,10 +2056,10 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (let ((server eglot--cached-server)) (setq eglot--cached-server nil) (when server - (remhash (expand-file-name (buffer-file-name (current-buffer))) - (eglot--managed-buffers server)) + (setf (eglot--managed-buffers server) + (delq (current-buffer) (eglot--managed-buffers server))) (when (and eglot-autoshutdown - (null (map-values (eglot--managed-buffers server)))) + (null (eglot--managed-buffers server))) (eglot-shutdown server))))))) (defun eglot--managed-mode-off () @@ -2386,7 +2382,7 @@ still unanswered LSP requests to the server\n"))) (remhash token (eglot--progress-reporters server)))))))))) (cl-defmethod eglot-handle-notification - (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics + (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode' "Handle notification publishDiagnostics." (cl-flet ((eglot--diag-type (sev) @@ -2397,7 +2393,7 @@ still unanswered LSP requests to the server\n"))) (mess (source code message) (concat source (and code (format " [%s]" code)) ": " message))) (if-let* ((path (expand-file-name (eglot-uri-to-path uri))) - (buffer (gethash path (eglot--managed-buffers server)))) + (buffer (find-buffer-visiting path))) (with-current-buffer buffer (cl-loop initially @@ -2908,7 +2904,7 @@ may be called multiple times (respecting the protocol of Try to visit the target file for a richer summary line." (pcase-let* ((file (eglot-uri-to-path uri)) - (visiting (or (gethash file (eglot--managed-buffers (eglot-current-server))) + (visiting (or (find-buffer-visiting file) (gethash uri eglot--temp-location-buffers))) (collect (lambda () (eglot--widening @@ -3608,14 +3604,13 @@ list ((FILENAME EDITS VERSION)...)." (with-current-buffer (get-buffer-create "*EGLOT proposed server changes*") (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t) - (target (current-buffer)) - (managed-buffers (eglot--managed-buffers (eglot-current-server)))) + (target (current-buffer))) (diff-mode) (erase-buffer) (pcase-dolist (`(,path ,edits ,_) prepared) (with-temp-buffer (let* ((diff (current-buffer)) - (existing-buf (gethash path (gethash path managed-buffers))) + (existing-buf (find-buffer-visiting path)) (existing-buf-label (prin1-to-string existing-buf))) (with-temp-buffer (if existing-buf @@ -3650,8 +3645,7 @@ edit proposed by the server." (eglot--dbind ((VersionedTextDocumentIdentifier) uri version) textDocument (list (eglot-uri-to-path uri) edits version))) - documentChanges)) - (managed-buffers (eglot--managed-buffers (eglot-current-server)))) + documentChanges))) (unless (and changes documentChanges) ;; We don't want double edits, and some servers send both ;; changes and documentChanges. This unless ensures that we @@ -3659,7 +3653,7 @@ edit proposed by the server." (cl-loop for (uri edits) on changes by #'cddr do (push (list (eglot-uri-to-path uri) edits) prepared))) (cl-flet ((notevery-visited-p () - (cl-notevery (lambda (p) (gethash p managed-buffers)) + (cl-notevery #'find-buffer-visiting (mapcar #'car prepared))) (accept-p () (y-or-n-p From 3228c1222c99e672ca0cd7599c07ea1db852aa1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 18 Apr 2024 08:03:10 -0500 Subject: [PATCH 100/149] Better way to fix bug#70036 Cache a new eglot--cached-tdi var per buffer, which contains value to return from eglot--TextDocumentIdentifier. This avoids frequent expensive recomputation of a value that requires potentially many 'file-truename' calls. This technique is used in a number of other cases already, like eglot--recent-changes or eglot--versioned-identifier. * lisp/progmodes/eglot.el (eglot--cached-tdi): New variable. (eglot--TextDocumentIdentifier): Tweak. (eglot--signal-textDocument/didOpen): Clear eglot--cached-tdi. --- lisp/progmodes/eglot.el | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 00f69b2ca83..90a607075d3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2518,12 +2518,17 @@ THINGS are either registrations or unregisterations (sic)." (t (setq success :json-false))) `(:success ,success))) +(defvar-local eglot--cached-tdi nil + "A cached LSP TextDocumentIdentifier URI string.") + (defun eglot--TextDocumentIdentifier () "Compute TextDocumentIdentifier object for current buffer." - `(:uri ,(eglot-path-to-uri (or buffer-file-name - (ignore-errors - (buffer-file-name - (buffer-base-buffer))))))) + `(:uri ,(or eglot--cached-tdi + (setq eglot--cached-tdi + (eglot-path-to-uri (or buffer-file-name + (ignore-errors + (buffer-file-name + (buffer-base-buffer))))))))) (defvar-local eglot--versioned-identifier 0) @@ -2816,7 +2821,9 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didOpen () "Send textDocument/didOpen to server." - (setq eglot--recent-changes nil eglot--versioned-identifier 0) + (setq eglot--recent-changes nil + eglot--versioned-identifier 0 + eglot--cached-tdi nil) (jsonrpc-notify (eglot--current-server-or-lose) :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem)))) From a3f6d92714c31ccb87f56b13ee2606c05493c87d Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 18 Apr 2024 20:28:16 +0300 Subject: [PATCH 101/149] Drag tabs to reorder buffers on the tab line. * lisp/tab-line.el (tab-line-mouse-move-tab): New command bound to [tab-line drag-mouse-1]. --- etc/NEWS | 3 ++- lisp/tab-line.el | 26 ++++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 78a1307b6a4..8ad1e78ca60 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -384,7 +384,8 @@ tabs function, is like the previous 'tab-line-tabs-window-buffers' where both of them show only buffers that were previously displayed in the window. But the difference is that the new function always keeps the original order of buffers on the tab line, even after switching between -these buffers. +these buffers. You can drag the tabs and release at a new position +to manually reorder the buffers on the tab line. --- *** New user option 'tab-line-tabs-buffer-group-function'. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 2eb97012262..84dd20a6307 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -959,6 +959,31 @@ is possible when `tab-line-switch-cycling' is non-nil." (let ((switch-to-buffer-obey-display-actions nil)) (switch-to-buffer buffer)))))))) +(defun tab-line-mouse-move-tab (event) + "Move a tab to a different position on the tab line. +This command should be bound to a drag event. It moves the tab +at the mouse-down event to the position at mouse-up event. +It can be used only when `tab-line-tabs-function' is +customized to `tab-line-tabs-fixed-window-buffers'." + (interactive "e") + (when (eq tab-line-tabs-function #'tab-line-tabs-fixed-window-buffers) + (let* ((posnp1 (tab-line-event-start event)) + (posnp2 (event-end event)) + (string1 (car (posn-string posnp1))) + (string2 (car (posn-string posnp2))) + (buffer1 (when string1 (tab-line--get-tab-property 'tab string1))) + (buffer2 (when string2 (tab-line--get-tab-property 'tab string2))) + (window1 (posn-window posnp1)) + (window2 (posn-window posnp2)) + (buffers (window-parameter window1 'tab-line-buffers)) + (pos2 (when buffer2 (seq-position buffers buffer2)))) + (when (and (eq window1 window2) buffer1 pos2) + (setq buffers (delq buffer1 buffers)) + (cl-pushnew buffer1 (nthcdr pos2 buffers)) + (set-window-parameter window1 'tab-line-buffers buffers) + (set-window-parameter window1 'tab-line-cache nil) + (with-selected-window window1 (force-mode-line-update)))))) + (defcustom tab-line-close-tab-function 'bury-buffer "What to do upon closing a tab on the tab line. @@ -1120,6 +1145,7 @@ of `tab-line-exclude', are exempt from `tab-line-mode'." (global-set-key [tab-line down-mouse-3] 'tab-line-context-menu) +(global-set-key [tab-line drag-mouse-1] 'tab-line-mouse-move-tab) (global-set-key [tab-line mouse-4] 'tab-line-hscroll-left) (global-set-key [tab-line mouse-5] 'tab-line-hscroll-right) From c833892140fbf4be45161bf85d4c1253c5503949 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Apr 2024 23:39:30 -0400 Subject: [PATCH 102/149] (eglot--signal-textDocument/didChange): Fix tests The tests call `eglot--signal-textDocument/didChange` eagerly, which means in the case where we use `track-changes` that they call it before the tracker's signal has been called. So make sure we fetch pending changes even if we haven't yet been notified of them, and make sure `eglot--versioned-identifier` is incremented even when the signal is not called. * lisp/progmodes/eglot.el (eglot--track-changes-fetch) (eglot--after-change): Increment `eglot--versioned-identifier` here... (eglot--track-changes-signal): ...instead of here. (eglot--signal-textDocument/didChange): Try and fetch changes even if the tracker's signal wasn't called yet. * test/lisp/progmodes/eglot-tests.el (eglot-tests--get): New function. (eglot-tests--lsp-abiding-column-1): Use it. --- lisp/progmodes/eglot.el | 7 ++++--- test/lisp/progmodes/eglot-tests.el | 12 +++++++++++- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 90a607075d3..d8eb1f1ee83 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2625,6 +2625,7 @@ buffer." (defun eglot--after-change (beg end pre-change-length) "Hook onto `after-change-functions'. Records BEG, END and PRE-CHANGE-LENGTH locally." + (cl-incf eglot--versioned-identifier) (pcase (car-safe eglot--recent-changes) (`(,lsp-beg ,lsp-end (,b-beg . ,b-beg-marker) @@ -2658,6 +2659,7 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." (if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil)) (track-changes-fetch id (lambda (beg end before) + (cl-incf eglot--versioned-identifier) (cond ((eq eglot--recent-changes :emacs-messup) nil) ((eq before 'error) (setf eglot--recent-changes :emacs-messup)) @@ -2668,7 +2670,6 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." eglot--recent-changes)))))) (defun eglot--track-changes-signal (id &optional distance) - (cl-incf eglot--versioned-identifier) (cond (distance ;; When distance is <100, we may as well coalesce the changes. @@ -2789,9 +2790,9 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didChange () "Send textDocument/didChange to server." + (when eglot--track-changes + (eglot--track-changes-fetch eglot--track-changes)) (when eglot--recent-changes - (when eglot--track-changes - (eglot--track-changes-fetch eglot--track-changes)) (let* ((server (eglot--current-server-or-lose)) (sync-capability (eglot-server-capable :textDocumentSync)) (sync-kind (if (numberp sync-capability) sync-capability diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 4725885038e..e501e24f5d2 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -821,6 +821,12 @@ int main() { (should (looking-back "\"foo.bar\": \"")) (should (looking-at "fb\"$")))))) +(defun eglot-tests--get (object path) + (dolist (op path) + (setq object (if (natnump op) (aref object op) + (plist-get object op)))) + object) + (defun eglot-tests--lsp-abiding-column-1 () (eglot--with-fixture '(("project" . @@ -837,7 +843,11 @@ int main() { (insert "p ") (eglot--signal-textDocument/didChange) (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys) - (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0)))))) + (message "PARAMS=%S" params) + (should (equal 71 (eglot-tests--get + params + '(:contentChanges 0 + :range :start :character))))) (beginning-of-line) (should (eq eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos)) (funcall eglot-move-to-linepos-function 71) From 2675c2824f77f46476831e637e4bc0fec692a0f1 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 19 Apr 2024 17:38:58 +0800 Subject: [PATCH 103/149] * java/INSTALL: Update instructions. --- java/INSTALL | 92 +++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 81 insertions(+), 11 deletions(-) diff --git a/java/INSTALL b/java/INSTALL index 6daef59084e..94bf0b01a96 100644 --- a/java/INSTALL +++ b/java/INSTALL @@ -268,14 +268,13 @@ When building for Intel systems, some ``ndk-build'' modules require the Netwide Assembler, usually installed under ``nasm'', to be present on the system that is building Emacs. -Google, Inc. has adapted many common Emacs dependencies to use the -`ndk-build' system. Here is a non-exhaustive list of what is known to -work, along with what has to be patched to make them work: +Google has adapted several Emacs dependencies to use the `ndk-build' +system, many of which require patches to function under an Emacs +environment. As such, it is generally the wiser choice to use our ports +in their place, but the following list and patches are still provided +for reference. libpng - https://android.googlesource.com/platform/external/libpng - libwebp - https://android.googlesource.com/platform/external/webp - (You must apply the patch at the end of this file for the resulting - binary to work on armv7 devices.) giflib - https://android.googlesource.com/platform/external/giflib (You must add LOCAL_EXPORT_CFLAGS := -I$(LOCAL_PATH) before its Android.mk includes $(BUILD_STATIC_LIBRARY)) @@ -307,6 +306,13 @@ Many of these dependencies have been migrated over to the However, the old ``Android.mk'' Makefiles are still present in older branches, and can be easily adapted to newer versions. +In addition, some Emacs dependencies provide `ndk-build' support +themselves: + + libwebp - https://android.googlesource.com/platform/external/webp + (You must apply the patch at the end of this file for the resulting + binary to work on armv7 devices.) + Emacs developers have ported the following dependencies to ARM Android systems: @@ -318,6 +324,15 @@ systems: (Please see the section TREE-SITTER near the end of this file.) harfbuzz - https://sourceforge.net/projects/android-ports-for-gnu-emacs (Please see the section HARFBUZZ near the end of this file.) + libxml2 - https://sourceforge.net/projects/android-ports-for-gnu-emacs + (Please see the section LIBXML2 near the end of this file.) + libjpeg-turbo - https://sourceforge.net/projects/android-ports-for-gnu-emacs + giflib - https://sourceforge.net/projects/android-ports-for-gnu-emacs + libtiff - https://sourceforge.net/projects/android-ports-for-gnu-emacs + libpng - https://sourceforge.net/projects/android-ports-for-gnu-emacs + (Please see the section IMAGE LIBRARIES near the end of this file.) + libselinux - https://sourceforge.net/projects/android-ports-for-gnu-emacs + (Please see the section SELINUX near the end of this file.) And other developers have ported the following dependencies to Android systems: @@ -345,14 +360,67 @@ To build Emacs with GnuTLS, you must unpack each of the following tar archives in that site: gmp-6.2.1-emacs.tgz - gnutls-3.7.8-emacs.tar.gz + gnutls-3.8.5-emacs.tar.gz + (or gnutls-3.8.5-emacs-armv7a.tar.gz on 32-bit systems) libtasn1-4.19.0-emacs.tar.gz p11-kit-0.24.1-emacs.tar.gz nettle-3.8-emacs.tar.gz -and add the resulting folders to ``--with-ndk-path''. Note that you -should not try to build these packages separately using any -`configure' script or Makefiles inside. +and add the resulting folders to ``--with-ndk-path''. Do not attempt to +build these packages separately by means of `configure' scripts or +Makefiles inside. + + +LIBXML2 + +A copy of libxml2 adapted for the same build system is provided under +the name: + + libxml2-2.12.4-emacs.tar.gz + +In contrast to the version distributed by Google, internationalization +is disabled, which eliminates the dependency on icu4c (and by extension +a C++ compiler). + + +IMAGE LIBRARIES + +ndk-build enabled versions of image libraries required by Emacs are also +provided as: + + giflib-5.2.1-emacs.tar.gz + libjpeg-turbo-3.0.2-emacs.tar.gz + libpng-1.6.41-emacs.tar.gz + tiff-4.5.0-emacs.tar.gz + +Of which all but libjpeg-turbo-3.0.2-emacs.tar.gz should compile on +every supported Android system and toolchain; where the latter does not +compile, i.e. old armeabi toolchains, Google's version is a suitable +substitute. + +Of the three remaining image-related dependencies, libwebp provides +upstream support for ndk-build, ImageMagick has been ported by +interested third-party developers, while librsvg2, with its numerous and +unnavigable web of dependencies and toolchains for non-C languages, +would be such a great undertaking to port that we do not anticipate its +ever becoming available. + +We are actively searching for alternatives to librsvg2 that are feasible +to port, or better yet, natively support Android. Please send +suggestions or patches to emacs-devel@gnu.org. + + +SELINUX + +The upstream version of libselinux is available as: + + libselinux-3.6-emacs.tar.gz + +and compiles on toolchains configured for Android 4.3 and later, which +are the earliest Android releases to support SELinux. Its principal +advantage over Google's edition is the absence of Android-specific +modifications that create dependencies on libpackagelistparser and +libcrypto; Google's pcre remains a requirement. TREE-SITTER @@ -372,7 +440,9 @@ A copy of HarfBuzz modified to build with the ndk-build system can also be found at that URL. To build Emacs with HarfBuzz, you must unpack the following tar archive in that site: - harfbuzz-7.1.0-emacs.tar.gz + harfbuzz-7.1.0-emacs.tar.gz (when building for Android >4.3 + with 21.0.x or later of the NDK) + harfbuzz-1.7.7.tar.gz (earlier NDK or platform releases) and add the resulting folder to ``--with-ndk-build''. From 52d3ee46dbc6fb0fbcfbb8e446fb385aef189893 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Apr 2024 12:15:47 +0200 Subject: [PATCH 104/149] New user option tramp-inhibit-errors-if-setting-file-attributes-fail * doc/misc/tramp.texi (Frequently Asked Questions): Explain tramp-inhibit-errors-if-setting-file-attributes-fail. * lisp/net/tramp.el (tramp-inhibit-errors-if-setting-file-attributes-fail): New defcustom. (tramp-skeleton-set-file-modes-times-uid-gid): Use it. --- doc/misc/tramp.texi | 11 +++++++++++ lisp/net/tramp.el | 11 ++++++++++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 131a23b7423..b503ce13373 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5887,6 +5887,17 @@ as above in your @file{~/.emacs}: @end lisp +@item +How to ignore errors when changing file attributes? + +@vindex tramp-inhibit-errors-if-setting-file-attributes-fail +Sometimes, for example while saving remote files, errors appear when +changing file attributes like permissions, time stamps, or ownership. +If these errors can be ignored, set user option +@code{tramp-inhibit-errors-if-setting-file-attributes-fail} to a +non-@code{nil} value. This transforms the error into a warning. + + @item How to disable other packages from calling @value{tramp}? diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5b101000926..34a636ab97d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3533,6 +3533,11 @@ on the same host. Otherwise, TARGET is quoted." ,@body))) +(defcustom tramp-inhibit-errors-if-setting-file-attributes-fail nil + "Whether to warn only if `tramp-*-set-file-{modes,times,uid-gid}' fails." + :version "30.1" + :type 'boolean) + (defmacro tramp-skeleton-set-file-modes-times-uid-gid (filename &rest body) "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. @@ -3548,7 +3553,11 @@ BODY is the backend specific code." ;; "file-writable-p". '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename") (tramp-flush-file-properties v localname)) - ,@body)) + (condition-case err + (progn ,@body) + (error (if tramp-inhibit-errors-if-setting-file-attributes-fail + (display-warning 'tramp (error-message-string err)) + (signal (car err) (cdr err))))))) (defmacro tramp-skeleton-write-region (start end filename append visit lockname mustbenew &rest body) From 82775f21413681b09c888527b5d2fb15354f0793 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 19 Apr 2024 10:37:16 -0700 Subject: [PATCH 105/149] ; * test/lisp/net/eww-tests.el (eww-test/display/html): Check for libxml. --- test/lisp/net/eww-tests.el | 1 + 1 file changed, 1 insertion(+) diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index b83435e0bd9..84767b2d932 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -50,6 +50,7 @@ temporary EWW buffer for our tests." (ert-deftest eww-test/display/html () "Test displaying a simple HTML page." + (skip-unless (libxml-available-p)) (eww-test--with-mock-retrieve (let ((eww-test--response-function (lambda (url) From 49ef173b0287e17273e4476df16dca5f2196b11c Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Fri, 19 Apr 2024 20:40:25 +0200 Subject: [PATCH 106/149] Make publishDiagnostics faster by using cached variable * lisp/progmodes/eglot.el (eglot--cached-tdi): Move variable. (eglot-handle-notification): Expose 'server' and search through managed buffers for a cached textDocumentIdentifier, which has a file-truename resolved path. * test/lisp/progmodes/eglot-tests.el (eglot-test-basic-symlink): Add regression test for symlink behavior --- lisp/progmodes/eglot.el | 21 +++++++++++++++------ test/lisp/progmodes/eglot-tests.el | 22 ++++++++++++++++++++++ 2 files changed, 37 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d8eb1f1ee83..b78916e7f1d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2381,8 +2381,11 @@ still unanswered LSP requests to the server\n"))) (lambda () (remhash token (eglot--progress-reporters server)))))))))) +(defvar-local eglot--cached-tdi nil + "A cached LSP TextDocumentIdentifier URI string.") + (cl-defmethod eglot-handle-notification - (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics + (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode' "Handle notification publishDiagnostics." (cl-flet ((eglot--diag-type (sev) @@ -2391,9 +2394,18 @@ still unanswered LSP requests to the server\n"))) ((= sev 2) 'eglot-warning) (t 'eglot-note))) (mess (source code message) - (concat source (and code (format " [%s]" code)) ": " message))) + (concat source (and code (format " [%s]" code)) ": " message)) + (find-it (uri) + ;; Search the managed buffers for a buffer with the + ;; provided diagnostic from the server. We do this to + ;; avoid calling `file-truename' too often, gaining an + ;; increase in performance. + (cl-loop for b in (eglot--managed-buffers server) + when (with-current-buffer b + (equal eglot--cached-tdi uri)) + return b))) (if-let* ((path (expand-file-name (eglot-uri-to-path uri))) - (buffer (find-buffer-visiting path))) + (buffer (find-it uri))) (with-current-buffer buffer (cl-loop initially @@ -2518,9 +2530,6 @@ THINGS are either registrations or unregisterations (sic)." (t (setq success :json-false))) `(:success ,success))) -(defvar-local eglot--cached-tdi nil - "A cached LSP TextDocumentIdentifier URI string.") - (defun eglot--TextDocumentIdentifier () "Compute TextDocumentIdentifier object for current buffer." `(:uri ,(or eglot--cached-tdi diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index e501e24f5d2..28579ccde5c 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -436,6 +436,28 @@ directory hierarchy." (flymake-goto-next-error 1 '() t) (should (eq 'flymake-error (face-at-point))))))) +(ert-deftest eglot-test-basic-symlink () + "Test basic symlink support." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("symlink-project" . + (("main.cpp" . "#include\"foo.h\"\nint main() { return foo(); }") + ("foo.h" . "int foo();")))) + (with-current-buffer + (find-file-noselect "symlink-project/main.cpp") + (make-symbolic-link "main.cpp" "mainlink.cpp") + (eglot--tests-connect) + (find-file-noselect "mainlink.cpp") + (with-current-buffer + (find-file-noselect "foo.h") + (goto-char 5) + (xref-find-references "foo") + (with-current-buffer (get-buffer "*xref*") + (end-of-buffer) + ;; Expect the xref buffer to not contain duplicate references to + ;; main.c and mainlink.c. If it did total lines would be 7. + (should (= (line-number-at-pos (point)) 5))))))) + (ert-deftest eglot-test-diagnostic-tags-unnecessary-code () "Test rendering of diagnostics tagged \"unnecessary\"." (skip-unless (executable-find "clangd")) From ff1d1f6df16a57acd699b18bdaa4baadff8269a1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 7 Apr 2024 19:28:24 -0700 Subject: [PATCH 107/149] ; Improve erc-services and upgrade documentation * doc/misc/erc.texi (Getting Help and Reporting Bugs): Describe alternate method for upgrading from GNU ELPA. This is a partial workaround for bug#68660 discovered by ERC contributor Alcor. * lisp/erc/erc-backend.el (erc-call-hooks): Add comment. * lisp/erc/erc-services.el (erc-nickserv-alist): Doc. * test/lisp/erc/erc-scenarios-base-renick.el (erc-scenarios-base-renick-queries-bouncer): Adjust timeout. --- doc/misc/erc.texi | 11 ++++- lisp/erc/erc-backend.el | 2 + lisp/erc/erc-services.el | 50 ++++++++++++---------- test/lisp/erc/erc-scenarios-base-renick.el | 2 +- 4 files changed, 41 insertions(+), 24 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index c7ab7e7bf21..0c7e3b09f41 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -2123,11 +2123,20 @@ to IRC, and don't forget that you can roll back to the previous version by running @kbd{M-x package-delete @key{RET}}. @xref{Packages,,,emacs, The Emacs Editor}, for more information. +Note that a bug affecting Emacs' packaging machinery may prevent the +above method from working on Emacs versions 29 and below. Users on 29 +can try running @kbd{C-u M-x package-install @key{RET}} instead. +Users on 28 and below can click on the @emph{installed} @samp{erc} +line item in the @file{*Packages*} buffer instead of the newest one, +and then, in the resulting @code{help-mode} buffer, find and activate +the button for the newest version, which should appear in the summary +item @samp{Other versions}. + In the rare instance you need an emergency fix or have volunteered to test an edge feature between ERC releases, you can try adding @samp{("devel" . "https://elpa.gnu.org/devel/")} to @code{package-archives} prior to performing the steps above. For -this, you'll want to instead select a ``snapshot'' version from the +this, you'll want to instead select a @dfn{snapshot} version from the menu. Please be aware that when going this route, the latest changes may not yet be available and you run the risk of incurring other bugs and encountering unstable features. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9fc8a4d29f4..ea5ea0928e0 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1536,6 +1536,8 @@ Finds hooks by looking in the `erc-server-responses' hash table." (let ((hook (or (erc-get-hook (erc-response.command message)) 'erc-default-server-functions))) (run-hook-with-args-until-success hook process message) + ;; Some handlers, like `erc-cmd-JOIN', open new targets without + ;; saving excursion, and `erc-open' sets the current buffer. (erc-with-server-buffer (run-hook-with-args 'erc-timer-hook (erc-current-time))))) diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 92cb9075b5e..0881006ed77 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -22,6 +22,13 @@ ;;; Commentary: +;; As of ERC 5.6, this library's main module, `services', mainly +;; concerns itself with authenticating to legacy IRC servers. If your +;; server supports SASL or CERTFP, please use one of those instead. +;; See (info "(erc) client-certificate") and (info "(erc) SASL") for +;; details. Note that this library also contains the local module +;; `services-regain' as well as standalone utility functions. + ;; There are two ways to go about identifying yourself automatically to ;; NickServ with this module. The more secure way is to listen for identify ;; requests from the user NickServ. Another way is to identify yourself to @@ -37,10 +44,7 @@ ;; Usage: ;; -;; Put into your .emacs: -;; -;; (require 'erc-services) -;; (erc-services-mode 1) +;; Customize the option `erc-modules' to include `services'. ;; ;; Add your nickname and NickServ password to `erc-nickserv-passwords'. ;; Using the Libera.Chat network as an example: @@ -50,10 +54,7 @@ ;; ;; The default automatic identification mode is autodetection of NickServ ;; identify requests. Set the variable `erc-nickserv-identify-mode' if -;; you'd like to change this behavior. You can also change the way -;; automatic identification is handled by using: -;; -;; M-x erc-nickserv-identify-mode +;; you'd like to change this behavior. ;; ;; If you'd rather not identify yourself automatically but would like access ;; to the functions contained in this file, just load this file without @@ -309,21 +310,26 @@ Example of use: "/msg\\s-NickServ\\s-IDENTIFY\\s-\^_password" "NickServ@services.slashnet.org" "IDENTIFY" nil nil nil)) - "Alist of NickServer details, sorted by network. + "Alist of NickServer details, sorted by network. Every element in the list has the form - (SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER SUCCESS-REGEXP) - -SYMBOL is a network identifier, a symbol, as used in `erc-networks-alist'. -NICKSERV is the description of the nickserv in the form nick!user@host. -REGEXP is a regular expression matching the message from nickserv. -NICK is nickserv's nickname. Use nick@server where necessary/possible. -KEYWORD is the keyword to use in the reply message to identify yourself. -USE-CURRENT indicates whether the current nickname must be used when - identifying. -ANSWER is the command to use for the answer. The default is `privmsg'. -SUCCESS-REGEXP is a regular expression matching the message nickserv - sends when you've successfully identified. -The last two elements are optional." + (NETWORK SENDER INSTRUCT-RX NICK SUBCMD YOUR-NICK-P ANSWER SUCCESS-RX) + +NETWORK is a network identifier, a symbol, as used in `erc-networks-alist'. +SENDER is the exact nick!user@host \"source\" for \"NOTICE\" messages +indicating success or requesting that the user identify. +INSTRUCT-RX is a regular expression matching a \"NOTICE\" from the + services bot instructing the user to identify. It must be non-null + when the option `erc-nickserv-identify-mode' is set to `autodetect'. + When it's `both', and this field is non-null, ERC will forgo + identifying on nick changes and after connecting. +NICK is the nickname of the services bot to use when issuing commands. +SUBCMD is the bot command for identifying, typically \"IDENTIFY\". +YOUR-NICK-P indicates whether to send the user's current nickname before + their password when identifying. +ANSWER is the command to use for the answer. The default is \"PRIVMSG\". +SUCCESS-RX is a regular expression matching the message NickServ sends + when you've successfully identified. +The last two elements are optional, as are others, where implied." :type '(repeat (list :tag "Nickserv data" (symbol :tag "Network name") diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index e0fcb8b9366..35f37a0159e 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -253,7 +253,7 @@ (ert-info ("Joined by bouncer to #chan@barnet, pal persent") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet")) (funcall expect 1 "rando") - (funcall expect 2 "come, sir, I am"))) + (funcall expect 5 "come, sir, I am"))) (ert-info ("Query buffer exists for rando@foonet") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "rando@foonet")) From c572c30fb121008e5b248688ebe319dd85633c72 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 12 Apr 2024 00:04:50 -0700 Subject: [PATCH 108/149] Simplify option erc-merge-wrap-merge-indicator * lisp/erc/erc-fill.el (erc-fill-wrap-merge-indicator): Reduce offering of acceptable values by removing leading symbols and ditching the `post' variant entirely. The justification for the latter move hinges on it not being well suited to next-gen requirements involving the splicing and deletion of inserted messages. Meeting these would be overly burdensome and involve scanning the buffer in both directions for every such operation. This option is new in ERC 5.6, which is yet unreleased. (erc-fill--wrap-massage-legacy-indicator-type): New function to warn of obsolete `erc-fill-wrap-merge-indicator' value and perform a migration for the current session. (erc-fill-wrap, erc-fill-wrap-enable): Preform preflight compat check for obsolete `erc-fill-wrap-merge-indicator' value types. (erc-fill-wrap-disable): Don't bother killing nonexistent variable `erc-fill--wrap-merge-indicator-post'. (erc-fill--wrap-merge-indicator-post): Remove unused variable. (erc-fill--wrap-insert-merged-post): Remove unused function. (erc-fill--wrap-insert-merged-pre): Adapt to simplified format for option `erc-merge-wrap-merge-indicator'. (erc-fill-wrap): Remove conditional dispatch because there is only one path and only one indicator style. (erc-fill--wrap-rejigger-region): Remove reference to nonexistent variable `erc-fill--wrap-merge-indicator-post'. * test/lisp/erc/erc-fill-tests.el (erc-fill-wrap--merge-action/indicator-pre): Update format of value for option `erc-fill-wrap-merge-indicator'. (erc-fill-wrap--merge-action/indicator-post): Remove test focusing on obsolete and unsupported `post' variant of option `erc-fill-wrap-merge-indicator'. (erc-fill--wrap-massage-legacy-indicator-type): New test. * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld: Delete file. (Bug#60936) --- lisp/erc/erc-fill.el | 97 ++++++++----------- test/lisp/erc/erc-fill-tests.el | 40 ++++++-- .../merge-wrap-indicator-post-01.eld | 1 - 3 files changed, 69 insertions(+), 69 deletions(-) delete mode 100644 test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index aa12b807fbc..7e21a097c7c 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -274,16 +274,10 @@ merged messages, see option `erc-fill-wrap-merge-indicator'." (defcustom erc-fill-wrap-merge-indicator nil "Indicator to help distinguish between merged messages. Only matters when the option `erc-fill-wrap-merge' is enabled. -If the first element is the symbol `pre', ERC uses this option to -generate a replacement for the speaker's name tag. If the first -element is `post', ERC affixes a short string to the end of the -previous message. In either case, the second element should be a -character, like ?>, and the last element a valid face. In -special cases, you may also specify a cons of either -aforementioned symbol and a string, which tells ERC not to manage -the process for you. If unsure, try either of the first two -presets, both of which replace a continued speaker's name with a -dot-product-like character in a `shadow'-like face. +If the value is a cons of a character, like ?>, and a valid face, +ERC generates a replacement for the speaker's name tag. The +first two presets replace a continued speaker's name with a +bullet-like character in `shadow' face. Note that as of ERC 5.6, this option is still experimental, and changing its value mid-session is not yet supported (though, if @@ -300,20 +294,14 @@ command." :type '(choice (const nil) (const :tag "Leading MIDDLE DOT (U+00B7) as speaker" - (pre #xb7 erc-fill-wrap-merge-indicator-face)) + (#xb7 . erc-fill-wrap-merge-indicator-face)) (const :tag "Leading MIDDLE DOT (U+00B7) sans gap" - (pre . #("\u00b7" 0 1 (font-lock-face - erc-fill-wrap-merge-indicator-face)))) + #("\u00b7" + 0 1 (font-lock-face erc-fill-wrap-merge-indicator-face))) (const :tag "Leading RIGHT-ANGLE BRACKET (>) as speaker" - (pre ?> erc-fill-wrap-merge-indicator-face)) - (const :tag "Trailing PARAGRAPH SIGN (U+00B6)" - (post #xb6 erc-fill-wrap-merge-indicator-face)) - (const :tag "Trailing TILDE (~)" - (post ?~ erc-fill-wrap-merge-indicator-face)) - (cons :tag "User-provided string (advanced)" - (choice (const pre) (const post)) string) - (list :tag "User-provided character-face pairing" - (choice (const pre) (const post)) character face))) + (?> . erc-fill-wrap-merge-indicator-face)) + (string :tag "User-provided string (advanced)") + (cons :tag "User-provided character-face pairing" character face))) (defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args) (apply (pcase erc-fill--wrap-visual-keys @@ -459,6 +447,28 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." " warning. See Info:\"(erc) Modules\" for more." (mapcar (lambda (s) (format "`%s'" s)) missing-deps))))) +(defun erc-fill--wrap-massage-legacy-indicator-type () + "Migrate obsolete 5.6-git `erc-fill-wrap-merge-indicator' format." + (pcase erc-fill-wrap-merge-indicator + (`(post . ,_) + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "The option `erc-fill-wrap-merge-indicator' has changed. Unfortunately," + " the `post' variant and related presets are no longer available." + " Setting to nil for the current session. Apologies for the disruption." + (setq erc-fill-wrap-merge-indicator nil))) + (`(pre . ,(and (pred stringp) string)) + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "The format of option `erc-fill-wrap-merge-indicator' has changed" + " from a cons of (pre . STRING) to STRING. Please update your settings." + " Changing temporarily to \"" string "\" for the current session.") + (setq erc-fill-wrap-merge-indicator string)) + (`(pre ,(and (pred characterp) char) ,face) + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "The format of option `erc-fill-wrap-merge-indicator' has changed" + " from (pre CHAR FACE) to a cons of (CHAR . FACE). Please update" + " when possible. Changing temporarily to %S for the current session." + (setq erc-fill-wrap-merge-indicator (cons char face)))))) + ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. @@ -505,6 +515,8 @@ enabled when shutting down. To opt out of `scrolltobottom' specifically, disable its minor mode, `erc-scrolltobottom-mode', via `erc-fill-wrap-mode-hook'." ((erc-fill--wrap-ensure-dependencies) + (when erc-fill-wrap-merge-indicator + (erc-fill--wrap-massage-legacy-indicator-type)) (erc--restore-initialize-priors erc-fill-wrap-mode erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys erc-fill--wrap-value erc-fill-static-center @@ -536,7 +548,6 @@ via `erc-fill-wrap-mode-hook'." (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) - (kill-local-variable 'erc-fill--wrap-merge-indicator-post) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt) (remove-hook 'erc-button--prev-next-predicate-functions @@ -612,35 +623,6 @@ to be disabled." "Whether to dedent speakers in CTCP \"ACTION\" lines.") (defvar-local erc-fill--wrap-merge-indicator-pre nil) -(defvar-local erc-fill--wrap-merge-indicator-post nil) - -;; To support `erc-fill-line-spacing' with the "post" variant, we'd -;; need to use a new "replacing" `display' spec value for each -;; insertion, and add a sentinel property alongside it atop every -;; affected newline, e.g., (erc-fill-eol-display START-POS), where -;; START-POS is the position of the newline in the replacing string. -;; Then, upon spotting this sentinel in `erc-fill' (and maybe -;; `erc-fill-wrap-refill-buffer'), we'd add `line-spacing' to the -;; corresponding `display' replacement, starting at START-POS. -(defun erc-fill--wrap-insert-merged-post () - "Add `display' property at end of previous line." - (save-excursion - (goto-char (point-min)) - (save-restriction - (widen) - (cl-assert (= ?\n (char-before (point)))) - (unless erc-fill--wrap-merge-indicator-post - (let ((option (cdr erc-fill-wrap-merge-indicator))) - (setq erc-fill--wrap-merge-indicator-post - (if (stringp option) - (concat option - (and (not (string-suffix-p "\n" option)) "\n")) - (propertize (concat (string (car option)) "\n") - 'font-lock-face (cadr option)))))) - (unless (eq (field-at-pos (- (point) 2)) 'erc-timestamp) - (put-text-property (1- (point)) (point) - 'display erc-fill--wrap-merge-indicator-post))) - 0)) (defun erc-fill--wrap-insert-merged-pre () "Add `display' property in lieu of speaker." @@ -649,11 +631,11 @@ to be disabled." (put-text-property (point-min) (point) 'display (car erc-fill--wrap-merge-indicator-pre)) (cdr erc-fill--wrap-merge-indicator-pre)) - (let* ((option (cdr erc-fill-wrap-merge-indicator)) + (let* ((option erc-fill-wrap-merge-indicator) (s (if (stringp option) (concat option) (concat (propertize (string (car option)) - 'font-lock-face (cadr option)) + 'font-lock-face (cdr option)) " ")))) (put-text-property (point-min) (point) 'display s) (cdr (setq erc-fill--wrap-merge-indicator-pre @@ -693,9 +675,7 @@ See `erc-fill-wrap-mode' for details." (put-text-property (point-min) (point) 'display "") (if erc-fill-wrap-merge-indicator - (pcase (car erc-fill-wrap-merge-indicator) - ('pre (erc-fill--wrap-insert-merged-pre)) - ('post (erc-fill--wrap-insert-merged-post))) + (erc-fill--wrap-insert-merged-pre) 0)) (t (erc-fill--wrap-measure (point-min) (point)))))))) @@ -732,8 +712,7 @@ case this module's insert hooks run by way of the process filter. With REPAIRP, destructively fill gaps and re-merge speakers." (goto-char start) (cl-assert (null erc-fill--wrap-rejigger-last-message)) - (setq erc-fill--wrap-merge-indicator-pre nil - erc-fill--wrap-merge-indicator-post nil) + (setq erc-fill--wrap-merge-indicator-pre nil) (let (erc-fill--wrap-rejigger-last-message) (while-let (((< (point) finish)) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 3c4ad04abd7..79cfc1190bc 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -299,17 +299,9 @@ (ert-deftest erc-fill-wrap--merge-action/indicator-pre () :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (let ((erc-fill-wrap-merge-indicator '(pre ?> shadow))) + (let ((erc-fill-wrap-merge-indicator '(?> . shadow))) (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01"))) -;; One crucial thing this test asserts is that the indicator is -;; omitted when the previous line ends in a stamp. -(ert-deftest erc-fill-wrap--merge-action/indicator-post () - :tags `(:unstable - ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (let ((erc-fill-wrap-merge-indicator '(post ?~ shadow))) - (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-post-01"))) - (ert-deftest erc-fill-line-spacing () :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) @@ -450,4 +442,34 @@ rear-nonsticky t font-lock-face erc-prompt-face)))))))))) +(ert-deftest erc-fill--wrap-massage-legacy-indicator-type () + (let (calls + erc-fill-wrap-merge-indicator) + (cl-letf (((symbol-function 'erc--warn-once-before-connect) + (lambda (_ &rest args) (push args calls)))) + ;; List of (pre CHAR FACE) becomes (CHAR . FACE). + (let ((erc-fill-wrap-merge-indicator + '(pre #xb7 erc-fill-wrap-merge-indicator-face))) + (erc-fill--wrap-massage-legacy-indicator-type) + (should (equal erc-fill-wrap-merge-indicator + '(#xb7 . erc-fill-wrap-merge-indicator-face))) + (should (string-search "(pre CHAR FACE)" (nth 1 (pop calls))))) + + ;; Cons of (CHAR . STRING) becomes STRING. + (let ((erc-fill-wrap-merge-indicator '(pre . "\u00b7"))) + (erc-fill--wrap-massage-legacy-indicator-type) + (should (equal erc-fill-wrap-merge-indicator "\u00b7")) + (should (string-search "(pre . STRING)" (nth 1 (pop calls))))) + + ;; Anything with a CAR of `post' becomes nil. + (let ((erc-fill-wrap-merge-indicator + '(post #xb6 erc-fill-wrap-merge-indicator-face))) + (erc-fill--wrap-massage-legacy-indicator-type) + (should-not erc-fill-wrap-merge-indicator) + (should (string-search "no longer available" (nth 1 (pop calls))))) + (let ((erc-fill-wrap-merge-indicator '(post . "\u00b7"))) + (erc-fill--wrap-massage-legacy-indicator-type) + (should-not erc-fill-wrap-merge-indicator) + (should (string-search "no longer available" (nth 1 (pop calls)))))))) + ;;; erc-fill-tests.el ends here diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld deleted file mode 100644 index e019e60bb26..00000000000 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld +++ /dev/null @@ -1 +0,0 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 507 508 (display #("~\n" 0 2 (font-lock-face shadow))) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file From 21b372a57bb0cab9ebdf93843090081eb4715030 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 12 Apr 2024 00:04:50 -0700 Subject: [PATCH 109/149] Improve erc-fill-wrap-merge refilling and movement * lisp/erc/erc-fill.el (erc-fill--wrap-escape-hidden-speaker): Add parameter to suppress escaping of hidden prefixes. (erc-fill--wrap-beginning-of-line): Remember original value of point, and pass it to `erc-fill--wrap-escape-hidden-speaker'. (erc-fill--wrap-previous-line, erc-fill--wrap-next-line): Guard call to `erc-fill--wrap-escape-hidden-speaker' with conditional check for `erc-fill-wrap-merge'. (erc-fill--wrap-insert-merged-pre): Add additional text property, `erc-fill--wrap-merge', to help identify `display' regions servicing `erc-fill-wrap-merge'. This should make resolving inconsistencies easier when "splicing" new messages between existing ones. (erc-fill-wrap): Add `erc-fill--wrap-merge' text property to merged speaker region. (erc-fill--wrap-rejigger-region): Remove assertion disallowing a non-nil `erc-fill--wrap-rejigger-last-message'. Instead, adopt the existing value of that variable when shadowing it for the remaining extent of the function's execution. When removing the `display' property, also look for nonempty replacement text, such as values specified by the option `erc-fill-wrap-merge-indicator'. (erc-fill--wrap-merged-button-p): Look for `erc-fill--wrap-merge' property instead of `display'. * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update. * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update. * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update. * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld: Update. * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update. (Bug#60936) --- lisp/erc/erc-fill.el | 72 +++++++++++-------- .../fill/snapshots/merge-01-start.eld | 2 +- .../fill/snapshots/merge-02-right.eld | 2 +- .../fill/snapshots/merge-wrap-01.eld | 2 +- .../snapshots/merge-wrap-indicator-pre-01.eld | 2 +- .../fill/snapshots/spacing-01-mono.eld | 2 +- 6 files changed, 48 insertions(+), 34 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 7e21a097c7c..c5d4e9c9e6f 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -318,24 +318,30 @@ command." ;; `kill-line' anyway so that users can see the error. (erc-fill--wrap-move #'kill-line #'kill-visual-line arg)) -(defun erc-fill--wrap-escape-hidden-speaker () +(defun erc-fill--wrap-escape-hidden-speaker (&optional old-point) "Move to start of message text when left of speaker. -Basically mimic what `move-beginning-of-line' does with invisible text." +Basically mimic what `move-beginning-of-line' does with invisible text. +Stay put if OLD-POINT lies within hidden region." (when-let ((erc-fill-wrap-merge) - (prop (get-text-property (point) 'display)) - ((or (equal prop "") (eq 'margin (car-safe (car-safe prop)))))) - (goto-char (text-property-not-all (point) (pos-eol) 'display prop)))) + (prop (get-text-property (point) 'erc-fill--wrap-merge)) + ((or (member prop '("" t)) + (eq 'margin (car-safe (car-safe prop))))) + (end (text-property-not-all (point) (pos-eol) + 'erc-fill--wrap-merge prop)) + ((or (null old-point) (>= old-point end)))) + (goto-char end))) (defun erc-fill--wrap-beginning-of-line (arg) "Defer to `move-beginning-of-line' or `beginning-of-visual-line'." (interactive "^p") - (let ((inhibit-field-text-motion t)) - (erc-fill--wrap-move #'move-beginning-of-line - #'beginning-of-visual-line arg)) - (if (get-text-property (point) 'erc-prompt) - (goto-char erc-input-marker) - ;; Mimic what `move-beginning-of-line' does with invisible text. - (erc-fill--wrap-escape-hidden-speaker))) + (let ((opoint (point))) + (let ((inhibit-field-text-motion t)) + (erc-fill--wrap-move #'move-beginning-of-line + #'beginning-of-visual-line arg)) + (if (get-text-property (point) 'erc-prompt) + (goto-char erc-input-marker) + (when erc-fill-wrap-merge + (erc-fill--wrap-escape-hidden-speaker opoint))))) (defun erc-fill--wrap-previous-line (&optional arg try-vscroll) "Move to ARGth previous logical or screen line." @@ -347,7 +353,8 @@ Basically mimic what `move-beginning-of-line' does with invisible text." (erc-fill--wrap-move (if visp #'previous-line #'previous-logical-line) #'previous-line arg try-vscroll)) - (erc-fill--wrap-escape-hidden-speaker))) + (when erc-fill-wrap-merge + (erc-fill--wrap-escape-hidden-speaker)))) (defun erc-fill--wrap-next-line (&optional arg try-vscroll) "Move to ARGth next logical or screen line." @@ -356,7 +363,9 @@ Basically mimic what `move-beginning-of-line' does with invisible text." erc-fill-wrap-force-screen-line-movement))) (erc-fill--wrap-move (if visp #'next-line #'next-logical-line) #'next-line - arg try-vscroll))) + arg try-vscroll) + (when erc-fill-wrap-merge + (erc-fill--wrap-escape-hidden-speaker)))) (defun erc-fill--wrap-end-of-line (arg) "Defer to `move-end-of-line' or `end-of-visual-line'." @@ -625,11 +634,14 @@ to be disabled." (defvar-local erc-fill--wrap-merge-indicator-pre nil) (defun erc-fill--wrap-insert-merged-pre () - "Add `display' property in lieu of speaker." + "Add `display' text property to speaker. +Also cover region with text prop `erc-fill--wrap-merge' set to t." (if erc-fill--wrap-merge-indicator-pre (progn - (put-text-property (point-min) (point) 'display - (car erc-fill--wrap-merge-indicator-pre)) + (add-text-properties (point-min) (point) + (list 'display + (car erc-fill--wrap-merge-indicator-pre) + 'erc-fill--wrap-merge t)) (cdr erc-fill--wrap-merge-indicator-pre)) (let* ((option erc-fill-wrap-merge-indicator) (s (if (stringp option) @@ -637,7 +649,8 @@ to be disabled." (concat (propertize (string (car option)) 'font-lock-face (cdr option)) " ")))) - (put-text-property (point-min) (point) 'display s) + (add-text-properties (point-min) (point) + (list 'display s 'erc-fill--wrap-merge t)) (cdr (setq erc-fill--wrap-merge-indicator-pre (cons s (erc-fill--wrap-measure (point-min) (point)))))))) @@ -672,8 +685,9 @@ See `erc-fill-wrap-mode' for details." (delete-region (1- (point)) (point)))))) ((and erc-fill-wrap-merge (erc-fill--wrap-continued-message-p)) - (put-text-property (point-min) (point) - 'display "") + (add-text-properties + (point-min) (point) + '(display "" erc-fill--wrap-merge "")) (if erc-fill-wrap-merge-indicator (erc-fill--wrap-insert-merged-pre) 0)) @@ -711,9 +725,9 @@ stash and restore `erc-fill--wrap-last-msg' before doing so, in case this module's insert hooks run by way of the process filter. With REPAIRP, destructively fill gaps and re-merge speakers." (goto-char start) - (cl-assert (null erc-fill--wrap-rejigger-last-message)) (setq erc-fill--wrap-merge-indicator-pre nil) - (let (erc-fill--wrap-rejigger-last-message) + (let ((erc-fill--wrap-rejigger-last-message + erc-fill--wrap-rejigger-last-message)) (while-let (((< (point) finish)) (beg (if (get-text-property (point) 'line-prefix) @@ -724,12 +738,13 @@ With REPAIRP, destructively fill gaps and re-merge speakers." ;; If this is a left-side stamp on its own line. (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil)) (when-let ((repairp) - (dbeg (text-property-not-all beg end 'display nil)) + (dbeg (text-property-not-all beg end + 'erc-fill--wrap-merge nil)) ((get-text-property (1+ dbeg) 'erc--speaker)) - (dval (get-text-property dbeg 'display)) - ((equal "" dval))) - (remove-text-properties - dbeg (text-property-not-all dbeg end 'display dval) '(display))) + (dval (get-text-property dbeg 'erc-fill--wrap-merge))) + (remove-list-of-text-properties + dbeg (text-property-not-all dbeg end 'erc-fill--wrap-merge dval) + '(display erc-fill--wrap-merge))) ;; This "should" work w/o `front-sticky' and `rear-nonsticky'. (let* ((pos (if-let (((eq 'erc-timestamp (field-at-pos beg))) (b (field-beginning beg)) @@ -777,9 +792,8 @@ like `erc-match-toggle-hidden-fools'." callback repair) (progress-reporter-done rep))))) -;; FIXME use own text property to avoid false positives. (defun erc-fill--wrap-merged-button-p (point) - (equal "" (get-text-property point 'display))) + (get-text-property point 'erc-fill--wrap-merge)) (defun erc-fill--wrap-nudge (arg) (when (zerop arg) diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld index 6ff7af218c0..166ed59e292 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 0)) erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld index 7d9822c80bc..8b502373807 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #8=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (wrap-prefix #1# line-prefix #9=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld index 2d0e5a5965f..9744e659813 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) erc-fill--wrap-merge #8="" display #8#) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #8# display #8#) 509 512 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld index 615de982b1e..36729b890be 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 509 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 514 (wrap-prefix #1# line-prefix #12# display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) erc-fill--wrap-merge t display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) erc-fill--wrap-merge t display #8#) 509 512 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 512 514 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld index ae364accdea..5405ca2a7dc 100644 --- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld +++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 438 441 (wrap-prefix #1# line-prefix #5# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) erc-fill--wrap-merge #6="" display #6#) 438 441 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) \ No newline at end of file From 86184cba2180a09b31e92f7366f9dd38de5b976a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 8 Apr 2024 14:21:43 -0700 Subject: [PATCH 110/149] Don't nest date stamp insertions in erc-stamp * etc/ERC-NEWS: Don't mention certain insertion-adjacent hooks being suppressed for date stamps, which is no longer true. * lisp/erc/erc-common.el (erc--solo): New utility function. * lisp/erc/erc-fill.el (erc-fill-wrap): Don't move last-message marker when encountering a date stamp. * lisp/erc/erc-stamp.el (erc-stamp--recover-on-reconnect): Restore `erc-stamp--date-stamps' on reconnect and rejoin. (erc-stamp--insert-date-hook): Fix erroneous doc string. (erc-stamp--date): New struct type. (erc-stamp--deferred-date-stamp): New internal variable to pass state between hook members. (erc-stamp--date-stamps): New internal variable to store a reference to all inserted timestamps. (erc-stamp--propertize-left-date-stamp): Don't hide messages because this function runs on `erc-insert-modify-hook'. Prefer doing so later, in `erc-insert-post-hook'. (erc-stamp--find-insertion-point): New helper function. (erc-stamp--insert-date-stamp-as-phony-message): Remove. (erc-stamp--lr-date-on-pre-modify): Remove function. Portions of body now appear in `erc-stamp--defer-date-insertion-on-post-modify'. (erc-stamp--defer-date-insertion-on-post-modify) (erc-stamp--defer-date-insertion-on-post-insert) (erc-stamp--defer-date-insertion-on-post-send): New functions, although the first incorporates parts of the now defunct `erc-stamp--lr-date-on-pre-modify'. (erc-stamp--date-mode): Update hook-member functions. (erc-stamp-prepend-date-stamps-p): Revise doc. (erc-insert-timestamp-left-and-right): Remove code to initialize a date stamp in place through a nested call to `erc-display-message'. Instead, "pre-render" date stamp and stash it for retrieval by the function `erc-stamp--defer-date-insertion-on-post-modify'. (erc-stamp--setup): Kill variables `erc-stamp--deferred-date-stamp' and `erc-stamp--date-stamps'. (erc-stamp--reset-on-clear): Remove trimmed stamps from `erc-stamp--date-stamps'. * lisp/erc/erc.el (erc--msg-props): Document `erc--hide' in doc string. (erc--with-inserted-msg): Remove unused macro. (erc--insert-line-splice-function): New variable. (erc--with-spliced-insertion): New macro. (erc--insert-line-function): Expand doc string. (erc--remove-from-prop-value-list): Tweak doc string. (erc--insert-before-markers-transplanting-hidden): New function. (erc--hide-message): Remember managed `invisible' prop value. Do so by recording them in the `erc--hide' "msg prop". (erc--delete-inserted-message, erc--delete-inserted-message-naively): Rename former to latter to emphasize that it's largely impractical for general use. (erc--ranked-properties): Add `erc--hide'. * test/lisp/erc/erc-button-tests.el (erc-button-tests--erc-button-alist--function-as-form): Use `erc-display-message' helper. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg) (erc-fill-tests--wrap-populate, erc-fill-wrap-tests--merge-action) (erc-fill-line-spacing): Use `erc-display-message' wrappers to intercept `erc-timer-hook' modifications. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--invisible-stamp): Add convenience commands to `extended-command-history' when running interactively. * test/lisp/erc/erc-tests.el (erc--insert-before-markers-transplanting-hidden): New test. (erc--delete-inserted-message, erc--delete-inserted-message-naively): Update test name as well as namesake function in body. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common-with-cleanup): Validate `erc-stamp--date-stamps' members after every scenario test. (erc-scenarios-common--assert-date-stamps): New function. * test/lisp/erc/resources/erc-tests-common.el: Require `erc-stamp' atop file when compiling. (erc-tests--common-display-message) (erc-tests-common-display-message) (erc-tests-common-with-date-aware-display-message): New functions and macro for running `erc-display-message' while intercepting additions to `erc-timer-hook' made by date-stamp-related post-insertion hooks. (erc-tests-common-snapshot-compare): Insert expected output into its own buffer for easier review during interactive sessions. This change is unrelated to the rest of this commit. (Bug#60936) --- etc/ERC-NEWS | 18 +- lisp/erc/erc-common.el | 9 + lisp/erc/erc-fill.el | 2 - lisp/erc/erc-stamp.el | 211 +++++++++++------- lisp/erc/erc.el | 88 ++++++-- test/lisp/erc/erc-button-tests.el | 8 +- test/lisp/erc/erc-fill-tests.el | 48 ++-- test/lisp/erc/erc-scenarios-match.el | 3 +- test/lisp/erc/erc-tests.el | 51 ++++- .../erc/resources/erc-scenarios-common.el | 7 + test/lisp/erc/resources/erc-tests-common.el | 34 ++- 11 files changed, 330 insertions(+), 149 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index d7f513addfb..b66ea6a7a02 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -486,16 +486,14 @@ these areas without inflicting collateral damage. Despite the rationale, this move admittedly ushers in a heightened potential for disruption because third-party members of ERC's modification hooks may not take kindly to encountering stamp-only -messages. They may also expect members of 'erc-insert-pre-hook' and -'erc-insert-done-hook' to run unconditionally, even though ERC -suppresses those hooks when inserting date stamps. Third parties may -also not appreciate that 'erc-timestamp-last-inserted-left' no longer -records the final trailing newline in 'erc-timestamp-format-left'. If -these inconveniences prove too encumbering to deal with right away, -see the escape hatch 'erc-stamp-prepend-date-stamps-p', which should -help ease the transition. As for detecting these new stamp-only -messages from members of 'erc-insert-modify-hook' and friends, see the -function 'erc-stamp-inserting-date-stamp-p'. +messages or the new behavior of 'erc-timestamp-last-inserted-left', +which no longer records the final trailing newline in the variable +'erc-timestamp-format-left'. If these inconveniences prove too +encumbering to deal with right away, see the escape hatch +'erc-stamp-prepend-date-stamps-p', which should help ease the +transition. As for detecting these new stamp-only messages from +members of 'erc-insert-modify-hook' and friends, see the function +'erc-stamp-inserting-date-stamp-p'. *** The role of a module's Custom group is now more clearly defined. Associating built-in modules with Custom groups and "provided" library diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 8388efe062c..4115e314b39 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -617,6 +617,15 @@ the resulting variables will end up with more useful doc strings." "Return position of CHAR in STRING or nil if not found." (inline-quote (string-search (string ,char) ,string))) +(define-inline erc--solo (list-or-atom) + "If LIST-OR-ATOM is a list of one element, return that element. +Otherwise, return LIST-OR-ATOM." + (inline-letevals (list-or-atom) + (inline-quote + (if (and (consp ,list-or-atom) (null (cdr ,list-or-atom))) + (car ,list-or-atom) + ,list-or-atom)))) + (defmacro erc--doarray (spec &rest body) "Map over ARRAY, running BODY with VAR bound to iteration element. Behave more or less like `seq-doseq', but tailor operations for diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index c5d4e9c9e6f..b2c8c991c96 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -674,8 +674,6 @@ See `erc-fill-wrap-mode' for details." (skip-syntax-forward "^-") (forward-char) (cond ((eq msg-prop 'datestamp) - (when erc-fill--wrap-last-msg - (set-marker erc-fill--wrap-last-msg (point-min))) (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bcb9b4aafef..d1ee1da994d 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -202,7 +202,8 @@ from entering them and instead jump over them." (when-let ((priors (or erc--server-reconnecting erc--target-priors))) (dolist (var '(erc-timestamp-last-inserted erc-timestamp-last-inserted-left - erc-timestamp-last-inserted-right)) + erc-timestamp-last-inserted-right + erc-stamp--date-stamps)) (when-let (existing (alist-get var priors)) (set var existing))))) @@ -652,7 +653,7 @@ printed just after each line's text (no alignment)." (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) (defvar erc-stamp--insert-date-hook nil - "Functions appended to send and modify hooks when inserting date stamp.") + "Hook run when inserting a date stamp.") (defvar-local erc-stamp--date-format-end nil "Tristate value indicating how and whether date stamps have been set up. @@ -661,9 +662,27 @@ stamps. An integer marks the `substring' TO parameter for truncating `erc-timestamp-format-left' prior to rendering. A value of t means the option's value doesn't require trimming.") -(defun erc-stamp--propertize-left-date-stamp () +;; This struct and its namesake variable exist to assist in testing. +(cl-defstruct erc-stamp--date + "Data relevant to life cycle of date-stamp insertion." + ( ts (error "Missing `ts' field") :type (or cons integer) + :documentation "Time recorded by `erc-insert-timestamp-left-and-right'.") + ( str (error "Missing `str' field") :type string + :documentation "Stamp rendered by `erc-insert-timestamp-left-and-right'.") + ( fn nil :type (or null function) + :documentation "Deferred insertion function created by post-modify hook.") + ( marker (make-marker) :type marker + :documentation "Insertion marker.")) + +(defvar-local erc-stamp--deferred-date-stamp nil + "Active `erc-stamp--date' instance. +Non-nil between insertion-modification and \"done\" (or timer) hook.") + +(defvar-local erc-stamp--date-stamps nil + "List of stamps in the current buffer.") + +(defun erc-stamp--propertize-left-date-stamp (&rest _) (add-text-properties (point-min) (1- (point-max)) '(field erc-timestamp)) - (erc--hide-message 'timestamp) (run-hooks 'erc-stamp--insert-date-hook)) (defun erc-stamp--format-date-stamp (ct) @@ -680,6 +699,16 @@ value of t means the option's value doesn't require trimming.") 0 erc-stamp--date-format-end) erc-timestamp-format-left)))) +(defun erc-stamp--find-insertion-point (p target-time) + "Scan buffer backwards from P looking for TARGET-TIME. +Return P or, if found, a position less than P." + (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (qq (erc--get-inserted-msg-beg q)) + (ts (get-text-property qq 'erc--ts)) + ((not (time-less-p ts target-time)))) + (setq p qq)) + p) + (defun erc-stamp-inserting-date-stamp-p () "Return non-nil if the narrowed buffer contains a date stamp. Expect to be called by members of `erc-insert-modify-hook' and @@ -687,75 +716,77 @@ Expect to be called by members of `erc-insert-modify-hook' and inserted is a date stamp." (erc--check-msg-prop 'erc--msg 'datestamp)) -;; Calling `erc-display-message' from within a hook it's currently -;; running is roundabout, but it's a definite means of ensuring hooks -;; can act on the date stamp as a standalone message to do things like -;; adjust invisibility props. -(defun erc-stamp--insert-date-stamp-as-phony-message (string) - (cl-assert (string-empty-p string)) - (setq string erc-timestamp-last-inserted-left) - (let ((erc-stamp--skip t) - (erc-insert-modify-hook `(,@erc-insert-modify-hook - erc-stamp--propertize-left-date-stamp)) - (erc--insert-line-function #'insert-before-markers) - ;; Don't run hooks that aren't expecting a narrowed buffer. - (erc-insert-pre-hook nil) - (erc-insert-done-hook nil)) - (erc-display-message nil nil (current-buffer) string))) - -(defun erc-stamp--lr-date-on-pre-modify (_) - (when-let (((not erc-stamp--skip)) - (ct (erc-stamp--current-time)) - (rendered (erc-stamp--format-date-stamp ct)) - ((not (string-equal rendered erc-timestamp-last-inserted-left))) - (erc-insert-timestamp-function - #'erc-stamp--insert-date-stamp-as-phony-message)) - (save-excursion - (save-restriction - (narrow-to-region (or erc--insert-marker erc-insert-marker) - (or erc--insert-marker erc-insert-marker)) - ;; Ensure all hooks, like `erc-stamp--insert-date-hook', only - ;; see the let-bound value below during `erc-add-timestamp'. - (setq erc-timestamp-last-inserted-left nil) - (let* ((aligned (erc-stamp--time-as-day ct)) - (erc-stamp--current-time aligned) - ;; Forget current `erc--cmd', etc. - (erc--msg-props (map-into `((erc--msg . datestamp)) - 'hash-table)) - (erc-timestamp-last-inserted-left rendered) - erc-timestamp-format erc-away-timestamp-format) - (erc-add-timestamp)) - (setq erc-timestamp-last-inserted-left rendered))))) - -;; This minor mode is just a placeholder and currently unhelpful for -;; managing complexity. A useful version would leave a marker during -;; post-modify hooks and then perform insertions (before markers) -;; during "done" hooks. This would enable completely decoupling from -;; and possibly deprecating `erc-insert-timestamp-left-and-right'. -;; However, doing this would require expanding the internal API to -;; include insertion and deletion handlers for twiddling and massaging -;; text properties based on context immediately after modifying text -;; earlier in a buffer (away from `erc-insert-marker'). Without such -;; handlers, things like "merged" `fill-wrap' speakers and invisible -;; messages may be damaged by buffer modifications. +(defun erc-stamp--defer-date-insertion-on-post-modify (hook-var) + "Schedule a date stamp to be inserted via HOOK-VAR. +Do so when `erc-stamp--deferred-date-stamp' and its `fn' slot are +non-nil." + (when-let ((data erc-stamp--deferred-date-stamp) + ((null (erc-stamp--date-fn data))) + (ct (erc-stamp--date-ts data)) + (rendered (erc-stamp--date-str data)) + (buffer (current-buffer)) + (symbol (make-symbol "erc-stamp--insert-date")) + (marker (setf (erc-stamp--date-marker data) (point-min-marker)))) + (setf (erc-stamp--date-fn data) symbol) + (fset symbol + (lambda (&rest _) + (remove-hook hook-var symbol) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (setq erc-stamp--date-stamps + (cl-sort (cons data erc-stamp--date-stamps) #'time-less-p + :key #'erc-stamp--date-ts)) + (setq erc-stamp--deferred-date-stamp nil) + (let* ((aligned (erc-stamp--time-as-day ct)) + (erc-stamp--current-time aligned) + (erc--msg-props (map-into '((erc--msg . datestamp)) + 'hash-table)) + (erc-insert-post-hook + `(,(lambda () + (set-marker marker (point-min)) + (set-marker-insertion-type marker t) + (erc--hide-message 'timestamp)) + ,@erc-insert-post-hook)) + (erc-insert-timestamp-function + #'erc-stamp--propertize-left-date-stamp) + (pos (erc-stamp--find-insertion-point marker aligned)) + ;; + erc-timestamp-format erc-away-timestamp-format) + (erc--with-spliced-insertion pos + (erc-display-message nil nil (current-buffer) rendered)) + (setf (erc-stamp--date-ts data) aligned)) + (setq erc-timestamp-last-inserted-left rendered))))) + (add-hook hook-var symbol -90))) + +(defun erc-stamp--defer-date-insertion-on-post-insert () + (erc-stamp--defer-date-insertion-on-post-modify 'erc-timer-hook)) + +(defun erc-stamp--defer-date-insertion-on-post-send () + (erc-stamp--defer-date-insertion-on-post-modify 'erc-send-completed-hook)) + +;; This minor mode is hopefully just a placeholder because it's quite +;; unhelpful for managing complexity. A useful version would exist as +;; a standalone module to allow completely decoupling from and +;; possibly deprecating `erc-insert-timestamp-left-and-right'. (define-minor-mode erc-stamp--date-mode "Insert date stamps as standalone messages." :interactive nil (if erc-stamp--date-mode - (progn (add-hook 'erc-insert-pre-hook - #'erc-stamp--lr-date-on-pre-modify 10 t) - (add-hook 'erc-pre-send-functions - #'erc-stamp--lr-date-on-pre-modify 10 t)) + (progn + (add-hook 'erc-insert-post-hook + #'erc-stamp--defer-date-insertion-on-post-insert 0 t) + (add-hook 'erc-send-post-hook + #'erc-stamp--defer-date-insertion-on-post-send 0 t)) (kill-local-variable 'erc-timestamp-last-inserted-left) - (remove-hook 'erc-insert-pre-hook - #'erc-stamp--lr-date-on-pre-modify t) - (remove-hook 'erc-pre-send-functions - #'erc-stamp--lr-date-on-pre-modify t))) + (remove-hook 'erc-insert-post-hook + #'erc-stamp--defer-date-insertion-on-post-insert t) + (remove-hook 'erc-send-post-hook + #'erc-stamp--defer-date-insertion-on-post-send t))) (defvar erc-stamp-prepend-date-stamps-p nil "When non-nil, date stamps are not independent messages. -This flag restores pre-5.6 behavior in which date stamps formed -the leading portion of affected messages. Beware that enabling +This flag restores pre-5.6 behavior in which date stamps were +prepended to normal chat messages. Beware that enabling this degrades the user experience by causing 5.6+ features, like `fill-wrap', dynamic invisibility, etc., to malfunction. When non-nil, none of the newline twiddling mentioned in the doc @@ -775,26 +806,17 @@ in the latter (if any) as part of the `erc-timestamp' field. Allow the stamp's `invisible' property to span that same interval but also cover the previous newline, in order to satisfy folding requirements related to `erc-legacy-invisible-bounds-p'. -Additionally, ensure every date stamp is identifiable as such so -that internal modules can easily distinguish between other -left-sided stamps and date stamps inserted by this function." +Additionally, ensure every date stamp is identifiable as such via +the function `erc-stamp-inserting-date-stamp-p' so that internal +modules can easily distinguish between other left-sided stamps +and date stamps inserted by this function." (unless (or erc-stamp--date-format-end erc-stamp-prepend-date-stamps-p (and (or (null erc-timestamp-format-left) (string-empty-p ; compat (string-trim erc-timestamp-format-left "\n"))) (always (erc-stamp--date-mode -1)) (setq erc-stamp-prepend-date-stamps-p t))) - (erc-stamp--date-mode +1) - ;; Hooks used by ^ are the preferred means of inserting date - ;; stamps. But they'll never see this inaugural message, so it - ;; must be handled specially. - (let ((erc--insert-marker (point-min-marker)) - (end-marker (point-max-marker))) - (set-marker-insertion-type erc--insert-marker t) - (erc-stamp--lr-date-on-pre-modify nil) - (narrow-to-region erc--insert-marker end-marker) - (set-marker end-marker nil) - (set-marker erc--insert-marker nil))) + (erc-stamp--date-mode +1)) (let* ((ct (erc-stamp--current-time)) (ts-right (with-suppressed-warnings ((obsolete erc-timestamp-format-right)) @@ -805,12 +827,22 @@ left-sided stamps and date stamps inserted by this function." ;; "prepended" date stamps as well. However, since this is a ;; compatibility oriented code path, and pre-5.6 did no such ;; thing, better to punt. - (when-let ((erc-stamp-prepend-date-stamps-p) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) - ((not (string= ts-left erc-timestamp-last-inserted-left)))) - (goto-char (point-min)) - (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) - (insert (setq erc-timestamp-last-inserted-left ts-left))) + (if-let ((erc-stamp-prepend-date-stamps-p) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + ((not (string= ts-left erc-timestamp-last-inserted-left)))) + (progn + (goto-char (point-min)) + (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp + ts-left) + (insert (setq erc-timestamp-last-inserted-left ts-left))) + (when-let + (((null erc-stamp--deferred-date-stamp)) + (rendered (erc-stamp--format-date-stamp ct)) + ((not (string-equal rendered erc-timestamp-last-inserted-left))) + ((null (cl-find rendered erc-stamp--date-stamps + :test #'string= :key #'erc-stamp--date-str)))) + (setq erc-stamp--deferred-date-stamp + (make-erc-stamp--date :ts ct :str rendered)))) ;; insert right timestamp (let ((erc-timestamp-only-if-changed-flag t) (erc-timestamp-last-inserted erc-timestamp-last-inserted-right)) @@ -924,6 +956,8 @@ For `erc-hide-timestamps, modify `buffer-invisibility-spec'." (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) (kill-local-variable 'erc-timestamp-last-inserted-right) + (kill-local-variable 'erc-stamp--deferred-date-stamp) + (kill-local-variable 'erc-stamp--date-stamps) (kill-local-variable 'erc-stamp--date-format-end))) (defun erc-hide-timestamps () @@ -992,7 +1026,12 @@ with the option `erc-echo-timestamps', see the companion option (move-marker erc-last-saved-position (1- (point-max)))) (defun erc-stamp--reset-on-clear (pos) - "Forget last-inserted stamps when POS is at insert marker." + "Forget last-inserted stamps when POS is at insert marker. +And discard stale references in `erc-stamp--date-stamps'." + (when erc-stamp--date-stamps + (setq erc-stamp--date-stamps + (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos)) + erc-stamp--date-stamps))) (when (= pos (1- erc-insert-marker)) (when erc-stamp--date-mode (add-hook 'erc-stamp--insert-date-hook diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4ed77655f19..84e3ac4bede 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -186,6 +186,10 @@ as of ERC 5.6: hooks that the current message should not affect stateful operations, such as recording a channel's most recent speaker + - `erc--hide': a symbol or list of symbols added as an `invisible' + prop value to the entire message, starting *before* the preceding + newline and ending before the trailing newline + This is an internal API, and the selection of related helper utilities is fluid and provisional. As of ERC 5.6, see the functions `erc--check-msg-prop' and `erc--get-inserted-msg-prop'.") @@ -3278,14 +3282,36 @@ if not found." (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) (get-text-property stack-pos prop))) -(defmacro erc--with-inserted-msg (&rest body) - "Simulate narrowing performed for send and insert hooks, and run BODY. -Expect callers to know that this doesn't wrap BODY in -`with-silent-modifications' or bind a temporary `erc--msg-props'." - `(when-let ((bounds (erc--get-inserted-msg-bounds))) - (save-restriction - (narrow-to-region (car bounds) (1+ (cdr bounds))) - ,@body))) +;; FIXME improve this nascent "message splicing" facility to include a +;; means for modules to adjust inserted messages on either side of the +;; splice position as well as to modify the spliced-in message itself +;; before and after each insertion-related hook runs. Also add a +;; counterpart to `erc--with-spliced-insertion' for deletions. +(defvar erc--insert-line-splice-function + #'erc--insert-before-markers-transplanting-hidden + "Function to handle in-place insertions away from prompt. +Modules that display \"stateful\" messages, where one message's content +depends on prior messages, should advise this locally as needed.") + +(defmacro erc--with-spliced-insertion (marker-or-pos &rest body) + "In BODY, ensure `erc-insert-line' inserts messages at MARKER-OR-POS. +If MARKER-OR-POS is a marker, let it advance normally (and permanently) +with each insertion. Allow modules to influence insertion by binding +`erc--insert-line-function' to `erc--insert-line-splice-function' around +BODY. Note that as of ERC 5.6, this macro cannot handle multiple +successive calls to `erc-insert-line' in BODY, such as when replaying +a history backlog." + (declare (indent 1)) + (let ((marker (make-symbol "marker"))) + `(progn + (cl-assert (= ?\n (char-before ,marker-or-pos))) + (cl-assert (null erc--insert-line-function)) + (let* ((,marker (and (not (markerp ,marker-or-pos)) + (copy-marker ,marker-or-pos))) + (erc--insert-marker (or ,marker ,marker-or-pos)) + (erc--insert-line-function erc--insert-line-splice-function)) + (prog1 (progn ,@body) + (when ,marker (set-marker ,marker nil))))))) (defun erc--traverse-inserted (beg end fn) "Visit messages between BEG and END and run FN in narrowed buffer. @@ -3325,7 +3351,11 @@ that this flag and the behavior it restores may disappear at any time, so if you need them, please let ERC know with \\[erc-bug].") (defvar erc--insert-line-function nil - "When non-nil, an alterntive to `insert' for inserting messages.") + "When non-nil, an `insert'-like function for inserting messages. +Modules, like `fill-wrap', that leave a marker at the beginning of an +inserted message clearly want that marker to advance along with text +inserted at that position. This can be addressed by binding this +variable to `insert-before-markers' around calls to `display-message'.") (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") @@ -3509,7 +3539,7 @@ also `erc-button-add-face'." end (next-single-property-change pos prop object to))))) (defun erc--remove-from-prop-value-list (from to prop val &optional object) - "Remove VAL from text prop value between FROM and TO. + "Remove VAL from text PROP value between FROM and TO. If current value is VAL itself, remove the property entirely. When VAL is a list, act as if this function were called repeatedly with VAL set to each of VAL's members." @@ -3573,19 +3603,45 @@ preceding newline to its last non-newline character.") (make-obsolete-variable 'erc-legacy-invisible-bounds-p "decremented interval now permanent" "30.1") +(defun erc--insert-before-markers-transplanting-hidden (string) + "Insert STRING before markers and migrate any `invisible' props. +Expect to be called with `point' at the start of an inserted message, +i.e., one with an `erc--msg' property. Check the message prop header +for invisibility props advertised via `erc--hide'. When found, remove +them from the previous newline, and add them to the newline suffixing +the inserted version of STRING." + (let* ((after (and (not erc-legacy-invisible-bounds-p) + (get-text-property (point) 'erc--hide))) + (before (and after (get-text-property (1- (point)) 'invisible))) + (a (and after (ensure-list after))) + (b (and before (ensure-list before))) + (new (and before (erc--solo (cl-intersection b a))))) + (when new + (erc--remove-from-prop-value-list (1- (point)) (point) 'invisible a)) + (prog1 (insert-before-markers string) + (when new + (erc--merge-prop (1- (point)) (point) 'invisible new))))) + (defun erc--hide-message (value) "Apply `invisible' text-property with VALUE to current message. Expect to run in a narrowed buffer during message insertion. Begin the invisible interval at the previous message's trailing newline and end before the current message's. If the preceding message ends in a double newline or there is no previous message, -don't bother including the preceding newline." +don't bother including the preceding newline. Additionally, +record VALUE as part of the `erc--hide' property in the +\"msg-props\" header." (if erc-legacy-invisible-bounds-p ;; Before ERC 5.6, this also used to add an `intangible' ;; property, but the docs say it's now obsolete. (erc--merge-prop (point-min) (point-max) 'invisible value) - (let ((beg (point-min)) + (let ((old-hide (erc--check-msg-prop 'erc--hide)) + (beg (point-min)) (end (point-max))) + (puthash 'erc--hide (if old-hide + `(,value . ,(ensure-list old-hide)) + value) + erc--msg-props) (save-restriction (widen) (when (or (<= beg 4) (= ?\n (char-before (- beg 2)))) @@ -3604,9 +3660,11 @@ Treat ARG in a manner similar to mode toggles defined by (when (or (not arg) (natnump arg)) (add-to-invisibility-spec prop)))) -(defun erc--delete-inserted-message (beg-or-point &optional end) +(defun erc--delete-inserted-message-naively (beg-or-point &optional end) "Remove message between BEG and END. -Expect BEG and END to match bounds as returned by the macro +Do this without updating messages on either side even if their +appearance was somehow influenced by the newly absent message. +Expect BEG and END to match bounds as returned by the function `erc--get-inserted-msg-bounds'. Ensure all markers residing at the start of the deleted message end up at the beginning of the subsequent message." @@ -3626,7 +3684,7 @@ subsequent message." -1)))))))) (defvar erc--ranked-properties - '(erc--msg erc--spkr erc--ts erc--cmd erc--ctcp erc--ephemeral)) + '(erc--msg erc--spkr erc--ts erc--cmd erc--hide erc--ctcp erc--ephemeral)) (defun erc--order-text-properties-from-hash (table) "Return a plist of text props from items in TABLE. diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 603b3745a27..9d8fb0081c5 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -74,9 +74,11 @@ (entry (list (rx "+1") 0 func #'ignore 0)) (erc-button-alist (cons entry erc-button-alist))) - (erc-display-message nil 'notice (current-buffer) "Foo bar baz") - (erc-display-message nil nil (current-buffer) "+1") - (erc-display-message nil 'notice (current-buffer) "Spam") + (erc-tests-common-display-message nil 'notice (current-buffer) + "Foo bar baz") + (erc-tests-common-display-message nil nil (current-buffer) "+1") + (erc-tests-common-display-message nil 'notice (current-buffer) "Spam") + (should (equal (pop erc-button-tests--form) '(53 55 ignore nil ("+1") "\\+1"))) (should-not erc-button-tests--form) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 79cfc1190bc..f8bfc362085 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -48,7 +48,7 @@ :command "PRIVMSG" :command-args (list "#chan" msg) :contents msg))) - (erc-display-message parsed nil (current-buffer) msg))) + (erc-tests-common-display-message parsed nil (current-buffer) msg))) (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) @@ -79,7 +79,7 @@ (erc-update-channel-member "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) - (erc-display-message + (erc-tests-common-display-message nil 'notice (current-buffer) (concat "This server is in debug mode and is logging all user I/O. " "If you do not wish for everything you send to be readable " @@ -260,29 +260,31 @@ (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "bob" "0.5") - (erc-process-ctcp-query - erc-server-process - (make-erc-response - :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1" - :sender "bob!~u@fake" - :command "PRIVMSG" - :command-args '("#chan" "\1ACTION one.\1") - :contents "\1ACTION one.\1") - "bob" "~u" "fake") + (erc-tests-common-with-date-aware-display-message + (erc-process-ctcp-query + erc-server-process + (make-erc-response + :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one.\1" + :sender "bob!~u@fake" + :command "PRIVMSG" + :command-args '("#chan" "\1ACTION one.\1") + :contents "\1ACTION one.\1") + "bob" "~u" "fake")) (erc-fill-tests--insert-privmsg "bob" "two.") (erc-fill-tests--insert-privmsg "bob" "2.5") ;; Compat switch to opt out of overhanging speaker. - (let (erc-fill--wrap-action-dedent-p) - (erc-process-ctcp-query - erc-server-process - (make-erc-response - :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1" - :sender "bob!~u@fake" :command "PRIVMSG" - :command-args '("#chan" "\1ACTION three\1") - :contents "\1ACTION three\1") - "bob" "~u" "fake")) + (erc-tests-common-with-date-aware-display-message + (let (erc-fill--wrap-action-dedent-p) + (erc-process-ctcp-query + erc-server-process + (make-erc-response + :unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1" + :sender "bob!~u@fake" :command "PRIVMSG" + :command-args '("#chan" "\1ACTION three\1") + :contents "\1ACTION three\1") + "bob" "~u" "fake"))) (erc-fill-tests--insert-privmsg "bob" "four.")) @@ -312,8 +314,10 @@ (erc-fill-tests--wrap-populate (lambda () (erc-fill-tests--insert-privmsg "bob" "This buffer is for text.") - (erc-display-message nil 'notice (current-buffer) "one two three") - (erc-display-message nil 'notice (current-buffer) "four five six") + (erc-tests-common-display-message nil 'notice + (current-buffer) "one two three") + (erc-tests-common-display-message nil 'notice + (current-buffer) "four five six") (erc-fill-tests--insert-privmsg "bob" "Somebody stop me") (erc-fill-tests--compare "spacing-01-mono"))))) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 22e34a8efe8..8600af800f1 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -71,7 +71,8 @@ ;; (defun erc-scenarios-match--invisible-stamp (hiddenp visiblep) (unless noninteractive - (kill-new "erc-match-toggle-hidden-fools")) + (push "erc-match-toggle-hidden-fools" extended-command-history) + (push "erc-toggle-timestamps" extended-command-history)) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "join/legacy") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 22432a68034..cc681384e9c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1927,7 +1927,48 @@ (lambda (arg) (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) -(ert-deftest erc--delete-inserted-message () +(ert-deftest erc--insert-before-markers-transplanting-hidden () + (with-current-buffer (get-buffer-create "*erc-test*") + (erc-mode) + (erc-tests-common-prep-for-insertion) + + ;; Create a message that has a foreign invisibility property on + ;; its trailing newline that's not claimed by the next message. + (let ((erc-insert-post-hook + (lambda () + (put-text-property (point-min) (point-max) 'invisible 'b)))) + (erc-display-message nil 'notice (current-buffer) "before")) + (should (eq 'b (get-text-property (1- erc-insert-marker) 'invisible))) + + ;; Insert a message that's hidden with `erc--hide-message'. It + ;; advertises `invisible' value `a', applied on the trailing + ;; newline of the previous message. + (let ((erc-insert-post-hook (lambda () (erc--hide-message 'a)))) + (erc-display-message nil 'notice (current-buffer) "after")) + + (goto-char (point-min)) + (should (search-forward "*** before\n" nil t)) + (should (equal '(a b) (get-text-property (1- (point)) 'invisible))) + + ;; Splice in a new message. + (let ((erc--insert-line-function + #'erc--insert-before-markers-transplanting-hidden) + (erc--insert-marker (copy-marker (point)))) + (goto-char (point-max)) + (erc-display-message nil 'notice (current-buffer) "middle")) + + (goto-char (point-min)) + (should (search-forward "*** before\n" nil t)) + (should (eq 'b (get-text-property (1- (point)) 'invisible))) + (should (looking-at (rx "*** middle\n"))) + (should (eq 'a (get-text-property (pos-eol) 'invisible))) + (forward-line) + (should (looking-at (rx "*** after\n"))) + + (setq buffer-invisibility-spec nil) + (when noninteractive (kill-buffer)))) + +(ert-deftest erc--delete-inserted-message-naively () (erc-mode) (erc--initialize-markers (point) nil) ;; Put unique invisible properties on the line endings. @@ -1945,7 +1986,7 @@ (should (eq 'datestamp (get-text-property (point) 'erc--msg))) (should (eq (point) (field-beginning (1+ (point))))) - (erc--delete-inserted-message (point)) + (erc--delete-inserted-message-naively (point)) ;; Preceding line ending clobbered, replaced by trailing. (should (looking-back (rx "*** one\n"))) @@ -1961,7 +2002,7 @@ (p (point))) (set-marker-insertion-type m t) (goto-char (point-max)) - (erc--delete-inserted-message p) + (erc--delete-inserted-message-naively p) (should (= (marker-position n) p)) (should (= (marker-position m) p)) (goto-char p) @@ -1975,7 +2016,7 @@ (should (looking-at (rx "*** three\n"))) (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p)) (let ((erc-legacy-invisible-bounds-p t)) - (erc--delete-inserted-message (point)))) + (erc--delete-inserted-message-naively (point)))) (should (looking-at (rx "*** four\n")))) (ert-info ("Deleting most recent message preserves markers") @@ -1985,7 +2026,7 @@ (should (equal "*** four\n" (buffer-substring p erc-insert-marker))) (set-marker-insertion-type m t) (goto-char (point-max)) - (erc--delete-inserted-message p) + (erc--delete-inserted-message-naively p) (should (= (marker-position m) p)) (should (= (marker-position n) p)) (goto-char p) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 9ad5ce49429..c7d5c9d6677 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -194,6 +194,7 @@ Dialog resource directories are located by expanding the variable (ert-info ("Running extra teardown") (funcall erc-scenarios-common-extra-teardown))) + (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) (when (and (boundp 'erc-autojoin-mode) (not (eq erc-autojoin-mode ,orig-autojoin-mode))) (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) @@ -325,6 +326,12 @@ See Info node `(emacs) Term Mode' for the various commands." erc-scenarios-common-interactive-debug-term-p)) (erc-scenarios-common-with-cleanup ,@body))) +(defun erc-scenarios-common--assert-date-stamps () + "Ensure all date stamps are accounted for." + (dolist (stamp erc-stamp--date-stamps) + (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp) + 'erc--msg))))) + (defun erc-scenarios-common-assert-initial-buf-name (id port) ;; Assert no limbo period when explicit ID given (should (string= (if id diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 99f15b89b03..2ec32db77cd 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -39,7 +39,7 @@ ;;; Code: (require 'ert-x) (require 'erc) - +(eval-when-compile (require 'erc-stamp)) (defmacro erc-tests-common-equal-with-props (a b) "Compare strings A and B for equality including text props. @@ -196,6 +196,25 @@ For simplicity, assume string evaluates to itself." (erc-readonly-mode +1) (funcall assert-fn test-fn))) +(defun erc-tests--common-display-message (orig &rest args) + (require 'erc-stamp) + (defvar erc-stamp--deferred-date-stamp) + (let (erc-stamp--deferred-date-stamp) + (prog1 (apply orig args) + (when-let ((inst erc-stamp--deferred-date-stamp) + (fn (erc-stamp--date-fn inst))) + (funcall fn))))) + +(defun erc-tests-common-display-message (&rest args) + (apply #'erc-tests--common-display-message #'erc-display-message args)) + +(defmacro erc-tests-common-with-date-aware-display-message (&rest body) + `(progn + (advice-add 'erc-display-message + :around #'erc-tests--common-display-message) + (unwind-protect (progn ,@body) + (advice-remove 'erc-display-message + #'erc-tests--common-display-message)))) ;;;; Buffer snapshots @@ -223,12 +242,19 @@ string." (print-escape-nonascii t) (got (erc--remove-text-properties (buffer-substring (point-min) erc-insert-marker))) - (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))) + (repr (funcall (or trans-fn #'identity) (prin1-to-string got))) + (xstr (read (with-temp-buffer + (insert-file-contents-literally expect-file) + (buffer-string))))) (with-current-buffer (generate-new-buffer name) (with-silent-modifications (insert (setq got (read repr)))) (when buf-init-fn (funcall buf-init-fn)) (erc-mode)) + (unless noninteractive + (with-current-buffer (generate-new-buffer (format "%s-xpt" name)) + (insert xstr) + (erc-mode))) ;; LHS is a string, RHS is a symbol. (if (string= erc-tests-common-snapshot-save-p (ert-test-name (ert-running-test))) @@ -242,9 +268,7 @@ string." ;; recursive (signals `max-lisp-eval-depth' exceeded). (named-let assert-equal ((latest (read repr)) - (expect (read (with-temp-buffer - (insert-file-contents-literally expect-file) - (buffer-string))))) + (expect xstr)) (pcase latest ((or "" 'nil) t) ((pred stringp) From 6000e48e0d7d5742ba817942f1b0dbbda9315ddc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 18 Apr 2024 22:18:57 -0700 Subject: [PATCH 111/149] Add erc--skip message property * lisp/erc/erc-backend.el (erc-server-connect): Add `erc--skip' property to `erc--msg-prop-overrides' so that timestamps only show up with the first server-sent message. (erc-server-PRIVMSG): Move `erc--msg-prop-overrides' declaration to top-level. * lisp/erc/erc-button.el (erc-button--display-error-notice-with-keys): Use `erc--skip' msg prop instead of `erc-stamp--skip' variable. * lisp/erc/erc-stamp.el (erc-stamp--skip): Remove variable. (erc-stamp--allow-unmanaged, erc-stamp--allow-unmanaged-p): Rename former to latter to remain consistent with convention used by other quasi-internal compatibility-related switches. (erc-add-timestamp): Check `erc--skip' property instead of deleted variable `erc-stamp--skip'. * lisp/erc/erc.el (erc--msg-props): Mention `erc--skip' in doc. (erc--check-msg-prop): Doc. (erc--memq-msg-prop): New function. (erc--ranked-properties): Add `erc--skip'. * test/lisp/erc/erc-scenarios-stamp.el (erc-scenarios-stamp--legacy-date-stamps): Revise to expect "opening connection.." to appear above first stamp. * test/lisp/erc/erc-tests.el (erc--memq-msg-prop): New test. (Bug#60936) --- lisp/erc/erc-backend.el | 5 +++-- lisp/erc/erc-button.el | 9 +++++---- lisp/erc/erc-stamp.el | 10 ++++------ lisp/erc/erc.el | 19 +++++++++++++++---- test/lisp/erc/erc-scenarios-stamp.el | 8 +++++--- test/lisp/erc/erc-tests.el | 7 +++++++ 6 files changed, 39 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ea5ea0928e0..ab419d2b018 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,6 +102,7 @@ (require 'erc-common) (defvar erc--display-context) +(defvar erc--msg-prop-overrides) (defvar erc--target) (defvar erc-channel-list) (defvar erc-channel-members) @@ -787,7 +788,8 @@ TLS (see `erc-session-client-certificate' for more details)." ;; MOTD line) (if (eq (process-status process) 'connect) ;; waiting for a non-blocking connect - keep the user informed - (progn + (let ((erc--msg-prop-overrides `((erc--skip . (stamp)) + ,@erc--msg-prop-overrides))) (erc-display-message nil nil buffer "Opening connection..\n") (run-at-time 1 nil erc--server-connect-function process)) (message "%s...done" msg) @@ -1994,7 +1996,6 @@ like `erc-insert-modify-hook'.") (and erc-ignore-reply-list (erc-ignored-reply-p msg tgt proc))) (when erc-minibuffer-ignored (message "Ignored %s from %s to %s" cmd sender-spec tgt)) - (defvar erc--msg-prop-overrides) (let* ((sndr (erc-parse-user sender-spec)) (nick (nth 0 sndr)) (login (nth 1 sndr)) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 4b4930e5bff..1f9d6fd64c0 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -830,7 +830,6 @@ argument when calling `erc-display-message'. Otherwise, add it to STRINGS. If STRINGS contains any trailing non-nil non-strings, concatenate leading string members before applying `format'. Otherwise, just concatenate everything." - (defvar erc-stamp--skip) (let* ((buffer (if (bufferp maybe-buffer) maybe-buffer (when (stringp maybe-buffer) @@ -847,9 +846,11 @@ non-strings, concatenate leading string members before applying #'format)) (string (apply op strings)) ;; Avoid timestamps unless left-sided. - (erc-stamp--skip (or (bound-and-true-p erc-stamp--display-margin-mode) - (not (fboundp 'erc-timestamp-offset)) - (zerop (erc-timestamp-offset)))) + (skipp (or (bound-and-true-p erc-stamp--display-margin-mode) + (not (fboundp 'erc-timestamp-offset)) + (zerop (erc-timestamp-offset)))) + (erc--msg-prop-overrides `(,@(and skipp `((erc--skip stamp))) + ,@erc--msg-prop-overrides)) (erc-insert-post-hook (cons (lambda () (setq string (buffer-substring (point-min) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d1ee1da994d..77981bc9d07 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -220,10 +220,7 @@ This becomes the message's `erc--ts' text property." (cl-defmethod erc-stamp--current-time :around () (or erc-stamp--current-time (cl-call-next-method))) -(defvar erc-stamp--skip nil - "Non-nil means inhibit `erc-add-timestamp' completely.") - -(defvar erc-stamp--allow-unmanaged nil +(defvar erc-stamp--allow-unmanaged-p nil "Non-nil means run `erc-add-timestamp' almost unconditionally. This is an unofficial escape hatch for code wanting to use lower-level message-insertion functions, like `erc-insert-line', @@ -243,8 +240,9 @@ known via \\[erc-bug].") This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (or erc-stamp--skip (and (not erc-stamp--allow-unmanaged) - (null erc--msg-props))) + (unless (and (not erc-stamp--allow-unmanaged-p) + (or (null erc--msg-props) + (erc--memq-msg-prop 'erc--skip 'stamp))) (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) (erc-stamp--invisible-property diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 84e3ac4bede..de203a2137f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -181,6 +181,9 @@ as of ERC 5.6: 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\" type otherwise; managed by the `stamp' module + - `erc--skip': list of symbols known to modules that indicate an + intent to skip or simplify module-specific processing + - `erc--ephemeral': a symbol prefixed by or matching a module name; indicates to other modules and members of modification hooks that the current message should not affect stateful @@ -3234,13 +3237,20 @@ a full refresh." (defun erc--check-msg-prop (prop &optional val) "Return PROP's value in `erc--msg-props' when populated. -If VAL is a list, return non-nil if PROP appears in VAL. If VAL -is otherwise non-nil, return non-nil if VAL compares `eq' to the -stored value. Otherwise, return the stored value." +If VAL is a list, return non-nil if PROP's value appears in VAL. If VAL +is otherwise non-nil, return non-nil if VAL compares `eq' to the stored +value. Otherwise, return the stored value." (and-let* ((erc--msg-props) (v (gethash prop erc--msg-props))) (if (consp val) (memq v val) (if val (eq v val) v)))) +(defun erc--memq-msg-prop (prop needle) + "Return non-nil if msg PROP's value is a list containing NEEDLE." + (and-let* ((erc--msg-props) + (haystack (gethash prop erc--msg-props)) + ((consp haystack))) + (memq needle haystack))) + (defmacro erc--get-inserted-msg-beg-at (point at-start-p) (macroexp-let2* nil ((point point) (at-start-p at-start-p)) @@ -3684,7 +3694,8 @@ subsequent message." -1)))))))) (defvar erc--ranked-properties - '(erc--msg erc--spkr erc--ts erc--cmd erc--hide erc--ctcp erc--ephemeral)) + '( erc--msg erc--spkr erc--ts erc--skip + erc--cmd erc--hide erc--ctcp erc--ephemeral)) (defun erc--order-text-properties-from-hash (table) "Return a plist of text props from items in TABLE. diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index 3a10f709548..6f2fbc1b7e9 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -101,17 +101,19 @@ :port port :full-name "tester" :nick "tester") - (funcall expect 5 "Opening connection") + (funcall expect 5 "*** Welcome") (goto-char (1- (match-beginning 0))) (should (eq 'erc-timestamp (field-at-pos (point)))) - (should (eq 'unknown (erc--get-inserted-msg-prop 'erc--msg))) + (should (eq 'notice (erc--get-inserted-msg-prop 'erc--msg))) ;; Force redraw of date stamp. (setq erc-timestamp-last-inserted-left nil) (funcall expect 5 "This server is in debug mode") (while (and (zerop (forward-line -1)) (not (eq 'erc-timestamp (field-at-pos (point)))))) - (should (erc--get-inserted-msg-prop 'erc--cmd))))))) + (should (erc--get-inserted-msg-prop 'erc--cmd)) + (should-not erc-stamp--date-mode) + (should-not erc-stamp--date-stamps)))))) ;; This user-owned hook member places a marker on the first message in ;; a buffer. Inserting a date stamp in front of it shouldn't move the diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index cc681384e9c..64229887ead 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2082,6 +2082,13 @@ (let ((v '(42 y))) (should-not (erc--check-msg-prop 'b v))))) +(ert-deftest erc--memq-msg-prop () + (let ((erc--msg-props (map-into '((a . 1) (b x y)) 'hash-table))) + (should-not (erc--memq-msg-prop 'a 1)) + (should-not (erc--memq-msg-prop 'b 'z)) + (should (erc--memq-msg-prop 'b 'x)) + (should (erc--memq-msg-prop 'b 'y)))) + (ert-deftest erc--merge-prop () (with-current-buffer (get-buffer-create "*erc-test*") ;; Baseline. From 473189ab6902b0488f8001fdf993522b82740663 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 13 Apr 2024 14:58:13 -0700 Subject: [PATCH 112/149] Fix regression involving erc-query-buffer-p * lisp/erc/erc.el (erc-server-or-unjoined-channel-buffer-p): Doc. (erc-query-buffer-p): Don't return non-nil in non-ERC buffers and server buffers, and continue to honor string arguments. The regression was introduced by 3d87e343 "Use modern fallback for channel name detection in ERC". Thanks to Libera user mekeor for reporting this bug. * test/lisp/erc/erc-tests.el (erc-query-buffer-p): New test. (Bug#67220) --- lisp/erc/erc.el | 11 ++++++++--- test/lisp/erc/erc-tests.el | 29 +++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 3 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index de203a2137f..053d44d5362 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1647,7 +1647,7 @@ the process buffer." "Return non-nil if argument BUFFER is an ERC server buffer. If BUFFER is nil, use the current buffer. For historical reasons, also return non-nil for channel buffers the client has -parted or from which it's been kicked." +parted or been kicked from." (with-current-buffer (or buffer (current-buffer)) (and (eq major-mode 'erc-mode) (null (erc-default-target))))) @@ -1669,8 +1669,13 @@ If BUFFER is nil, the current buffer is used." (defun erc-query-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC query buffer. -If BUFFER is nil, the current buffer is used." - (not (erc-channel-p (or buffer (current-buffer))))) +If BUFFER is nil, use the current buffer." + (and-let* ((target (if buffer + (progn (when (stringp buffer) + (setq buffer (get-buffer buffer))) + (buffer-local-value 'erc--target buffer)) + erc--target))) + (not (erc--target-channel-p target)))) (defun erc-ison-p (nick) "Return non-nil if NICK is online." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 64229887ead..999d9f100c9 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1227,6 +1227,35 @@ (erc-tests-common-kill-buffers)) +(ert-deftest erc-query-buffer-p () + ;; Nil in a non-ERC buffer. + (should-not (erc-query-buffer-p)) + (should-not (erc-query-buffer-p (current-buffer))) + (should-not (erc-query-buffer-p (buffer-name))) + + (erc-tests-common-make-server-buf) + ;; Nil in a server buffer. + (should-not (erc-query-buffer-p)) + (should-not (erc-query-buffer-p (current-buffer))) + (should-not (erc-query-buffer-p (buffer-name))) + + ;; Nil in a channel buffer. + (with-current-buffer (erc--open-target "#chan") + (should-not (erc-query-buffer-p)) + (should-not (erc-query-buffer-p (current-buffer))) + (should-not (erc-query-buffer-p (buffer-name)))) + + ;; Non-nil in a query buffer. + (with-current-buffer (erc--open-target "alice") + (should (erc-query-buffer-p)) + (should (erc-query-buffer-p (current-buffer))) + (should (erc-query-buffer-p (buffer-name)))) + + (should (erc-query-buffer-p (get-buffer "alice"))) + (should (erc-query-buffer-p "alice")) + + (erc-tests-common-kill-buffers)) + (ert-deftest erc--valid-local-channel-p () (ert-info ("Local channels not supported") (let ((erc--isupport-params (make-hash-table))) From f90008411e827390857a4ad25e0c40fa5d27212a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 19 Apr 2024 16:21:21 -0500 Subject: [PATCH 113/149] Eglot: tweak previous change (bug#70036) * lisp/progmodes/eglot.el (eglot--TextDocumentIdentifier-uri): Rename from eglot--cached-tdi. (eglot-handle-notification): Tweak comment. Use eglot--TextDocumentIdentifier-uri. (eglot--TextDocumentIdentifier) (eglot--signal-textDocument/didOpen): Use eglot--TextDocumentIdentifier-uri. * test/lisp/progmodes/eglot-tests.el (eglot-test-basic-symlink): Address compilation warning. Tweak comment slightly. --- lisp/progmodes/eglot.el | 21 +++++++++++---------- test/lisp/progmodes/eglot-tests.el | 7 ++++--- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b78916e7f1d..3c963feeed4 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2381,7 +2381,7 @@ still unanswered LSP requests to the server\n"))) (lambda () (remhash token (eglot--progress-reporters server)))))))))) -(defvar-local eglot--cached-tdi nil +(defvar-local eglot--TextDocumentIdentifier-uri nil "A cached LSP TextDocumentIdentifier URI string.") (cl-defmethod eglot-handle-notification @@ -2396,13 +2396,13 @@ still unanswered LSP requests to the server\n"))) (mess (source code message) (concat source (and code (format " [%s]" code)) ": " message)) (find-it (uri) - ;; Search the managed buffers for a buffer with the - ;; provided diagnostic from the server. We do this to - ;; avoid calling `file-truename' too often, gaining an - ;; increase in performance. + ;; Search managed buffers with server-provided URIs since + ;; that's what we give them in the "didOpen" notification + ;; `find-buffer-visiting' would be nicer, but it calls the + ;; the potentially slow `file-truename' (bug#70036). (cl-loop for b in (eglot--managed-buffers server) when (with-current-buffer b - (equal eglot--cached-tdi uri)) + (equal eglot--TextDocumentIdentifier-uri uri)) return b))) (if-let* ((path (expand-file-name (eglot-uri-to-path uri))) (buffer (find-it uri))) @@ -2531,9 +2531,10 @@ THINGS are either registrations or unregisterations (sic)." `(:success ,success))) (defun eglot--TextDocumentIdentifier () - "Compute TextDocumentIdentifier object for current buffer." - `(:uri ,(or eglot--cached-tdi - (setq eglot--cached-tdi + "Compute TextDocumentIdentifier object for current buffer. +Sets `eglot--TextDocumentIdentifier-uri' (which see) as a side effect." + `(:uri ,(or eglot--TextDocumentIdentifier-uri + (setq eglot--TextDocumentIdentifier-uri (eglot-path-to-uri (or buffer-file-name (ignore-errors (buffer-file-name @@ -2833,7 +2834,7 @@ When called interactively, use the currently active server" "Send textDocument/didOpen to server." (setq eglot--recent-changes nil eglot--versioned-identifier 0 - eglot--cached-tdi nil) + eglot--TextDocumentIdentifier-uri nil) (jsonrpc-notify (eglot--current-server-or-lose) :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem)))) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 28579ccde5c..282e66f56a5 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -453,9 +453,10 @@ directory hierarchy." (goto-char 5) (xref-find-references "foo") (with-current-buffer (get-buffer "*xref*") - (end-of-buffer) - ;; Expect the xref buffer to not contain duplicate references to - ;; main.c and mainlink.c. If it did total lines would be 7. + (goto-char (point-max)) + ;; Expect xref buffer to not contain duplicate references to + ;; main.c and mainlink.c. If it did, total lines would be 7. + ;; FIXME: make less brittle by counting actual references. (should (= (line-number-at-pos (point)) 5))))))) (ert-deftest eglot-test-diagnostic-tags-unnecessary-code () From e5b4d4dd1bb4d568ed20cfb7354c5ff898af7a05 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Fri, 19 Apr 2024 16:26:36 -0700 Subject: [PATCH 114/149] ; Improve wording of manual entry for `peg-run' * doc/lispref/peg.texi (Parsing Expression Grammars): "lambda form" isn't really a meaningful term. Prefer plain "function", though in this case we've used "anonymous function" to avoid ambiguity. --- doc/lispref/peg.texi | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi index 72a7cacac20..b85d0de048d 100644 --- a/doc/lispref/peg.texi +++ b/doc/lispref/peg.texi @@ -78,12 +78,13 @@ of a larger grammar. At the end of parsing, one of @var{failure-function} or @var{success-function} is called, depending on whether the parsing -succeeded or not. If @var{success-function} is called, it is passed a -lambda form that runs all the actions collected on the stack during -parsing -- by default this lambda form is simply executed. If parsing -fails, the @var{failure-function} is called with a list of @acronym{PEG} -expressions that failed during parsing; by default this list is -discarded. +succeeded or not. If @var{success-function} is provided, it should be a +function that receives as its only argument an anonymous function that +runs all the actions collected on the stack during parsing. By default +this anonymous function is simply executed. If parsing fails, a +function provided as @var{failure-function} will be called with a list +of @acronym{PEG} expressions that failed during parsing. By default +this list is discarded. @end defun The @var{peg-matcher} passed to @code{peg-run} is produced by a call to From 8166d9d1747648d1f457195090ad36dd333bbc52 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 15 Apr 2024 23:13:20 -0700 Subject: [PATCH 115/149] ; Minor fix in tree-sitter manual section * doc/lispref/parsing.texi (User-defined Things): Mention treesit-defun-type-regexp. --- doc/lispref/parsing.texi | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 55ba10bb41b..5fd1eaaa57e 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1662,11 +1662,11 @@ thing, @code{treesit-end-of-thing} moves to the end of a thing, and @code{treesit-thing-at-point} returns the thing at point. There are also defun commands that specifically use the @code{defun} -definition, like @code{treesit-beginning-of-defun}, -@code{treesit-end-of-defun}, and @code{treesit-defun-at-point}. In -addition, these functions use @var{treesit-defun-tactic} as the -navigation tactic. They are described in more detail in other sections -(@pxref{Tree-sitter Major Modes}). +definition (as a fallback of @var{treesit-defun-type-regexp}), like +@code{treesit-beginning-of-defun}, @code{treesit-end-of-defun}, and +@code{treesit-defun-at-point}. In addition, these functions use +@var{treesit-defun-tactic} as the navigation tactic. They are described +in more detail in other sections (@pxref{Tree-sitter Major Modes}). @node Multiple Languages @section Parsing Text in Multiple Languages From 996b9576713f9d63ea7ff7e9630a15cb0a0214eb Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 16 Apr 2024 23:46:39 -0700 Subject: [PATCH 116/149] New function treesit-parser-changed-ranges - Add a new field last_changed_ranges to tree-sitter parser object. - Add a new function treesit-parser-changed-ranges * doc/lispref/parsing.texi (Using Parser): Add the function in tree-sitter manual. * src/treesit.c (treesit_get_changed_ranges): New function, refactored out of treesit_call_after_change_functions. (treesit_call_after_change_functions): Pull out treesit_get_changed_ranges. (treesit_ensure_parsed): Save the changed ranges to the parser object. (make_treesit_parser): Initialize the new parser field last_changed_ranges. (Ftreesit_parser_changed_ranges): New function. (Qtreesit_unparsed_edits): New error. * src/treesit.h (Lisp_TS_Parser): New field. --- doc/lispref/parsing.texi | 20 ++++++++++++++++ etc/NEWS | 3 +++ src/treesit.c | 49 ++++++++++++++++++++++++++++++++++++---- src/treesit.h | 3 +++ 4 files changed, 71 insertions(+), 4 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5fd1eaaa57e..65672997bda 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -539,6 +539,26 @@ symbol, rather than a lambda function. This function returns the list of @var{parser}'s notifier functions. @end defun +Sometimes a user might want to synchronously get the changed ranges of +the last reparse, and @code{treesit-parser-changed-ranges} is just for +it. This function basically returns the @var{ranges} that the notifier +functions were passed. + +@defun treesit-parser-changed-ranges parser &optional quiet +This function returns the ranges that has been changed since last +reparse. It returns a list of cons cells of the form +@w{@code{(@var{start} . @var{end})}}, where @var{start} and @var{end} +mark the start and the end positions of a range. + +This function should almost always be called immediately after +reparsing. If it's called when there are new buffer edits that hasn't +been reparsed, Emacs signals @code{treesit-unparsed-edits}, unless +@var{quiet} is non-nil. + +Calling this function multiple times consecutively doesn't change its +return value; it always returns the ranges affected by the last reparse. +@end defun + @node Retrieving Nodes @section Retrieving Nodes @cindex retrieve node, tree-sitter diff --git a/etc/NEWS b/etc/NEWS index 8ad1e78ca60..73daac1be3b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2538,6 +2538,9 @@ only return parsers for that language. If TAG is given, only return parsers with that tag. Note that passing nil as tag doesn't mean return all parsers, but rather "all parsers with no tags". ++++ +*** New function 'treesit-parser-changed-ranges' which returns buffer regions that are affected by the last buffer edits + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/src/treesit.c b/src/treesit.c index d86ab501187..76354361284 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -1017,9 +1017,8 @@ treesit_check_buffer_size (struct buffer *buffer) static Lisp_Object treesit_make_ranges (const TSRange *, uint32_t, struct buffer *); -static void -treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, - Lisp_Object parser) +static Lisp_Object +treesit_get_changed_ranges (TSTree *old_tree, TSTree *new_tree, Lisp_Object parser) { /* If the old_tree is NULL, meaning this is the first parse, the changed range is the whole buffer. */ @@ -1039,7 +1038,13 @@ treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, lisp_ranges = Fcons (Fcons (Fpoint_min (), Fpoint_max ()), Qnil); set_buffer_internal (oldbuf); } + return lisp_ranges; +} +static void +treesit_call_after_change_functions (Lisp_Object lisp_ranges, + Lisp_Object parser) +{ specpdl_ref count = SPECPDL_INDEX (); /* let's trust the after change functions and not clone a new ranges @@ -1091,13 +1096,17 @@ treesit_ensure_parsed (Lisp_Object parser) XTS_PARSER (parser)->tree = new_tree; XTS_PARSER (parser)->need_reparse = false; + Lisp_Object changed_ranges; + changed_ranges = treesit_get_changed_ranges (tree, new_tree, parser); + XTS_PARSER (parser)->last_changed_ranges = changed_ranges; + /* After-change functions should run at the very end, most crucially after need_reparse is set to false, this way if the function calls some tree-sitter function which invokes treesit_ensure_parsed again, it returns early and do not recursively call the after change functions again. (ref:notifier-inside-ensure-parsed) */ - treesit_call_after_change_functions (tree, new_tree, parser); + treesit_call_after_change_functions (changed_ranges, parser); ts_tree_delete (tree); } @@ -1171,6 +1180,7 @@ make_treesit_parser (Lisp_Object buffer, TSParser *parser, lisp_parser->after_change_functions = Qnil; lisp_parser->tag = tag; lisp_parser->last_set_ranges = Qnil; + lisp_parser->last_changed_ranges = Qnil; lisp_parser->buffer = buffer; lisp_parser->parser = parser; lisp_parser->tree = tree; @@ -1818,6 +1828,32 @@ positions. PARSER is the parser issuing the notification. */) return Qnil; } +DEFUN ("treesit-parser-changed-ranges", Ftreesit_parser_changed_ranges, + Streesit_parser_changed_ranges, + 1, 2, 0, + doc: /* Return the buffer regions affected by the last reparse of PARSER. + +Returns a list of cons (BEG . END), where each cons represents a region +in which the buffer content was affected by the last reparse. + +This function should almost always be called immediately after +reparsing. If it's called when there are new buffer edits that hasn't +been reparsed, Emacs signals `treesit-unparsed-edits', unless QUIET is +non-nil. + +Calling this function multiple times consecutively doesn't change its +return value; it always returns the ranges affected by the last +reparse. */) + (Lisp_Object parser, Lisp_Object quiet) +{ + treesit_check_parser (parser); + + if (XTS_PARSER (parser)->need_reparse && NILP (quiet)) + xsignal1 (Qtreesit_unparsed_edits, parser); + + return XTS_PARSER (parser)->last_changed_ranges; +} + /*** Node API */ @@ -4010,6 +4046,7 @@ syms_of_treesit (void) DEFSYM (Qtreesit_query_error, "treesit-query-error"); DEFSYM (Qtreesit_parse_error, "treesit-parse-error"); DEFSYM (Qtreesit_range_invalid, "treesit-range-invalid"); + DEFSYM (Qtreesit_unparsed_edits, "treesit-unparsed_edits"); DEFSYM (Qtreesit_buffer_too_large, "treesit-buffer-too-large"); DEFSYM (Qtreesit_load_language_error, @@ -4038,6 +4075,8 @@ syms_of_treesit (void) define_error (Qtreesit_range_invalid, "RANGES are invalid: they have to be ordered and should not overlap", Qtreesit_error); + define_error (Qtreesit_unparsed_edits, "There are unparsed edits in the buffer", + Qtreesit_error); define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GiB)", Qtreesit_error); define_error (Qtreesit_load_language_error, @@ -4178,6 +4217,8 @@ the symbol of that THING. For example, (or sexp sentence). */); defsubr (&Streesit_parser_add_notifier); defsubr (&Streesit_parser_remove_notifier); + defsubr (&Streesit_parser_changed_ranges); + defsubr (&Streesit_node_type); defsubr (&Streesit_node_start); defsubr (&Streesit_node_end); diff --git a/src/treesit.h b/src/treesit.h index bb81bf0e2b3..aa71933fe8d 100644 --- a/src/treesit.h +++ b/src/treesit.h @@ -49,6 +49,9 @@ struct Lisp_TS_Parser ranges the users wants to set, and avoid reparse if the new ranges is the same as the last set one. */ Lisp_Object last_set_ranges; + /* The range of buffer content that was affected by the last + re-parse. */ + Lisp_Object last_changed_ranges; /* The buffer associated with this parser. */ Lisp_Object buffer; /* The pointer to the tree-sitter parser. Never NULL. */ From f62c1b4cd00e5b2f1cdc94796cf55d006c3113eb Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Fri, 19 Apr 2024 00:18:03 -0700 Subject: [PATCH 117/149] Tree-sitter: only update range and reparse for changed ranges In the very beginning, there's bug#66732, to solve that bug, we added treesit--pre-redisplay and treesit--syntax-propertize-notifier. However, to fix bug#66732, we were updating ranges for the whole buffer which makes Emacs extremely slow when there are a lot of local parsers in a large buffer. Then to solve that we introduced a workaround where we only update ranges in a fixed range around point. This change fixes the original problem (bug#66732) without using that workaround. * lisp/treesit.el (treesit--font-lock-notifier): (treesit--syntax-propertize-notifier): Remove functions (treesit--pre-redisplay): Use the new function treesit-parser-changed-ranges to get the changed ranges of the primary parser, and only update ranges for those ranges. Plus do the work of the removed function. (treesit-major-mode-setup): Remove setup for the removed functions. --- lisp/treesit.el | 97 ++++++++++++++++++++----------------------------- 1 file changed, 40 insertions(+), 57 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index 2b899a84183..03df169da44 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1328,18 +1328,6 @@ non-nil, print debugging information." (max node-start start) (min node-end end) face (treesit-node-type node))))))))) -(defun treesit--font-lock-notifier (ranges parser) - "Ensures updated parts of the parse-tree are refontified. -RANGES is a list of (BEG . END) ranges, PARSER is the tree-sitter -parser notifying of the change." - (with-current-buffer (treesit-parser-buffer parser) - (dolist (range ranges) - (when treesit--font-lock-verbose - (message "Notifier received range: %s-%s" - (car range) (cdr range))) - (with-silent-modifications - (put-text-property (car range) (cdr range) 'fontified nil))))) - (defvar-local treesit--syntax-propertize-start nil "If non-nil, next `syntax-propertize' should start at this position. @@ -1348,20 +1336,6 @@ When tree-sitter parser reparses, it calls and that function sets this variable to the start of the affected region.") -(defun treesit--syntax-propertize-notifier (ranges parser) - "Sets `treesit--syntax-propertize-start' to the smallest start. -Specifically, the smallest start position among all the ranges in -RANGES for PARSER." - (with-current-buffer (treesit-parser-buffer parser) - (when-let* ((range-starts (mapcar #'car ranges)) - (min-range-start - (seq-reduce - #'min (cdr range-starts) (car range-starts)))) - (if (null treesit--syntax-propertize-start) - (setq treesit--syntax-propertize-start min-range-start) - (setq treesit--syntax-propertize-start - (min treesit--syntax-propertize-start min-range-start)))))) - (defvar-local treesit--pre-redisplay-tick nil "The last `buffer-chars-modified-tick' that we've processed. Because `pre-redisplay-functions' could be called multiple times @@ -1369,32 +1343,47 @@ during a single command loop, we use this variable to debounce calls to `treesit--pre-redisplay'.") (defun treesit--pre-redisplay (&rest _) - "Force reparse and consequently run all notifiers. - -One of the notifiers is `treesit--font-lock-notifier', which will -mark the region whose syntax has changed to \"need to refontify\". - -For example, when the user types the final slash of a C block -comment /* xxx */, not only do we need to fontify the slash, but -also the whole block comment, which previously wasn't fontified -as comment due to incomplete parse tree." + "Force a reparse on the primary parser and do some work. + +After the parser reparses, we get the changed ranges, and +1) update non-primary parsers' ranges in the changed ranges +2) mark these ranges as to-be-fontified, +3) tell syntax-ppss to start reparsing from the min point of the ranges + +We need to mark to-be-fontified ranges before redisplay starts working, +because sometimes the range edited by the user is not the only range +that needs to be refontified. For example, when the user types the +final slash of a C block comment /* xxx */, not only do we need to +fontify the slash, but also the whole block comment, which previously +wasn't fontified as comment due to incomplete parse tree." (unless (eq treesit--pre-redisplay-tick (buffer-chars-modified-tick)) - ;; `treesit-update-ranges' will force the host language's parser to - ;; reparse and set correct ranges for embedded parsers. Then - ;; `treesit-parser-root-node' will force those parsers to reparse. - (let ((len (+ (* (window-body-height) (window-body-width)) 800))) - ;; FIXME: As a temporary fix, this prevents Emacs from updating - ;; every single local parsers in the buffer every time there's an - ;; edit. Moving forward, we need some way to properly track the - ;; regions which need update on parser ranges, like what jit-lock - ;; and syntax-ppss does. - (treesit-update-ranges - (max (point-min) (- (point) len)) - (min (point-max) (+ (point) len)))) - ;; Force repase on _all_ the parsers might not be necessary, but - ;; this is probably the most robust way. - (dolist (parser (treesit-parser-list)) - (treesit-parser-root-node parser)) + (let ((primary-parser + ;; TODO: We need something less ugly than this for getting + ;; the primary parser/language. + (if treesit-range-settings + (let ((query (car (car treesit-range-settings)))) + (if (treesit-query-p query) + (treesit-parser-create + (treesit-query-language query)) + (car (treesit-parser-list)))) + (car (treesit-parser-list))))) + ;; Force a reparse on the primary parser. + (treesit-parser-root-node primary-parser) + (dolist (range (treesit-parser-changed-ranges primary-parser)) + ;; 1. Update ranges. + (treesit-update-ranges (car range) (cdr range)) + ;; 2. Mark the changed ranges to be fontified. + (when treesit--font-lock-verbose + (message "Notifier received range: %s-%s" + (car range) (cdr range))) + (with-silent-modifications + (put-text-property (car range) (cdr range) 'fontified nil)) + ;; 3. Set `treesit--syntax-propertize-start'. + (if (null treesit--syntax-propertize-start) + (setq treesit--syntax-propertize-start (car range)) + (setq treesit--syntax-propertize-start + (min treesit--syntax-propertize-start (car range)))))) + (setq treesit--pre-redisplay-tick (buffer-chars-modified-tick)))) (defun treesit--pre-syntax-ppss (start end) @@ -2956,14 +2945,8 @@ before calling this function." (font-lock-fontify-syntactically-function . treesit-font-lock-fontify-region))) (treesit-font-lock-recompute-features) - (dolist (parser (treesit-parser-list)) - (treesit-parser-add-notifier - parser #'treesit--font-lock-notifier)) (add-hook 'pre-redisplay-functions #'treesit--pre-redisplay 0 t)) ;; Syntax - (dolist (parser (treesit-parser-list)) - (treesit-parser-add-notifier - parser #'treesit--syntax-propertize-notifier)) (add-hook 'syntax-propertize-extend-region-functions #'treesit--pre-syntax-ppss 0 t) ;; Indent. From 71d2ec7aba3d6ef9386e807970b0bfaa2043d128 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Apr 2024 22:19:00 -0400 Subject: [PATCH 118/149] (track-changes--call-signal): Silence late signals * lisp/emacs-lisp/track-changes.el (track-changes--call-signal): Skip the call if the tracker was unregistered. --- lisp/emacs-lisp/track-changes.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index c11c976312b..ac7a99f3c3c 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -364,7 +364,7 @@ and re-enable the TRACKER corresponding to ID." (setf (track-changes--tracker-state id) track-changes--state) (funcall func beg end (or before lenbefore))) ;; Re-enable the tracker's signal only after running `func', so - ;; as to avoid recursive invocations. + ;; as to avoid nested invocations. (cl-pushnew id track-changes--clean-trackers)))) ;;;; Auxiliary functions. @@ -578,8 +578,10 @@ Details logged to `track-changes--error-log'") (defun track-changes--call-signal (buf tracker) (when (buffer-live-p buf) (with-current-buffer buf - ;; Silence ourselves if `track-changes-fetch' was called in the mean time. - (unless (memq tracker track-changes--clean-trackers) + ;; Silence ourselves if `track-changes-fetch' was called + ;; or the tracker was unregistered in the mean time. + (when (and (not (memq tracker track-changes--clean-trackers)) + (memq tracker track-changes--trackers)) (funcall (track-changes--tracker-signal tracker) tracker))))) ;;;; Extra candidates for the API. From 42776dc5b7702cec2feb787fbf770d91623b9818 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Apr 2024 09:53:35 +0300 Subject: [PATCH 119/149] ; Fix documentation of recent commits related to treesit * src/treesit.c (Ftreesit_parser_changed_ranges): * doc/lispref/parsing.texi (Using Parser): Fix wording. --- doc/lispref/parsing.texi | 12 ++++++------ src/treesit.c | 8 ++++---- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 65672997bda..f79502f3bab 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -539,10 +539,10 @@ symbol, rather than a lambda function. This function returns the list of @var{parser}'s notifier functions. @end defun -Sometimes a user might want to synchronously get the changed ranges of -the last reparse, and @code{treesit-parser-changed-ranges} is just for -it. This function basically returns the @var{ranges} that the notifier -functions were passed. +Sometimes a Lisp program might need to synchronously get the changed +ranges of the last reparse. The function +@code{treesit-parser-changed-ranges} exists for this purpose. It +returns the ranges which were passed to the notifier functions. @defun treesit-parser-changed-ranges parser &optional quiet This function returns the ranges that has been changed since last @@ -552,8 +552,8 @@ mark the start and the end positions of a range. This function should almost always be called immediately after reparsing. If it's called when there are new buffer edits that hasn't -been reparsed, Emacs signals @code{treesit-unparsed-edits}, unless -@var{quiet} is non-nil. +been reparsed, Emacs signals the @code{treesit-unparsed-edits} error, +unless the optional argument @var{quiet} is non-nil. Calling this function multiple times consecutively doesn't change its return value; it always returns the ranges affected by the last reparse. diff --git a/src/treesit.c b/src/treesit.c index 76354361284..52d158b1bf8 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -1833,13 +1833,13 @@ DEFUN ("treesit-parser-changed-ranges", Ftreesit_parser_changed_ranges, 1, 2, 0, doc: /* Return the buffer regions affected by the last reparse of PARSER. -Returns a list of cons (BEG . END), where each cons represents a region -in which the buffer content was affected by the last reparse. +Returns a list of cons cells (BEG . END), where each cons cell represents +a region in which changes in buffer contents affected the last reparse. This function should almost always be called immediately after reparsing. If it's called when there are new buffer edits that hasn't -been reparsed, Emacs signals `treesit-unparsed-edits', unless QUIET is -non-nil. +been reparsed, Emacs signals the `treesit-unparsed-edits' error, unless +optional argument QUIET is non-nil. Calling this function multiple times consecutively doesn't change its return value; it always returns the ranges affected by the last From b93d568e47cd8c1a0e5f524d443287927f8a423c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Apr 2024 10:25:12 +0300 Subject: [PATCH 120/149] ; On MS-Windows, skip eglot test that creates symlinks * test/lisp/progmodes/eglot-tests.el (eglot-test-basic-symlink): Skip this test on MS-Windows. --- test/lisp/progmodes/eglot-tests.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 282e66f56a5..c4ca870fbe6 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -439,6 +439,8 @@ directory hierarchy." (ert-deftest eglot-test-basic-symlink () "Test basic symlink support." (skip-unless (executable-find "clangd")) + ;; MS-Windows either fails symlink creation or pops up UAC prompts. + (skip-when (eq system-type 'windows-nt)) (eglot--with-fixture `(("symlink-project" . (("main.cpp" . "#include\"foo.h\"\nint main() { return foo(); }") From 4d5fac4002412567b2b587c3cc4a1535ace0f2a8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Apr 2024 10:32:34 +0300 Subject: [PATCH 121/149] ; * lisp/progmodes/eglot.el (eglot-path-to-uri): Add comment. --- lisp/progmodes/eglot.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 3c963feeed4..efdbfba1075 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1090,13 +1090,15 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." (defun eglot-path-to-uri (path) "Convert PATH, a file name, to LSP URI string and return it." + ;; Some LSP servers don't resolve symlinks, so we must do that + ;; for them by calling 'file-truename below'. (let ((truepath (file-truename path))) (if (and (url-type (url-generic-parse-url path)) - ;; It might be MS Windows path which includes a drive - ;; letter that looks like a URL scheme (bug#59338) + ;; PATH might be MS Windows file name which includes a + ;; drive letter that looks like a URL scheme (bug#59338). (not (and (eq system-type 'windows-nt) (file-name-absolute-p truepath)))) - ;; Path is already a URI, so forward it to the LSP server + ;; PATH is already a URI, so forward it to the LSP server ;; untouched. The server should be able to handle it, since ;; it provided this URI to clients in the first place. path From 3af9c33263df84f7a16bc07991f99352259121eb Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Apr 2024 09:43:30 +0200 Subject: [PATCH 122/149] Complete fix for eww-tests.el * test/lisp/net/eww-tests.el (eww-test/readable/toggle-display) (eww-test/readable/default-readable): Check for libxml. (Bug#70472) --- test/lisp/net/eww-tests.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el index 84767b2d932..4ba51da408f 100644 --- a/test/lisp/net/eww-tests.el +++ b/test/lisp/net/eww-tests.el @@ -197,6 +197,7 @@ This sets `eww-before-browse-history-function' to (ert-deftest eww-test/readable/toggle-display () "Test toggling the display of the \"readable\" parts of a web page." + (skip-unless (libxml-available-p)) (eww-test--with-mock-retrieve (let* ((shr-width most-positive-fixnum) (shr-use-fonts nil) @@ -234,7 +235,8 @@ This sets `eww-before-browse-history-function' to (ert-deftest eww-test/readable/default-readable () "Test that EWW displays readable parts of pages by default when applicable." - (eww-test--with-mock-retrieve + (skip-unless (libxml-available-p)) + (eww-test--with-mock-retrieve (let* ((eww-test--response-function (lambda (_url) (concat "Content-Type: text/html\n\n" From dd2f9895116dc6774c2a63d0b1455d7766c7caac Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Apr 2024 10:05:37 +0200 Subject: [PATCH 123/149] * test/infra/Dockerfile.emba: Add libxml2-dev. --- test/infra/Dockerfile.emba | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index d79072b06b5..233e210fc74 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -29,7 +29,7 @@ FROM debian:bullseye as emacs-base RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \ - libdbus-1-dev libacl1-dev acl git texinfo gdb \ + libxml2-dev libdbus-1-dev libacl1-dev acl git texinfo gdb \ && rm -rf /var/lib/apt/lists/* FROM emacs-base as emacs-inotify From c99a1bb1cfc758d3ba78581b72ef8412ee258f76 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Wed, 17 Apr 2024 20:26:16 +0200 Subject: [PATCH 124/149] With glasses-uncapitalize-p, use a display overlay property * lisp/progmodes/glasses.el (glasses-make-readable): Use the 'display' property instead of 'after-string', so that one is able to place the cursor on the uncapitalized character. (Bug#70441) --- lisp/progmodes/glasses.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index 92de2a2581f..18ab4911c89 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -232,8 +232,7 @@ CATEGORY is the overlay category. If it is nil, use the `glasses' category." (save-match-data (re-search-backward "\\<.") (looking-at glasses-uncapitalize-regexp)))) - (overlay-put o 'invisible t) - (overlay-put o 'after-string (downcase (match-string n)))))) + (overlay-put o 'display (downcase (match-string n)))))) ;; Separator change (when (and (not (string= glasses-original-separator glasses-separator)) (not (string= glasses-original-separator ""))) From 1bbc2fa416ce4e6b78b3a72894fe749ceef31aaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 20 Apr 2024 10:41:59 +0200 Subject: [PATCH 125/149] Update gravatar-tests after URL escaping change (bug#70312) * test/lisp/image/gravatar-tests.el (gravatar-default-image): It seems we now escape less. --- test/lisp/image/gravatar-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el index edab6845775..b92c45a1d27 100644 --- a/test/lisp/image/gravatar-tests.el +++ b/test/lisp/image/gravatar-tests.el @@ -50,7 +50,7 @@ (should (equal (gravatar--query-string) "r=g&d=404"))) (let ((gravatar-default-image "https://foo/bar.png")) (should (equal (gravatar--query-string) - "r=g&d=https%3A%2F%2Ffoo%2Fbar.png"))))) + "r=g&d=https://foo/bar.png"))))) (ert-deftest gravatar-force-default () "Test query strings for `gravatar-force-default'." From 08b55ec559bd3e203abe5bbbdc2bc9135d385222 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Apr 2024 12:11:18 +0300 Subject: [PATCH 126/149] Avoid "C-h for help" prompt in "C-h" commands describing keys * lisp/info.el (Info-goto-emacs-key-command-node): Call 'read-key-sequence' instead of using 'interactive' with the "k" code, and suppress the "C-h for help" echo. * lisp/help.el (help--read-key-sequence): Suppress the "C-h for help" prompt in echo-keystrokes. Give the prompt the 'minibuffer-prompt' face. (Bug#70432) --- lisp/help.el | 8 +++++++- lisp/info.el | 10 +++++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/help.el b/lisp/help.el index d4e39f04e53..e13c34b6a5b 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1049,6 +1049,9 @@ with `mouse-movement' events." (let ((enable-disabled-menus-and-buttons t) (cursor-in-echo-area t) (side-event nil) + ;; Showing the list of key sequences makes no sense when they + ;; asked about a key sequence. + (echo-keystrokes-help nil) saved-yank-menu) (unwind-protect (let (last-modifiers key-list) @@ -1066,8 +1069,11 @@ with `mouse-movement' events." ;; After a click, see if a double click is on the way. (and (memq 'click last-modifiers) (not (sit-for (/ (mouse-double-click-time) 1000.0) t)))) - (let* ((seq (read-key-sequence "\ + (let* ((prompt + (propertize "\ Describe the following key, mouse click, or menu item: " + 'face 'minibuffer-prompt)) + (seq (read-key-sequence prompt nil nil 'can-return-switch-frame)) (raw-seq (this-single-command-raw-keys)) (keyn (when (> (length seq) 0) diff --git a/lisp/info.el b/lisp/info.el index b1b9d48855a..c2c393cb243 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4794,7 +4794,15 @@ Interactively, if the binding is `execute-extended-command', a command is read. The command is found by looking up in Emacs manual's indices or in another manual found via COMMAND's `info-file' property or the variable `Info-file-list-for-emacs'." - (interactive "kFind documentation for key: ") + (interactive + (let ((enable-disabled-menus-and-buttons t) + (cursor-in-echo-area t) + ;; Showing the list of key sequences makes no sense when they + ;; asked about a key sequence. + (echo-keystrokes-help nil) + (prompt (propertize "Find documentation for key: " + 'face 'minibuffer-prompt))) + (list (read-key-sequence prompt nil nil 'can-return-switch-frame)))) (let ((command (key-binding key))) (cond ((null command) (message "%s is undefined" (key-description key))) From a4a136217dd20ee701d28ac1adfc828bfdd4655e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 20 Apr 2024 13:08:20 +0200 Subject: [PATCH 127/149] Kill process in files-tests before exiting * test/lisp/files-tests.el (files-tests-file-name-non-special-start-file-process): Make sure that the subprocess is killed before the test concludes. --- test/lisp/files-tests.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index d4c1ef3ba67..ad54addf06b 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1196,18 +1196,21 @@ unquoted file names." "emacs" (current-buffer) (concat invocation-directory invocation-name) "--version"))) - (accept-process-output proc) - (goto-char (point-min)) - (should (search-forward emacs-version nil t)) - ;; Don't stop the test run with a query, as the subprocess - ;; may or may not be dead by the time we reach here. - (set-process-query-on-exit-flag proc nil) - ;; On MS-Windows, wait for the process to die, since the OS - ;; will not let us delete a directory that is the cwd of a - ;; running process. - (when (eq system-type 'windows-nt) - (while (process-live-p proc) - (sleep-for 0.1))))))) + (unwind-protect + (progn + (accept-process-output proc) + (goto-char (point-min)) + (should (search-forward emacs-version nil t)) + ;; Don't stop the test run with a query, as the subprocess + ;; may or may not be dead by the time we reach here. + (set-process-query-on-exit-flag proc nil) + ;; On MS-Windows, wait for the process to die, since the OS + ;; will not let us delete a directory that is the cwd of a + ;; running process. + (when (eq system-type 'windows-nt) + (while (process-live-p proc) + (sleep-for 0.1)))) + (delete-process proc)))))) (files-tests--with-temp-non-special-and-file-name-handler (tmpdir nospecial-dir t) (with-temp-buffer From 12cd8d26151907f8721f0cfe36e26294ab653708 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Apr 2024 14:30:50 +0300 Subject: [PATCH 128/149] ; * lisp/treesit.el (treesit-parser-changed-ranges): Declare. --- lisp/treesit.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/treesit.el b/lisp/treesit.el index 03df169da44..4c9cf5a36e7 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -61,6 +61,7 @@ (declare-function treesit-parser-set-included-ranges "treesit.c") (declare-function treesit-parser-included-ranges "treesit.c") +(declare-function treesit-parser-changed-ranges "treesit.c") (declare-function treesit-parser-add-notifier "treesit.c") (declare-function treesit-node-type "treesit.c") From 00caec805810c752f0015c2ca23a494621e63046 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 12 Apr 2024 22:41:10 +0200 Subject: [PATCH 129/149] New command 'completion-preview-complete' This command completes the symbol at point up to the longest common prefix of all completions candidates. We also add an indication of the longest common prefix in the completion preview by highlighting that part of the preview with the 'completion-preview-exact' face. To facilitate these features we change the way we store the completion candidates while the preview is visible, to explicitly keep the common prefix along with a list of its suffixes. * lisp/completion-preview.el (completion-preview--try-table): Return longest common prefix and list of suffixes instead of list of full candidates. Add illustrative comment. (completion-preview--capf-wrapper, completion-preview--update) (completion-preview--show, completion-preview-insert) (completion-preview-next-candidate): Adjust. (completion-preview-common): New face. (completion-preview-exact): Tweak to distinguish it from 'completion-preview-common'. (completion-preview-complete): New command. (completion-preview-active-mode-map): Bind it. (completion-preview-mode): Mention it in docstring. (completion-preview-commands): Add 'completion-preview-complete'. (completion-preview--make-overlay): Simplify. (completion-preview--internal-command-p): Remove. (completion-preview-require-certain-commands): Update. (completion-preview--inhibit-update): New inline function. (completion-preview--inhibit-update-p): New local variable. (completion-preview--post-command, completion-preview-hide): Reset it to nil. * test/lisp/completion-preview-tests.el (completion-preview-tests--check-preview): Check the 'face' property of both the first and last character. Update callers. (completion-preview-insert-calls-exit-function) (completion-preview-complete): New tests. (Bug#70381) --- lisp/completion-preview.el | 282 +++++++++++++++++++------- test/lisp/completion-preview-tests.el | 147 ++++++++++++-- 2 files changed, 335 insertions(+), 94 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 4e52aa9b151..8bc8cadc46b 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -39,6 +39,16 @@ ;; example, to M-n and M-p in `completion-preview-active-mode-map' to ;; have them handy whenever the preview is visible. ;; +;; When the completion candidate that the preview is showing shares a +;; common prefix with all other candidates, Completion Preview mode +;; underlines that common prefix. If you want to insert the common +;; prefix but with a different suffix than the one the preview is +;; showing, use the command `completion-preview-complete'. This command +;; inserts just the common prefix and lets you go on typing as usual. +;; If you invoke `completion-preview-complete' when there is no common +;; prefix (so nothing is underlined in the preview), it displays a list +;; of all matching completion candidates. +;; ;; If you set the user option `completion-preview-exact-match-only' to ;; non-nil, Completion Preview mode only suggests a completion ;; candidate when its the only possible completion for the (partial) @@ -73,7 +83,8 @@ first candidate, and you can cycle between the candidates with insert-char delete-backward-char backward-delete-char-untabify - analyze-text-conversion) + analyze-text-conversion + completion-preview-complete) "List of commands that should trigger completion preview." :type '(repeat (function :tag "Command" :value self-insert-command)) :version "30.1") @@ -104,16 +115,22 @@ If this option is nil, these commands do not display any message." (defface completion-preview '((t :inherit shadow)) - "Face for completion preview overlay." + "Face for completion candidates in the completion preview overlay." :version "30.1") -(defface completion-preview-exact +(defface completion-preview-common '((((supports :underline t)) :underline t :inherit completion-preview) (((supports :weight bold)) :weight bold :inherit completion-preview) (t :background "gray")) - "Face for exact completion preview overlay." + "Face for the longest common prefix in the completion preview." + :version "30.1") + +(defface completion-preview-exact + ;; An exact match is also the longest common prefix of all matches. + '((t :underline "gray25" :inherit completion-preview-common)) + "Face for matches in the completion preview overlay." :version "30.1") (defface completion-preview-highlight @@ -124,6 +141,8 @@ If this option is nil, these commands do not display any message." (defvar-keymap completion-preview-active-mode-map :doc "Keymap for Completion Preview Active mode." "C-i" #'completion-preview-insert + ;; FIXME: Should this have another/better binding by default? + "M-i" #'completion-preview-complete ;; "M-n" #'completion-preview-next-candidate ;; "M-p" #'completion-preview-prev-candidate ) @@ -131,8 +150,8 @@ If this option is nil, these commands do not display any message." (defvar-keymap completion-preview--mouse-map :doc "Keymap for mouse clicks on the completion preview." "" #'completion-preview-insert - "C-" #'completion-at-point - "" #'completion-at-point + "C-" #'completion-preview-complete + "" #'completion-preview-complete "" #'completion-preview-prev-candidate "" #'completion-preview-next-candidate) @@ -147,14 +166,16 @@ If this option is nil, these commands do not display any message." Completion Preview mode avoids updating the preview after these commands.") -(defsubst completion-preview--internal-command-p () - "Return non-nil if `this-command' manipulates the completion preview." - (memq this-command completion-preview--internal-commands)) +(defvar-local completion-preview--inhibit-update-p nil + "Whether to inhibit updating the completion preview following this command.") + +(defsubst completion-preview--inhibit-update () + "Inhibit updating the completion preview following this command." + (setq completion-preview--inhibit-update-p t)) (defsubst completion-preview-require-certain-commands () "Check if `this-command' is one of `completion-preview-commands'." - (or (completion-preview--internal-command-p) - (memq this-command completion-preview-commands))) + (memq this-command completion-preview-commands)) (defun completion-preview-require-minimum-symbol-length () "Check if the length of symbol at point is at least above a certain threshold. @@ -167,7 +188,8 @@ Completion Preview mode avoids updating the preview after these commands.") "Hide the completion preview." (when completion-preview--overlay (delete-overlay completion-preview--overlay) - (setq completion-preview--overlay nil))) + (setq completion-preview--overlay nil + completion-preview--inhibit-update-p nil))) (defun completion-preview--make-overlay (pos string) "Make preview overlay showing STRING at POS, or move existing preview there." @@ -175,13 +197,9 @@ Completion Preview mode avoids updating the preview after these commands.") (move-overlay completion-preview--overlay pos pos) (setq completion-preview--overlay (make-overlay pos pos)) (overlay-put completion-preview--overlay 'window (selected-window))) - (let ((previous (overlay-get completion-preview--overlay 'after-string))) - (unless (and previous (string= previous string) - (eq (get-text-property 0 'face previous) - (get-text-property 0 'face string))) - (add-text-properties 0 1 '(cursor 1) string) - (overlay-put completion-preview--overlay 'after-string string)) - completion-preview--overlay)) + (add-text-properties 0 1 '(cursor 1) string) + (overlay-put completion-preview--overlay 'after-string string) + completion-preview--overlay) (defsubst completion-preview--get (prop) "Return property PROP of the completion preview overlay." @@ -221,17 +239,25 @@ See also `completion-styles'.") PROPS is a property list with additional information about TABLE. See `completion-at-point-functions' for more details. -If TABLE contains a matching completion, return a list -\(PREVIEW BEG END ALL BASE EXIT-FN) where PREVIEW is the text to -show in the completion preview, ALL is the list of all matching -completion candidates, BASE is a common prefix that TABLE elided -from the start of each candidate, and EXIT-FN is either a -function to call after inserting PREVIEW or nil. If TABLE does -not contain matching completions, or if there are multiple -matching completions and `completion-preview-exact-match-only' is -non-nil, return nil instead." +If TABLE contains a matching candidate, return a list +\(BASE COMMON SUFFIXES) where BASE is a prefix of the text +between BEG and END that TABLE elided from the start of each candidate, +COMMON is the longest common prefix of all matching candidates, +SUFFIXES is a list of different suffixes that together with COMMON yield +the matching candidates. If TABLE does not contain matching +candidates or if there are multiple matching completions and +`completion-preview-exact-match-only' is non-nil, return nil instead." + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; ;; + ;; | buffer text | preview | ;; + ;; | | | ;; + ;; beg end | ;; + ;; |------+------|--+--------| Each of base, common and suffix ;; + ;; | base | common | suffix | <- may be empty, except common and ;; + ;; suffix cannot both be empty. ;; + ;; ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (let* ((pred (plist-get props :predicate)) - (exit-fn (plist-get props :exit-function)) (string (buffer-substring beg end)) (md (completion-metadata string table pred)) (sort-fn (or (completion-metadata-get md 'cycle-sort-function) @@ -250,16 +276,16 @@ non-nil, return nil instead." (when last (setcdr last nil) (when-let ((sorted (funcall sort-fn - (delete prefix (all-completions prefix all))))) - (unless (and (cdr sorted) completion-preview-exact-match-only) - (list (propertize (substring (car sorted) (length prefix)) - 'face (if (cdr sorted) - 'completion-preview - 'completion-preview-exact) - 'mouse-face 'completion-preview-highlight - 'keymap completion-preview--mouse-map) - (+ beg base) end sorted - (substring string 0 base) exit-fn)))))) + (delete prefix (all-completions prefix all)))) + (common (try-completion prefix sorted)) + (lencom (length common)) + (suffixes sorted)) + (unless (and (cdr suffixes) completion-preview-exact-match-only) + ;; Remove the common prefix from each candidate. + (while sorted + (setcar sorted (substring (car sorted) lencom)) + (setq sorted (cdr sorted))) + (list (substring string 0 base) common suffixes)))))) (defun completion-preview--capf-wrapper (capf) "Translate return value of CAPF to properties for completion preview overlay." @@ -267,25 +293,41 @@ non-nil, return nil instead." (and (consp res) (not (functionp res)) (seq-let (beg end table &rest plist) res - (or (completion-preview--try-table table beg end plist) + (or (when-let ((data (completion-preview--try-table + table beg end plist))) + `(,(+ beg (length (car data))) ,end ,plist ,@data)) (unless (eq 'no (plist-get plist :exclusive)) ;; Return non-nil to exclude other capfs. '(nil))))))) (defun completion-preview--update () "Update completion preview." - (seq-let (preview beg end all base exit-fn) + (seq-let (beg end props base common suffixes) (run-hook-wrapped 'completion-at-point-functions #'completion-preview--capf-wrapper) - (when preview - (let ((ov (completion-preview--make-overlay end preview))) + (when-let ((suffix (car suffixes))) + (set-text-properties 0 (length suffix) + (list 'face (if (cdr suffixes) + 'completion-preview + 'completion-preview-exact)) + suffix) + (set-text-properties 0 (length common) + (list 'face (if (cdr suffixes) + 'completion-preview-common + 'completion-preview-exact)) + common) + (let ((ov (completion-preview--make-overlay + end (propertize (concat (substring common (- end beg)) suffix) + 'mouse-face 'completion-preview-highlight + 'keymap completion-preview--mouse-map)))) (overlay-put ov 'completion-preview-beg beg) (overlay-put ov 'completion-preview-end end) (overlay-put ov 'completion-preview-index 0) - (overlay-put ov 'completion-preview-cands all) + (overlay-put ov 'completion-preview-suffixes suffixes) + (overlay-put ov 'completion-preview-common common) (overlay-put ov 'completion-preview-base base) - (overlay-put ov 'completion-preview-exit-fn exit-fn) + (overlay-put ov 'completion-preview-props props) (completion-preview-active-mode))))) (defun completion-preview--show () @@ -308,17 +350,22 @@ point, otherwise hide it." ;; flicker, even with slow completion backends. (let* ((beg (completion-preview--get 'completion-preview-beg)) (end (max (point) (overlay-start completion-preview--overlay))) - (cands (completion-preview--get 'completion-preview-cands)) + (sufs (completion-preview--get 'completion-preview-suffixes)) (index (completion-preview--get 'completion-preview-index)) - (cand (nth index cands)) - (after (completion-preview--get 'after-string)) - (face (get-text-property 0 'face after))) + (common (completion-preview--get 'completion-preview-common)) + (suffix (nth index sufs)) + (cand nil)) + (set-text-properties 0 (length suffix) + (list 'face (if (cdr sufs) + 'completion-preview + 'completion-preview-exact)) + suffix) + (setq cand (concat common (nth index sufs))) (if (and (<= beg (point) end (1- (+ beg (length cand)))) (string-prefix-p (buffer-substring beg end) cand)) ;; The previous preview is still applicable, update it. (overlay-put (completion-preview--make-overlay end (propertize (substring cand (- end beg)) - 'face face 'mouse-face 'completion-preview-highlight 'keymap completion-preview--mouse-map)) 'completion-preview-end end) @@ -329,16 +376,18 @@ point, otherwise hide it." (defun completion-preview--post-command () "Create, update or delete completion preview post last command." - (if (and (completion-preview-require-certain-commands) - (completion-preview-require-minimum-symbol-length)) - ;; We should show the preview. - (or - ;; If we're called after a command that itself updates the - ;; preview, don't do anything. - (completion-preview--internal-command-p) - ;; Otherwise, show the preview. - (completion-preview--show)) - (completion-preview-active-mode -1))) + (let ((internal-p (or completion-preview--inhibit-update-p + (memq this-command + completion-preview--internal-commands)))) + (setq completion-preview--inhibit-update-p nil) + + ;; If we're called after a command that itself updates the + ;; preview, don't do anything. + (unless internal-p + (if (and (completion-preview-require-certain-commands) + (completion-preview-require-minimum-symbol-length)) + (completion-preview--show) + (completion-preview-active-mode -1))))) (defun completion-preview-insert () "Insert the completion candidate that the preview is showing." @@ -347,16 +396,84 @@ point, otherwise hide it." (let* ((pre (completion-preview--get 'completion-preview-base)) (end (completion-preview--get 'completion-preview-end)) (ind (completion-preview--get 'completion-preview-index)) - (all (completion-preview--get 'completion-preview-cands)) - (efn (completion-preview--get 'completion-preview-exit-fn)) + (all (completion-preview--get 'completion-preview-suffixes)) + (com (completion-preview--get 'completion-preview-common)) + (efn (plist-get (completion-preview--get 'completion-preview-props) + :exit-function)) (aft (completion-preview--get 'after-string)) - (str (concat pre (nth ind all)))) + (str (concat pre com (nth ind all)))) (completion-preview-active-mode -1) (goto-char end) (insert (substring-no-properties aft)) (when (functionp efn) (funcall efn str 'finished))) (user-error "No current completion preview"))) +(defun completion-preview-complete () + "Complete up to the longest common prefix of all completion candidates. + +If you call this command twice in a row, or otherwise if there is no +common prefix to insert, it displays the list of matching completion +candidates unless `completion-auto-help' is nil. If you repeat this +command again when the completions list is visible, it scrolls the +completions list." + (interactive) + (unless completion-preview-active-mode + (user-error "No current completion preview")) + (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (completion-preview--get 'completion-preview-end)) + (com (completion-preview--get 'completion-preview-common)) + (cur (completion-preview--get 'completion-preview-index)) + (all (completion-preview--get 'completion-preview-suffixes)) + (base (completion-preview--get 'completion-preview-base)) + (props (completion-preview--get 'completion-preview-props)) + (efn (plist-get props :exit-function)) + (ins (substring-no-properties com (- end beg)))) + (goto-char end) + (if (string-empty-p ins) + ;; If there's nothing to insert, call `completion-at-point' to + ;; show the completions list (or just display a message when + ;; `completion-auto-help' is nil). + (let* ((completion-styles completion-preview-completion-styles) + (sub (substring-no-properties com)) + (col (mapcar (lambda (suf) + (concat sub (substring-no-properties suf))) + (append (nthcdr cur all) (take cur all)))) + ;; The candidates are already in order. + (props (plist-put props :display-sort-function #'identity)) + ;; The :exit-function might be slow, e.g. when the + ;; backend is Eglot, so we ensure that the preview is + ;; hidden before any original :exit-function is called. + (props (plist-put props :exit-function + (when (functionp efn) + (lambda (string status) + (completion-preview-active-mode -1) + (funcall efn string status))))) + ;; The predicate is meant for the original completion + ;; candidates, which may be symbols or cons cells, but + ;; now we only have strings, so it might be unapplicable. + (props (plist-put props :predicate nil)) + (completion-at-point-functions + (list (lambda () `(,beg ,end ,col ,@props))))) + (completion-preview--inhibit-update) + (completion-at-point)) + ;; Otherwise, insert the common prefix and update the preview. + (insert ins) + (let ((suf (nth cur all)) + (pos (point))) + (if (or (string-empty-p suf) (null suf)) + ;; If we've inserted a full candidate, let the post-command + ;; hook update the completion preview in case the candidate + ;; can be completed further. + (when (functionp efn) + (funcall efn (concat base com) (if (cdr all) 'exact 'finished))) + ;; Otherwise, remove the common prefix from the preview. + (completion-preview--inhibit-update) + (overlay-put (completion-preview--make-overlay + pos (propertize + suf 'mouse-face 'completion-preview-highlight + 'keymap completion-preview--mouse-map)) + 'completion-preview-end pos)))))) + (defun completion-preview-prev-candidate () "Cycle the candidate that the preview is showing to the previous suggestion." (interactive) @@ -372,18 +489,29 @@ prefix argument and defaults to 1." (when completion-preview-active-mode (let* ((beg (completion-preview--get 'completion-preview-beg)) (end (completion-preview--get 'completion-preview-end)) - (all (completion-preview--get 'completion-preview-cands)) + (all (completion-preview--get 'completion-preview-suffixes)) + (com (completion-preview--get 'completion-preview-common)) (cur (completion-preview--get 'completion-preview-index)) (len (length all)) (new (mod (+ cur direction) len)) - (str (nth new all))) - (while (or (<= (+ beg (length str)) end) - (not (string-prefix-p (buffer-substring beg end) str))) - (setq new (mod (+ new direction) len) str (nth new all))) - (let ((aft (propertize (substring str (- end beg)) - 'face (if (< 1 len) - 'completion-preview - 'completion-preview-exact) + (suf (nth new all)) + (lencom (length com))) + ;; Skip suffixes that are no longer applicable. This may happen + ;; when the user continues typing and immediately runs this + ;; command, before the completion backend returns an updated set + ;; of completions for the new (longer) prefix, so we still have + ;; the previous (larger) set of candidates at hand. + (while (or (<= (+ beg lencom (length suf)) end) + (not (string-prefix-p (buffer-substring beg end) + (concat com suf)))) + (setq new (mod (+ new direction) len) + suf (nth new all))) + (set-text-properties 0 (length suf) + (list 'face (if (cdr all) + 'completion-preview + 'completion-preview-exact)) + suf) + (let ((aft (propertize (substring (concat com suf) (- end beg)) 'mouse-face 'completion-preview-highlight 'keymap completion-preview--mouse-map))) (add-text-properties 0 1 '(cursor 1) aft) @@ -398,6 +526,7 @@ prefix argument and defaults to 1." (buffer-local-value 'completion-preview-active-mode buffer)) (dolist (cmd '(completion-preview-insert + completion-preview-complete completion-preview-prev-candidate completion-preview-next-candidate)) (put cmd 'completion-predicate #'completion-preview--active-p)) @@ -409,11 +538,12 @@ prefix argument and defaults to 1." This mode automatically shows and updates the completion preview according to the text around point. \\\ -When the preview is visible, \\[completion-preview-insert] -accepts the completion suggestion, +When the preview is visible, \\[completion-preview-insert] accepts the +completion suggestion, \\[completion-preview-complete] completes up to +the longest common prefix of all completion candidates, \\[completion-preview-next-candidate] cycles forward to the next -completion suggestion, and \\[completion-preview-prev-candidate] -cycles backward." +completion suggestion, and \\[completion-preview-prev-candidate] cycles +backward." :lighter " CP" (if completion-preview-mode (add-hook 'post-command-hook #'completion-preview--post-command nil t) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 5b2c28bd3dd..7d358d07519 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -27,23 +27,25 @@ (when-let ((bounds (bounds-of-thing-at-point 'symbol))) (append (list (car bounds) (cdr bounds) completions) props)))) -(defun completion-preview-tests--check-preview (string &optional exact) +(defun completion-preview-tests--check-preview + (string &optional beg-face end-face) "Check that the completion preview is showing STRING. -If EXACT is non-nil, check that STRING has the -`completion-preview-exact' face. Otherwise check that STRING has -the `completion-preview' face. +BEG-FACE and END-FACE say which faces the beginning and end of STRING +should have, respectively. Both BEG-FACE and END-FACE default to +`completion-preview'. If STRING is nil, check that there is no completion preview instead." (if (not string) - (should (not completion-preview--overlay)) + (should-not completion-preview--overlay) (should completion-preview--overlay) (let ((after-string (completion-preview--get 'after-string))) (should (string= after-string string)) (should (eq (get-text-property 0 'face after-string) - (if exact - 'completion-preview-exact + (or beg-face 'completion-preview))) + (should (eq (get-text-property (1- (length after-string)) 'face after-string) + (or end-face 'completion-preview)))))) (ert-deftest completion-preview () @@ -57,7 +59,9 @@ instead." (completion-preview--post-command)) ;; Exact match - (completion-preview-tests--check-preview "barbaz" 'exact) + (completion-preview-tests--check-preview "barbaz" + 'completion-preview-exact + 'completion-preview-exact) (insert "v") (let ((this-command 'self-insert-command)) @@ -71,7 +75,9 @@ instead." (completion-preview--post-command)) ;; Exact match again - (completion-preview-tests--check-preview "barbaz" 'exact))) + (completion-preview-tests--check-preview "barbaz" + 'completion-preview-exact + 'completion-preview-exact))) (ert-deftest completion-preview-multiple-matches () "Test Completion Preview mode with multiple matching candidates." @@ -84,12 +90,12 @@ instead." (completion-preview--post-command)) ;; Multiple matches, the preview shows the first one - (completion-preview-tests--check-preview "bar") + (completion-preview-tests--check-preview "bar" 'completion-preview-common) (completion-preview-next-candidate 1) ;; Next match - (completion-preview-tests--check-preview "baz"))) + (completion-preview-tests--check-preview "baz" 'completion-preview-common))) (ert-deftest completion-preview-exact-match-only () "Test `completion-preview-exact-match-only'." @@ -111,7 +117,9 @@ instead." (completion-preview--post-command)) ;; Exact match - (completion-preview-tests--check-preview "m" 'exact))) + (completion-preview-tests--check-preview "m" + 'completion-preview-exact + 'completion-preview-exact))) (ert-deftest completion-preview-function-capfs () "Test Completion Preview mode with capfs that return a function." @@ -124,7 +132,7 @@ instead." (insert "foo") (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "bar"))) + (completion-preview-tests--check-preview "bar" 'completion-preview-common))) (ert-deftest completion-preview-non-exclusive-capfs () "Test Completion Preview mode with non-exclusive capfs." @@ -140,11 +148,13 @@ instead." (insert "foo") (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "bar") + (completion-preview-tests--check-preview "bar" 'completion-preview-common) (setq-local completion-preview-exact-match-only t) (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "barbaz" 'exact))) + (completion-preview-tests--check-preview "barbaz" + 'completion-preview-exact + 'completion-preview-exact))) (ert-deftest completion-preview-face-updates () "Test updating the face in completion preview when match is no longer exact." @@ -160,7 +170,9 @@ instead." (insert "b") (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "arbaz" 'exact) + (completion-preview-tests--check-preview "arbaz" + 'completion-preview-exact + 'completion-preview-exact) (delete-char -1) (let ((this-command 'delete-backward-char)) (completion-preview--post-command)) @@ -173,13 +185,15 @@ instead." (with-temp-buffer (setq-local completion-at-point-functions (list - (lambda () (user-error "bad")) + (lambda () (user-error "Bad")) (completion-preview-tests--capf '("foobarbaz")))) (insert "foo") (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "barbaz" 'exact))) + (completion-preview-tests--check-preview "barbaz" + 'completion-preview-exact + 'completion-preview-exact))) (ert-deftest completion-preview-mid-symbol-cycle () "Test cycling the completion preview with point at the middle of a symbol." @@ -196,4 +210,101 @@ instead." (completion-preview-next-candidate 1) (completion-preview-tests--check-preview "z"))) +(ert-deftest completion-preview-complete () + "Test `completion-preview-complete'." + (with-temp-buffer + (let ((exit-fn-called nil) + (exit-fn-args nil) + (message-args nil) + (completion-auto-help nil)) + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar" "foobaz" "foobash" "foobash-mode") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (message "here") + + (completion-preview-tests--check-preview "bar" 'completion-preview-common) + + ;; Insert the common prefix, "ba". + (completion-preview-complete) + + ;; Only "r" should remain. + (completion-preview-tests--check-preview "r") + + (cl-letf (((symbol-function #'minibuffer-message) + (lambda (&rest args) (setq message-args args)))) + + ;; With `completion-auto-help' set to nil, a second call to + ;; `completion-preview-complete' just displays a message. + (completion-preview-complete) + (setq completion-preview--inhibit-update-p nil) + + (should (equal message-args '("Next char not unique")))) + + ;; The preview should stay put. + (completion-preview-tests--check-preview "r") + ;; (completion-preview-active-mode -1) + + ;; Narrow further. + (insert "s") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + + ;; The preview should indicate an exact match. + (completion-preview-tests--check-preview "h" + 'completion-preview-common + 'completion-preview-common) + + ;; Insert the entire preview content. + (completion-preview-complete) + (setq completion-preview--inhibit-update-p nil) + (let ((this-command 'completion-preview-complete)) + (completion-preview--post-command)) + + ;; The preview should update to indicate that there's a further + ;; possible completion. + (completion-preview-tests--check-preview "-mode" + 'completion-preview-exact + 'completion-preview-exact) + (should exit-fn-called) + (should (equal exit-fn-args '("foobash" exact))) + (setq exit-fn-called nil exit-fn-args nil) + + ;; Insert the extra suffix. + (completion-preview-complete) + + ;; Nothing more to show, so the preview should now be gone. + (should-not completion-preview--overlay) + (should exit-fn-called) + (should (equal exit-fn-args '("foobash-mode" finished)))))) + +(ert-deftest completion-preview-insert-calls-exit-function () + "Test that `completion-preview-insert' calls the completion exit function." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar" "foobaz") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "bar" 'completion-preview-common) + (completion-preview-insert) + (should (string= (buffer-string) "foobar")) + (should-not completion-preview--overlay) + (should exit-fn-called) + (should (equal exit-fn-args '("foobar" finished)))))) + ;;; completion-preview-tests.el ends here From 571fd42d48a0d99b7b210bd218836bd2f6ce2ccf Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 20 Apr 2024 20:44:30 +0800 Subject: [PATCH 130/149] Eliminate minor wart in EmacsService.java * java/org/gnu/emacs/EmacsService.java (openContentUri): Replace arg BYTES with URI and change its type to String. * src/android.c (android_init_emacs_service): * src/androidvfs.c (android_authority_name) (android_authority_open): Adjust commentary and code to match. --- java/org/gnu/emacs/EmacsService.java | 45 ++++++++-------------------- src/android.c | 2 +- src/androidvfs.c | 32 +++++--------------- 3 files changed, 21 insertions(+), 58 deletions(-) diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index b1ec397bc41..2d4079c11b0 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -962,11 +962,13 @@ invocation of app_process (through android-emacs) can string; make it writable if WRITABLE, and readable if READABLE. Truncate the file if TRUNCATE. - Value is the resulting file descriptor or -1 upon failure. */ + Value is the resulting file descriptor or an exception will be + raised. */ public int - openContentUri (byte[] bytes, boolean writable, boolean readable, + openContentUri (String uri, boolean writable, boolean readable, boolean truncate) + throws FileNotFoundException, IOException { String name, mode; ParcelFileDescriptor fd; @@ -985,39 +987,16 @@ invocation of app_process (through android-emacs) can if (truncate) mode += "t"; - /* Try to open an associated ParcelFileDescriptor. */ + /* Try to open a corresponding ParcelFileDescriptor. Though + `fd.detachFd' is exclusive to Honeycomb and up, this function is + never called on systems older than KitKat, which is Emacs's + minimum requirement for access to /content/by-authority. */ - try - { - /* The usual file name encoding question rears its ugly head - again. */ - - name = new String (bytes, "UTF-8"); - fd = resolver.openFileDescriptor (Uri.parse (name), mode); - - /* Use detachFd on newer versions of Android or plain old - dup. */ - - if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB_MR1) - { - i = fd.detachFd (); - fd.close (); - - return i; - } - else - { - i = EmacsNative.dup (fd.getFd ()); - fd.close (); + fd = resolver.openFileDescriptor (Uri.parse (uri), mode); + i = fd.detachFd (); + fd.close (); - return i; - } - } - catch (Exception exception) - { - exception.printStackTrace (); - return -1; - } + return i; } /* Return whether Emacs is directly permitted to access the diff --git a/src/android.c b/src/android.c index 507ffc458d8..7a7eadc946a 100644 --- a/src/android.c +++ b/src/android.c @@ -1632,7 +1632,7 @@ android_init_emacs_service (void) FIND_METHOD (reset_ic, "resetIC", "(Lorg/gnu/emacs/EmacsWindow;I)V"); FIND_METHOD (open_content_uri, "openContentUri", - "([BZZZ)I"); + "(Ljava/lang/String;ZZZ)I"); FIND_METHOD (check_content_uri, "checkContentUri", "(Ljava/lang/String;ZZ)Z"); FIND_METHOD (query_battery, "queryBattery", "()[J"); diff --git a/src/androidvfs.c b/src/androidvfs.c index 88ea345a298..9e65dd2b140 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -3130,8 +3130,10 @@ android_authority_name (struct android_vnode *vnode, char *name, return NULL; } - /* NAME must be a valid JNI string, so that it can be encoded - properly. */ + /* If the URI is not a valid JNI string, return immediately. This + should not be possible, since /content file names are encoded + into JNI strings at the naming stage; the check is performed + only out of an abundance of caution. */ if (android_verify_jni_string (name)) goto no_entry; @@ -3169,7 +3171,6 @@ android_authority_open (struct android_vnode *vnode, int flags, AAsset **asset) { struct android_authority_vnode *vp; - size_t length; jobject string; int fd; JNIEnv *env; @@ -3189,22 +3190,11 @@ android_authority_open (struct android_vnode *vnode, int flags, feasible. */ env = android_java_env; - /* Allocate a buffer to hold the file name. */ - length = strlen (vp->uri); - string = (*env)->NewByteArray (env, length); - if (!string) - { - (*env)->ExceptionClear (env); - errno = ENOMEM; - return -1; - } - - /* Copy the URI into this byte array. */ - (*env)->SetByteArrayRegion (env, string, 0, length, - (jbyte *) vp->uri); + /* Allocate a JNI string to hold VP->uri. */ + string = (*env)->NewStringUTF (env, vp->uri); + android_exception_check (); /* Try to open the file descriptor. */ - fd = (*env)->CallNonvirtualIntMethod (env, emacs_service, service_class.class, service_class.open_content_uri, @@ -3215,13 +3205,7 @@ android_authority_open (struct android_vnode *vnode, int flags, (jboolean) !(mode & O_WRONLY), (jboolean) ((mode & O_TRUNC) != 0)); - if ((*env)->ExceptionCheck (env)) - { - (*env)->ExceptionClear (env); - errno = ENOMEM; - ANDROID_DELETE_LOCAL_REF (string); - return -1; - } + android_exception_check_1 (string); /* If fd is -1, just assume that the file does not exist, and return -1 with errno set to ENOENT. */ From 24ea3024ae241d1fc5fb3e05d584211070b73d5d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Apr 2024 11:17:39 -0400 Subject: [PATCH 131/149] (cl-print-object): Fix indirect cause of bug#70436 * lisp/emacs-lisp/cl-print.el (cl-print-object): Fix specializer for the byte-code case. --- lisp/emacs-lisp/cl-print.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 5e5eee1da9e..39688661eb1 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -180,7 +180,7 @@ into a button whose action shows the function's disassembly.") ;; FIXME: Don't degenerate to `prin1' for the contents of char-tables ;; and records! -(cl-defmethod cl-print-object ((object compiled-function) stream) +(cl-defmethod cl-print-object ((object byte-code-function) stream) (unless stream (setq stream standard-output)) ;; We use "#f(...)" rather than "#<...>" so that pp.el gives better results. (princ "#f(compiled-function " stream) From 0536b96011d24797d16d97a59a62f633a3d30472 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 20 Apr 2024 11:23:58 -0400 Subject: [PATCH 132/149] (backtrace--print-func-and-args): Fix (part of) bug#70436 The source of bug#70436 is that we print a value into the buffer and then we generate its print representation a second time to get its length to find the bounds of the thing we just printed. Not only it's wasteful, but it risks bugs because the two "prints" can be inconsistent with each other. This is not a complete fix because in the non EVALD case we still use that same broken way. * lisp/emacs-lisp/backtrace.el (backtrace--print-func-and-args): Don't re-print things just to get their length. (backtrace--print-to-string): Skip a temp-buffer indirection. --- lisp/emacs-lisp/backtrace.el | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index e47e2662afa..120972d6cd8 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -678,12 +678,10 @@ characters with appropriate settings of `print-level' and (defun backtrace--print-to-string (sexp &optional limit) ;; This is for use by callers who wrap the call with ;; backtrace--with-output-variables. - (setq limit (or limit backtrace-line-length)) - (with-temp-buffer - (insert (cl-print-to-string-with-limit #'backtrace--print sexp limit)) - ;; Add a unique backtrace-form property. - (put-text-property (point-min) (point) 'backtrace-form (gensym)) - (buffer-string))) + (propertize (cl-print-to-string-with-limit #'backtrace--print sexp + (or limit backtrace-line-length)) + ;; Add a unique backtrace-form property. + 'backtrace-form (gensym))) (defun backtrace-print-frame (frame view) "Insert a backtrace FRAME at point formatted according to VIEW. @@ -722,9 +720,10 @@ Format it according to VIEW." (def (find-function-advised-original fun)) (fun-file (or (symbol-file fun 'defun) (and (subrp def) - (not (eq 'unevalled (cdr (subr-arity def)))) + (not (special-form-p def)) (find-lisp-object-file-name fun def)))) - (fun-pt (point))) + (fun-beg (point)) + (fun-end nil)) (cond ((and evald (not debugger-stack-frame-as-list)) (if (atom fun) @@ -734,6 +733,7 @@ Format it according to VIEW." fun (when (and args (backtrace--line-length-or-nil)) (/ backtrace-line-length 2))))) + (setq fun-end (point)) (if args (insert (backtrace--print-to-string args @@ -749,10 +749,16 @@ Format it according to VIEW." (t (let ((fun-and-args (cons fun args))) (insert (backtrace--print-to-string fun-and-args))) - (cl-incf fun-pt))) + ;; Skip the open-paren. + (cl-incf fun-beg))) (when fun-file - (make-text-button fun-pt (+ fun-pt - (length (backtrace--print-to-string fun))) + (make-text-button fun-beg + (or fun-end + (+ fun-beg + ;; FIXME: `backtrace--print-to-string' will + ;; not necessarily print FUN in the same way + ;; as it did when it was in FUN-AND-ARGS! + (length (backtrace--print-to-string fun)))) :type 'help-function-def 'help-args (list fun fun-file))) ;; After any frame that uses eval-buffer, insert a comment that From 21e33567fabdc1310005ff6f96684be514527e8d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 20 Apr 2024 17:49:28 +0200 Subject: [PATCH 133/149] gitlab-ci.yml adaptions * test/infra/gitlab-ci.yml (test-filenotify-gio, test-eglot): Add TEST_HOME. (test-tree-sitter): Extend SELECTOR. --- test/infra/gitlab-ci.yml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 4c44ba6c55c..d262218e276 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -254,7 +254,10 @@ test-filenotify-gio: variables: target: emacs-filenotify-gio # This is needed in order to get a JUnit test report. - make_params: '-k -C test check-expensive LOGFILES="lisp/autorevert-tests.log lisp/filenotify-tests.log"' + make_params: >- + '-k -C test check-expensive + TEST_HOME=/root + LOGFILES="lisp/autorevert-tests.log lisp/filenotify-tests.log"' build-image-eglot: stage: platform-images @@ -271,7 +274,9 @@ test-eglot: variables: target: emacs-eglot # This is needed in order to get a JUnit test report. - make_params: '-k -C test check-expensive LOGFILES="lisp/progmodes/eglot-tests.log"' + make_params: >- + '-k -C test check-expensive + TEST_HOME=/root LOGFILES="lisp/progmodes/eglot-tests.log"' build-image-tree-sitter: stage: platform-images @@ -287,8 +292,12 @@ test-tree-sitter: optional: true variables: target: emacs-tree-sitter + selector: >- + \(and\ \$\{SELECTOR_EXPENSIVE\}\ \(or\ \\\"^treesit\\\"\ \\\"-ts-\\\"\)\) # This is needed in order to get a JUnit test report. - make_params: '-k -C test SELECTOR=\(and\ \$\{SELECTOR_EXPENSIVE\}\ \\\"-ts-\\\"\) TEST_HOME=/root LOGFILES="$tree_sitter_files"' + make_params: >- + '-k -C test check SELECTOR=$selector + TEST_HOME=/root LOGFILES="$tree_sitter_files"' build-image-gnustep: stage: platform-images From 3dfca6f9c7f4da512fff48cf6957c6492e2c0449 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sat, 20 Apr 2024 17:25:20 -0700 Subject: [PATCH 134/149] Re-encode message bodies with externalized attachments during FCC Bug#70338 * lisp/gnus/message.el (message-do-fcc): If the user has requested to externalize attachments, we can't use the cached version of the message body from sending. This mirrors an equivalent check for GCC in `gnus-inews-do-gcc'. --- lisp/gnus/message.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 979d2fecf56..b2805774162 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5768,8 +5768,10 @@ The result is a fixnum." (with-temp-buffer (insert-buffer-substring buf) (message-clone-locals buf) - ;; Avoid re-doing things like GPG-encoding secret parts. - (if (not encoded-cache) + ;; Avoid re-doing things like GPG-encoding secret parts, unless + ;; the user has requested that attachments be externalized, in + ;; which case we have to re-encode the message body. + (if (or mml-externalize-attachments (not encoded-cache)) (message-encode-message-body) (erase-buffer) (insert encoded-cache)) From 9c01da56a547f493535e73877e16ccefcb2730a0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 21 Apr 2024 12:54:17 +0200 Subject: [PATCH 135/149] Fix use of "dired" in Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Do not use "--dired" when long format output isn't requested. --- lisp/net/tramp-sh.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 66e648624b2..60478707c2d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2653,6 +2653,18 @@ The method used must be an out-of-band method." (let ((dired (tramp-get-ls-command-with v "--dired"))) (when (stringp switches) (setq switches (split-string switches))) + ;; Newer coreutil versions of ls (9.5 and up) imply long format + ;; output when "--dired" is given. Suppress this implicit rule. + (when dired + (let ((tem switches) + case-fold-search) + (catch 'long + (while tem + (when (and (not (string-match-p "--" (car tem))) + (string-match-p "l" (car tem))) + (throw 'long nil)) + (setq tem (cdr tem))) + (setq dired nil)))) (setq switches (append switches (split-string (tramp-sh--quoting-style-options v)) (when dired `(,dired)))) From 4773ecb93193495f141e5d60c0c5ded58eaa2c98 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 21 Apr 2024 21:11:22 +0800 Subject: [PATCH 136/149] Better verify arguments to android-relinquish-directory-access * src/androidvfs.c (Fandroid_relinquish_directory_access): Provide for NULL values from android_name_file and remote files. * src/xdisp.c (decode_mode_spec): Don't intern file-remote-p. (syms_of_xdisp) : New defsym. --- src/androidvfs.c | 17 ++++++++++++----- src/xdisp.c | 5 ++++- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/androidvfs.c b/src/androidvfs.c index 9e65dd2b140..c4b3dba4af0 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -7805,10 +7805,10 @@ DEFUN ("android-relinquish-directory-access", Sandroid_relinquish_directory_access, 1, 1, "DDirectory: ", doc: /* Relinquish access to the provided directory. -DIRECTORY must be an inferior directory to a subdirectory of -/content/storage. Once the command completes, the parent of DIRECTORY -below that subdirectory from will cease to appear there, but no files -will be removed. */) +DIRECTORY must be the toplevel directory of an open SAF volume (i.e., a +file under /content/storage), or one of its inferiors. Once the command +completes, the SAF directory holding this directory will vanish, but no +files will be removed. */) (Lisp_Object file) { struct android_vnode *vp; @@ -7824,7 +7824,14 @@ will be removed. */) return Qnil; file = ENCODE_FILE (Fexpand_file_name (file, Qnil)); - vp = android_name_file (SSDATA (file)); + + if (!NILP (call1 (Qfile_remote_p, file))) + signal_error ("Cannot relinquish access to remote file", file); + + vp = android_name_file (SSDATA (file)); + + if (!vp) + report_file_error ("Relinquishing directory", file); if (vp->type != ANDROID_VNODE_SAF_TREE) { diff --git a/src/xdisp.c b/src/xdisp.c index 5fe16ab9536..72a217513ef 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28860,7 +28860,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, Lisp_Object val = Qnil; if (STRINGP (curdir)) - val = dsafe_call1 (intern ("file-remote-p"), curdir); + val = dsafe_call1 (Qfile_remote_p, curdir); val = unbind_to (count, val); @@ -38257,6 +38257,9 @@ The default value is zero, which disables this feature. The recommended non-zero value is between 100000 and 1000000, depending on your patience and the speed of your system. */); max_redisplay_ticks = 0; + + /* Called by decode_mode_spec. */ + DEFSYM (Qfile_remote_p, "file-remote-p"); } From bf5755aa91905a376e4ac9fedde6a645486e1589 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 20 Apr 2024 00:42:25 -0700 Subject: [PATCH 137/149] Add treesit-add-font-lock-rules This function should help users customize font-lock rules. * lisp/treesit.el (treesit-add-font-lock-rules): New function. --- etc/NEWS | 11 ++++++++++- lisp/treesit.el | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 73daac1be3b..82c73f7416b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2539,7 +2539,16 @@ parsers with that tag. Note that passing nil as tag doesn't mean return all parsers, but rather "all parsers with no tags". +++ -*** New function 'treesit-parser-changed-ranges' which returns buffer regions that are affected by the last buffer edits +*** New function 'treesit-parser-changed-ranges'. + +This function returns buffer regions that are affected by the last +buffer edits. + +*** New function 'treesit-add-font-lock-rules'. + +This function helps user to add custom font-lock rules to a tree-sitter +major mode. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/treesit.el b/lisp/treesit.el index 4c9cf5a36e7..e55e04e53b3 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -817,6 +817,17 @@ OVERRIDE is the override flag for this query. Its value can be t, nil, append, prepend, keep. See more in `treesit-font-lock-rules'.") +(defsubst treesit--font-lock-setting-feature (setting) + "Reutrn the feature of SETTING. +SETTING should be a setting in `treesit-font-lock-settings'." + (nth 2 setting)) + +(defsubst treesit--font-lock-setting-enable (setting) + "Return enabled SETTING." + (let ((new-setting (copy-tree setting))) + (setf (nth 1 new-setting) t) + new-setting)) + (defun treesit--font-lock-level-setter (sym val) "Custom setter for `treesit-font-lock-level'. Set the default value of SYM to VAL, recompute fontification @@ -1095,6 +1106,43 @@ and leave settings for other languages unchanged." ((memq feature remove-list) nil) (t current-value)))))) +(defun treesit-add-font-lock-rules (rules &optional how feature) + "Add font-lock RULES to the current buffer + +RULES should be the return value of `treesit-font-lock-rules'. RULES +will be enabled and added to `treesit-font-lock-settings'. + +HOW can be either :before or :after. If HOW is :before, prepend RULES +before all other existing font-lock rules in +`treesit-font-lock-settings'; if :after or omitted, append RULES after +all existing rules. + +If FEATURE is non-nil, add RULES before/after rules for FEATURE. See +docstring of `treesit-font-lock-rules' for what is a feature." + (let ((rules (seq-map #'treesit--font-lock-setting-enable rules)) + (feature-idx + (when feature + (cl-position-if + (lambda (setting) + (eq (treesit--font-lock-setting-feature setting) feature)) + treesit-font-lock-settings)))) + (pcase (cons how feature) + ((or '(:after . nil) '(nil . nil)) + (setq treesit-font-lock-settings + (append treesit-font-lock-settings rules))) + ('(:before . nil) + (setq treesit-font-lock-settings + (append rules treesit-font-lock-settings))) + (`(:after . ,_feature) + (setf (nthcdr (1+ feature-idx) treesit-font-lock-settings) + (append rules + (nthcdr (1+ feature-idx) + treesit-font-lock-settings)))) + (`(:before . ,_feature) + (setf (nthcdr feature-idx treesit-font-lock-settings) + (append rules + (nthcdr feature-idx treesit-font-lock-settings))))))) + (defun treesit-fontify-with-override (start end face override &optional bound-start bound-end) "Apply FACE to the region between START and END. From 91cad6df73e5d64ae5621baa8e01a295433e1e55 Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Thu, 18 Apr 2024 18:52:06 -0700 Subject: [PATCH 138/149] Improve function signature font-lock rust-ts-mode (bug#70465) * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--font-lock-settings): Add font-lock rule for Rust function signatures and missing function modifier keyword 'default'. --- lisp/progmodes/rust-ts-mode.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 7112ceced57..92978db64af 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -129,7 +129,7 @@ to be checked as its standard input." "Rust built-in macros for tree-sitter font-locking.") (defvar rust-ts-mode--keywords - '("as" "async" "await" "break" "const" "continue" "dyn" "else" + '("as" "async" "await" "break" "const" "continue" "default" "dyn" "else" "enum" "extern" "fn" "for" "if" "impl" "in" "let" "loop" "match" "mod" "move" "pub" "ref" "return" "static" "struct" "trait" "type" "union" "unsafe" "use" "where" "while" (crate) (self) (super) @@ -176,6 +176,7 @@ to be checked as its standard input." :language 'rust :feature 'definition '((function_item name: (identifier) @font-lock-function-name-face) + (function_signature_item name: (identifier) @font-lock-function-name-face) (macro_definition "macro_rules!" @font-lock-constant-face) (macro_definition (identifier) @font-lock-preprocessor-face) (field_declaration name: (field_identifier) @font-lock-property-name-face) From 81391ae3f52a41f30137642976ae06dd49572bfe Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 21 Apr 2024 21:25:19 -0700 Subject: [PATCH 139/149] Add tree-sitter comment-indent-new-line (bug#70074) * lisp/progmodes/c-ts-common.el: (c-ts-common-comment-indent-new-line): New function. (c-ts-common-comment-setup): Setup comment-line-break-function and comment-multi-line. --- lisp/progmodes/c-ts-common.el | 50 +++++++++++++++++++++++++++++++++-- 1 file changed, 48 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index e48bcc64f14..298fb3cd074 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -221,7 +221,9 @@ Set up: - `adaptive-fill-first-line-regexp' - `paragraph-start' - `paragraph-separate' - - `fill-paragraph-function'" + - `fill-paragraph-function' + - `comment-line-break-function' + - `comment-multi-line'" (setq-local comment-start "// ") (setq-local comment-end "") (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) @@ -267,7 +269,51 @@ Set up: eol) "\f"))) (setq-local paragraph-separate paragraph-start) - (setq-local fill-paragraph-function #'c-ts-common--fill-paragraph)) + (setq-local fill-paragraph-function #'c-ts-common--fill-paragraph) + + (setq-local comment-line-break-function + #'c-ts-common-comment-indent-new-line) + (setq-local comment-multi-line t)) + +(defun c-ts-common-comment-indent-new-line (&optional soft) + "Break line at point and indent, continuing comment if within one. + +This is like `comment-indent-new-line', but specialized for C-style // +and /* */ comments. SOFT works the same as in +`comment-indent-new-line'." + ;; I want to experiment with explicitly listing out all each cases and + ;; handle them separately, as opposed to fiddling with `comment-start' + ;; and friends. This will have more duplicate code and will be less + ;; generic, but in the same time might save us from writting cryptic + ;; code to handle all sorts of edge cases. + ;; + ;; For this command, let's try to make it basic: if the current line + ;; is a // comment, insert a newline and a // prefix; if the current + ;; line is in a /* comment, insert a newline and a * prefix. No + ;; auto-fill or other smart features. + (cond + ((save-excursion + (beginning-of-line) + (looking-at (rx "//" (group (* " "))))) + (let ((whitespaces (match-string 1))) + (if soft (insert-and-inherit ?\n) (newline 1)) + (delete-region (point) (line-end-position)) + (insert "//" whitespaces))) + + ((save-excursion + (beginning-of-line) + (looking-at (rx "/*"))) + (if soft (insert-and-inherit ?\n) (newline 1)) + (delete-region (point) (line-end-position)) + (insert " *")) + + ((save-excursion + (beginning-of-line) + (looking-at (rx (group (* " ") (or "*" "|") (* " "))))) + (let ((prefix (match-string 1))) + (if soft (insert-and-inherit ?\n) (newline 1)) + (delete-region (point) (line-end-position)) + (insert prefix))))) ;;; Statement indent From ecf15513ea303a5ddf0d006b8ea6ebba665c737f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 21 Apr 2024 21:41:00 -0700 Subject: [PATCH 140/149] Make c-ts-common-comment-indent-new-line work for more cases * lisp/progmodes/c-ts-common.el: (c-ts-common-comment-indent-new-line): Handle the case where user types M-j in the middle of a line; and when the line starts with /**. --- lisp/progmodes/c-ts-common.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 298fb3cd074..732b61bdd8f 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -292,27 +292,31 @@ and /* */ comments. SOFT works the same as in ;; line is in a /* comment, insert a newline and a * prefix. No ;; auto-fill or other smart features. (cond + ;; Line starts with // ((save-excursion (beginning-of-line) (looking-at (rx "//" (group (* " "))))) (let ((whitespaces (match-string 1))) (if soft (insert-and-inherit ?\n) (newline 1)) - (delete-region (point) (line-end-position)) + (delete-region (line-beginning-position) (point)) (insert "//" whitespaces))) + ;; Line starts with /* or /** ((save-excursion (beginning-of-line) - (looking-at (rx "/*"))) - (if soft (insert-and-inherit ?\n) (newline 1)) - (delete-region (point) (line-end-position)) - (insert " *")) + (looking-at (rx "/*" (group (? "*") (* " "))))) + (let ((whitespace-and-star-len (length (match-string 1)))) + (if soft (insert-and-inherit ?\n) (newline 1)) + (delete-region (line-beginning-position) (point)) + (insert " *" (make-string whitespace-and-star-len ?\s)))) + ;; Line starts with * ((save-excursion (beginning-of-line) (looking-at (rx (group (* " ") (or "*" "|") (* " "))))) (let ((prefix (match-string 1))) (if soft (insert-and-inherit ?\n) (newline 1)) - (delete-region (point) (line-end-position)) + (delete-region (line-beginning-position) (point)) (insert prefix))))) ;;; Statement indent From 5c51bc934ebb88dd9dd8b228e99c39518c92c54b Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Thu, 18 Apr 2024 18:22:05 -0700 Subject: [PATCH 141/149] Add font-locking for Rust macros (bug#70464) * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--font-lock-settings): Add font-locking for Rust macro metavariables, fragment specifiers and repitition patterns. --- lisp/progmodes/rust-ts-mode.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 92978db64af..25f1df4a9f9 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -179,6 +179,8 @@ to be checked as its standard input." (function_signature_item name: (identifier) @font-lock-function-name-face) (macro_definition "macro_rules!" @font-lock-constant-face) (macro_definition (identifier) @font-lock-preprocessor-face) + (token_binding_pattern + name: (metavariable) @font-lock-variable-name-face) (field_declaration name: (field_identifier) @font-lock-property-name-face) (parameter pattern: (_) @rust-ts-mode--fontify-pattern) (closure_parameters (_) @rust-ts-mode--fontify-pattern) @@ -219,7 +221,9 @@ to be checked as its standard input." :language 'rust :feature 'operator - `([,@rust-ts-mode--operators] @font-lock-operator-face) + `([,@rust-ts-mode--operators] @font-lock-operator-face + (token_repetition_pattern ["$" "*" "+"] @font-lock-operator-face) + (token_repetition ["$" "*" "+"] @font-lock-operator-face)) :language 'rust :feature 'string @@ -249,8 +253,7 @@ to be checked as its standard input." (_ type: (scoped_identifier path: (identifier) @font-lock-type-face)))) (mod_item name: (identifier) @font-lock-constant-face) - (primitive_type) @font-lock-type-face - (type_identifier) @font-lock-type-face + [(fragment_specifier) (primitive_type) (type_identifier)] @font-lock-type-face ((scoped_identifier name: (identifier) @rust-ts-mode--fontify-tail)) ((scoped_identifier path: (identifier) @font-lock-type-face) (:match ,(rx bos @@ -260,8 +263,7 @@ to be checked as its standard input." eos) @font-lock-type-face)) ((scoped_identifier path: (identifier) @rust-ts-mode--fontify-scope)) - ((scoped_type_identifier path: (identifier) @rust-ts-mode--fontify-scope)) - (type_identifier) @font-lock-type-face) + ((scoped_type_identifier path: (identifier) @rust-ts-mode--fontify-scope))) :language 'rust :feature 'property @@ -295,7 +297,8 @@ to be checked as its standard input." (return_expression (identifier) @font-lock-variable-use-face) (tuple_expression (identifier) @font-lock-variable-use-face) (unary_expression (identifier) @font-lock-variable-use-face) - (while_expression condition: (identifier) @font-lock-variable-use-face)) + (while_expression condition: (identifier) @font-lock-variable-use-face) + (metavariable) @font-lock-variable-use-face) :language 'rust :feature 'escape-sequence From ac2a4f61bdd0dc3a71a544d25de7cb36d37f44f9 Mon Sep 17 00:00:00 2001 From: Noah Peart Date: Fri, 19 Apr 2024 10:27:10 -0700 Subject: [PATCH 142/149] Add rust-ts-mode font-locking tests (bug#70464) * test/lisp/progmodes/rust-ts-mode-tests.el: New file for rust-ts-mode tests. * test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs: New file with rust-ts-mode font-locking tests. New tests added for macro font-locking (bug#70464) and function signatures (bug#70465). --- .../rust-ts-mode-resources/font-lock.rs | 25 ++++++++++++++ test/lisp/progmodes/rust-ts-mode-tests.el | 34 +++++++++++++++++++ 2 files changed, 59 insertions(+) create mode 100644 test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs create mode 100644 test/lisp/progmodes/rust-ts-mode-tests.el diff --git a/test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs b/test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs new file mode 100644 index 00000000000..377cda0e3b9 --- /dev/null +++ b/test/lisp/progmodes/rust-ts-mode-resources/font-lock.rs @@ -0,0 +1,25 @@ +// -*- rust-ts-mode-indent-offset: 0 -*- +// Trait with function signature +trait Foo { + fn foo(); +// ^ font-lock-function-name-face +} + +// Macros +macro_rules! unsafe_foo { + ($env:expr, $name:ident $(, $args:expr)*) => { +// ^ font-lock-variable-name-face +// ^ font-lock-type-face +// ^ font-lock-variable-name-face +// ^ font-lock-type-face +// ^ font-lock-operator-face +// ^ font-lock-variable-name-face +// ^ font-lock-type-face +// ^ font-lock-operator-face + { + foo!($env, $name $(, $args)*); +// ^ font-lock-variable-use-face +// ^ font-lock-operator-face +// ^ font-lock-operator-face + } + }; diff --git a/test/lisp/progmodes/rust-ts-mode-tests.el b/test/lisp/progmodes/rust-ts-mode-tests.el new file mode 100644 index 00000000000..f718a57fc9e --- /dev/null +++ b/test/lisp/progmodes/rust-ts-mode-tests.el @@ -0,0 +1,34 @@ +;;; rust-ts-mode-tests.el --- Tests for rust-ts-mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023-2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-font-lock) +(require 'ert-x) +(require 'treesit) + +(ert-deftest rust-ts-test-font-lock () + (skip-unless (treesit-ready-p 'rust)) + (let ((treesit-font-lock-level 4)) + (ert-font-lock-test-file (ert-resource-file "font-lock.rs") 'rust-ts-mode))) + +(provide 'rust-ts-mode-tests) + +;;; rust-ts-mode-tests.el ends here From 7d6f4d90856000df805269fb620adb8bd3760717 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Apr 2024 13:31:57 +0800 Subject: [PATCH 143/149] Fix load order of certain Android shared libraries * java/org/gnu/emacs/EmacsNative.java (libraryDeps): Move dependencies of selinux and gnutls before their respective dependents. --- java/org/gnu/emacs/EmacsNative.java | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 24440bd5953..567242f2ec3 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -327,20 +327,20 @@ public static native void blitRect (Bitmap src, Bitmap dest, int x1, loaded from Java. Every time you add a new shared library dependency to Emacs, - please add it here as well. */ + please insert it here as well, before other shared libraries of + which it might be a dependency. */ libraryDeps = new String[] { "c++_shared", "gnustl_shared", "stlport_shared", "gabi++_shared", - "png_emacs", "selinux_emacs", - "crypto_emacs", "pcre_emacs", + "png_emacs", "pcre_emacs", + "selinux_emacs", "crypto_emacs", "packagelistparser_emacs", - "gnutls_emacs", "gmp_emacs", - "nettle_emacs", "p11-kit_emacs", - "tasn1_emacs", "hogweed_emacs", - "jpeg_emacs", - "tiff_emacs", "xml2_emacs", - "icuuc_emacs", "harfbuzz_emacs", - "tree-sitter_emacs", }; + "gmp_emacs", "nettle_emacs", + "p11-kit_emacs", "tasn1_emacs", + "hogweed_emacs", "gnutls_emacs", + "jpeg_emacs", "tiff_emacs", + "icuuc_emacs", "xml2_emacs", + "harfbuzz_emacs", "tree-sitter_emacs", }; for (String dependency : libraryDeps) { From d51b0d2ebe4d0f55993e8e13f6d35b1eb23abf52 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Apr 2024 09:45:40 +0300 Subject: [PATCH 144/149] * lisp/files.el (find-alternate-file): Fix the order of restoring buffer. Swap the order of restoring original buffer's file names and restoring original's buffer name with 'rename-buffer' (bug#68235). --- lisp/files.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 1e11dd44bad..9f5ed85ce60 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2113,15 +2113,15 @@ killed." (rename-buffer oname))) (unless (eq (current-buffer) obuf) (with-current-buffer obuf - (unless (get-buffer oname) - ;; Restore original's buffer name so 'kill-buffer' can use it - ;; to assign its last name (Bug#68235). - (rename-buffer oname)) ;; Restore original buffer's file names so they can be still ;; used when referencing the now defunct buffer (Bug#68235). (setq buffer-file-name ofile) (setq buffer-file-number onum) (setq buffer-file-truename otrue) + (unless (get-buffer oname) + ;; Restore original's buffer name so 'kill-buffer' can use it + ;; to assign its last name (Bug#68235). + (rename-buffer oname)) ;; We already ran these; don't run them again. (let (kill-buffer-query-functions kill-buffer-hook) (kill-buffer obuf)))))) From 086608876ad4e3aacdce7169206482cef0cb7129 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Apr 2024 09:50:45 +0300 Subject: [PATCH 145/149] * lisp/emacs-lisp/warnings.el (warning-display-at-bottom): New defcustom. (display-warning): Use 'warning-display-at-bottom' to display the warning buffer at the bottom of the screen and to scroll to the last warning message (bug#69983). --- lisp/emacs-lisp/warnings.el | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 8b43c6a8726..6a1187fdb0f 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -120,6 +120,14 @@ so only the element (FOO) will match it. See also `warning-suppress-log-types'." :type '(repeat (repeat symbol)) :version "22.1") + +(defcustom warning-display-at-bottom t + "Display the warning buffer at the bottom of the screen. +The output window will be scrolled to the bottom of the buffer +to show the last warning message." + :type 'boolean + :version "30.1") + ;; The autoload cookie is so that programs can bind this variable ;; safely, testing the existing value, before they call one of the @@ -362,10 +370,21 @@ entirely by setting `warning-suppress-types' or (or (< (warning-numeric-level level) (warning-numeric-level warning-minimum-level)) (warning-suppress-p type warning-suppress-types) - (let ((window (display-buffer buffer))) + (let ((window (display-buffer + buffer + (when warning-display-at-bottom + '(display-buffer--maybe-at-bottom + (window-height . (lambda (window) + (fit-window-to-buffer window 10))) + (category . warning)))))) (when (and (markerp warning-series) (eq (marker-buffer warning-series) buffer)) (set-window-start window warning-series)) + (when warning-display-at-bottom + (with-selected-window window + (goto-char (point-max)) + (set-window-point window (1- (point-max))) + (recenter -1))) (sit-for 0))))))))) ;; Use \\ so that help-enable-autoload can do its thing. From 419550c7907275bf962986e1cc8fba1989d8659c Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 22 Apr 2024 09:54:18 +0300 Subject: [PATCH 146/149] * lisp/progmodes/flymake.el: Small improvements for buffers display. (flymake-mode-map): Bind mouse-1 click on the fringe to 'flymake-show-buffer-diagnostics' (bug#70459). (flymake-show-buffer-diagnostics): Display buffer diagnostics at the bottom. (flymake-show-project-diagnostics): Display project diagnostics at the bottom. --- lisp/progmodes/flymake.el | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 22a139d3045..f5bf68db574 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1331,7 +1331,10 @@ Interactively, with a prefix arg, FORCE is t." nil)))))))) (defvar flymake-mode-map - (let ((map (make-sparse-keymap))) map) + (let ((map (make-sparse-keymap))) + (define-key map `[,flymake-fringe-indicator-position mouse-1] + #'flymake-show-buffer-diagnostics) + map) "Keymap for `flymake-mode'.") ;;;###autoload @@ -1972,8 +1975,12 @@ buffer." (current-buffer))))) (with-current-buffer target (setq flymake--diagnostics-buffer-source source) - (display-buffer (current-buffer)) - (revert-buffer)))) + (revert-buffer) + (display-buffer (current-buffer) + `((display-buffer-reuse-window + display-buffer-below-selected) + (window-height . (lambda (window) + (fit-window-to-buffer window 10)))))))) ;;; Per-project diagnostic listing @@ -2073,8 +2080,11 @@ some of this variable's contents the diagnostic listings.") (with-current-buffer buffer (flymake-project-diagnostics-mode) (setq-local flymake--project-diagnostic-list-project prj) - (display-buffer (current-buffer)) - (revert-buffer)))) + (revert-buffer) + (display-buffer (current-buffer) + `((display-buffer-reuse-window + display-buffer-at-bottom) + (window-height . fit-window-to-buffer)))))) (defun flymake--update-diagnostics-listings (buffer) "Update diagnostics listings somehow relevant to BUFFER." From 4d9629b087fe6df941b553c6931b2f8996901e21 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 21 Apr 2024 23:57:09 -0700 Subject: [PATCH 147/149] Cover more cases in c-ts-common-comment-indent-new-line * lisp/progmodes/c-ts-common.el: (c-ts-common-comment-indent-new-line): Handle the case for ///, which is used by rust. --- lisp/progmodes/c-ts-common.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 732b61bdd8f..735126e1eac 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -292,10 +292,10 @@ and /* */ comments. SOFT works the same as in ;; line is in a /* comment, insert a newline and a * prefix. No ;; auto-fill or other smart features. (cond - ;; Line starts with // + ;; Line starts with //, or ///, or ////... ((save-excursion (beginning-of-line) - (looking-at (rx "//" (group (* " "))))) + (looking-at (rx "//" (group (* "/") (* " "))))) (let ((whitespaces (match-string 1))) (if soft (insert-and-inherit ?\n) (newline 1)) (delete-region (line-beginning-position) (point)) From 3bcdf010a9f2576bac0d7f23af70fa9dff81ef95 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Apr 2024 16:27:30 +0800 Subject: [PATCH 148/149] Generate Android shared library list automatically * .gitignore: Ignore new generated files. * cross/Makefile.in (src/Makefile): Remove leftover specification of the source Gnulib directory. * cross/ndk-build/ndk-build.mk.in (NDK_BUILD_READELF): New variable. * java/Makefile.in (CONFIG_FILE, ALL_DEPENDENCIES, READELF) (cf-stamp-1, cf-stamp): New variables and rules; compute the set of library files in the order of loading and generate a file with this information. (ALL_CLASS_FILES): New variable; if builddir is not srcdir, $($(CONFIG_FILE), $(CLASS_FILES)): Depend on EmacsConfig.java. add generated files in the build directory. (classes.dex): Adjust to match. * java/org/gnu/emacs/EmacsNative.java (EmacsNative) : Load shared libraries from EMACS_SHARED_LIBRARIES rather than a hard-coded list. * m4/ndk-build.m4 (ndk_INIT): Search for readelf... (ndk_CHECK_MODULES): ...and substitute its path as NDK_BUILD_READELF. --- .gitignore | 4 ++ cross/Makefile.in | 2 +- cross/ndk-build/ndk-build.mk.in | 1 + java/Makefile.in | 91 +++++++++++++++++++++++++++-- java/org/gnu/emacs/EmacsNative.java | 52 ++++++++--------- m4/ndk-build.m4 | 11 ++++ 6 files changed, 126 insertions(+), 35 deletions(-) diff --git a/.gitignore b/.gitignore index 29c571a3dcb..4098e2210b5 100644 --- a/.gitignore +++ b/.gitignore @@ -66,6 +66,10 @@ java/org/gnu/emacs/*.class # Built by `aapt'. java/org/gnu/emacs/R.java +# Built by `make'. +java/org/gnu/emacs/EmacsConfig.java +java/org/gnu/emacs/cf-stamp + # Built by `config.status'. java/AndroidManifest.xml diff --git a/cross/Makefile.in b/cross/Makefile.in index 1e8daea6f91..575c6c4cb29 100644 --- a/cross/Makefile.in +++ b/cross/Makefile.in @@ -140,7 +140,7 @@ src/Makefile: $(top_builddir)/src/Makefile.android -e 's/\.\.\/admin\/charsets/..\/..\/admin\/charsets/g' \ -e 's/^libsrc =.*$$/libsrc = \.\.\/\.\.\/lib-src/g' \ -e 's/libsrc =.*$$/libsrc = \.\.\/\.\.\/lib-src/g' \ - -e 's/-I\$$(top_srcdir)\/lib/-I..\/$(subst /,\/,$(srcdir))\/lib/g' \ + -e 's/-I\$$(top_srcdir)\/lib//g' \ < $(top_builddir)/src/Makefile.android > $@ src/epaths.h: $(top_builddir)/src/epaths.h diff --git a/cross/ndk-build/ndk-build.mk.in b/cross/ndk-build/ndk-build.mk.in index ea1be5af6f1..9948e019e3b 100644 --- a/cross/ndk-build/ndk-build.mk.in +++ b/cross/ndk-build/ndk-build.mk.in @@ -27,6 +27,7 @@ NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@ NDK_BUILD_ANY_CXX_MODULE = @NDK_BUILD_ANY_CXX_MODULE@ NDK_BUILD_SHARED = NDK_BUILD_STATIC = +NDK_BUILD_READELF = @NDK_BUILD_READELF@ define uniqify $(if $1,$(firstword $1) $(call uniqify,$(filter-out $(firstword $1),$1))) diff --git a/java/Makefile.in b/java/Makefile.in index 7d732be8f91..bd1938689d5 100644 --- a/java/Makefile.in +++ b/java/Makefile.in @@ -83,6 +83,10 @@ RESOURCE_FILES := $(foreach file,$(wildcard $(srcdir)/res/*), \ # code. Instead, it is automatically included by the Java compiler. RESOURCE_FILE := $(srcdir)/org/gnu/emacs/R.java +# EmacsConfig.java is a file that holds information regarding the set of +# shared libraries this binary links to, and similar build variables. +CONFIG_FILE := $(builddir)/org/gnu/emacs/EmacsConfig.java + # CLASS_FILES is what should actually be built and included in the # resulting Emacs executable. The Java compiler might generate more # than one class file for each source file, so this only serves as a @@ -294,8 +298,72 @@ $(RESOURCE_FILE): $(RESOURCE_FILES) -J $(dir $@) -M AndroidManifest.xml \ -S $(top_srcdir)/java/res -# Make all class files depend on R.java being built. -$(CLASS_FILES): $(RESOURCE_FILE) +# Generate a list of libemacs's dependencies with each item ordered +# before its dependents for the startup process to load in advance, as +# older versions of the dynamic linker do not consider these libraries +# when resolving its imports. The several following statements are +# executed from a recursive `make' run after shared libraries are +# generated. + +ALL_DEPENDENCIES := + +ifneq (,$(filter cf-stamp-1,$(MAKECMDGOALS))) +# Don't be sidetracked by dependencies of shared libraries outside the +# ndk-build directory. +define get-dependencies +$(foreach x, \ +$(and $(wildcard $(top_builddir)/cross/ndk-build/$1.so), \ + $(shell $(NDK_BUILD_READELF) -d \ + $(wildcard $(top_builddir)/cross/ndk-build/$1.so) \ + | sed -n 's/.*(NEEDED).*\[\(.*\.so\)\].*/\1/p')), \ +$(basename $(notdir $(x)))) +endef #get-dependencies +define resolve-one-dependency +$(foreach dependency,$(call get-dependencies,$1),\ + $(if $(findstring "$(dependency)",$(ALL_DEPENDENCIES)),,\ + $(call resolve-one-dependency,$(basename $(notdir $(dependency)))) \ + $(eval ALL_DEPENDENCIES := $(ALL_DEPENDENCIES) "$(dependency)",))) +endef #resolve-one-dependency +DEPENDENCIES := $(foreach file,$(NDK_BUILD_SHARED),\ + $(basename $(notdir $(file)))) +$(foreach file,$(DEPENDENCIES),\ + $(if $(findstring "$(file)",$(ALL_DEPENDENCIES)),,\ + $(call resolve-one-dependency,$(file)) \ + $(eval ALL_DEPENDENCIES := $(ALL_DEPENDENCIES) "$(file)",))) +endif + +# EmacsConfig.java: +ifeq (${V},1) +AM_V_EMACSCONFIG = +else +AM_V_EMACSCONFIG = @$(info $. GEN org/gnu/emacs/EmacsConfig.java) +endif + +.PHONY: cf-stamp-1 +cf-stamp-1: + $(AM_V_at) echo 'package org.gnu.emacs;\ +public class EmacsConfig\ +{\ +/* This is a generated file. Do not edit! */\ +public static final String[] EMACS_SHARED_LIBRARIES\ += {$(ALL_DEPENDENCIES)};\ +}' | sed 's/\\//g' > globals.tmp + $(AM_V_at) mkdir -p org/gnu/emacs + $(AM_V_at) $(top_srcdir)/build-aux/move-if-change \ + globals.tmp org/gnu/emacs/EmacsConfig.java + +# cf-stamp-1 is a phony target invoked in a second `make' instance after +# all shared libraries are compiled, because the computation of +# ALL_DEPENDENCIES cannot be postponed until that stage in this instance +# of Make. +cf-stamp: $(NDK_BUILD_SHARED) $(CROSS_LIBS) + $(AM_V_EMACSCONFIG) $(MAKE) cf-stamp-1 + $(AM_V_at) touch $@ +$(CONFIG_FILE): cf-stamp; @true + +# Make all class files depend on R.java and EmacsConfig.java being +# built. +$(CLASS_FILES): $(RESOURCE_FILE) $(CONFIG_FILE) .SUFFIXES: .java .class $(CLASS_FILES) &: $(JAVA_FILES) @@ -305,13 +373,23 @@ $(CLASS_FILES) &: $(JAVA_FILES) # N.B. that find must be called all over again in case javac generated # nested classes. +ALL_CLASS_FILES = \ + $(subst $$,\$$,$(shell find $(srcdir) -type f -name *.class)) + +ifneq ($(builddir),$(srcdir)) +# If the build directory is distinct from the source directory, also +# include generated class files located there. +ALL_CLASS_FILES = $(ALL_CLASS_FILES) \ + $(subst $$,\$$,$(shell find $(builddir) -type f -name *.class)) +endif + classes.dex: $(CLASS_FILES) $(if $(IS_D8_R8), $(srcdir)/proguard.conf) $(AM_V_D8) $(D8) --classpath $(ANDROID_JAR) \ - $(subst $$,\$$,$(shell find $(srcdir) -type f \ - -name *.class)) --output $(builddir) \ + $(ALL_CLASS_FILES) \ + --output $(builddir) \ --min-api $(ANDROID_MIN_SDK) \ $(if $(filter false,$(ANDROID_DEBUGGABLE)),--release, \ - --debug) \ + --debug) \ $(if $(IS_D8_R8),--pg-conf $(srcdir)/proguard.conf) # When emacs.keystore expires, regenerate it with: @@ -345,7 +423,8 @@ TAGS: $(ETAGS) $(tagsfiles) $(AM_V_GEN) $(ETAGS) $(tagsfiles) clean: - rm -f *.apk emacs.apk-in *.dex *.unaligned *.class *.idsig + rm -f *.apk emacs.apk-in *.dex *.unaligned *.class *.idsig \ + cf-stamp $(CONFIG_FILE) rm -rf install-temp $(RESOURCE_FILE) TAGS find . -name '*.class' $(FIND_DELETE) diff --git a/java/org/gnu/emacs/EmacsNative.java b/java/org/gnu/emacs/EmacsNative.java index 567242f2ec3..9b3e60e1a84 100644 --- a/java/org/gnu/emacs/EmacsNative.java +++ b/java/org/gnu/emacs/EmacsNative.java @@ -321,39 +321,35 @@ public static native void blitRect (Bitmap src, Bitmap dest, int x1, static { - /* Older versions of Android cannot link correctly with shared - libraries that link with other shared libraries built along - Emacs unless all requisite shared libraries are explicitly - loaded from Java. - - Every time you add a new shared library dependency to Emacs, - please insert it here as well, before other shared libraries of - which it might be a dependency. */ - - libraryDeps = new String[] { "c++_shared", "gnustl_shared", - "stlport_shared", "gabi++_shared", - "png_emacs", "pcre_emacs", - "selinux_emacs", "crypto_emacs", - "packagelistparser_emacs", - "gmp_emacs", "nettle_emacs", - "p11-kit_emacs", "tasn1_emacs", - "hogweed_emacs", "gnutls_emacs", - "jpeg_emacs", "tiff_emacs", - "icuuc_emacs", "xml2_emacs", - "harfbuzz_emacs", "tree-sitter_emacs", }; + /* A library search path misconfiguration prevents older versions of + Android from successfully loading application shared libraries + unless all requisite shared libraries provided by the application + are explicitly loaded from Java. The build process arranges that + EmacsConfig.EMACS_SHARED_LIBRARIES hold the names of each of + these libraries in the correct order, so load them now. */ + + libraryDeps = EmacsConfig.EMACS_SHARED_LIBRARIES; for (String dependency : libraryDeps) { - try - { - System.loadLibrary (dependency); - } - catch (UnsatisfiedLinkError exception) - { - /* Ignore this exception. */ - } + /* Remove the "lib" prefix, if any. */ + if (dependency.startsWith ("lib")) + dependency = dependency.substring (3); + + /* If this library is provided by the operating system, don't + link to it. */ + if (dependency.equals ("z") + || dependency.equals ("c") + || dependency.equals ("m") + || dependency.equals ("dl") + || dependency.equals ("log") + || dependency.equals ("android")) + continue; + + System.loadLibrary (dependency); } + /* At this point, it should be alright to load Emacs. */ System.loadLibrary ("emacs"); }; }; diff --git a/m4/ndk-build.m4 b/m4/ndk-build.m4 index abe06063ab0..2689ee34287 100644 --- a/m4/ndk-build.m4 +++ b/m4/ndk-build.m4 @@ -339,6 +339,16 @@ NDK_BUILD_NASM= AS_IF([test "$ndk_ARCH" = "x86" || test "$ndk_ARCH" = "x86_64"], [AC_CHECK_PROGS([NDK_BUILD_NASM], [nasm])]) +# Search for a suitable readelf binary, which is required to generate +# the shared library list loaded on old Android systems. +AC_PATH_PROGS([READELF], [readelf llvm-readelf $host_alias-readelf], + [], [$ndk_ranlib_search_path:$PATH]) +AS_IF([test -z "$READELF"], + [AC_MSG_ERROR([A suitable `readelf' utility cannot be located. +Please verify that the Android NDK has been installed correctly, +or install a functioning `readelf' yourself.])]) +NDK_BUILD_READELF="$READELF" + # Search for a C++ compiler. Upon failure, pretend the C compiler is a # C++ compiler and use that instead. @@ -644,6 +654,7 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES], AC_SUBST([NDK_BUILD_CXX_LDFLAGS]) AC_SUBST([NDK_BUILD_ANY_CXX_MODULE]) AC_SUBST([NDK_BUILD_CFLAGS]) + AC_SUBST([NDK_BUILD_READELF]) AC_CONFIG_FILES([$ndk_DIR/Makefile]) AC_CONFIG_FILES([$ndk_DIR/ndk-build.mk]) From 931cd9331363051a8cb5ef45dc37937e63b243d9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 22 Apr 2024 16:37:01 +0800 Subject: [PATCH 149/149] ; * java/Makefile.in: Fix typos. --- java/Makefile.in | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/java/Makefile.in b/java/Makefile.in index bd1938689d5..abddae6b5cf 100644 --- a/java/Makefile.in +++ b/java/Makefile.in @@ -367,7 +367,7 @@ $(CLASS_FILES): $(RESOURCE_FILE) $(CONFIG_FILE) .SUFFIXES: .java .class $(CLASS_FILES) &: $(JAVA_FILES) - $(AM_V_JAVAC) $(JAVAC) $(JAVAFLAGS) $(JAVA_FILES) + $(AM_V_JAVAC) $(JAVAC) $(JAVAFLAGS) $(JAVA_FILES) $(CONFIG_FILE) $(AM_V_SILENT) touch $(CLASS_FILES) # N.B. that find must be called all over again in case javac generated @@ -375,17 +375,18 @@ $(CLASS_FILES) &: $(JAVA_FILES) ALL_CLASS_FILES = \ $(subst $$,\$$,$(shell find $(srcdir) -type f -name *.class)) +ALL_CLASS_FILES_1 = ifneq ($(builddir),$(srcdir)) # If the build directory is distinct from the source directory, also # include generated class files located there. -ALL_CLASS_FILES = $(ALL_CLASS_FILES) \ +ALL_CLASS_FILES_1 = \ $(subst $$,\$$,$(shell find $(builddir) -type f -name *.class)) endif classes.dex: $(CLASS_FILES) $(if $(IS_D8_R8), $(srcdir)/proguard.conf) $(AM_V_D8) $(D8) --classpath $(ANDROID_JAR) \ - $(ALL_CLASS_FILES) \ + $(ALL_CLASS_FILES) $(ALL_CLASS_FILES_1) \ --output $(builddir) \ --min-api $(ANDROID_MIN_SDK) \ $(if $(filter false,$(ANDROID_DEBUGGABLE)),--release, \