* 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)
(cherry picked from commit
86184cba2180a09b31e92f7366f9dd38de5b976a)
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
"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
(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")
(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)))))
(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.
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)
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
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
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))
;; "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))
(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 ()
(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
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'.")
(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.
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'.")
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."
(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))))
(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."
-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.
(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)
: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)))
(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 "
(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."))
(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")))))
;;
(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")
(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.
(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")))
(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)
(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")
(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)
(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)))
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
;;; 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.
(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
(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)))
;; 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)
projects / emacs.git / commitdiff