From: "J.P." <jp@neverwas.me>
To: 64301@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
Date: Sat, 08 Jul 2023 07:19:26 -0700 [thread overview]
Message-ID: <87sf9y32q9.fsf__33690.2443015546$1688826033$gmane$org@neverwas.me> (raw)
In-Reply-To: <87bkh21gfa.fsf@neverwas.me> (J. P.'s message of "Mon, 26 Jun 2023 06:50:17 -0700")
[-- Attachment #1: Type: text/plain, Size: 117 bytes --]
v3. Fix problem calculating column width. Add command to toggle fool
invisibility. Add test for hidden date stamps.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 10172 bytes --]
From aae534bcbe0eb75e436c428b248a87748ec185b6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 8 Jul 2023 07:06:09 -0700
Subject: [PATCH 0/4] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (4):
[5.6] Respect existing invisibility props in erc-stamp
[5.6] Simplify erc-button-add-nickname-buttons
[5.6] Add text props for CTCPs and speakers in ERC
[5.6] Handle composite faces better in erc-display-message
etc/ERC-NEWS | 29 ++-
lisp/erc/erc-backend.el | 39 ++--
lisp/erc/erc-button.el | 78 ++++----
lisp/erc/erc-dcc.el | 16 +-
lisp/erc/erc-fill.el | 25 ++-
lisp/erc/erc-match.el | 29 +--
lisp/erc/erc-sasl.el | 8 +-
lisp/erc/erc-stamp.el | 21 ++-
lisp/erc/erc-track.el | 12 +-
lisp/erc/erc.el | 99 +++++++---
test/lisp/erc/erc-button-tests.el | 2 +-
test/lisp/erc/erc-fill-tests.el | 5 +-
test/lisp/erc/erc-scenarios-match.el | 259 ++++++++++++++++++++++++---
13 files changed, 467 insertions(+), 155 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 40bcd934772..795553f1666 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -144,11 +144,12 @@ the same effect by issuing a "/CLEAR" at the prompt.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, the function 'erc-echo-timestamp' is now
interactive and can be invoked on any message to view its timestamp in
-the echo area. The command 'erc-button-previous' now moves to the
-beginning instead of the end of buttons. A new command, 'erc-news',
-can now be invoked to visit this very file. And the 'irccontrols'
-module now supports additional colors and special handling for
-"spoilers" (hidden text).
+the echo area. Fool visibility has become togglable with the new
+command 'erc-match-toggle-hidden-fools'. The 'button' module's
+'erc-button-previous' now moves to the beginning instead of the end of
+buttons. A new command, 'erc-news', can be invoked to visit this very
+file. And the 'irccontrols' module now supports additional colors and
+special handling for "spoilers" (hidden text).
** Changes in the library API.
@@ -197,6 +198,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp',
now spans message bodies but not the newlines delimiting them.
Somewhat relatedly, the function 'erc-insert-aligned' has been
deprecated and removed from the primary client code path.
+Additionally, the 'stamp' module now merges its 'invisible' property
+with existing ones, when present, and it includes all white space
+around stamps when doing so.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 549de4feeb8..a5b0af41b2a 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -660,6 +660,10 @@ erc-match--hide-fools-offset-bounds
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide comments from designated fools."
(when (eq match-type 'fool)
+ (erc-match--hide-message)))
+
+(defun erc-match--hide-message ()
+ (progn ; FIXME raise sexp
(if erc-match--hide-fools-offset-bounds
(let ((beg (point-min))
(end (point-max)))
@@ -677,12 +681,21 @@ erc-beep-on-match
(beep)))
(defun erc-match--modify-invisibility-spec ()
- "Add an ellipsis property to the local spec."
+ "Add an `erc-match' property to the local spec."
(if erc-match-mode
(add-to-invisibility-spec 'erc-match)
(erc-with-all-buffers-of-server nil nil
(remove-from-invisibility-spec 'erc-match))))
+(defun erc-match-toggle-hidden-fools ()
+ "Toggle fool visibility.
+Expect `erc-hide-fools' or a function that does something similar
+to be in `erc-text-matched-hook'."
+ (interactive)
+ (if (memq 'erc-match (ensure-list buffer-invisibility-spec))
+ (remove-from-invisibility-spec 'erc-match)
+ (add-to-invisibility-spec 'erc-match)))
+
(provide 'erc-match)
;;; erc-match.el ends here
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 2f52d78d42b..83ee4a200ed 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -437,6 +437,7 @@ erc-insert-timestamp-right
(goto-char (point-max))
(forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
+ (buffer-invisibility-spec nil) ; `current-column' > 0
window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index edc1749cdd2..715fe9c25d7 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -24,8 +24,11 @@
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
-(require 'erc-stamp)
-(require 'erc-match)
+(eval-when-compile
+ (require 'erc-join)
+ (require 'erc-stamp)
+ (require 'erc-match))
+
(require 'erc-fill)
;; This defends against a regression in which all matching by the
@@ -62,6 +65,9 @@ erc-scenarios-match--stamp-left-current-nick
;; interactively, and check for wierdness before and after doing
;; M-: (remove-from-invisibility-spec 'erc-match) RET.
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
+ (unless noninteractive
+ (kill-new "(remove-from-invisibility-spec 'erc-match)"))
+
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
@@ -236,6 +242,93 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
-(eval-when-compile (require 'erc-join))
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
+ :tags '(:expensive-test)
+ (should (eq erc-insert-timestamp-function
+ #'erc-insert-timestamp-left-and-right))
+
+ ;; Rewind the clock to known date artificially.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-static)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `erc-match'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+ (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
+ (mend (next-single-property-change mbeg 'erc-command)))
+
+ (if (/= 1 bob-utterance-counter)
+ (should-not (field-at-pos mend))
+ ;; For Bob's stamped message, check newline after stamp.
+ (should (eq (field-at-pos mend) 'erc-timestamp))
+ (setq mend (field-end mend)))
+
+ ;; The `erc-timestamp' property spans entire messages,
+ ;; including stamps and filled text, which makes for
+ ;; convenient traversal when `erc-stamp-mode' is enabled.
+ (should (get-text-property (pos-bol) 'erc-timestamp))
+ (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
+ mend))
+
+ ;; Line ending has the `invisible' property `erc-match'.
+ (should (= (char-after mend) ?\n))
+ (should (eq (get-text-property mend'invisible) 'erc-match))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that extends until the start of the message proper.
+ (should (equal (get-text-property (point) 'invisible)
+ '(timestamp erc-match)))
+ (should (= (next-single-property-change (point) 'invisible)
+ (1+ (pos-eol))))))
+
+ (ert-info ("Folding preserved despite invisibility")
+ ;; Message has a trailing time stamp, but it's been folded
+ ;; over to the next line.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (save-excursion
+ (forward-line)
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp erc-match)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (save-excursion (forward-line) (pos-eol)))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
;;; erc-scenarios-match.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Respect-existing-invisibility-props-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 22450 bytes --]
From 4ac5a1835bdaa31d69449e1bcc3aa3d33c770585 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 2 Jul 2023 20:58:37 -0700
Subject: [PATCH 1/4] [5.6] Respect existing invisibility props in erc-stamp
* lisp/erc/erc-match.el (erc-hide-fools): change `invisible' property
to `erc-match' for all messages, not just those with offset bounds.
(erc-match--modify-invisibility-spec): Fix error in doc string.
(erc-match-toggle-hidden-fools): New command.
* lisp/erc/erc-stamp.el (erc-stamp--invisible-property):
Add new internal variable to hold existing `invisible' property merged
with the one registered by this module.
(erc-stamp--skip-when-invisible): Add new internal variable to act as
escape hatch for pre ERC-5.6 behavior in which timestamps were not
applied at all to invisible messages. This led to strange-looking,
uneven logs, and it prevented other modules from offering toggle
functionality for invisibility spec members registered to them.
(erc-add-timestamp): Merge with existing `invisible' property, when
present, instead of clobbering, but only when escape hatch
`erc-stamp--skip-when-invisible' is nil.
(erc-insert-timestamp-left, erc-format-timestamp): Use possibly merged
`invisible' prop value. Don't bother with `isearch-open-invisible',
which only affects overlays.
* test/lisp/erc/erc-scenarios-match.el
(erc-scenarios-match--invisible-stamp): Move setup and core assertions
for stamp-related tests into fixture.
(erc-scenarios-match--stamp-left-fools-invisible): Fix temporarily
disabled test and use fixture.
(erc-scenarios-match--stamp-right-fools-invisible,
erc-scenarios-match--stamp-right-invisible-fill-wrap): New test.
(Bug#64301)
---
etc/ERC-NEWS | 14 +-
lisp/erc/erc-match.el | 18 +-
lisp/erc/erc-stamp.el | 21 ++-
test/lisp/erc/erc-scenarios-match.el | 259 ++++++++++++++++++++++++---
4 files changed, 273 insertions(+), 39 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 5665b760ea9..37435a1d915 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -144,11 +144,12 @@ the same effect by issuing a "/CLEAR" at the prompt.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, the function 'erc-echo-timestamp' is now
interactive and can be invoked on any message to view its timestamp in
-the echo area. The command 'erc-button-previous' now moves to the
-beginning instead of the end of buttons. A new command, 'erc-news',
-can now be invoked to visit this very file. And the 'irccontrols'
-module now supports additional colors and special handling for
-"spoilers" (hidden text).
+the echo area. Fool visibility has become togglable with the new
+command 'erc-match-toggle-hidden-fools'. The 'button' module's
+'erc-button-previous' now moves to the beginning instead of the end of
+buttons. A new command, 'erc-news', can be invoked to visit this very
+file. And the 'irccontrols' module now supports additional colors and
+special handling for "spoilers" (hidden text).
** Changes in the library API.
@@ -197,6 +198,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp',
now spans message bodies but not the newlines delimiting them.
Somewhat relatedly, the function 'erc-insert-aligned' has been
deprecated and removed from the primary client code path.
+Additionally, the 'stamp' module now merges its 'invisible' property
+with existing ones, when present, and it includes all white space
+around stamps when doing so.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 2b7fff87ff0..cd2c55b0091 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -669,10 +669,9 @@ erc-hide-fools
(save-restriction
(widen)
(put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
- ;; The docs say `intangible' is deprecated, but this has been
- ;; like this for ages. Should verify unneeded and remove if so.
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)))))
+ ;; Before ERC 5.6, this also used to add an `intangible'
+ ;; property, but the docs say it's now obsolete.
+ (put-text-property (point-min) (point-max) 'invisible 'erc-match))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -681,12 +680,21 @@ erc-beep-on-match
(beep)))
(defun erc-match--modify-invisibility-spec ()
- "Add an ellipsis property to the local spec."
+ "Add an `erc-match' property to the local spec."
(if erc-match-mode
(add-to-invisibility-spec 'erc-match)
(erc-with-all-buffers-of-server nil nil
(remove-from-invisibility-spec 'erc-match))))
+(defun erc-match-toggle-hidden-fools ()
+ "Toggle fool visibility.
+Expect `erc-hide-fools' or a function that does something similar
+to be in `erc-text-matched-hook'."
+ (interactive)
+ (if (memq 'erc-match (ensure-list buffer-invisibility-spec))
+ (remove-from-invisibility-spec 'erc-match)
+ (add-to-invisibility-spec 'erc-match)))
+
(provide 'erc-match)
;;; erc-match.el ends here
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 5035e60a87d..83ee4a200ed 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -179,6 +179,12 @@ stamp
(kill-local-variable 'erc-timestamp-last-inserted-left)
(kill-local-variable 'erc-timestamp-last-inserted-right))))
+(defvar erc-stamp--invisible-property nil
+ "Existing `invisible' property value and/or symbol `timestamp'.")
+
+(defvar erc-stamp--skip-when-invisible nil
+ "Escape hatch for omitting stamps when first char is invisible.")
+
(defun erc-stamp--recover-on-reconnect ()
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
@@ -209,8 +215,11 @@ erc-add-timestamp
(progn ; remove this `progn' on next major refactor
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
+ (erc-stamp--invisible-property
+ ;; FIXME on major version bump, make this `erc-' prefixed.
+ (if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(erc-stamp--current-time ct))
- (unless invisible
+ (unless (setq invisible (and erc-stamp--skip-when-invisible invisible))
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
;; FIXME this will error when advice has been applied.
@@ -380,7 +389,7 @@ erc-insert-timestamp-left
(s (if ignore-p (make-string len ? ) string)))
(unless ignore-p (setq erc-timestamp-last-inserted string))
(erc-put-text-property 0 len 'field 'erc-timestamp s)
- (erc-put-text-property 0 len 'invisible 'timestamp s)
+ (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
(defun erc-insert-aligned (string pos)
@@ -428,6 +437,7 @@ erc-insert-timestamp-right
(goto-char (point-max))
(forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
+ (buffer-invisibility-spec nil) ; `current-column' > 0
window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
@@ -477,6 +487,8 @@ erc-insert-timestamp-right
(put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
+ (erc-put-text-property from (point) 'invisible
+ erc-stamp--invisible-property)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
@@ -520,9 +532,8 @@ erc-format-timestamp
(let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
- (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
- (erc-put-text-property 0 (length ts)
- 'isearch-open-invisible 'timestamp ts)
+ (erc-put-text-property 0 (length ts) 'invisible
+ erc-stamp--invisible-property ts)
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 782907bfc30..715fe9c25d7 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -24,8 +24,12 @@
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
-(require 'erc-stamp)
-(require 'erc-match)
+(eval-when-compile
+ (require 'erc-join)
+ (require 'erc-stamp)
+ (require 'erc-match))
+
+(require 'erc-fill)
;; This defends against a regression in which all matching by the
;; `erc-match-message' fails when `erc-add-timestamp' precedes it in
@@ -57,28 +61,23 @@ erc-scenarios-match--stamp-left-current-nick
(should (eq (get-text-property (1- (point)) 'font-lock-face)
'erc-current-nick-face))))))
-;; This asserts that when stamps appear before a message,
-;; some non-nil invisibility property spans the entire message.
-(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
- :tags '(:expensive-test)
- (ert-skip "WIP: fix included in bug#64301")
+;; When hacking on tests that use this fixture, it's best to run it
+;; interactively, and check for wierdness before and after doing
+;; M-: (remove-from-invisibility-spec 'erc-match) RET.
+(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
+ (unless noninteractive
+ (kill-new "(remove-from-invisibility-spec 'erc-match)"))
+
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
(port (process-contact dumb-server :service))
(erc-server-flood-penalty 0.1)
- (erc-insert-timestamp-function 'erc-insert-timestamp-left)
(erc-timestamp-only-if-changed-flag nil)
(erc-fools '("bob"))
(erc-text-matched-hook '(erc-hide-fools))
(erc-autojoin-channels-alist '((FooNet "#chan")))
- (expect (erc-d-t-make-expecter))
- (hiddenp (lambda ()
- (and (eq (field-at-pos (pos-bol)) 'erc-timestamp)
- (get-text-property (pos-bol) 'invisible)
- (>= (next-single-property-change (pos-bol)
- 'invisible nil)
- (pos-eol))))))
+ (expect (erc-d-t-make-expecter)))
(ert-info ("Connect")
(with-current-buffer (erc :server "127.0.0.1"
@@ -94,30 +93,242 @@ erc-scenarios-match--stamp-left-fools-invisible
(ert-info ("Ensure lines featuring \"bob\" are invisible")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(should (funcall expect 10 "<bob> tester, welcome!"))
- (should (funcall hiddenp))
+ (ert-info ("<bob> tester, welcome!") (funcall hiddenp))
;; Alice's is the only one visible.
(should (funcall expect 10 "<alice> tester, welcome!"))
- (should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
- (should (get-text-property (pos-bol) 'invisible))
- (should-not (get-text-property (point) 'invisible))
+ (ert-info ("<alice> tester, welcome!") (funcall visiblep))
(should (funcall expect 10 "<bob> alice: But, as it seems"))
- (should (funcall hiddenp))
+ (ert-info ("<bob> alice: But, as it seems") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: Well, this is the forest"))
- (should (funcall hiddenp))
+ (ert-info ("<alice> bob: Well, this is the forest") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: And will you"))
- (should (funcall hiddenp))
+ (ert-info ("<alice> bob: And will you") (funcall hiddenp))
(should (funcall expect 10 "<bob> alice: Live, and be prosperous"))
- (should (funcall hiddenp))
+ (ert-info ("<bob> alice: Live, and be prosperous") (funcall hiddenp))
(should (funcall expect 10 "ERC>"))
(should-not (get-text-property (pos-bol) 'invisible))
(should-not (get-text-property (point) 'invisible))))))
-(eval-when-compile (require 'erc-join))
+;; This asserts that when stamps appear before a message, registered
+;; invisibility properties owned by modules span the entire message.
+(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
+ :tags '(:expensive-test)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left))
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ ;; This is a time-stamped message.
+ (should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
+
+ ;; Leading stamp has combined `invisible' property value.
+ (should (equal (get-text-property (pos-bol) 'invisible)
+ '(timestamp erc-match)))
+
+ ;; Message proper has the `invisible' property `erc-match'.
+ (let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
+ (should (eq (get-text-property msg-beg 'invisible) 'erc-match))
+ (should (>= (next-single-property-change msg-beg 'invisible nil)
+ (pos-eol)))))
+
+ (lambda ()
+ ;; This is a time-stamped message.
+ (should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
+ (should (get-text-property (pos-bol) 'invisible))
+
+ ;; The entire message proper is visible.
+ (let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
+ (should
+ (= (next-single-property-change msg-beg 'invisible nil (pos-eol))
+ (pos-eol))))))))
+
+(defun erc-scenarios-match--find-eol ()
+ (save-excursion
+ (goto-char (next-single-property-change (point) 'erc-command))
+ (pos-eol)))
+
+;; In most cases, `erc-hide-fools' makes line endings invisible.
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+ :tags '(:expensive-test)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (let ((end (erc-scenarios-match--find-eol)))
+ ;; The end of the message is a newline.
+ (should (= ?\n (char-after end)))
+
+ ;; Every message has a trailing time stamp.
+ (should (eq (field-at-pos (1- end)) 'erc-timestamp))
+
+ ;; Stamps have a combined `invisible' property value.
+ (should (equal (get-text-property (1- end) 'invisible)
+ '(timestamp erc-match)))
+
+ ;; The final newline is hidden by `match', not `stamps'
+ (should (equal (get-text-property end 'invisible) 'erc-match))
+
+ ;; The message proper has the `invisible' property `erc-match',
+ ;; and it starts after the preceding newline.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+
+ ;; It ends just before the timestamp.
+ (let ((msg-end (next-single-property-change (pos-bol) 'invisible)))
+ (should (equal (get-text-property msg-end 'invisible)
+ '(timestamp erc-match)))
+
+ ;; Stamp's `invisible' property extends throughout the stamp
+ ;; and ends before the trailing newline.
+ (should (= (next-single-property-change msg-end 'invisible) end)))))
+
+ (lambda ()
+ (let ((end (erc-scenarios-match--find-eol)))
+ ;; This message has a time stamp like all the others.
+ (should (eq (field-at-pos (1- end)) 'erc-timestamp))
+
+ ;; The entire message proper is visible.
+ (should-not (get-text-property (pos-bol) 'invisible))
+ (let ((inv-beg (next-single-property-change (pos-bol) 'invisible)))
+ (should (eq (get-text-property inv-beg 'invisible)
+ 'timestamp))))))))
+
+;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides
+;; the preceding message's line ending.
+(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap ()
+ :tags '(:expensive-test)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)
+ (erc-fill-function #'erc-fill-wrap))
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ ;; Every message has a trailing time stamp.
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+
+ ;; Stamps appear in the right margin.
+ (should (equal (car (get-text-property (1- (pos-eol)) 'display))
+ '(margin right-margin)))
+
+ ;; Stamps have a combined `invisible' property value.
+ (should (equal (get-text-property (1- (pos-eol)) 'invisible)
+ '(timestamp erc-match)))
+
+ ;; The message proper has the `invisible' property `erc-match',
+ ;; which starts at the preceding newline...
+ (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
+
+ ;; ... and ends just before the timestamp.
+ (let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible)))
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp erc-match)))
+
+ ;; The newline before `erc-insert-marker' is still visible.
+ (should-not (get-text-property (pos-eol) 'invisible))
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol)))))
+
+ (lambda ()
+ ;; This message has a time stamp like all the others.
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+
+ ;; Unlike hidden messages, the preceding newline is visible.
+ (should-not (get-text-property (1- (pos-bol)) 'invisible))
+
+ ;; The entire message proper is visible.
+ (let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
+ (should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
+ :tags '(:expensive-test)
+ (should (eq erc-insert-timestamp-function
+ #'erc-insert-timestamp-left-and-right))
+
+ ;; Rewind the clock to known date artificially.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-static)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `erc-match'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+ (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
+ (mend (next-single-property-change mbeg 'erc-command)))
+
+ (if (/= 1 bob-utterance-counter)
+ (should-not (field-at-pos mend))
+ ;; For Bob's stamped message, check newline after stamp.
+ (should (eq (field-at-pos mend) 'erc-timestamp))
+ (setq mend (field-end mend)))
+
+ ;; The `erc-timestamp' property spans entire messages,
+ ;; including stamps and filled text, which makes for
+ ;; convenient traversal when `erc-stamp-mode' is enabled.
+ (should (get-text-property (pos-bol) 'erc-timestamp))
+ (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
+ mend))
+
+ ;; Line ending has the `invisible' property `erc-match'.
+ (should (= (char-after mend) ?\n))
+ (should (eq (get-text-property mend'invisible) 'erc-match))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that extends until the start of the message proper.
+ (should (equal (get-text-property (point) 'invisible)
+ '(timestamp erc-match)))
+ (should (= (next-single-property-change (point) 'invisible)
+ (1+ (pos-eol))))))
+
+ (ert-info ("Folding preserved despite invisibility")
+ ;; Message has a trailing time stamp, but it's been folded
+ ;; over to the next line.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (save-excursion
+ (forward-line)
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(timestamp erc-match)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (save-excursion (forward-line) (pos-eol)))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
;;; erc-scenarios-match.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Simplify-erc-button-add-nickname-buttons.patch --]
[-- Type: text/x-patch, Size: 7251 bytes --]
From a8e8078b95fa3dfa0b37b88a4d3b94432ae75468 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 30 Jun 2023 23:42:01 -0700
Subject: [PATCH 2/4] [5.6] Simplify erc-button-add-nickname-buttons
* lisp/erc/erc-button.el (erc-button--nick): Remove `face' slot which
was set to `erc-button-face' by default. It's ignored when the button
is a nick and thus completely useless.
(erc-button-add-nickname-buttons): Rework and reflow for readability.
Don't bind or set `erc-button' face because it's ignored when dealing
with nicks. Don't return the value of face options when calling a
`form' function because they can be nil in practice even though their
Custom type specs do not say so.
* lisp/erc/erc.el (erc--get-speaker-bounds): New helper function to
retrieve bounds of a speaker label when present. (Bug#64301)
---
lisp/erc/erc-button.el | 78 ++++++++++++++++++++----------------------
lisp/erc/erc.el | 10 ++++++
2 files changed, 47 insertions(+), 41 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 0c616a6026d..c30f7c10ca6 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -355,8 +355,6 @@ erc-button--nick
( cuser nil :type (or null erc-channel-user)
;; The CDR of a value from an `erc-channel-users' table.
:documentation "A possibly nil `erc-channel-user'.")
- ( face erc-button-face :type symbol
- :documentation "Temp `erc-button-face' while buttonizing.")
( nickname-face erc-button-nickname-face :type symbol
:documentation "Temp `erc-button-nickname-face' while buttonizing.")
( mouse-face erc-button-mouse-face :type symbol
@@ -431,45 +429,43 @@ erc-button--phantom-users-mode
(defun erc-button-add-nickname-buttons (entry)
"Search through the buffer for nicknames, and add buttons."
- (let ((form (nth 2 entry))
- (fun (nth 3 entry))
- (erc-button-buttonize-nicks (and erc-button-buttonize-nicks
- erc-button--modify-nick-function))
- bounds word)
- (when (and form (setq form (erc-button--extract-form form)))
- (goto-char (point-min))
- (while (erc-forward-word)
- (when (setq bounds (erc-bounds-of-word-at-point))
- (setq word (buffer-substring-no-properties
- (car bounds) (cdr bounds)))
- (let* ((erc-button-face erc-button-face)
- (erc-button-mouse-face erc-button-mouse-face)
- (erc-button-nickname-face erc-button-nickname-face)
- (down (erc-downcase word))
- (cuser (and erc-channel-users
- (gethash down erc-channel-users)))
- (user (or (and cuser (car cuser))
- (and erc-server-users
- (gethash down erc-server-users))
- (funcall erc-button--fallback-user-function
- down word bounds)))
- (data (list word)))
- (when (or (not (functionp form))
- (and-let* ((user)
- (obj (funcall form (make-erc-button--nick
- :bounds bounds :data data
- :downcased down :user user
- :cuser (cdr cuser)))))
- (setq bounds (erc-button--nick-bounds obj)
- data (erc-button--nick-data obj)
- erc-button-mouse-face
- (erc-button--nick-mouse-face obj)
- erc-button-nickname-face
- (erc-button--nick-nickname-face obj)
- erc-button-face
- (erc-button--nick-face obj))))
- (erc-button-add-button (car bounds) (cdr bounds)
- fun t data))))))))
+ (when-let ((form (nth 2 entry))
+ ;; Spoof `form' slot of default legacy `nicknames' entry
+ ;; so `erc-button--extract-form' sees a function value.
+ (form (let ((erc-button-buttonize-nicks
+ (and erc-button-buttonize-nicks
+ erc-button--modify-nick-function)))
+ (erc-button--extract-form form)))
+ (seen 0))
+ (goto-char (point-min))
+ (while-let
+ (((erc-forward-word))
+ (bounds (or (and (= 1 (cl-incf seen)) (erc--get-speaker-bounds))
+ (erc-bounds-of-word-at-point)))
+ (word (buffer-substring-no-properties (car bounds) (cdr bounds)))
+ (down (erc-downcase word)))
+ (let* ((erc-button-mouse-face erc-button-mouse-face)
+ (erc-button-nickname-face erc-button-nickname-face)
+ (cuser (and erc-channel-users (gethash down erc-channel-users)))
+ (user (or (and cuser (car cuser))
+ (and erc-server-users (gethash down erc-server-users))
+ (funcall erc-button--fallback-user-function
+ down word bounds)))
+ (data (list word)))
+ (when (or (not (functionp form))
+ (and-let* ((user)
+ (obj (funcall form (make-erc-button--nick
+ :bounds bounds :data data
+ :downcased down :user user
+ :cuser (cdr cuser)))))
+ (setq erc-button-mouse-face ; might be null
+ (erc-button--nick-mouse-face obj)
+ erc-button-nickname-face ; might be null
+ (erc-button--nick-nickname-face obj)
+ data (erc-button--nick-data obj)
+ bounds (erc-button--nick-bounds obj))))
+ (erc-button-add-button (car bounds) (cdr bounds) (nth 3 entry)
+ 'nickp data))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e23185934f7..06b88ade2a0 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5025,6 +5025,16 @@ erc-is-message-ctcp-and-not-action-p
(and (erc-is-message-ctcp-p message)
(not (string-match "^\C-aACTION.*\C-a$" message))))
+(define-inline erc--get-speaker-bounds ()
+ "Return the bounds of `erc-speaker' property when present.
+Assume buffer is narrowed to the confines of an inserted message."
+ (inline-quote
+ (and-let*
+ (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE)))
+ (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min))
+ (next-single-property-change (point-min) 'erc-speaker))))
+ (cons beg (next-single-property-change beg 'erc-speaker)))))
+
(defvar erc--user-from-nick-function #'erc--examine-nick
"Function to possibly consider unknown user.
Must return either nil or a cons of an `erc-server-user' and a
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Add-text-props-for-CTCPs-and-speakers-in-ERC.patch --]
[-- Type: text/x-patch, Size: 11148 bytes --]
From 0f324a9946804fe01476ed62be9c23e99b47aaed Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 24 Jun 2023 18:33:20 -0700
Subject: [PATCH 3/4] [5.6] Add text props for CTCPs and speakers in ERC
* lisp/erc/erc-fill.el (erc-fill-spaced-commands,
erc-fill--spaced-commands): Rename former to latter and demote from
user option to internal variable.
(erc-fill--wrap-continued-message-p): Use
`erc-ctcp' text prop instead of face to detect ACTION.
(erc-fill--wrap-action-dedent-p): New variable to toggle whether
`line-prefix' is applied to CTCP ACTION messages.
(erc-fill-wrap): Look for `erc-speaker' property before falling back
on word at point. Use `erc-ctcp' to detect ACTION messages.
* lisp/erc/erc.el (erc-notice-face, erc-action-face): Prefer weight of
`semi-bold' when available so that buttonization is at least somewhat
visible.
(erc-send-action): Ensure nickname passed to `erc-display-message' has
`erc-speaker' property and `erc-ctcp' ACTION property. Apply both
`erc-input-face' and `erc-action-face' to messages.
(erc--own-property-names): Add `erc-speaker'.
(erc-format-privmessage): Don't clobber `erc-nick-prefix-face'. That
is, retain face applied to a leading stretch of characters in the
`nick' parameter. But continue to discard trailing faces.
(erc-format-my-nick, erc-ctcp-query-ACTION): Add a new text property,
`erc-speaker', to the nick portion of the formatted speaker label. Do
this to assist modules, like `button' and `match', that re-parse
speakers in inserted messages.
(erc-process-ctcp-query): Add `erc-ctcp' property to entire message
before insertion hooks. (Bug#64301)
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--compare): Warn
about certain unreliable comparisons if generalizing helper for use by
other modules.
---
lisp/erc/erc-fill.el | 25 ++++++++++++++-------
lisp/erc/erc.el | 40 ++++++++++++++++++++++++---------
test/lisp/erc/erc-fill-tests.el | 5 ++++-
3 files changed, 51 insertions(+), 19 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 5115e45210d..a65c95f1d85 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -124,11 +124,9 @@ erc-fill-line-spacing
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) number))
-(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE)
+(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."
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type '(repeat (choice integer symbol)))
+Only considered when `erc-fill-line-spacing' is non-nil.")
(defvar-local erc-fill--function nil
"Internal copy of `erc-fill-function'.
@@ -153,12 +151,12 @@ erc-fill
(p (point-min)))
(widen)
(when (or (and-let* ((cmd (get-text-property p 'erc-command)))
- (memq cmd erc-fill-spaced-commands))
+ (memq cmd erc-fill--spaced-commands))
(and-let* ((cmd (save-excursion
(forward-line -1)
(get-text-property (point)
'erc-command))))
- (memq cmd erc-fill-spaced-commands)))
+ (memq cmd erc-fill--spaced-commands)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@@ -384,8 +382,7 @@ erc-fill--wrap-continued-message-p
(when (eq 'erc-timestamp (field-at-pos m))
(set-marker m (field-end m)))
(and (eq 'PRIVMSG (get-text-property m 'erc-command))
- (not (eq (get-text-property m 'font-lock-face)
- 'erc-action-face))
+ (not (eq (get-text-property m 'erc-ctcp) 'ACTION))
(cons (get-text-property m 'erc-timestamp)
(get-text-property (1+ m) 'erc-data)))))
(ts (pop props))
@@ -418,6 +415,12 @@ erc-fill--wrap-stamp-insert-prefixed-date
`(space :width (- erc-fill--wrap-value ,width))))
args)
+;; An escape hatch for third-party code expecting speakers of ACTION
+;; messages to be exempt from `line-prefix'. This could be converted
+;; into a user option if users feel similarly.
+(defvar erc-fill--wrap-action-dedent-p t
+ "Whether to dedent speakers in CTCP \"ACTION\" lines.")
+
(defun erc-fill-wrap ()
"Use text props to mimic the effect of `erc-fill-static'.
See `erc-fill-wrap-mode' for details."
@@ -428,6 +431,12 @@ erc-fill-wrap
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
(progn
+ (when-let ((e (erc--get-speaker-bounds))
+ (b (pop e))
+ ((or erc-fill--wrap-action-dedent-p
+ (not (eq (get-text-property b 'erc-ctcp)
+ 'ACTION)))))
+ (goto-char e))
(skip-syntax-forward "^-")
(forward-char)
;; Using the `invisible' property might make more
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 06b88ade2a0..d43281825fb 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1302,12 +1302,15 @@ erc-command-indicator-face
(defface erc-notice-face
'((default :weight bold)
+ (((class color) (min-colors 88) (supports :weight semi-bold))
+ :weight semi-bold :foreground "SlateBlue")
(((class color) (min-colors 88)) :foreground "SlateBlue")
(t :foreground "blue"))
"ERC face for notices."
:group 'erc-faces)
-(defface erc-action-face '((t :weight bold))
+(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold)
+ (t :weight bold))
"ERC face for actions generated by /ME."
:group 'erc-faces)
@@ -2723,10 +2726,13 @@ erc-send-action
(erc-send-ctcp-message tgt (format "ACTION %s" str) force)
(let ((erc-insert-pre-hook
(cons (lambda (s) ; Leave newline be.
- (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s))
- erc-insert-pre-hook)))
- (erc-display-message nil 'input (current-buffer)
- 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h "")))
+ (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)
+ (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s))
+ erc-insert-pre-hook))
+ (nick (erc-current-nick)))
+ (setq nick (propertize nick 'erc-speaker nick))
+ (erc-display-message nil '(action input) (current-buffer)
+ 'ACTION ?n nick ?a str ?u "" ?h "")))
;; Display interface
@@ -4532,7 +4538,7 @@ erc-ensure-channel-name
(concat "#" channel)))
(defvar erc--own-property-names
- '( tags erc-parsed display ; core
+ '( tags erc-speaker erc-parsed display ; core
;; `erc-display-prompt'
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
@@ -5051,11 +5057,19 @@ erc-format-privmessage
(mark-e (if msgp (if privp "*" ">") "-"))
(str (format "%s%s%s %s" mark-s nick mark-e msg))
(nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
+ (nick-prefix-face (get-text-property 0 'font-lock-face nick))
+ (prefix-len (or (and nick-prefix-face (text-property-not-all
+ 0 (length nick) 'font-lock-face
+ nick-prefix-face nick))
+ 0))
(msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
;; add text properties to text before the nick, the nick and after the nick
(erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str)
- (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick))
- 'font-lock-face nick-face str)
+ (erc-put-text-properties (+ (length mark-s) prefix-len)
+ (+ (length mark-s) (length nick))
+ '(font-lock-face erc-speaker) str
+ (list nick-face
+ (substring-no-properties nick prefix-len)))
(erc-put-text-property (+ (length mark-s) (length nick)) (length str)
'font-lock-face msg-face str)
str))
@@ -5107,7 +5121,7 @@ erc-format-my-nick
(concat
(propertize open 'font-lock-face 'erc-default-face)
(propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
- (propertize nick 'font-lock-face 'erc-my-nick-face)
+ (propertize nick 'font-lock-face 'erc-my-nick-face 'erc-speaker nick)
(propertize close 'font-lock-face 'erc-default-face)))
(let ((prefix "> "))
(propertize prefix 'font-lock-face 'erc-default-face))))
@@ -5345,7 +5359,12 @@ erc-process-ctcp-query
'ctcp-empty ?n nick)
(while queries
(let* ((type (upcase (car (split-string (car queries)))))
- (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
+ (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
+ (erc-insert-pre-hook
+ (cons (lambda (s)
+ (put-text-property 0 (1- (length s)) 'erc-ctcp
+ (intern type) s))
+ erc-insert-pre-hook)))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
(run-hook-with-args-until-success
@@ -5380,6 +5399,7 @@ erc-ctcp-query-ACTION
(buf (or (erc-get-buffer to proc)
(erc-get-buffer nick proc)
(process-buffer proc))))
+ (setq nick (propertize nick 'erc-speaker nick))
(erc-display-message
parsed 'action buf
'ACTION ?n nick ?u login ?h host ?a s))))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 15a8087f848..99ec4a9635e 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -153,7 +153,10 @@ erc-fill-tests--compare
(with-temp-file expect-file
(insert repr))
(if (file-exists-p expect-file)
- ;; Compare set-equal over intervals
+ ;; Compare set-equal over intervals. This comparison is
+ ;; less useful for messages treated by other modules because
+ ;; it doesn't compare "nested" props belonging to
+ ;; string-valued properties, like timestamps.
(should (equal-including-properties
(read repr)
(read (with-temp-buffer
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Handle-composite-faces-better-in-erc-display-mes.patch --]
[-- Type: text/x-patch, Size: 23546 bytes --]
From aae534bcbe0eb75e436c428b248a87748ec185b6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 24 Jun 2023 18:33:20 -0700
Subject: [PATCH 4/4] [5.6] Handle composite faces better in
erc-display-message
* etc/ERC-NEWS: Tell users to update their customized
`erc-track-faces-priority-list' values.
* lisp/erc/erc-backend.el (erc-server-401, erc-server-402,
erc-server-403, erc-server-404, erc-server-405, erc-server-406,
erc-server-412, erc-server-421, erc-server-432, erc-server-442,
erc-server-461, erc-server-474, erc-server-475, erc-server-482):
Change `erc-display-message' `type' arg from list of both `error' and
`notice' to just a lone `error' symbol.
(erc-server-465, erc-server-431): Inline calls to
`erc-display-error-notice, except just pass `error' for `type' arg.
Also, remove forward declaration for `erc-display-error-notice' from
atop file.
* lisp/erc/erc-dcc.el (erc-dcc-do-GET-command,
erc-dcc-do-SEND-command, erc-ctcp-query-DCC, erc-dcc-handle-ctcp-chat,
erc-dcc-get-filter, erc-dcc-get-sentinel): Change
`erc-display-message' `type' arg from list to `error'.
* lisp/erc/erc-match.el (erc-hide-fools): Merge `invisible' prop
`erc-match' with existing, if present, and move body to helper for
hiding matched messages.
(erc-match--hide-message): New generalized helper function to hide
messages regardless of match type.
* lisp/erc/erc-sasl.el (erc-server-902, erc-server-907,
erc-server-904, erc-server-908): Change `erc-display-message' `type'
arg from list to `error'.
* lisp/erc/erc-track.el: Require `erc-button' atop file because
options, like `erc-track-faces-priority-list', whose Custom type
involves faces, fail validation otherwise.
(erc-track--attn-faces): Add new internal variable for faces that
should always light up the mode line no matter what.
(erc-track-modified-channels, erc-track-face-priority): Prepend
`erc-track--attn-faces' to `erc-track-faces-priority-list'.
* lisp/erc/erc.el (erc--compose-text-properties): New internal
variable to alter behavior of `erc-put-text-property'.
(erc--merge-prop): Port over `erc-button-add-face' for general use by
all of ERC.
(erc-display-message-highlight): Set face to `erc-default-face' the
symbol instead of the string.
(erc-display-message): Explain how type param works when it's a list.
Fix code in type-as-list branch so that it combines faces instead of
clobbers them.
(erc-nickname-in-use): Inline `erc-display-error-notice' but change
`type' arg from list to `error'.
(erc-put-text-property): Unalias from `put-text-property' and instead
fall back to latter unless caller wants to combine faces, in which
case defer to `erc--merge-prop'.
* test/lisp/erc/erc-button-tests.el
(erc-button--display-error-notice-with-keys): Expect a combined "error
notice" face. (Bug#64301)
---
etc/ERC-NEWS | 15 ++++++++++
lisp/erc/erc-backend.el | 39 +++++++++++-------------
lisp/erc/erc-dcc.el | 16 +++++-----
lisp/erc/erc-match.el | 13 ++++----
lisp/erc/erc-sasl.el | 8 ++---
lisp/erc/erc-track.el | 12 ++++++--
lisp/erc/erc.el | 49 ++++++++++++++++++++++---------
test/lisp/erc/erc-button-tests.el | 2 +-
8 files changed, 97 insertions(+), 57 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 37435a1d915..795553f1666 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -228,6 +228,21 @@ The 'fill' module is now defined by 'define-erc-module'. The same
goes for ERC's imenu integration, which has 'imenu' now appearing in
the default value of 'erc-modules'.
+*** 'erc-display-message' combines faces when 'type' is a list.
+Users may notice that ERC now renders messages passed to the
+convenience function 'erc-display-error-notice' in a combination of
+'erc-error-face' and 'erc-notice-face'. This is merely a consequence
+of that function being a wrapper around 'erc-display-message', which
+has gotten smarter about how it treats face properties when its 'type'
+parameter is a list. Originally, ERC's authors intended to display
+both server-originating and ERC-generated errors in this style, but
+due to various complications, that intent was never realized until
+this release, and even now only partially so. Indeed, to minimize
+churn, the effect has been limited to internal and usage errors. For
+third-party code, the key take away is that more 'font-lock-face'
+properties encountered in the wild may be combinations of faces rather
+than simple ones.
+
*** Prompt input is split before 'erc-pre-send-functions' has a say.
Hook members are now treated to input whose lines have already been
adjusted to fall within the allowed length limit. For convenience,
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index f1b51f9234a..bf21ec96225 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -148,7 +148,6 @@ erc-whowas-on-nosuchnick
(declare-function erc-current-time "erc" (&optional specified-time))
(declare-function erc-default-target "erc" nil)
(declare-function erc-delete-default-channel "erc" (channel &optional buffer))
-(declare-function erc-display-error-notice "erc" (parsed string))
(declare-function erc-display-server-message "erc" (_proc parsed))
(declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time))
(declare-function erc-format-message "erc" (msg &rest args))
@@ -2411,47 +2410,47 @@ erc-server-322-message
(when erc-whowas-on-nosuchnick
(erc-log (format "cmd: WHOWAS: %s" nick/channel))
(erc-server-send (format "WHOWAS %s 1" nick/channel)))
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
's401 ?n nick/channel)))
(define-erc-response-handler (402)
"No such server." nil
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
's402 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (403)
"No such channel." nil
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
's403 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (404)
"Cannot send to channel." nil
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
's404 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (405)
"Can't join that many channels." nil
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
's405 ?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (406)
"No such nick." nil
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
's406 ?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (412)
"No text to send." nil
- (erc-display-message parsed '(notice error) 'active 's412))
+ (erc-display-message parsed 'error 'active 's412))
(define-erc-response-handler (421)
"Unknown command." nil
- (erc-display-message parsed '(notice error) 'active 's421
+ (erc-display-message parsed 'error 'active 's421
?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (432)
"Bad nick." nil
- (erc-display-message parsed '(notice error) 'active 's432
+ (erc-display-message parsed 'error 'active 's432
?n (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (433)
@@ -2469,12 +2468,12 @@ erc-server-322-message
(define-erc-response-handler (442)
"Not on channel." nil
- (erc-display-message parsed '(notice error) 'active 's442
+ (erc-display-message parsed 'error 'active 's442
?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (461)
"Not enough parameters for command." nil
- (erc-display-message parsed '(notice error) 'active 's461
+ (erc-display-message parsed 'error 'active 's461
?c (cadr (erc-response.command-args parsed))
?m (erc-response.contents parsed)))
@@ -2482,20 +2481,19 @@ erc-server-322-message
"You are banned from this server." nil
(setq erc-server-banned t)
;; show the server's message, as a reason might be provided
- (erc-display-error-notice
- parsed
+ (erc-display-message parsed 'error 'active
(erc-response.contents parsed)))
(define-erc-response-handler (474)
"Banned from channel errors." nil
- (erc-display-message parsed '(notice error) nil
+ (erc-display-message parsed 'error nil
(intern (format "s%s"
(erc-response.command parsed)))
?c (cadr (erc-response.command-args parsed))))
(define-erc-response-handler (475)
"Channel key needed." nil
- (erc-display-message parsed '(notice error) nil 's475
+ (erc-display-message parsed 'error nil 's475
?c (cadr (erc-response.command-args parsed)))
(when erc-prompt-for-channel-key
(let ((channel (cadr (erc-response.command-args parsed)))
@@ -2516,7 +2514,7 @@ erc-server-322-message
"You need to be a channel operator to do that." nil
(let ((channel (cadr (erc-response.command-args parsed)))
(message (erc-response.contents parsed)))
- (erc-display-message parsed '(notice error) 'active 's482
+ (erc-display-message parsed 'error 'active 's482
?c channel ?m message)))
(define-erc-response-handler (671)
@@ -2551,11 +2549,8 @@ erc-server-322-message
;; 491 - No O-lines for your host
;; 501 - Unknown MODE flag
;; 502 - Cannot change mode for other users
- "Generic display of server error messages.
-
-See `erc-display-error-notice'." nil
- (erc-display-error-notice
- parsed
+ "Display error message as given from server." nil
+ (erc-display-message parsed 'error 'active
(intern (format "s%s" (erc-response.command parsed)))))
;; FIXME: These are yet to be implemented, they're just stubs for now
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index cc2dcc9a788..8968295a83c 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -566,7 +566,7 @@ erc-dcc-do-GET-command
file))
(erc-dcc-get-file elt file proc)
(erc-display-message
- nil '(notice error) proc
+ nil 'error proc
'dcc-get-cmd-aborted
?n nick ?f filename)))
(t
@@ -578,7 +578,7 @@ erc-dcc-do-GET-command
(setq erc-dcc-list (cons (plist-put elt :turbo t)
(delq elt erc-dcc-list)))))
(erc-display-message
- nil '(notice error) 'active
+ nil 'error 'active
'dcc-get-notfound ?n nick ?f filename))))
(defvar-local erc-dcc-byte-count nil)
@@ -648,7 +648,7 @@ erc-dcc-do-SEND-command
nil 'notice 'active
'dcc-send-offer ?n nick ?f file)
(erc-dcc-send-file nick file) t)
- (erc-display-message nil '(notice error) proc "File not found") t))
+ (erc-display-message nil 'error proc "File not found") t))
;;; Server message handling (i.e. messages from remote users)
@@ -675,7 +675,7 @@ erc-ctcp-query-DCC
(funcall handler proc query nick login host to)
;; FIXME: Send a ctcp error notice to the remote end?
(erc-display-message
- nil '(notice error) proc
+ nil 'error proc
'dcc-ctcp-unknown
?q query ?n nick ?u login ?h host))))
@@ -771,7 +771,7 @@ erc-dcc-handle-ctcp-chat
(;; DCC CHAT requests must be sent to you, and you alone.
(not (erc-current-nick-p to))
(erc-display-message
- nil '(notice error) proc
+ nil 'error proc
'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-chat-regexp query)
;; We need to use let* here, since erc-dcc-member might clutter
@@ -805,7 +805,7 @@ erc-dcc-handle-ctcp-chat
proc))))
(t
(erc-display-message
- nil '(notice error) proc
+ nil 'error proc
'dcc-malformed ?n nick ?u login ?h host ?q query)))))
@@ -1053,7 +1053,7 @@ erc-dcc-get-filter
((and (> (plist-get erc-dcc-entry-data :size) 0)
(> received-bytes (plist-get erc-dcc-entry-data :size)))
(erc-display-message
- nil '(notice error) 'active
+ nil 'error 'active
'dcc-get-file-too-long
?f (file-name-nondirectory (buffer-name)))
(delete-process proc))
@@ -1085,7 +1085,7 @@ erc-dcc-get-sentinel
(erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
(let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size))))
(erc-display-message
- nil (if done 'notice '(notice error)) erc-server-process
+ nil (if done 'notice 'error) erc-server-process
(if done 'dcc-get-complete 'dcc-get-failed)
?v (plist-get erc-dcc-entry-data :size)
?f erc-dcc-file-name
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index cd2c55b0091..a5b0af41b2a 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -657,21 +657,22 @@ erc-go-to-log-matches-buffer
(defvar-local erc-match--hide-fools-offset-bounds nil)
-;; FIXME this should merge with instead of overwrite existing
-;; `invisible' values.
(defun erc-hide-fools (match-type _nickuserhost _message)
- "Hide foolish comments.
-This function should be called from `erc-text-matched-hook'."
+ "Hide comments from designated fools."
(when (eq match-type 'fool)
+ (erc-match--hide-message)))
+
+(defun erc-match--hide-message ()
+ (progn ; FIXME raise sexp
(if erc-match--hide-fools-offset-bounds
(let ((beg (point-min))
(end (point-max)))
(save-restriction
(widen)
- (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match)))
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
- (put-text-property (point-min) (point-max) 'invisible 'erc-match))))
+ (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index c6922b1b26b..73d318fd4fd 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -377,7 +377,7 @@ erc-sasl--destroy
(define-erc-response-handler (902)
"Handle an ERR_NICKLOCKED response." nil
- (erc-display-message parsed '(notice error) 'active 's902
+ (erc-display-message parsed 'error 'active 's902
?n (car (erc-response.command-args parsed))
?s (erc-response.contents parsed))
(erc-sasl--destroy proc))
@@ -391,19 +391,19 @@ erc-sasl--destroy
(define-erc-response-handler (907)
"Handle a RPL_SASLALREADY response." nil
- (erc-display-message parsed '(notice error) 'active 's907
+ (erc-display-message parsed 'error 'active 's907
?s (erc-response.contents parsed)))
(define-erc-response-handler (904 905 906)
"Handle various SASL-related error responses." nil
- (erc-display-message parsed '(notice error) 'active
+ (erc-display-message parsed 'error 'active
(intern (format "s%s" (erc-response.command parsed)))
?s (erc-response.contents parsed))
(erc-sasl--destroy proc))
(define-erc-response-handler (908)
"Handle a RPL_SASLMECHS response." nil
- (erc-display-message parsed '(notice error) 'active 's908
+ (erc-display-message parsed 'error 'active 's908
?m (alist-get 'mechanism erc-sasl--options)
?s (string-join (cdr (erc-response.command-args parsed))
" "))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index e060b7039bd..bc09c5d87fb 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -37,6 +37,7 @@
(eval-when-compile (require 'cl-lib))
(require 'erc)
(require 'erc-match)
+(require 'erc-button) ; for validating faces in custom options
;;; Code:
@@ -309,6 +310,8 @@ erc-track-switch-direction
(const leastactive)
(const mostactive)))
+(defconst erc-track--attn-faces '((erc-error-face erc-notice-face))
+ "Faces whose presence always trigger mode-line inclusion.")
(defun erc-track-remove-from-mode-line ()
"Remove `erc-track-modified-channels' from the mode-line."
@@ -736,6 +739,9 @@ erc-track-find-face
(declare (obsolete erc-track-select-mode-line-face "28.1"))
(erc-track-select-mode-line-face (car faces) (cdr faces)))
+;; Note that unless called by `erc-track-modified-channels',
+;; `erc-track-faces-priority-list' will not begin with
+;; `erc-track--attn-faces'.
(defun erc-track-select-mode-line-face (cur-face new-faces)
"Return the face to use in the mode line.
@@ -802,7 +808,9 @@ erc-track-modified-channels
;; (in the car), change its face attribute (in the cddr) if
;; necessary. See `erc-modified-channels-alist' for the
;; exact data structure used.
- (let ((faces (erc-faces-in (buffer-string))))
+ (let ((faces (erc-faces-in (buffer-string)))
+ (erc-track-faces-priority-list
+ `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)))
(unless (and
(or (eq erc-track-priority-faces-only 'all)
(member this-channel erc-track-priority-faces-only))
@@ -873,7 +881,7 @@ erc-track-face-priority
higher number than any other face in that list."
(let ((count 0))
(catch 'done
- (dolist (item erc-track-faces-priority-list)
+ (dolist (item `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))
(if (equal item face)
(throw 'done t)
(setq count (1+ count)))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d43281825fb..98127697815 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2885,6 +2885,25 @@ erc-display-line
(process-buffer erc-server-process)
(current-buffer))))))
+(defvar erc--compose-text-properties nil
+ "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
+
+(defun erc--merge-prop (from to prop val &optional object)
+ "Compose existing PROP values with VAL between FROM and TO in OBJECT.
+For spans where PROP is non-nil, cons VAL onto the existing
+value, ensuring a proper list. Otherwise, just set PROP to VAL.
+See also `erc-button-add-face'."
+ (let ((old (get-text-property from prop object))
+ (pos from)
+ (end (next-single-property-change from prop object to))
+ new)
+ (while (< pos to)
+ (setq new (if old (cons val (ensure-list old)) val))
+ (put-text-property pos end prop new object)
+ (setq pos end
+ old (get-text-property pos prop object)
+ end (next-single-property-change pos prop object to)))))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
@@ -2896,7 +2915,7 @@ erc-display-message-highlight
0 (length string)
'font-lock-face (or (intern-soft
(concat "erc-" (symbol-name type) "-face"))
- "erc-default-face")
+ 'erc-default-face)
string)
string)))
@@ -3100,6 +3119,10 @@ erc-display-message
ARGS, PARSED, and TYPE are used to format MSG sensibly.
+When TYPE is a list of symbols, call handlers from left to right.
+For example, expect a TYPE of (notice error) to result in MSG's
+`font-lock-face' being (erc-error-face erc-notice-face).
+
See also `erc-format-message' and `erc-display-line'."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
@@ -3110,10 +3133,9 @@ erc-display-message
((null type)
string)
((listp type)
- (mapc (lambda (type)
- (setq string
- (erc-display-message-highlight type string)))
- type)
+ (let ((erc--compose-text-properties t))
+ (dolist (type type)
+ (setq string (erc-display-message-highlight type string))))
string)
((symbolp type)
(erc-display-message-highlight type string))))
@@ -4941,17 +4963,14 @@ erc--nickname-in-use-make-request
(erc-cmd-NICK temp))
(defun erc-nickname-in-use (nick reason)
- "If NICK is unavailable, tell the user the REASON.
-
-See also `erc-display-error-notice'."
+ "Explain REASON NICK is taken and maybe ask for alternate."
(if (or (not erc-try-new-nick-p)
;; how many default-nicks are left + one more try...
(eq erc-nick-change-attempt-count
(if (consp erc-nick)
(+ (length erc-nick) 1)
1)))
- (erc-display-error-notice
- nil
+ (erc-display-message nil 'error 'active
(format "Nickname %s is %s, try another." nick reason))
(setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
(let ((newnick (nth 1 erc-default-nicks))
@@ -4974,8 +4993,7 @@ erc-nickname-in-use
(- 9 (length erc-nick-uniquifier))))
erc-nick-uniquifier)))
(erc--nickname-in-use-make-request nick newnick)
- (erc-display-error-notice
- nil
+ (erc-display-message nil 'error 'active
(format "Nickname %s is %s, trying %s"
nick reason newnick)))))
@@ -6079,7 +6097,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defalias 'erc-put-text-property 'put-text-property
+(defun erc-put-text-property (start end property value &optional object)
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -6089,7 +6107,10 @@ 'erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support.")
+EmacsSpeak support."
+ (if erc--compose-text-properties
+ (erc--merge-prop start end property value object)
+ (put-text-property start end property value object)))
(defalias 'erc-list 'ensure-list)
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index 6a6f6934389..3dacf95a59f 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -265,7 +265,7 @@ erc-button--display-error-notice-with-keys
(ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
(erc-button-next 1)
(should (equal (get-text-property (point) 'font-lock-face)
- '(erc-button erc-error-face)))
+ '(erc-button erc-error-face erc-notice-face)))
(should (eq (get-text-property (point) 'mouse-face) 'highlight))
(should (eq erc-button-face 'erc-button))) ; extent evaporates
--
2.41.0
next prev parent reply other threads:[~2023-07-08 14:19 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <87bkh21gfa.fsf@neverwas.me>
2023-07-05 14:03 ` bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with J.P.
2023-07-08 14:19 ` J.P. [this message]
[not found] ` <87sf9y32q9.fsf@neverwas.me>
2023-07-14 2:20 ` J.P.
[not found] ` <87zg3zqlnr.fsf@neverwas.me>
2023-07-15 14:05 ` J.P.
[not found] ` <87cz0tnubk.fsf@neverwas.me>
2023-07-20 13:29 ` J.P.
[not found] ` <871qh2iudy.fsf@neverwas.me>
2023-07-23 14:00 ` J.P.
2023-06-26 13:50 J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87sf9y32q9.fsf__33690.2443015546$1688826033$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=64301@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).