Tidy up ERC's internal text-property API

* lisp/erc/erc-fill.el (erc-fill--spaced-commands): Remove unused
internal variable originally intended for ERC 5.6.
(erc-fill): Check for `erc-msg' being `msg', which carries the same
meaning as `erc-cmd' being `PRIVMSG' or `NOTICE', except that inserted
outgoing messages now no longer normally have an `erc-cmd' property.
(erc-fill-wrap-mode, erc-fill-wrap-disable): Kill
`erc-fill--wrap-last-msg'.
(erc-fill--wrap-max-lull): Convert from buffer-local to normal
variable.
(erc-fill--wrap-continued-message-p): Rework slightly to guard against
resetting the "last speaker" marker when the `erc-ephemeral' text
property is present.  This tells insert- and send-related hook members
to pretend the current message doesn't exist when performing stateful
operations.  That is, modules should expect the message being inserted
to possibly disappear or be replaced.  Also, look for `erc-msg' being
`msg' instead of `erc-cmd' being `PRIVMSG', and fix bug involving only
checking `erc-ctcp' in the current message.
* lisp/erc/erc-stamp.el (erc-add-timestamp): Don't insert timestamps
when the `erc-ephemeral' text property is present.
* lisp/erc/erc.el (erc--msg-props): Add doc string explaining the
purpose of this variable and the various text properties most commonly
present in its value.
(erc--msg-prop-overrides): Add doc string.
(erc-send-action): Don't set `erc-cmd' prop on outgoing CTCP ACTIONs.
(erc-display-message): Reverse overrides to prefer items toward the
front of the alist.
(erc-process-ctcp-query): Include existing overrides from environs.
(erc-send-current-line): Include existing overrides from environs.
(erc-display-msg): Fix doc string and reverse overrides.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--insert-privmsg):
Remove stray comment.
(erc-fill-tests--save-p): Set value from environment variable.
(erc-fill-tests--compare): Limit writing snapshots to one test at a
time.
(erc-fill-wrap--merge-action): Fix expected output for non-action
messages that follow action messages.  These were previously merged
but escaped detection.
* test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
(Bug#60936)
This commit is contained in:
F. Jason Park 2023-09-02 13:43:22 -07:00
parent 5c4a9b7303
commit 9acd8c8e53
5 changed files with 108 additions and 40 deletions

View file

@ -145,10 +145,6 @@ Its value should be larger than that of the variable
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) number))
(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE)
"Types of messages to add space between on graphical displays.
Only considered when `erc-fill-line-spacing' is non-nil.")
(defvar-local erc-fill--function nil
"Internal copy of `erc-fill-function'.
Takes precedence over the latter when non-nil.")
@ -175,11 +171,11 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
(when-let* ((erc-fill-line-spacing)
(p (point-min)))
(widen)
(when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands)
(and-let* ((cmd (save-excursion
(forward-line -1)
(get-text-property (point) 'erc-cmd))))
(memq cmd erc-fill--spaced-commands)))
(when (or (erc--check-msg-prop 'erc-msg 'msg)
(and-let* ((m (save-excursion
(forward-line -1)
(erc--get-inserted-msg-prop 'erc-msg))))
(eq 'msg m)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@ -463,6 +459,7 @@ is not recommended."
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill--function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
(kill-local-variable 'erc-fill--wrap-last-msg)
(remove-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p t))
'local)
@ -479,13 +476,17 @@ variable can be converted to a public one if needed by third
parties.")
(defvar-local erc-fill--wrap-last-msg nil)
(defvar-local erc-fill--wrap-max-lull (* 24 60 60))
(defvar erc-fill--wrap-max-lull (* 24 60 60))
(defun erc-fill--wrap-continued-message-p ()
"Return non-nil when the current speaker hasn't changed.
That is, indicate whether the text just inserted is from the same
sender as that of the previous \"PRIVMSG\"."
(prog1 (and-let*
(and
(not (erc--check-msg-prop 'erc-ephemeral))
(progn ; preserve blame for now, unprogn on next major change
(prog1
(and-let*
((m (or erc-fill--wrap-last-msg
(setq erc-fill--wrap-last-msg (point-min-marker))
nil))
@ -493,8 +494,9 @@ sender as that of the previous \"PRIVMSG\"."
(props (save-restriction
(widen)
(and-let*
(((eq 'PRIVMSG (get-text-property m 'erc-cmd)))
((not (eq (get-text-property m 'erc-msg) 'ACTION)))
(((eq 'msg (get-text-property m 'erc-msg)))
((not (eq (get-text-property m 'erc-ctcp)
'ACTION)))
((not (invisible-p m)))
(spr (next-single-property-change m 'erc-speaker)))
(cons (get-text-property m 'erc-ts)
@ -509,7 +511,7 @@ sender as that of the previous \"PRIVMSG\"."
((not (erc--check-msg-prop 'erc-ctcp 'ACTION)))
(nick (get-text-property speaker 'erc-speaker))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
(set-marker erc-fill--wrap-last-msg (point-min))))))
(defun erc-fill--wrap-measure (beg end)
"Return display spec width for inserted region between BEG and END.

View file

@ -243,7 +243,8 @@ or `erc-send-modify-hook'."
(erc-stamp--invisible-property
;; FIXME on major version bump, make this `erc-' prefixed.
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(skipp (and erc-stamp--skip-when-invisible invisible))
(skipp (or (and erc-stamp--skip-when-invisible invisible)
(erc--check-msg-prop 'erc-ephemeral)))
(erc-stamp--current-time ct))
(when erc--msg-props
(puthash 'erc-ts ct erc--msg-props))

View file

@ -136,8 +136,62 @@ concerning buffers."
:group 'erc)
(defvar erc-message-parsed) ; only known to this file
(defvar erc--msg-props nil)
(defvar erc--msg-prop-overrides nil)
(defvar erc--msg-props nil
"Hash table containing metadata properties for current message.
Provided by the insertion functions `erc-display-message' and
`erc-display-msg' while running their modification hooks.
Initialized when null for each visitation round from function
parameters and environmental factors, as well as the alist
`erc--msg-prop-overrides'. Keys are symbols. Values are opaque
objects, unless otherwise specified. Items present after running
`erc-insert-post-hook' or `erc-send-post-hook' become text
properties added to the first character of an inserted message.
A given message therefore spans the interval extending from one
set of such properties to the newline before the next (or
`erc-insert-marker'). As of ERC 5.6, this forms the basis for
visiting and editing inserted messages. Modules should align
their markers accordingly. The following properties have meaning
as of ERC 5.6:
- `erc-msg': a symbol, guaranteed present; values include:
- `msg', signifying a `PRIVMSG' or an incoming `NOTICE'
- `self', a fallback used by `erc-display-msg' for callers
that don't specify an `erc-msg'
- `unknown', a similar fallback for `erc-display-message'
- a catalog key, such as `s401' or `finished'
- an `erc-display-message' TYPE parameter, like `notice'
- `erc-cmd': a message's associated IRC command, as read by
`erc--get-eq-comparable-cmd'; currently either a symbol, like
`PRIVMSG', or a number, like 5, which represents the numeric
\"005\"; absent on \"local\" messages, such as simple warnings
and help text, and on outgoing messages unless echoed back by
the server (assuming future support)
- `erc-ctcp': a CTCP command, like `ACTION'
- `erc-ts': a timestamp, possibly provided by the server; as of
5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
type otherwise; managed by the `stamp' module
- `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
operations, such as recording a channel's most recent speaker
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'.")
(defvar erc--msg-prop-overrides nil
"Alist of \"message properties\" for populating `erc--msg-props'.
These override any defaults normally shown to modification hooks
by `erc-display-msg' and `erc-display-message'. Modules should
accommodate existing overrides when applicable. Items toward the
front shadow any that follow. Ignored when `erc--msg-props' is
already non-nil.")
;; Forward declarations
(defvar tabbar--local-hlf)
@ -2898,9 +2952,9 @@ If ARG is non-nil, show the *erc-protocol* buffer."
"Send CTCP ACTION information described by STR to TGT."
(erc-send-ctcp-message tgt (format "ACTION %s" str) force)
;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
(let ((erc--msg-prop-overrides '((erc-msg . msg)
(erc-cmd . PRIVMSG)
(erc-ctcp . ACTION)))
(let ((erc--msg-prop-overrides `((erc-msg . msg)
(erc-ctcp . ACTION)
,@erc--msg-prop-overrides))
(nick (erc-current-nick)))
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message nil '(t action input) (current-buffer)
@ -3554,9 +3608,9 @@ filling, and other effects."
table)
(when cmd
(puthash 'erc-cmd cmd table))
(and erc--msg-prop-overrides
(pcase-dolist (`(,k . ,v) erc--msg-prop-overrides)
(puthash k v table)))
(and-let* ((ovs erc--msg-prop-overrides))
(pcase-dolist (`(,k . ,v) (reverse ovs))
(puthash k v table)))
table)))
(erc-message-parsed parsed))
(setq string
@ -5830,7 +5884,8 @@ See also `erc-display-message'."
(let* ((type (upcase (car (split-string (car queries)))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
(erc--msg-prop-overrides `((erc-msg . msg)
(erc-ctcp . ,(intern type)))))
(erc-ctcp . ,(intern type))
,@erc--msg-prop-overrides)))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
(run-hook-with-args-until-success
@ -6835,8 +6890,8 @@ ERC prints them as a single message joined by newlines.")
(when-let (((not (erc--input-split-abortp state)))
(inhibit-read-only t)
(old-buf (current-buffer)))
(let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG)
(erc-msg . msg))))
(let ((erc--msg-prop-overrides `((erc-msg . msg)
,@erc--msg-prop-overrides)))
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region erc-input-marker (erc-end-of-input-line))
@ -6978,15 +7033,18 @@ Return non-nil only if we actually send anything."
t)))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at point."
"Insert LINE into current buffer and run \"send\" hooks.
Expect LINE to originate from input submitted interactively at
the prompt, such as outgoing chat messages or echoed slash
commands."
(when erc-insert-this
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
(erc--msg-props (or erc--msg-props
(map-into (cons '(erc-msg . self)
erc--msg-prop-overrides)
'hash-table)))
(erc--msg-props (or erc--msg-props ; prefer `self' to `unknown'
(let ((ovs erc--msg-prop-overrides))
(map-into `((erc-msg . self) ,@(reverse ovs))
'hash-table))))
beg)
(insert (erc-format-my-nick))
(setq beg (point))