emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 6000e48e0d7 5/6: Add erc--skip message property


From: F. Jason Park
Subject: master 6000e48e0d7 5/6: Add erc--skip message property
Date: Fri, 19 Apr 2024 16:59:57 -0400 (EDT)

branch: master
commit 6000e48e0d7d5742ba817942f1b0dbbda9315ddc
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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)
---
 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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]