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)
This commit is contained in:
F. Jason Park
parent
21b372a57b
commit
86184cba21
11 changed files with 328 additions and 147 deletions
18
etc/ERC-NEWS
18
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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--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--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)))))
|
||||
(defun erc-stamp--defer-date-insertion-on-post-insert ()
|
||||
(erc-stamp--defer-date-insertion-on-post-modify 'erc-timer-hook))
|
||||
|
||||
;; 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-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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue