From e9a46be97ced245860cad8c699c4fe976f5f8a7c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 18 Apr 2024 22:18:57 -0700 Subject: [PATCH] Add erc--skip message property * lisp/erc/erc-backend.el (erc-server-connect): Add `erc--skip' property to `erc--msg-prop-overrides' so that timestamps only show up with the first server-sent message. (erc-server-PRIVMSG): Move `erc--msg-prop-overrides' declaration to top-level. * lisp/erc/erc-button.el (erc-button--display-error-notice-with-keys): Use `erc--skip' msg prop instead of `erc-stamp--skip' variable. * lisp/erc/erc-stamp.el (erc-stamp--skip): Remove variable. (erc-stamp--allow-unmanaged, erc-stamp--allow-unmanaged-p): Rename former to latter to remain consistent with convention used by other quasi-internal compatibility-related switches. (erc-add-timestamp): Check `erc--skip' property instead of deleted variable `erc-stamp--skip'. * lisp/erc/erc.el (erc--msg-props): Mention `erc--skip' in doc. (erc--check-msg-prop): Doc. (erc--memq-msg-prop): New function. (erc--ranked-properties): Add `erc--skip'. * test/lisp/erc/erc-scenarios-stamp.el (erc-scenarios-stamp--legacy-date-stamps): Revise to expect "opening connection.." to appear above first stamp. * test/lisp/erc/erc-tests.el (erc--memq-msg-prop): New test. (Bug#60936) (cherry picked from commit 6000e48e0d7d5742ba817942f1b0dbbda9315ddc) --- lisp/erc/erc-backend.el | 5 +++-- lisp/erc/erc-button.el | 9 +++++---- lisp/erc/erc-stamp.el | 10 ++++------ lisp/erc/erc.el | 19 +++++++++++++++---- test/lisp/erc/erc-scenarios-stamp.el | 8 +++++--- test/lisp/erc/erc-tests.el | 7 +++++++ 6 files changed, 39 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ea5ea0928e0..ab419d2b018 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,6 +102,7 @@ (require 'erc-common) (defvar erc--display-context) +(defvar erc--msg-prop-overrides) (defvar erc--target) (defvar erc-channel-list) (defvar erc-channel-members) @@ -787,7 +788,8 @@ TLS (see `erc-session-client-certificate' for more details)." ;; MOTD line) (if (eq (process-status process) 'connect) ;; waiting for a non-blocking connect - keep the user informed - (progn + (let ((erc--msg-prop-overrides `((erc--skip . (stamp)) + ,@erc--msg-prop-overrides))) (erc-display-message nil nil buffer "Opening connection..\n") (run-at-time 1 nil erc--server-connect-function process)) (message "%s...done" msg) @@ -1994,7 +1996,6 @@ like `erc-insert-modify-hook'.") (and erc-ignore-reply-list (erc-ignored-reply-p msg tgt proc))) (when erc-minibuffer-ignored (message "Ignored %s from %s to %s" cmd sender-spec tgt)) - (defvar erc--msg-prop-overrides) (let* ((sndr (erc-parse-user sender-spec)) (nick (nth 0 sndr)) (login (nth 1 sndr)) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 4b4930e5bff..1f9d6fd64c0 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -830,7 +830,6 @@ argument when calling `erc-display-message'. Otherwise, add it to STRINGS. If STRINGS contains any trailing non-nil non-strings, concatenate leading string members before applying `format'. Otherwise, just concatenate everything." - (defvar erc-stamp--skip) (let* ((buffer (if (bufferp maybe-buffer) maybe-buffer (when (stringp maybe-buffer) @@ -847,9 +846,11 @@ non-strings, concatenate leading string members before applying #'format)) (string (apply op strings)) ;; Avoid timestamps unless left-sided. - (erc-stamp--skip (or (bound-and-true-p erc-stamp--display-margin-mode) - (not (fboundp 'erc-timestamp-offset)) - (zerop (erc-timestamp-offset)))) + (skipp (or (bound-and-true-p erc-stamp--display-margin-mode) + (not (fboundp 'erc-timestamp-offset)) + (zerop (erc-timestamp-offset)))) + (erc--msg-prop-overrides `(,@(and skipp `((erc--skip stamp))) + ,@erc--msg-prop-overrides)) (erc-insert-post-hook (cons (lambda () (setq string (buffer-substring (point-min) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d1ee1da994d..77981bc9d07 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -220,10 +220,7 @@ This becomes the message's `erc--ts' text property." (cl-defmethod erc-stamp--current-time :around () (or erc-stamp--current-time (cl-call-next-method))) -(defvar erc-stamp--skip nil - "Non-nil means inhibit `erc-add-timestamp' completely.") - -(defvar erc-stamp--allow-unmanaged nil +(defvar erc-stamp--allow-unmanaged-p nil "Non-nil means run `erc-add-timestamp' almost unconditionally. This is an unofficial escape hatch for code wanting to use lower-level message-insertion functions, like `erc-insert-line', @@ -243,8 +240,9 @@ known via \\[erc-bug].") This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (or erc-stamp--skip (and (not erc-stamp--allow-unmanaged) - (null erc--msg-props))) + (unless (and (not erc-stamp--allow-unmanaged-p) + (or (null erc--msg-props) + (erc--memq-msg-prop 'erc--skip 'stamp))) (let* ((ct (erc-stamp--current-time)) (invisible (get-text-property (point-min) 'invisible)) (erc-stamp--invisible-property diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 84e3ac4bede..de203a2137f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -181,6 +181,9 @@ as of ERC 5.6: 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\" type otherwise; managed by the `stamp' module + - `erc--skip': list of symbols known to modules that indicate an + intent to skip or simplify module-specific processing + - `erc--ephemeral': a symbol prefixed by or matching a module name; indicates to other modules and members of modification hooks that the current message should not affect stateful @@ -3234,13 +3237,20 @@ a full refresh." (defun erc--check-msg-prop (prop &optional val) "Return PROP's value in `erc--msg-props' when populated. -If VAL is a list, return non-nil if PROP appears in VAL. If VAL -is otherwise non-nil, return non-nil if VAL compares `eq' to the -stored value. Otherwise, return the stored value." +If VAL is a list, return non-nil if PROP's value appears in VAL. If VAL +is otherwise non-nil, return non-nil if VAL compares `eq' to the stored +value. Otherwise, return the stored value." (and-let* ((erc--msg-props) (v (gethash prop erc--msg-props))) (if (consp val) (memq v val) (if val (eq v val) v)))) +(defun erc--memq-msg-prop (prop needle) + "Return non-nil if msg PROP's value is a list containing NEEDLE." + (and-let* ((erc--msg-props) + (haystack (gethash prop erc--msg-props)) + ((consp haystack))) + (memq needle haystack))) + (defmacro erc--get-inserted-msg-beg-at (point at-start-p) (macroexp-let2* nil ((point point) (at-start-p at-start-p)) @@ -3684,7 +3694,8 @@ subsequent message." -1)))))))) (defvar erc--ranked-properties - '(erc--msg erc--spkr erc--ts erc--cmd erc--hide erc--ctcp erc--ephemeral)) + '( erc--msg erc--spkr erc--ts erc--skip + erc--cmd erc--hide erc--ctcp erc--ephemeral)) (defun erc--order-text-properties-from-hash (table) "Return a plist of text props from items in TABLE. diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index 3a10f709548..6f2fbc1b7e9 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -101,17 +101,19 @@ :port port :full-name "tester" :nick "tester") - (funcall expect 5 "Opening connection") + (funcall expect 5 "*** Welcome") (goto-char (1- (match-beginning 0))) (should (eq 'erc-timestamp (field-at-pos (point)))) - (should (eq 'unknown (erc--get-inserted-msg-prop 'erc--msg))) + (should (eq 'notice (erc--get-inserted-msg-prop 'erc--msg))) ;; Force redraw of date stamp. (setq erc-timestamp-last-inserted-left nil) (funcall expect 5 "This server is in debug mode") (while (and (zerop (forward-line -1)) (not (eq 'erc-timestamp (field-at-pos (point)))))) - (should (erc--get-inserted-msg-prop 'erc--cmd))))))) + (should (erc--get-inserted-msg-prop 'erc--cmd)) + (should-not erc-stamp--date-mode) + (should-not erc-stamp--date-stamps)))))) ;; This user-owned hook member places a marker on the first message in ;; a buffer. Inserting a date stamp in front of it shouldn't move the diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index cc681384e9c..64229887ead 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2082,6 +2082,13 @@ (let ((v '(42 y))) (should-not (erc--check-msg-prop 'b v))))) +(ert-deftest erc--memq-msg-prop () + (let ((erc--msg-props (map-into '((a . 1) (b x y)) 'hash-table))) + (should-not (erc--memq-msg-prop 'a 1)) + (should-not (erc--memq-msg-prop 'b 'z)) + (should (erc--memq-msg-prop 'b 'x)) + (should (erc--memq-msg-prop 'b 'y)))) + (ert-deftest erc--merge-prop () (with-current-buffer (get-buffer-create "*erc-test*") ;; Baseline. -- 2.39.5