aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/erc
diff options
context:
space:
mode:
authorF. Jason Park2023-09-02 13:43:22 -0700
committerF. Jason Park2023-10-27 13:09:29 -0700
commit9acd8c8e530dda326ae5bf852c2437fdcde4e8cc (patch)
treee20478f3f0a2c638505b010b3252cbb2f82bcdd3 /lisp/erc
parent5c4a9b73031f1607e4f793c5c0ef27004cc258db (diff)
downloademacs-9acd8c8e530dda326ae5bf852c2437fdcde4e8cc.tar.gz
emacs-9acd8c8e530dda326ae5bf852c2437fdcde4e8cc.zip
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)
Diffstat (limited to 'lisp/erc')
-rw-r--r--lisp/erc/erc-fill.el30
-rw-r--r--lisp/erc/erc-stamp.el3
-rw-r--r--lisp/erc/erc.el90
3 files changed, 92 insertions, 31 deletions
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e28c3563ebf..e8f3f624ff1 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -145,10 +145,6 @@ Its value should be larger than that of the variable
145 :package-version '(ERC . "5.6") ; FIXME sync on release 145 :package-version '(ERC . "5.6") ; FIXME sync on release
146 :type '(choice (const nil) number)) 146 :type '(choice (const nil) number))
147 147
148(defvar erc-fill--spaced-commands '(PRIVMSG NOTICE)
149 "Types of messages to add space between on graphical displays.
150Only considered when `erc-fill-line-spacing' is non-nil.")
151
152(defvar-local erc-fill--function nil 148(defvar-local erc-fill--function nil
153 "Internal copy of `erc-fill-function'. 149 "Internal copy of `erc-fill-function'.
154Takes precedence over the latter when non-nil.") 150Takes 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'."
175 (when-let* ((erc-fill-line-spacing) 171 (when-let* ((erc-fill-line-spacing)
176 (p (point-min))) 172 (p (point-min)))
177 (widen) 173 (widen)
178 (when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands) 174 (when (or (erc--check-msg-prop 'erc-msg 'msg)
179 (and-let* ((cmd (save-excursion 175 (and-let* ((m (save-excursion
180 (forward-line -1) 176 (forward-line -1)
181 (get-text-property (point) 'erc-cmd)))) 177 (erc--get-inserted-msg-prop 'erc-msg))))
182 (memq cmd erc-fill--spaced-commands))) 178 (eq 'msg m)))
183 (put-text-property (1- p) p 179 (put-text-property (1- p) p
184 'line-spacing erc-fill-line-spacing)))))))) 180 'line-spacing erc-fill-line-spacing))))))))
185 181
@@ -463,6 +459,7 @@ is not recommended."
463 (kill-local-variable 'erc-fill--wrap-value) 459 (kill-local-variable 'erc-fill--wrap-value)
464 (kill-local-variable 'erc-fill--function) 460 (kill-local-variable 'erc-fill--function)
465 (kill-local-variable 'erc-fill--wrap-visual-keys) 461 (kill-local-variable 'erc-fill--wrap-visual-keys)
462 (kill-local-variable 'erc-fill--wrap-last-msg)
466 (remove-hook 'erc-button--prev-next-predicate-functions 463 (remove-hook 'erc-button--prev-next-predicate-functions
467 #'erc-fill--wrap-merged-button-p t)) 464 #'erc-fill--wrap-merged-button-p t))
468 'local) 465 'local)
@@ -479,13 +476,17 @@ variable can be converted to a public one if needed by third
479parties.") 476parties.")
480 477
481(defvar-local erc-fill--wrap-last-msg nil) 478(defvar-local erc-fill--wrap-last-msg nil)
482(defvar-local erc-fill--wrap-max-lull (* 24 60 60)) 479(defvar erc-fill--wrap-max-lull (* 24 60 60))
483 480
484(defun erc-fill--wrap-continued-message-p () 481(defun erc-fill--wrap-continued-message-p ()
485 "Return non-nil when the current speaker hasn't changed. 482 "Return non-nil when the current speaker hasn't changed.
486That is, indicate whether the text just inserted is from the same 483That is, indicate whether the text just inserted is from the same
487sender as that of the previous \"PRIVMSG\"." 484sender as that of the previous \"PRIVMSG\"."
488 (prog1 (and-let* 485 (and
486 (not (erc--check-msg-prop 'erc-ephemeral))
487 (progn ; preserve blame for now, unprogn on next major change
488 (prog1
489 (and-let*
489 ((m (or erc-fill--wrap-last-msg 490 ((m (or erc-fill--wrap-last-msg
490 (setq erc-fill--wrap-last-msg (point-min-marker)) 491 (setq erc-fill--wrap-last-msg (point-min-marker))
491 nil)) 492 nil))
@@ -493,8 +494,9 @@ sender as that of the previous \"PRIVMSG\"."
493 (props (save-restriction 494 (props (save-restriction
494 (widen) 495 (widen)
495 (and-let* 496 (and-let*
496 (((eq 'PRIVMSG (get-text-property m 'erc-cmd))) 497 (((eq 'msg (get-text-property m 'erc-msg)))
497 ((not (eq (get-text-property m 'erc-msg) 'ACTION))) 498 ((not (eq (get-text-property m 'erc-ctcp)
499 'ACTION)))
498 ((not (invisible-p m))) 500 ((not (invisible-p m)))
499 (spr (next-single-property-change m 'erc-speaker))) 501 (spr (next-single-property-change m 'erc-speaker)))
500 (cons (get-text-property m 'erc-ts) 502 (cons (get-text-property m 'erc-ts)
@@ -509,7 +511,7 @@ sender as that of the previous \"PRIVMSG\"."
509 ((not (erc--check-msg-prop 'erc-ctcp 'ACTION))) 511 ((not (erc--check-msg-prop 'erc-ctcp 'ACTION)))
510 (nick (get-text-property speaker 'erc-speaker)) 512 (nick (get-text-property speaker 'erc-speaker))
511 ((erc-nick-equal-p props nick)))) 513 ((erc-nick-equal-p props nick))))
512 (set-marker erc-fill--wrap-last-msg (point-min)))) 514 (set-marker erc-fill--wrap-last-msg (point-min))))))
513 515
514(defun erc-fill--wrap-measure (beg end) 516(defun erc-fill--wrap-measure (beg end)
515 "Return display spec width for inserted region between BEG and END. 517 "Return display spec width for inserted region between BEG and END.
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index daa33cac3b2..b3812470a4d 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -243,7 +243,8 @@ or `erc-send-modify-hook'."
243 (erc-stamp--invisible-property 243 (erc-stamp--invisible-property
244 ;; FIXME on major version bump, make this `erc-' prefixed. 244 ;; FIXME on major version bump, make this `erc-' prefixed.
245 (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp)) 245 (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
246 (skipp (and erc-stamp--skip-when-invisible invisible)) 246 (skipp (or (and erc-stamp--skip-when-invisible invisible)
247 (erc--check-msg-prop 'erc-ephemeral)))
247 (erc-stamp--current-time ct)) 248 (erc-stamp--current-time ct))
248 (when erc--msg-props 249 (when erc--msg-props
249 (puthash 'erc-ts ct erc--msg-props)) 250 (puthash 'erc-ts ct erc--msg-props))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 872ce5b4f49..0471ee0bbb8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -136,8 +136,62 @@ concerning buffers."
136 :group 'erc) 136 :group 'erc)
137 137
138(defvar erc-message-parsed) ; only known to this file 138(defvar erc-message-parsed) ; only known to this file
139(defvar erc--msg-props nil) 139
140(defvar erc--msg-prop-overrides nil) 140(defvar erc--msg-props nil
141 "Hash table containing metadata properties for current message.
142Provided by the insertion functions `erc-display-message' and
143`erc-display-msg' while running their modification hooks.
144Initialized when null for each visitation round from function
145parameters and environmental factors, as well as the alist
146`erc--msg-prop-overrides'. Keys are symbols. Values are opaque
147objects, unless otherwise specified. Items present after running
148`erc-insert-post-hook' or `erc-send-post-hook' become text
149properties added to the first character of an inserted message.
150A given message therefore spans the interval extending from one
151set of such properties to the newline before the next (or
152`erc-insert-marker'). As of ERC 5.6, this forms the basis for
153visiting and editing inserted messages. Modules should align
154their markers accordingly. The following properties have meaning
155as of ERC 5.6:
156
157 - `erc-msg': a symbol, guaranteed present; values include:
158
159 - `msg', signifying a `PRIVMSG' or an incoming `NOTICE'
160 - `self', a fallback used by `erc-display-msg' for callers
161 that don't specify an `erc-msg'
162 - `unknown', a similar fallback for `erc-display-message'
163 - a catalog key, such as `s401' or `finished'
164 - an `erc-display-message' TYPE parameter, like `notice'
165
166 - `erc-cmd': a message's associated IRC command, as read by
167 `erc--get-eq-comparable-cmd'; currently either a symbol, like
168 `PRIVMSG', or a number, like 5, which represents the numeric
169 \"005\"; absent on \"local\" messages, such as simple warnings
170 and help text, and on outgoing messages unless echoed back by
171 the server (assuming future support)
172
173 - `erc-ctcp': a CTCP command, like `ACTION'
174
175 - `erc-ts': a timestamp, possibly provided by the server; as of
176 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
177 type otherwise; managed by the `stamp' module
178
179 - `erc-ephemeral': a symbol prefixed by or matching a module
180 name; indicates to other modules and members of modification
181 hooks that the current message should not affect stateful
182 operations, such as recording a channel's most recent speaker
183
184This is an internal API, and the selection of related helper
185utilities is fluid and provisional. As of ERC 5.6, see the
186functions `erc--check-msg-prop' and `erc--get-inserted-msg-prop'.")
187
188(defvar erc--msg-prop-overrides nil
189 "Alist of \"message properties\" for populating `erc--msg-props'.
190These override any defaults normally shown to modification hooks
191by `erc-display-msg' and `erc-display-message'. Modules should
192accommodate existing overrides when applicable. Items toward the
193front shadow any that follow. Ignored when `erc--msg-props' is
194already non-nil.")
141 195
142;; Forward declarations 196;; Forward declarations
143(defvar tabbar--local-hlf) 197(defvar tabbar--local-hlf)
@@ -2898,9 +2952,9 @@ If ARG is non-nil, show the *erc-protocol* buffer."
2898 "Send CTCP ACTION information described by STR to TGT." 2952 "Send CTCP ACTION information described by STR to TGT."
2899 (erc-send-ctcp-message tgt (format "ACTION %s" str) force) 2953 (erc-send-ctcp-message tgt (format "ACTION %s" str) force)
2900 ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us. 2954 ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
2901 (let ((erc--msg-prop-overrides '((erc-msg . msg) 2955 (let ((erc--msg-prop-overrides `((erc-msg . msg)
2902 (erc-cmd . PRIVMSG) 2956 (erc-ctcp . ACTION)
2903 (erc-ctcp . ACTION))) 2957 ,@erc--msg-prop-overrides))
2904 (nick (erc-current-nick))) 2958 (nick (erc-current-nick)))
2905 (setq nick (propertize nick 'erc-speaker nick)) 2959 (setq nick (propertize nick 'erc-speaker nick))
2906 (erc-display-message nil '(t action input) (current-buffer) 2960 (erc-display-message nil '(t action input) (current-buffer)
@@ -3554,9 +3608,9 @@ filling, and other effects."
3554 table) 3608 table)
3555 (when cmd 3609 (when cmd
3556 (puthash 'erc-cmd cmd table)) 3610 (puthash 'erc-cmd cmd table))
3557 (and erc--msg-prop-overrides 3611 (and-let* ((ovs erc--msg-prop-overrides))
3558 (pcase-dolist (`(,k . ,v) erc--msg-prop-overrides) 3612 (pcase-dolist (`(,k . ,v) (reverse ovs))
3559 (puthash k v table))) 3613 (puthash k v table)))
3560 table))) 3614 table)))
3561 (erc-message-parsed parsed)) 3615 (erc-message-parsed parsed))
3562 (setq string 3616 (setq string
@@ -5830,7 +5884,8 @@ See also `erc-display-message'."
5830 (let* ((type (upcase (car (split-string (car queries))))) 5884 (let* ((type (upcase (car (split-string (car queries)))))
5831 (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) 5885 (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
5832 (erc--msg-prop-overrides `((erc-msg . msg) 5886 (erc--msg-prop-overrides `((erc-msg . msg)
5833 (erc-ctcp . ,(intern type))))) 5887 (erc-ctcp . ,(intern type))
5888 ,@erc--msg-prop-overrides)))
5834 (if (and hook (boundp hook)) 5889 (if (and hook (boundp hook))
5835 (if (string-equal type "ACTION") 5890 (if (string-equal type "ACTION")
5836 (run-hook-with-args-until-success 5891 (run-hook-with-args-until-success
@@ -6835,8 +6890,8 @@ ERC prints them as a single message joined by newlines.")
6835 (when-let (((not (erc--input-split-abortp state))) 6890 (when-let (((not (erc--input-split-abortp state)))
6836 (inhibit-read-only t) 6891 (inhibit-read-only t)
6837 (old-buf (current-buffer))) 6892 (old-buf (current-buffer)))
6838 (let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG) 6893 (let ((erc--msg-prop-overrides `((erc-msg . msg)
6839 (erc-msg . msg)))) 6894 ,@erc--msg-prop-overrides)))
6840 (erc-set-active-buffer (current-buffer)) 6895 (erc-set-active-buffer (current-buffer))
6841 ;; Kill the input and the prompt 6896 ;; Kill the input and the prompt
6842 (delete-region erc-input-marker (erc-end-of-input-line)) 6897 (delete-region erc-input-marker (erc-end-of-input-line))
@@ -6978,15 +7033,18 @@ Return non-nil only if we actually send anything."
6978 t))))) 7033 t)))))
6979 7034
6980(defun erc-display-msg (line) 7035(defun erc-display-msg (line)
6981 "Display LINE as a message of the user to the current target at point." 7036 "Insert LINE into current buffer and run \"send\" hooks.
7037Expect LINE to originate from input submitted interactively at
7038the prompt, such as outgoing chat messages or echoed slash
7039commands."
6982 (when erc-insert-this 7040 (when erc-insert-this
6983 (save-excursion 7041 (save-excursion
6984 (erc--assert-input-bounds) 7042 (erc--assert-input-bounds)
6985 (let ((insert-position (marker-position (goto-char erc-insert-marker))) 7043 (let ((insert-position (marker-position (goto-char erc-insert-marker)))
6986 (erc--msg-props (or erc--msg-props 7044 (erc--msg-props (or erc--msg-props ; prefer `self' to `unknown'
6987 (map-into (cons '(erc-msg . self) 7045 (let ((ovs erc--msg-prop-overrides))
6988 erc--msg-prop-overrides) 7046 (map-into `((erc-msg . self) ,@(reverse ovs))
6989 'hash-table))) 7047 'hash-table))))
6990 beg) 7048 beg)
6991 (insert (erc-format-my-nick)) 7049 (insert (erc-format-my-nick))
6992 (setq beg (point)) 7050 (setq beg (point))