mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
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)
This commit is contained in:
parent
86184cba21
commit
6000e48e0d
6 changed files with 39 additions and 19 deletions
|
|
@ -102,6 +102,7 @@
|
||||||
(require 'erc-common)
|
(require 'erc-common)
|
||||||
|
|
||||||
(defvar erc--display-context)
|
(defvar erc--display-context)
|
||||||
|
(defvar erc--msg-prop-overrides)
|
||||||
(defvar erc--target)
|
(defvar erc--target)
|
||||||
(defvar erc-channel-list)
|
(defvar erc-channel-list)
|
||||||
(defvar erc-channel-members)
|
(defvar erc-channel-members)
|
||||||
|
|
@ -787,7 +788,8 @@ TLS (see `erc-session-client-certificate' for more details)."
|
||||||
;; MOTD line)
|
;; MOTD line)
|
||||||
(if (eq (process-status process) 'connect)
|
(if (eq (process-status process) 'connect)
|
||||||
;; waiting for a non-blocking connect - keep the user informed
|
;; 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")
|
(erc-display-message nil nil buffer "Opening connection..\n")
|
||||||
(run-at-time 1 nil erc--server-connect-function process))
|
(run-at-time 1 nil erc--server-connect-function process))
|
||||||
(message "%s...done" msg)
|
(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)))
|
(and erc-ignore-reply-list (erc-ignored-reply-p msg tgt proc)))
|
||||||
(when erc-minibuffer-ignored
|
(when erc-minibuffer-ignored
|
||||||
(message "Ignored %s from %s to %s" cmd sender-spec tgt))
|
(message "Ignored %s from %s to %s" cmd sender-spec tgt))
|
||||||
(defvar erc--msg-prop-overrides)
|
|
||||||
(let* ((sndr (erc-parse-user sender-spec))
|
(let* ((sndr (erc-parse-user sender-spec))
|
||||||
(nick (nth 0 sndr))
|
(nick (nth 0 sndr))
|
||||||
(login (nth 1 sndr))
|
(login (nth 1 sndr))
|
||||||
|
|
|
||||||
|
|
@ -830,7 +830,6 @@ argument when calling `erc-display-message'. Otherwise, add it
|
||||||
to STRINGS. If STRINGS contains any trailing non-nil
|
to STRINGS. If STRINGS contains any trailing non-nil
|
||||||
non-strings, concatenate leading string members before applying
|
non-strings, concatenate leading string members before applying
|
||||||
`format'. Otherwise, just concatenate everything."
|
`format'. Otherwise, just concatenate everything."
|
||||||
(defvar erc-stamp--skip)
|
|
||||||
(let* ((buffer (if (bufferp maybe-buffer)
|
(let* ((buffer (if (bufferp maybe-buffer)
|
||||||
maybe-buffer
|
maybe-buffer
|
||||||
(when (stringp maybe-buffer)
|
(when (stringp maybe-buffer)
|
||||||
|
|
@ -847,9 +846,11 @@ non-strings, concatenate leading string members before applying
|
||||||
#'format))
|
#'format))
|
||||||
(string (apply op strings))
|
(string (apply op strings))
|
||||||
;; Avoid timestamps unless left-sided.
|
;; Avoid timestamps unless left-sided.
|
||||||
(erc-stamp--skip (or (bound-and-true-p erc-stamp--display-margin-mode)
|
(skipp (or (bound-and-true-p erc-stamp--display-margin-mode)
|
||||||
(not (fboundp 'erc-timestamp-offset))
|
(not (fboundp 'erc-timestamp-offset))
|
||||||
(zerop (erc-timestamp-offset))))
|
(zerop (erc-timestamp-offset))))
|
||||||
|
(erc--msg-prop-overrides `(,@(and skipp `((erc--skip stamp)))
|
||||||
|
,@erc--msg-prop-overrides))
|
||||||
(erc-insert-post-hook
|
(erc-insert-post-hook
|
||||||
(cons (lambda ()
|
(cons (lambda ()
|
||||||
(setq string (buffer-substring (point-min)
|
(setq string (buffer-substring (point-min)
|
||||||
|
|
|
||||||
|
|
@ -220,10 +220,7 @@ This becomes the message's `erc--ts' text property."
|
||||||
(cl-defmethod erc-stamp--current-time :around ()
|
(cl-defmethod erc-stamp--current-time :around ()
|
||||||
(or erc-stamp--current-time (cl-call-next-method)))
|
(or erc-stamp--current-time (cl-call-next-method)))
|
||||||
|
|
||||||
(defvar erc-stamp--skip nil
|
(defvar erc-stamp--allow-unmanaged-p nil
|
||||||
"Non-nil means inhibit `erc-add-timestamp' completely.")
|
|
||||||
|
|
||||||
(defvar erc-stamp--allow-unmanaged nil
|
|
||||||
"Non-nil means run `erc-add-timestamp' almost unconditionally.
|
"Non-nil means run `erc-add-timestamp' almost unconditionally.
|
||||||
This is an unofficial escape hatch for code wanting to use
|
This is an unofficial escape hatch for code wanting to use
|
||||||
lower-level message-insertion functions, like `erc-insert-line',
|
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'
|
This function is meant to be called from `erc-insert-modify-hook'
|
||||||
or `erc-send-modify-hook'."
|
or `erc-send-modify-hook'."
|
||||||
(unless (or erc-stamp--skip (and (not erc-stamp--allow-unmanaged)
|
(unless (and (not erc-stamp--allow-unmanaged-p)
|
||||||
(null erc--msg-props)))
|
(or (null erc--msg-props)
|
||||||
|
(erc--memq-msg-prop 'erc--skip 'stamp)))
|
||||||
(let* ((ct (erc-stamp--current-time))
|
(let* ((ct (erc-stamp--current-time))
|
||||||
(invisible (get-text-property (point-min) 'invisible))
|
(invisible (get-text-property (point-min) 'invisible))
|
||||||
(erc-stamp--invisible-property
|
(erc-stamp--invisible-property
|
||||||
|
|
|
||||||
|
|
@ -181,6 +181,9 @@ as of ERC 5.6:
|
||||||
5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
|
5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
|
||||||
type otherwise; managed by the `stamp' module
|
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
|
- `erc--ephemeral': a symbol prefixed by or matching a module
|
||||||
name; indicates to other modules and members of modification
|
name; indicates to other modules and members of modification
|
||||||
hooks that the current message should not affect stateful
|
hooks that the current message should not affect stateful
|
||||||
|
|
@ -3234,13 +3237,20 @@ a full refresh."
|
||||||
|
|
||||||
(defun erc--check-msg-prop (prop &optional val)
|
(defun erc--check-msg-prop (prop &optional val)
|
||||||
"Return PROP's value in `erc--msg-props' when populated.
|
"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
|
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
|
is otherwise non-nil, return non-nil if VAL compares `eq' to the stored
|
||||||
stored value. Otherwise, return the stored value."
|
value. Otherwise, return the stored value."
|
||||||
(and-let* ((erc--msg-props)
|
(and-let* ((erc--msg-props)
|
||||||
(v (gethash prop erc--msg-props)))
|
(v (gethash prop erc--msg-props)))
|
||||||
(if (consp val) (memq v val) (if val (eq v val) v))))
|
(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)
|
(defmacro erc--get-inserted-msg-beg-at (point at-start-p)
|
||||||
(macroexp-let2* nil ((point point)
|
(macroexp-let2* nil ((point point)
|
||||||
(at-start-p at-start-p))
|
(at-start-p at-start-p))
|
||||||
|
|
@ -3684,7 +3694,8 @@ subsequent message."
|
||||||
-1))))))))
|
-1))))))))
|
||||||
|
|
||||||
(defvar erc--ranked-properties
|
(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)
|
(defun erc--order-text-properties-from-hash (table)
|
||||||
"Return a plist of text props from items in TABLE.
|
"Return a plist of text props from items in TABLE.
|
||||||
|
|
|
||||||
|
|
@ -101,17 +101,19 @@
|
||||||
:port port
|
:port port
|
||||||
:full-name "tester"
|
:full-name "tester"
|
||||||
:nick "tester")
|
:nick "tester")
|
||||||
(funcall expect 5 "Opening connection")
|
(funcall expect 5 "*** Welcome")
|
||||||
(goto-char (1- (match-beginning 0)))
|
(goto-char (1- (match-beginning 0)))
|
||||||
(should (eq 'erc-timestamp (field-at-pos (point))))
|
(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.
|
;; Force redraw of date stamp.
|
||||||
(setq erc-timestamp-last-inserted-left nil)
|
(setq erc-timestamp-last-inserted-left nil)
|
||||||
|
|
||||||
(funcall expect 5 "This server is in debug mode")
|
(funcall expect 5 "This server is in debug mode")
|
||||||
(while (and (zerop (forward-line -1))
|
(while (and (zerop (forward-line -1))
|
||||||
(not (eq 'erc-timestamp (field-at-pos (point))))))
|
(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
|
;; 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
|
;; a buffer. Inserting a date stamp in front of it shouldn't move the
|
||||||
|
|
|
||||||
|
|
@ -2082,6 +2082,13 @@
|
||||||
(let ((v '(42 y)))
|
(let ((v '(42 y)))
|
||||||
(should-not (erc--check-msg-prop 'b v)))))
|
(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 ()
|
(ert-deftest erc--merge-prop ()
|
||||||
(with-current-buffer (get-buffer-create "*erc-test*")
|
(with-current-buffer (get-buffer-create "*erc-test*")
|
||||||
;; Baseline.
|
;; Baseline.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue