commit 42776dc5b7702cec2feb787fbf770d91623b9818 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Apr 20 09:53:35 2024 +0300 ; Fix documentation of recent commits related to treesit * src/treesit.c (Ftreesit_parser_changed_ranges): * doc/lispref/parsing.texi (Using Parser): Fix wording. 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 commit 71d2ec7aba3d6ef9386e807970b0bfaa2043d128 Author: Stefan Monnier Date: Fri Apr 19 22:19:00 2024 -0400 (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. 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. commit f62c1b4cd00e5b2f1cdc94796cf55d006c3113eb Author: Yuan Fu Date: Fri Apr 19 00:18:03 2024 -0700 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. 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. commit 996b9576713f9d63ea7ff7e9630a15cb0a0214eb Author: Yuan Fu Date: Tue Apr 16 23:46:39 2024 -0700 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. 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. */ commit 8166d9d1747648d1f457195090ad36dd333bbc52 Author: Yuan Fu Date: Mon Apr 15 23:13:20 2024 -0700 ; Minor fix in tree-sitter manual section * doc/lispref/parsing.texi (User-defined Things): Mention treesit-defun-type-regexp. 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 commit e5b4d4dd1bb4d568ed20cfb7354c5ff898af7a05 Author: Eric Abrahamsen Date: Fri Apr 19 16:26:36 2024 -0700 ; 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. 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 commit f90008411e827390857a4ad25e0c40fa5d27212a Author: João Távora Date: Fri Apr 19 16:21:21 2024 -0500 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. 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 () commit 473189ab6902b0488f8001fdf993522b82740663 Author: F. Jason Park Date: Sat Apr 13 14:58:13 2024 -0700 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) 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))) commit 6000e48e0d7d5742ba817942f1b0dbbda9315ddc Author: F. Jason Park Date: Thu Apr 18 22:18:57 2024 -0700 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) 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. commit 86184cba2180a09b31e92f7366f9dd38de5b976a Author: F. Jason Park Date: Mon Apr 8 14:21:43 2024 -0700 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) 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) commit 21b372a57bb0cab9ebdf93843090081eb4715030 Author: F. Jason Park Date: Fri Apr 12 00:04:50 2024 -0700 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) 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 commit c572c30fb121008e5b248688ebe319dd85633c72 Author: F. Jason Park Date: Fri Apr 12 00:04:50 2024 -0700 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) 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 commit ff1d1f6df16a57acd699b18bdaa4baadff8269a1 Author: F. Jason Park Date: Sun Apr 7 19:28:24 2024 -0700 ; 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. 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")) commit 49ef173b0287e17273e4476df16dca5f2196b11c Author: Theodor Thornhill Date: Fri Apr 19 20:40:25 2024 +0200 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 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")) commit 82775f21413681b09c888527b5d2fb15354f0793 Author: Jim Porter Date: Fri Apr 19 10:37:16 2024 -0700 ; * test/lisp/net/eww-tests.el (eww-test/display/html): Check for libxml. 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) commit 52d3ee46dbc6fb0fbcfbb8e446fb385aef189893 Author: Michael Albinus Date: Fri Apr 19 12:15:47 2024 +0200 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. 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) commit 2675c2824f77f46476831e637e4bc0fec692a0f1 Author: Po Lu Date: Fri Apr 19 17:38:58 2024 +0800 * java/INSTALL: Update instructions. 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''.