* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
@ 2023-06-26 13:50 J.P.
0 siblings, 0 replies; 7+ messages in thread
From: J.P. @ 2023-06-26 13:50 UTC (permalink / raw)
To: 64301; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5178 bytes --]
Tags: patch
Currently, modules that operate on inserted messages use heuristics,
like delimiting characters and face properties, to find the bounds of
the "speaker label" (my term for the stylized nick prepended to the
start of every displayed message). I think it's worth making these
boundaries easier and more reliable to detect. At a bare minimum, having
a specific text property or field spanning the nick portion should
provide enough information to identify other regions of interest
preceding the actual message (in most cases). The attached patch
attempts to do this.
However, it may be useful in the long run to provide an internal
interface for influencing how this happens. Use cases include hiding or
altering bookend styling (currently hard-coded to angle brackets) and
using alternate display names for nicks themselves. One approach for
implementing something like this was proposed in an iteration of the
change set from bug#60933 [1] but was ultimately removed prior to
installation.
The attached patch also fixes a somewhat related bug discovered by
incal. From emacs -Q:
- Set `erc-format-nick-function' to `erc-format-@nick'
- Customize `erc-nick-prefix-face' to make it easily noticeable
- Connect to some network
- Create a new dummy channel and say something
- Notice that your speaker nick is decorated with the status prefix
"@" but that it lacks the face changes you made earlier
The only thing giving me pause about this bug is that there's no
(surviving) mention of it in the usual places, and the offending code
has been around since at least 2006. So, it's possible we're still
missing something here.
Thanks.
[1] https://lists.gnu.org/archive/html/emacs-erc/2023-04/msg00018.html
See `erc--format-speaker-functions' in the third patch
0003-5.6-Use-getter-for-finding-users-in-erc-server-PRIVM.patch.
In GNU Emacs 30.0.50 (build 4, x86_64-pc-linux-gnu, GTK+ Version
3.24.37, cairo version 1.17.6) of 2023-06-25 built on localhost
Repository revision: a6de0d22e4209e2c75dbf1e8c005dfc9d8c64cce
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 37 (Workstation Edition)
Configured using:
'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
'CFLAGS=-O0 -g3'
PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec epa derived epg rfc6068 epg-config
gnus-util text-property-search time-date mm-decode mm-bodies mm-encode
mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047
rfc2045 ietf-drums mm-util mail-prsvr mail-utils erc auth-source cl-seq
eieio eieio-core cl-macs password-cache json subr-x map format-spec
cl-loaddefs cl-lib erc-backend erc-networks byte-opt gv bytecomp
byte-compile erc-common erc-compat erc-loaddefs rmc iso-transl tooltip
cconv eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type
elisp-mode mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd
fontset image regexp-opt fringe tabulated-list replace newcomment
text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow
isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process
emacs)
Memory information:
((conses 16 64551 8809) (symbols 48 8582 0) (strings 32 23258 1697)
(string-bytes 1 673861) (vectors 16 15002)
(vector-slots 8 207268 8157) (floats 8 24 37) (intervals 56 231 0)
(buffers 976 10))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Don-t-clobber-erc-nick-prefix-face.patch --]
[-- Type: text/x-patch, Size: 5378 bytes --]
From 41e15143e16a842fc4ae072d28a647f25c58fdb8 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] [5.6] Don't clobber erc-nick-prefix-face
* lisp/erc/erc-fill.el (erc-fill-wrap): Look for `erc-speaker'
property before falling back on word at point.
* lisp/erc/erc.el (erc-send-action): Ensure nickname passed to
`erc-display-message' has `erc-speaker' property.
(erc--own-property-names): Add `erc-speaker'.
(erc-format-privmessage): Retain face applied to a leading stretch of
characters in the `nick' parameter. But continue to discard any
trailing faces.
(erc-format-privmessage, 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.
---
lisp/erc/erc-fill.el | 10 +++++++++-
lisp/erc/erc.el | 22 ++++++++++++++++------
2 files changed, 25 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 5115e45210d..acc07e7a6af 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -428,8 +428,16 @@ erc-fill-wrap
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
(progn
+ (when-let ((b (next-single-property-change
+ (point) 'erc-speaker nil (pos-eol)))
+ ((not (= (pos-eol) b)))
+ ;; String vals `eq' along same stretch
+ (e (text-property-not-all
+ b (pos-eol) 'erc-speaker
+ (get-text-property b 'erc-speaker))))
+ (goto-char e))
(skip-syntax-forward "^-")
- (forward-char)
+ (skip-syntax-forward "-")
;; Using the `invisible' property might make more
;; sense, but that would require coordination
;; with other modules, like `erc-match'.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 70adbb15b5f..c7720221115 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2724,9 +2724,11 @@ erc-send-action
(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-insert-pre-hook))
+ (nick (erc-current-nick)))
+ (setq nick (propertize nick 'erc-speaker nick))
(erc-display-message nil 'input (current-buffer)
- 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h "")))
+ 'ACTION ?n nick ?a str ?u "" ?h "")))
;; Display interface
@@ -4532,7 +4534,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
@@ -5037,11 +5039,18 @@ 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 (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))
@@ -5093,7 +5102,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))))
@@ -5366,6 +5375,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))))
--
2.40.1
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
[not found] <87bkh21gfa.fsf@neverwas.me>
@ 2023-07-05 14:03 ` J.P.
2023-07-08 14:19 ` J.P.
[not found] ` <87sf9y32q9.fsf@neverwas.me>
2 siblings, 0 replies; 7+ messages in thread
From: J.P. @ 2023-07-05 14:03 UTC (permalink / raw)
To: 64301; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 3506 bytes --]
v2. Add `erc-ctcp' text property to inserted CTCP ACTION messages.
Demote `erc-fill-spaced-commands' from a user option to an internal
variable. Dedent action messages with module `fill-wrap'. Combine faces
in `erc-display-message' when called with a list `type' arg. Have
`erc-put-text-property' conditionally combine prop values instead of
clobber. Apply `invisible' property to white space around stamps.
This iteration includes a number of changes, the most important being
one that looks severe but is largely mechanical. It concerns a bug
that's been around forever and, as such, is now part of the foundation.
Basically, the `type' parameter of the function `erc-display-message'
determines a special handler that applies styling to a message. When the
parameter is a list, the function calls each handler in turn, left to
right, which clobbers existing faces instead of combines them. The net
effect (in most cases) is identical to calling the function with the
last member alone. Despite this, it would seem ending up with multiple,
"layered" faces was the authors' original intent based on the ubiquity
of call sites featuring the list variant.
Authoritative intent aside, in the intervening decades, other code was
written that expects the current clobbering behavior. An example of this
exists in the default value of `erc-track-faces-priority-list', which
contains `erc-error-face' alone rather than paired with
`erc-notice-face'. There may indeed be others that will go undetected
should we make this "fix," which I'm still in favor of despite the
attendant risk. Though improved call-site readability is one upside, I'm
more interested in the UX possibilities such layering opens up. Subtle
benefits can already be seen after applying these changes, for example,
in text inserted for outgoing /me commands, which now sport a
combination of `erc-input-face' and `erc-action-face'.
In a bid to mitigate potential breakage, at least internally, I've gone
ahead and mass-replaced all instances of
(erc-display-message parsed '(notice error) ...)
with
(erc-display-message parsed 'error ...)
which amounts to 38 incisions in total. Once again, if we leave things
as is, users who've customized `erc-track-faces-priority-list' won't
ever see error-colored text in their mode line, which is a deal breaker.
The other major change involves making time stamps more sensitive to
existing invisible text by combining `stamp'-owned spec members with
existing properties and by extending those propertized areas to include
surrounding white space. Previously, the `stamp' module went to great
lengths to avoid applying stamps to invisible messages entirely.
However, this policy caused uneven output in logs with `left-handed'
stamps and in formerly hidden messages mentioning designated "fools".
It's true that what I'm proposing would mark a complete reversal, but
it's not as drastic as it sounds. To see the effect, do something like
(setq erc-insert-timestamp-function #'erc-insert-timestamp-left
erc-timestamp-only-if-changed-flag nil
erc-text-matched-hook '(erc-log-matches erc-hide-fools)
erc-fools '("somebot"))
After connecting, say something to trigger "somebot" while ensuring
`erc-toggle-timestamps' still works. Then do
M-: (remove-from-invisibility-spec 'erc-match) RET
and notice that the revealed text has timestamps in all the right
places. And if you have the `log' module enabled, notice that stamps are
likewise present on all messages.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 41806 bytes --]
From 171dbaefbdc47154b21aa7f7e8c980958f983313 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 4 Jul 2023 23:21:25 -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 | 15 +++
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 | 14 +--
lisp/erc/erc-sasl.el | 8 +-
lisp/erc/erc-stamp.el | 20 +++-
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 | 160 +++++++++++++++++++++++----
13 files changed, 347 insertions(+), 146 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 5665b760ea9..40bcd934772 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -224,6 +224,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-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-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-fill.el b/lisp/erc/erc-fill.el
index 35289910d0a..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))))))))
@@ -433,13 +431,8 @@ erc-fill-wrap
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
(progn
- (when-let ((b (next-single-property-change
- (point) 'erc-speaker nil (pos-eol)))
- ((/= (pos-eol) b))
- ;; String vals `eq' along same stretch
- (e (text-property-not-all
- b (pos-eol) 'erc-speaker
- (get-text-property b 'erc-speaker)))
+ (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)))))
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 2b7fff87ff0..549de4feeb8 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -657,22 +657,18 @@ 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)
(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)))
- ;; 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)))))
+ (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.
+ (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-networks.el b/lisp/erc/erc-networks.el
index 482d6d901ab..dd481032e7e 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -29,6 +29,8 @@
;;
;; This is the "networks" module.
;;
+;; M-x erc-server-select provides an alternative way to connect to servers by
+;; choosing networks.
;; You can use (eq (erc-network) 'Network) if you'd like to set variables or do
;; certain actions according to which network you're connected to.
;; If a network you use is not listed in `erc-networks-alist', you can put
@@ -485,8 +487,6 @@ erc-server-alist
(choice (integer :tag "Port number")
(list :tag "Port range"
integer integer)))))))
-(make-obsolete-variable 'erc-server-alist
- "specify `:server' with `erc-tls'." "30.1")
(defcustom erc-networks-alist
'((4-irc "4-irc.com")
@@ -1544,9 +1544,9 @@ erc-ports-list
result)))))
(nreverse result)))
+;;;###autoload
(defun erc-server-select ()
"Interactively select a server to connect to using `erc-server-alist'."
- (declare (obsolete erc-tls "30.1"))
(interactive)
(let* ((completion-ignore-case t)
(net (intern
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-stamp.el b/lisp/erc/erc-stamp.el
index 5035e60a87d..2f52d78d42b 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)
@@ -477,6 +486,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 +531,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/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index ef064c6a4ee..bc09c5d87fb 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -164,7 +164,6 @@ erc-track-use-faces
(defcustom erc-track-faces-priority-list
'(erc-error-face
- (erc-error-face erc-notice-face)
(erc-nick-default-face erc-current-nick-face)
erc-current-nick-face
erc-keyword-face
@@ -311,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."
@@ -738,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.
@@ -804,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))
@@ -875,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 a7d3f7d0ed5..98127697815 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1309,7 +1309,8 @@ erc-notice-face
"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)
@@ -4962,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))
@@ -4995,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)))))
@@ -5052,6 +5049,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
@@ -5069,8 +5076,9 @@ erc-format-privmessage
(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 (text-property-not-all 0 (length nick) 'font-lock-face
- nick-prefix-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
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
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 782907bfc30..edc1749cdd2 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -26,6 +26,7 @@
(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 +58,20 @@ 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)
(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 +87,155 @@ 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))))))
+;; 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)))))))
+
(eval-when-compile (require 'erc-join))
;;; 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: 15079 bytes --]
From f6698105d08b0c9186b7a95ffc00dcd8cd496506 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.
* 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.
---
lisp/erc/erc-match.el | 7 +-
lisp/erc/erc-stamp.el | 20 +++-
test/lisp/erc/erc-scenarios-match.el | 160 +++++++++++++++++++++++----
3 files changed, 157 insertions(+), 30 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 2b7fff87ff0..468358536ae 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.
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 5035e60a87d..2f52d78d42b 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)
@@ -477,6 +486,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 +531,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..edc1749cdd2 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -26,6 +26,7 @@
(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 +58,20 @@ 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)
(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 +87,155 @@ 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))))))
+;; 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)))))))
+
(eval-when-compile (require 'erc-join))
;;; 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 2ce173cb0a29b3b0eb74904749b59e68efc71b53 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 b56dd9c5b17e68b80e097cb601062264cbafb94b 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: 23290 bytes --]
From 171dbaefbdc47154b21aa7f7e8c980958f983313 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.
* 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 | 9 ++----
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, 93 insertions(+), 57 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 5665b760ea9..40bcd934772 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -224,6 +224,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 468358536ae..549de4feeb8 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -657,21 +657,18 @@ 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)
(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
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
[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.
[not found] ` <87sf9y32q9.fsf@neverwas.me>
2 siblings, 0 replies; 7+ messages in thread
From: J.P. @ 2023-07-08 14:19 UTC (permalink / raw)
To: 64301; +Cc: emacs-erc
[-- 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
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
[not found] ` <87sf9y32q9.fsf@neverwas.me>
@ 2023-07-14 2:20 ` J.P.
[not found] ` <87zg3zqlnr.fsf@neverwas.me>
1 sibling, 0 replies; 7+ messages in thread
From: J.P. @ 2023-07-14 2:20 UTC (permalink / raw)
To: 64301-done; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> v2. [...] Combine faces in `erc-display-message' when called with a
> list `type' arg.
> [...]
>
> This iteration includes a number of changes, the most important being
> one that looks severe but is largely mechanical. It concerns a bug
> that's been around forever and, as such, is now part of the foundation.
> Basically, the `type' parameter of the function `erc-display-message'
> determines a special handler that applies styling to a message. When the
> parameter is a list, the function calls each handler in turn, left to
> right, which clobbers existing faces instead of combines them. The net
> effect (in most cases) is identical to calling the function with the
> last member alone. Despite this, it would seem ending up with multiple,
> "layered" faces was the authors' original intent based on the ubiquity
> of call sites featuring the list variant.
>
> Authoritative intent aside, in the intervening decades, other code was
> written that expects the current clobbering behavior. An example of this
> exists in the default value of `erc-track-faces-priority-list', which
> contains `erc-error-face' alone rather than paired with
> `erc-notice-face'. There may indeed be others that will go undetected
> should we make this "fix," which I'm still in favor of despite the
> attendant risk.
Actually, I decided against doing this after all [1]. There was simply no
telling what kind of damage might result from these changes rippling
through two decades of third-party code.
> Though improved call-site readability is one upside, I'm more
> interested in the UX possibilities such layering opens up. Subtle
> benefits can already be seen after applying these changes, for
> example, in text inserted for outgoing /me commands, which now sport a
> combination of `erc-input-face' and `erc-action-face'.
>
> In a bid to mitigate potential breakage, at least internally, I've gone
> ahead and mass-replaced all instances of
> (erc-display-message parsed '(notice error) ...)
> with
> (erc-display-message parsed 'error ...)
> which amounts to 38 incisions in total. Once again, if we leave things
> as is, users who've customized `erc-track-faces-priority-list' won't
> ever see error-colored text in their mode line, which is a deal breaker.
Instead of all that, I've implemented an uglier and less transparent
(but also non-disruptive) way for `erc-display-message' to perform such
layering. Basically, callers can request the effect by specifying a
slight variant of its list `type' parameter, namely, one headed by the
symbol t, e.g,
(erc-display-message parsed '(t notice error) ...)
Without the t, this function acts as it always has. With it, the
function composes faces atop one another, left to right. Existing call
sites obviously won't benefit, but at least they'll be shielded from
harm. Hope that's an agreeable compromise.
Thanks and closing.
[1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=d45770e8
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
[not found] ` <87zg3zqlnr.fsf@neverwas.me>
@ 2023-07-15 14:05 ` J.P.
[not found] ` <87cz0tnubk.fsf@neverwas.me>
1 sibling, 0 replies; 7+ messages in thread
From: J.P. @ 2023-07-15 14:05 UTC (permalink / raw)
To: 64301-done; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 451 bytes --]
Some functionality I introduced for wrangling text properties in
erc-match.el was shoddily done and not very usable from the perspective
of another module building on erc-match as a foundation. The attached
patch attempts to correct that. It also ditches "erc-" namespacing for
invisibility spec members because the potential for collision seems
pretty low given that we're only talking ERC buffers. (Hopefully, I'm
not missing any downsides here.)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Don-t-bother-namespacing-ERC-s-own-invisibility-.patch --]
[-- Type: text/x-patch, Size: 16630 bytes --]
From 9fe0a765eba8105ef616280487882247834c299a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 14 Jul 2023 21:08:31 -0700
Subject: [PATCH] [5.6] Don't bother namespacing ERC's own invisibility props
* lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable):
Update name of internal flag for hiding messages.
* lisp/erc/erc-match.el (erc-match--hide-fools-offset-bounds,
erc-match--offset-invisible-bounds-p): Rename internal variable from
former to latter.
(erc-match--hide-fools-offset-bounds): Call `erc-match--hide-message'
with own `invisible' property value specifically for fools.
Specifically, use `match-fools' rather than `erc-match' or
`erc-match-fools' to save room when visually inspecting. This retains
the module name as a prefix to hopefully minimize collisions with
invisibility spec members owned by non-ERC minor modes.
(erc-match--hide-message): Define property parameter instead of
hard-coding to `erc-match'.
(erc-match--modify-invisibility-spec): Use toggle command
non-interactively for adding and removing invisibility spec member.
(erc-match-toggle-hidden-fools): Add explicit override argument and
defer to general helper for actually modifying spec.
(erc-match--toggle-hidden): New helper for toggling invisibility
spec.
* lisp/erc/erc.el (erc--merge-prop): If new value is a list, prepend
onto existing.
* test/lisp/erc/erc-scenarios-match.el:
(erc-scenarios-match--invisible-stamp): Fix comment.
(erc-scenarios-match--find-eol): Fix bug affecting interactive use.
(erc-scenarios-match--stamp-left-fools-invisible,
erc-scenarios-match--stamp-right-fools-invisible,
erc-scenarios-match--stamp-right-invisible-fill-wrap,
erc-scenarios-match--stamp-both-invisible-fill-static): Update
`invisible' property from `erc-match' to `match-fools'.
* test/lisp/erc/erc-tests.el (erc-tests--equal-including-properties):
Relocate macro in same file.
(erc--merge-prop): New test. (Bug#64301)
---
lisp/erc/erc-fill.el | 4 +--
lisp/erc/erc-match.el | 43 +++++++++++++++--------
lisp/erc/erc.el | 9 +++--
test/lisp/erc/erc-scenarios-match.el | 51 ++++++++++++++++------------
test/lisp/erc/erc-tests.el | 50 +++++++++++++++++++++++----
5 files changed, 110 insertions(+), 47 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a65c95f1d85..2dfae35b871 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -290,7 +290,7 @@ erc-fill-wrap-mode-map
(defvar erc-match-mode)
(defvar erc-button-mode)
-(defvar erc-match--hide-fools-offset-bounds)
+(defvar erc-match--offset-invisible-bounds-p)
(defun erc-fill--wrap-ensure-dependencies ()
(let (missing-deps)
@@ -340,7 +340,7 @@ fill-wrap
(erc-stamp--display-margin-mode +1))
(when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
(require 'erc-match)
- (setq erc-match--hide-fools-offset-bounds t))
+ (setq erc-match--offset-invisible-bounds-p t))
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index a5b0af41b2a..3fba35536b3 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -655,24 +655,25 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(defvar-local erc-match--hide-fools-offset-bounds nil)
+(defvar-local erc-match--offset-invisible-bounds-p nil
+ "Whether to hide a message from its preceding newline.")
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide comments from designated fools."
(when (eq match-type 'fool)
- (erc-match--hide-message)))
+ (erc-match--hide-message 'match-fools)))
-(defun erc-match--hide-message ()
+(defun erc-match--hide-message (prop)
(progn ; FIXME raise sexp
- (if erc-match--hide-fools-offset-bounds
+ (if erc-match--offset-invisible-bounds-p
(let ((beg (point-min))
(end (point-max)))
(save-restriction
(widen)
- (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match)))
+ (erc--merge-prop (1- beg) (1- end) 'invisible prop)))
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
- (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match))))
+ (erc--merge-prop (point-min) (point-max) 'invisible prop))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -682,19 +683,31 @@ erc-beep-on-match
(defun erc-match--modify-invisibility-spec ()
"Add an `erc-match' property to the local spec."
+ ;; Hopefully, this will be extended to do the same for other
+ ;; invisible properties managed by this module.
(if erc-match-mode
- (add-to-invisibility-spec 'erc-match)
+ (erc-match-toggle-hidden-fools +1)
(erc-with-all-buffers-of-server nil nil
- (remove-from-invisibility-spec 'erc-match))))
+ (erc-match-toggle-hidden-fools -1))))
-(defun erc-match-toggle-hidden-fools ()
+(defun erc-match-toggle-hidden-fools (arg)
"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)))
+Expect the function `erc-hide-fools' or similar to be present in
+`erc-text-matched-hook'."
+ (interactive "P")
+ (erc-match--toggle-hidden 'match-fools arg))
+
+(defun erc-match--toggle-hidden (prop arg)
+ "Toggle invisibility for spec member PROP.
+Treat ARG in a manner similar to mode toggles defined by
+`define-minor-mode'."
+ (when arg
+ (setq arg (prefix-numeric-value arg)))
+ (if (memq prop (ensure-list buffer-invisibility-spec))
+ (unless (natnump arg)
+ (remove-from-invisibility-spec prop))
+ (when (or (not arg) (natnump arg))
+ (add-to-invisibility-spec prop))))
(provide 'erc-match)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 03c21059a92..6ed919c91c2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3011,13 +3011,18 @@ erc--merge-prop
"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'."
+When VAL is itself a list, prepend its members onto an existing
+value. 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))
+ (setq new (if old
+ (if (listp val)
+ (append val (ensure-list 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)
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 8a718962c55..a438635960e 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -62,11 +62,15 @@ erc-scenarios-match--stamp-left-current-nick
'erc-current-nick-face))))))
;; 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.
+;; interactively, and visually inspect the output with various
+;; combinations of:
+;;
+;; M-x erc-match-toggle-hidden-fools RET
+;; M-x erc-toggle-timestamps RET
+;;
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(unless noninteractive
- (kill-new "(remove-from-invisibility-spec 'erc-match)"))
+ (kill-new "erc-match-toggle-hidden-fools"))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
@@ -128,11 +132,11 @@ erc-scenarios-match--stamp-left-fools-invisible
;; Leading stamp has combined `invisible' property value.
(should (equal (get-text-property (pos-bol) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
- ;; Message proper has the `invisible' property `erc-match'.
+ ;; Message proper has the `invisible' property `match-fools'.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
- (should (eq (get-text-property msg-beg 'invisible) 'erc-match))
+ (should (eq (get-text-property msg-beg 'invisible) 'match-fools))
(should (>= (next-single-property-change msg-beg 'invisible nil)
(pos-eol)))))
@@ -149,7 +153,10 @@ erc-scenarios-match--stamp-left-fools-invisible
(defun erc-scenarios-match--find-eol ()
(save-excursion
- (goto-char (next-single-property-change (point) 'erc-command))
+ (if-let ((next (next-single-property-change (point) 'erc-command)))
+ (goto-char next)
+ ;; We're already at the end of the message.
+ (should (get-text-property (1- (point)) 'erc-command)))
(pos-eol)))
;; In most cases, `erc-hide-fools' makes line endings invisible.
@@ -168,19 +175,19 @@ erc-scenarios-match--stamp-right-fools-invisible
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- end) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
;; The final newline is hidden by `match', not `stamps'
- (should (equal (get-text-property end 'invisible) 'erc-match))
+ (should (equal (get-text-property end 'invisible) 'match-fools))
- ;; The message proper has the `invisible' property `erc-match',
+ ;; The message proper has the `invisible' property `match-fools',
;; and it starts after the preceding newline.
- (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
;; 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)))
+ '(timestamp match-fools)))
;; Stamp's `invisible' property extends throughout the stamp
;; and ends before the trailing newline.
@@ -215,16 +222,16 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- (pos-eol)) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
- ;; The message proper has the `invisible' property `erc-match',
+ ;; The message proper has the `invisible' property `match-fools',
;; which starts at the preceding newline...
- (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
+ (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools))
;; ... 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)))
+ '(timestamp match-fools)))
;; The newline before `erc-insert-marker' is still visible.
(should-not (get-text-property (pos-eol) 'invisible))
@@ -265,8 +272,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(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))
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
(let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
(mend (next-single-property-change mbeg 'erc-command)))
@@ -283,9 +290,9 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(should (= (next-single-property-change (pos-bol) 'erc-timestamp)
mend))
- ;; Line ending has the `invisible' property `erc-match'.
+ ;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
- (should (eq (get-text-property mend'invisible) 'erc-match))))
+ (should (eq (get-text-property mend'invisible) 'match-fools))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
@@ -298,7 +305,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static
;; 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)))
+ '(timestamp match-fools)))
(should (= (next-single-property-change (point) 'invisible)
(1+ (pos-eol))))))
@@ -314,7 +321,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(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)))
+ '(timestamp match-fools)))
;; Combined `invisible' property spans entire timestamp.
(should (= (next-single-property-change msgend 'invisible)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b5db5fe8764..610fb149a94 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1272,6 +1272,50 @@ erc-process-input-line
(should-not calls))))))
+(defmacro erc-tests--equal-including-properties (a b)
+ (list (if (< emacs-major-version 29)
+ 'ert-equal-including-properties
+ 'equal-including-properties)
+ a b))
+
+(ert-deftest erc--merge-prop ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Baseline.
+ (insert "abc\n")
+ (erc--merge-prop 1 3 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 0 2 (erc-test x))))
+ (erc--merge-prop 1 3 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x)))))
+
+ ;; Multiple intervals.
+ (goto-char (point-min))
+ (insert "def\n")
+ (erc--merge-prop 1 2 'erc-test 'x)
+ (erc--merge-prop 2 3 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("def" 0 1 (erc-test x) 1 2 (erc-test y))))
+ (erc--merge-prop 1 3 'erc-test 'z)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y)))))
+
+ ;; New val as list.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (erc--merge-prop 2 3 'erc-test '(y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z)))))
+ (erc--merge-prop 1 3 'erc-test '(w x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
@@ -1488,12 +1532,6 @@ erc-message
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
-(defmacro erc-tests--equal-including-properties (a b)
- (list (if (< emacs-major-version 29)
- 'ert-equal-including-properties
- 'equal-including-properties)
- a b))
-
(ert-deftest erc-format-privmessage ()
;; Basic PRIVMSG
(should (erc-tests--equal-including-properties
--
2.41.0
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
[not found] ` <87cz0tnubk.fsf@neverwas.me>
@ 2023-07-20 13:29 ` J.P.
[not found] ` <871qh2iudy.fsf@neverwas.me>
1 sibling, 0 replies; 7+ messages in thread
From: J.P. @ 2023-07-20 13:29 UTC (permalink / raw)
To: 64301-done; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 157 bytes --]
v2 (invisibility API). Move primary message-hiding function to erc.el.
Invert meaning of invisible-bounds switch and make old non-nil behavior
new default.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 11485 bytes --]
From 8f0f4c1d424e0a70c6e46b97ca5b75699f80c892 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 20 Jul 2023 05:38:35 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (1):
[5.6] Improve ERC's internal invisibility API
etc/ERC-NEWS | 9 +++
lisp/erc/erc-fill.el | 16 +++--
lisp/erc/erc-match.el | 46 +++++++-------
lisp/erc/erc.el | 32 +++++++++-
test/lisp/erc/erc-scenarios-match.el | 95 ++++++++++++++++++++--------
test/lisp/erc/erc-tests.el | 50 +++++++++++++--
6 files changed, 183 insertions(+), 65 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4c881e32ab4..16577c73b2e 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -287,6 +287,15 @@ 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'.
+*** Hidden messages contain a preceding rather than trailing newline.
+ERC has traditionally only offered to hide messages involving fools,
+but plans are to make hiding more powerful. Anyone depending on the
+existing behavior should be aware that hidden messages now start and
+end one character earlier, so that hidden line endings precede rather
+than follow accompanying text. However, an escape hatch is available
+in the variable 'erc-legacy-invisible-bounds-p'. It reinstates the
+old behavior, which is unsupported by newer modules and features.
+
*** 'erc-display-message' optionally combines faces.
Users may notice that ERC now inserts some important error messages in
a combination of 'erc-error-face' and 'erc-notice-face'. This is
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 2dfae35b871..bb11b03e791 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -288,11 +288,17 @@ erc-fill-wrap-mode-map
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
-(defvar erc-match-mode)
(defvar erc-button-mode)
-(defvar erc-match--offset-invisible-bounds-p)
+(defvar erc-legacy-invisible-bounds-p)
(defun erc-fill--wrap-ensure-dependencies ()
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (when erc-legacy-invisible-bounds-p
+ (erc--warn-once-before-connect 'erc-fill-wrap-mode
+ "Module `fill-wrap' is incompatible with the obsolete compatibility"
+ " flag `erc-legacy-invisible-bounds-p'. Disabling locally in %s."
+ (current-buffer))
+ (setq-local erc-legacy-invisible-bounds-p nil)))
(let (missing-deps)
(unless erc-fill-mode
(push 'fill missing-deps)
@@ -336,11 +342,7 @@ fill-wrap
;; Internal integrations.
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
- (when (or erc-stamp-mode (memq 'stamp erc-modules))
- (erc-stamp--display-margin-mode +1))
- (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
- (require 'erc-match)
- (setq erc-match--offset-invisible-bounds-p t))
+ (erc-stamp--display-margin-mode +1)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 3fba35536b3..50db8a132ec 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -655,25 +655,10 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(defvar-local erc-match--offset-invisible-bounds-p nil
- "Whether to hide a message from its preceding newline.")
-
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide comments from designated fools."
(when (eq match-type 'fool)
- (erc-match--hide-message 'match-fools)))
-
-(defun erc-match--hide-message (prop)
- (progn ; FIXME raise sexp
- (if erc-match--offset-invisible-bounds-p
- (let ((beg (point-min))
- (end (point-max)))
- (save-restriction
- (widen)
- (erc--merge-prop (1- beg) (1- end) 'invisible prop)))
- ;; Before ERC 5.6, this also used to add an `intangible'
- ;; property, but the docs say it's now obsolete.
- (erc--merge-prop (point-min) (point-max) 'invisible prop))))
+ (erc--hide-message 'match-fools)))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4192ea9a9e2..972cf8d63f3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3007,6 +3007,9 @@ erc-display-line
(defvar erc--compose-text-properties nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
+;; We could maintain a cache of all combined values and dispense
+;; archetype singleton objects so all occurrences of some list (a b)
+;; across all ERC buffers are actually the same object.
(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
@@ -3028,6 +3031,26 @@ erc--merge-prop
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defvar erc-legacy-invisible-bounds-p nil
+ "Whether to hide trailing rather than preceding newlines.
+Beginning in ERC 5.6, invisibility extends from a message's
+preceding newline to its last non-newline character.")
+(make-obsolete-variable 'erc-legacy-invisible-bounds-p
+ "decremented interval now permanent" "30.1")
+
+(defun erc--hide-message (value)
+ "Apply `invisible' text-property with VALUE to current message.
+Expect to run in a narrowed buffer during message insertion."
+ (if erc-legacy-invisible-bounds-p
+ ;; Before ERC 5.6, this also used to add an `intangible'
+ ;; property, but the docs say it's now obsolete.
+ (erc--merge-prop (point-min) (point-max) 'invisible value)
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index a438635960e..cd899fddb98 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -151,6 +151,12 @@ erc-scenarios-match--stamp-left-fools-invisible
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
+(defun erc-scenarios-match--find-bol ()
+ (save-excursion
+ (should (get-text-property (1- (point)) 'erc-command))
+ (goto-char (should (previous-single-property-change (point) 'erc-command)))
+ (pos-bol)))
+
(defun erc-scenarios-match--find-eol ()
(save-excursion
(if-let ((next (next-single-property-change (point) 'erc-command)))
@@ -160,13 +166,14 @@ erc-scenarios-match--find-eol
(pos-eol)))
;; In most cases, `erc-hide-fools' makes line endings invisible.
-(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+(defun 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)))
+ (let ((beg (erc-scenarios-match--find-bol))
+ (end (erc-scenarios-match--find-eol)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
@@ -178,7 +185,11 @@ erc-scenarios-match--stamp-right-fools-invisible
'(timestamp match-fools)))
;; The final newline is hidden by `match', not `stamps'
- (should (equal (get-text-property end 'invisible) 'match-fools))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property end 'invisible) 'match-fools))
+ (should (eq (get-text-property beg 'invisible) 'match-fools))
+ (should-not (get-text-property end 'invisible))))
;; The message proper has the `invisible' property `match-fools',
;; and it starts after the preceding newline.
@@ -204,6 +215,17 @@ erc-scenarios-match--stamp-right-fools-invisible
(should (eq (get-text-property inv-beg 'invisible)
'timestamp))))))))
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+ :tags '(:expensive-test)
+ (erc-scenarios-match--stamp-right-fools-invisible))
+
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset ()
+ :tags '(:expensive-test)
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (should-not erc-legacy-invisible-bounds-p)
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc-scenarios-match--stamp-right-fools-invisible))))
+
;; 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 ()
@@ -249,8 +271,7 @@ 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)))))))
-(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
- :tags '(:expensive-test)
+(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -292,7 +313,11 @@ erc-scenarios-match--stamp-both-invisible-fill-static
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
- (should (eq (get-text-property mend'invisible) 'match-fools))))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property mend 'invisible) 'match-fools))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
@@ -338,4 +363,15 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
+ :tags '(:expensive-test)
+ (erc-scenarios-match--stamp-both-invisible-fill-static))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
+ :tags '(:expensive-test)
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (should-not erc-legacy-invisible-bounds-p)
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc-scenarios-match--stamp-both-invisible-fill-static))))
+
;;; erc-scenarios-match.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Improve-ERC-s-internal-invisibility-API.patch --]
[-- Type: text/x-patch, Size: 24866 bytes --]
From 8f0f4c1d424e0a70c6e46b97ca5b75699f80c892 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 14 Jul 2023 21:08:31 -0700
Subject: [PATCH 1/1] [5.6] Improve ERC's internal invisibility API
* etc/ERC-NEWS: Mention that line endings have moved from the end to
the beginning of hidden messages.
* lisp/erc/erc-fill.el (erc-fill--wrap-ensure-dependencies): Warn when
users have `erc-legacy-invisible-bounds-p' enabled, and force it to
its default value of nil in the current buffer.
(erc-fill-wrap-mode, erc-fill-wrap-enable): Move business involving
compat variable for enabling legacy hidden-message behavior to helper.
* lisp/erc/erc-match.el (erc-match--hide-fools-offset-bounds): Move
internal variable from to main library file and rename to
`erc-legacy-invisible-bounds-p'. Also make obsolete and flip
semantics so non-nil enables the traditional behavior.
(erc-match--hide-message): Move to main library file and rename to
`erc--hide-message'. Add a property-value parameter instead of
hard-coding to `erc-match'. Also, condition behavior on inverted and
renamed compatibility flag `erc-legacy-invisible-bounds-p'.
(erc-hide-fools): Call `erc--hide-message' with own value for
`invisible' property specifically for fools. That is, use
`match-fools' rather than `erc-match' or `erc-match-fools' to save
room when visually inspecting. This retains the module name as a
prefix to hopefully minimize collisions with invisibility spec members
owned by non-ERC minor modes. The `timestamp' spec member owned by
erc-stamp likewise lacks a namespace prefix, but its feature/group
is already inherent.
(erc-match--modify-invisibility-spec): Use toggle command
non-interactively for adding and removing invisibility spec member.
(erc-match-toggle-hidden-fools): Add explicit override argument and
defer to general helper for actually modifying spec.
(erc-match--toggle-hidden): New helper for toggling invisibility
spec.
* lisp/erc/erc.el (erc--merge-prop): If new value is a list, prepend
onto existing. Add note about possible space optimization.
(erc-legacy-invisible-bounds-p): New obsolete compat variable to
enable traditional pre-5.6 invisibility interval on hidden messages.
Replaces `erc-match--hide-fools-offset-bounds-p' but has an inverted
meaning. The new default value of nil means invisibility covers a
shifted interval consisting of the message body plus the line ending
immediately preceding it.
(erc--hide-message): New function, formerly `erc-match--hide-message'
from erc-match.el introduced in ERC 5.6.
* test/lisp/erc/erc-scenarios-match.el:
(erc-scenarios-match--invisible-stamp): Fix comment and use API
function in interactive convenience setup.
(erc-scenarios-match--find-bol): New test helper.
(erc-scenarios-match--find-eol): Fix bug affecting interactive use.
(erc-scenarios-match--stamp-left-fools-invisible,
erc-scenarios-match--stamp-right-fools-invisible,
erc-scenarios-match--stamp-right-invisible-fill-wrap,
erc-scenarios-match--stamp-both-invisible-fill-static): Update
`invisible' property from `erc-match' to `match-fools'.
(erc-scenarios-match--stamp-right-fools-invisible,
erc-scenarios-match--stamp-both-invisible-fill-static): Move test
body to function of same name for use in multiple cases.
(erc-scenarios-match--stamp-right-fools-invisible--nooffset,
erc-scenarios-match--stamp-both-invisible-fill-static--nooffset): New
test variants asserting proper hiding with old pre-5.6 invisibility
interval.
* test/lisp/erc/erc-tests.el (erc-tests--equal-including-properties):
Relocate macro in same file.
(erc--merge-prop): New test. (Bug#64301)
---
etc/ERC-NEWS | 9 +++
lisp/erc/erc-fill.el | 16 +++--
lisp/erc/erc-match.el | 46 +++++++-------
lisp/erc/erc.el | 32 +++++++++-
test/lisp/erc/erc-scenarios-match.el | 95 ++++++++++++++++++++--------
test/lisp/erc/erc-tests.el | 50 +++++++++++++--
6 files changed, 183 insertions(+), 65 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 4c881e32ab4..16577c73b2e 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -287,6 +287,15 @@ 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'.
+*** Hidden messages contain a preceding rather than trailing newline.
+ERC has traditionally only offered to hide messages involving fools,
+but plans are to make hiding more powerful. Anyone depending on the
+existing behavior should be aware that hidden messages now start and
+end one character earlier, so that hidden line endings precede rather
+than follow accompanying text. However, an escape hatch is available
+in the variable 'erc-legacy-invisible-bounds-p'. It reinstates the
+old behavior, which is unsupported by newer modules and features.
+
*** 'erc-display-message' optionally combines faces.
Users may notice that ERC now inserts some important error messages in
a combination of 'erc-error-face' and 'erc-notice-face'. This is
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a65c95f1d85..bb11b03e791 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -288,11 +288,17 @@ erc-fill-wrap-mode-map
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
-(defvar erc-match-mode)
(defvar erc-button-mode)
-(defvar erc-match--hide-fools-offset-bounds)
+(defvar erc-legacy-invisible-bounds-p)
(defun erc-fill--wrap-ensure-dependencies ()
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (when erc-legacy-invisible-bounds-p
+ (erc--warn-once-before-connect 'erc-fill-wrap-mode
+ "Module `fill-wrap' is incompatible with the obsolete compatibility"
+ " flag `erc-legacy-invisible-bounds-p'. Disabling locally in %s."
+ (current-buffer))
+ (setq-local erc-legacy-invisible-bounds-p nil)))
(let (missing-deps)
(unless erc-fill-mode
(push 'fill missing-deps)
@@ -336,11 +342,7 @@ fill-wrap
;; Internal integrations.
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
- (when (or erc-stamp-mode (memq 'stamp erc-modules))
- (erc-stamp--display-margin-mode +1))
- (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
- (require 'erc-match)
- (setq erc-match--hide-fools-offset-bounds t))
+ (erc-stamp--display-margin-mode +1)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index a5b0af41b2a..50db8a132ec 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -655,24 +655,10 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(defvar-local erc-match--hide-fools-offset-bounds nil)
-
(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)))
- (save-restriction
- (widen)
- (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.
- (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match))))
+ (erc--hide-message 'match-fools)))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -682,19 +668,31 @@ erc-beep-on-match
(defun erc-match--modify-invisibility-spec ()
"Add an `erc-match' property to the local spec."
+ ;; Hopefully, this will be extended to do the same for other
+ ;; invisible properties managed by this module.
(if erc-match-mode
- (add-to-invisibility-spec 'erc-match)
+ (erc-match-toggle-hidden-fools +1)
(erc-with-all-buffers-of-server nil nil
- (remove-from-invisibility-spec 'erc-match))))
+ (erc-match-toggle-hidden-fools -1))))
-(defun erc-match-toggle-hidden-fools ()
+(defun erc-match-toggle-hidden-fools (arg)
"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)))
+Expect the function `erc-hide-fools' or similar to be present in
+`erc-text-matched-hook'."
+ (interactive "P")
+ (erc-match--toggle-hidden 'match-fools arg))
+
+(defun erc-match--toggle-hidden (prop arg)
+ "Toggle invisibility for spec member PROP.
+Treat ARG in a manner similar to mode toggles defined by
+`define-minor-mode'."
+ (when arg
+ (setq arg (prefix-numeric-value arg)))
+ (if (memq prop (ensure-list buffer-invisibility-spec))
+ (unless (natnump arg)
+ (remove-from-invisibility-spec prop))
+ (when (or (not arg) (natnump arg))
+ (add-to-invisibility-spec prop))))
(provide 'erc-match)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index eca6a90d706..972cf8d63f3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3007,22 +3007,50 @@ erc-display-line
(defvar erc--compose-text-properties nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
+;; We could maintain a cache of all combined values and dispense
+;; archetype singleton objects so all occurrences of some list (a b)
+;; across all ERC buffers are actually the same object.
(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'."
+When VAL is itself a list, prepend its members onto an existing
+value. 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))
+ (setq new (if old
+ (if (listp val)
+ (append val (ensure-list 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)))))
+(defvar erc-legacy-invisible-bounds-p nil
+ "Whether to hide trailing rather than preceding newlines.
+Beginning in ERC 5.6, invisibility extends from a message's
+preceding newline to its last non-newline character.")
+(make-obsolete-variable 'erc-legacy-invisible-bounds-p
+ "decremented interval now permanent" "30.1")
+
+(defun erc--hide-message (value)
+ "Apply `invisible' text-property with VALUE to current message.
+Expect to run in a narrowed buffer during message insertion."
+ (if erc-legacy-invisible-bounds-p
+ ;; Before ERC 5.6, this also used to add an `intangible'
+ ;; property, but the docs say it's now obsolete.
+ (erc--merge-prop (point-min) (point-max) 'invisible value)
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el
index 8a718962c55..cd899fddb98 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -62,11 +62,15 @@ erc-scenarios-match--stamp-left-current-nick
'erc-current-nick-face))))))
;; 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.
+;; interactively, and visually inspect the output with various
+;; combinations of:
+;;
+;; M-x erc-match-toggle-hidden-fools RET
+;; M-x erc-toggle-timestamps RET
+;;
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(unless noninteractive
- (kill-new "(remove-from-invisibility-spec 'erc-match)"))
+ (kill-new "erc-match-toggle-hidden-fools"))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
@@ -128,11 +132,11 @@ erc-scenarios-match--stamp-left-fools-invisible
;; Leading stamp has combined `invisible' property value.
(should (equal (get-text-property (pos-bol) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
- ;; Message proper has the `invisible' property `erc-match'.
+ ;; Message proper has the `invisible' property `match-fools'.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
- (should (eq (get-text-property msg-beg 'invisible) 'erc-match))
+ (should (eq (get-text-property msg-beg 'invisible) 'match-fools))
(should (>= (next-single-property-change msg-beg 'invisible nil)
(pos-eol)))))
@@ -147,19 +151,29 @@ erc-scenarios-match--stamp-left-fools-invisible
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
+(defun erc-scenarios-match--find-bol ()
+ (save-excursion
+ (should (get-text-property (1- (point)) 'erc-command))
+ (goto-char (should (previous-single-property-change (point) 'erc-command)))
+ (pos-bol)))
+
(defun erc-scenarios-match--find-eol ()
(save-excursion
- (goto-char (next-single-property-change (point) 'erc-command))
+ (if-let ((next (next-single-property-change (point) 'erc-command)))
+ (goto-char next)
+ ;; We're already at the end of the message.
+ (should (get-text-property (1- (point)) 'erc-command)))
(pos-eol)))
;; In most cases, `erc-hide-fools' makes line endings invisible.
-(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+(defun 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)))
+ (let ((beg (erc-scenarios-match--find-bol))
+ (end (erc-scenarios-match--find-eol)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
@@ -168,19 +182,23 @@ erc-scenarios-match--stamp-right-fools-invisible
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- end) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
;; The final newline is hidden by `match', not `stamps'
- (should (equal (get-text-property end 'invisible) 'erc-match))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property end 'invisible) 'match-fools))
+ (should (eq (get-text-property beg 'invisible) 'match-fools))
+ (should-not (get-text-property end 'invisible))))
- ;; The message proper has the `invisible' property `erc-match',
+ ;; The message proper has the `invisible' property `match-fools',
;; and it starts after the preceding newline.
- (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
;; 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)))
+ '(timestamp match-fools)))
;; Stamp's `invisible' property extends throughout the stamp
;; and ends before the trailing newline.
@@ -197,6 +215,17 @@ erc-scenarios-match--stamp-right-fools-invisible
(should (eq (get-text-property inv-beg 'invisible)
'timestamp))))))))
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+ :tags '(:expensive-test)
+ (erc-scenarios-match--stamp-right-fools-invisible))
+
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset ()
+ :tags '(:expensive-test)
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (should-not erc-legacy-invisible-bounds-p)
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc-scenarios-match--stamp-right-fools-invisible))))
+
;; 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 ()
@@ -215,16 +244,16 @@ erc-scenarios-match--stamp-right-invisible-fill-wrap
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- (pos-eol)) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
- ;; The message proper has the `invisible' property `erc-match',
+ ;; The message proper has the `invisible' property `match-fools',
;; which starts at the preceding newline...
- (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
+ (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools))
;; ... 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)))
+ '(timestamp match-fools)))
;; The newline before `erc-insert-marker' is still visible.
(should-not (get-text-property (pos-eol) 'invisible))
@@ -242,8 +271,7 @@ 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)))))))
-(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
- :tags '(:expensive-test)
+(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -265,8 +293,8 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(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))
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
(let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
(mend (next-single-property-change mbeg 'erc-command)))
@@ -283,9 +311,13 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(should (= (next-single-property-change (pos-bol) 'erc-timestamp)
mend))
- ;; Line ending has the `invisible' property `erc-match'.
+ ;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
- (should (eq (get-text-property mend'invisible) 'erc-match))))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property mend 'invisible) 'match-fools))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
@@ -298,7 +330,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static
;; 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)))
+ '(timestamp match-fools)))
(should (= (next-single-property-change (point) 'invisible)
(1+ (pos-eol))))))
@@ -314,7 +346,7 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(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)))
+ '(timestamp match-fools)))
;; Combined `invisible' property spans entire timestamp.
(should (= (next-single-property-change msgend 'invisible)
@@ -331,4 +363,15 @@ erc-scenarios-match--stamp-both-invisible-fill-static
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
+ :tags '(:expensive-test)
+ (erc-scenarios-match--stamp-both-invisible-fill-static))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
+ :tags '(:expensive-test)
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (should-not erc-legacy-invisible-bounds-p)
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc-scenarios-match--stamp-both-invisible-fill-static))))
+
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b5db5fe8764..610fb149a94 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1272,6 +1272,50 @@ erc-process-input-line
(should-not calls))))))
+(defmacro erc-tests--equal-including-properties (a b)
+ (list (if (< emacs-major-version 29)
+ 'ert-equal-including-properties
+ 'equal-including-properties)
+ a b))
+
+(ert-deftest erc--merge-prop ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Baseline.
+ (insert "abc\n")
+ (erc--merge-prop 1 3 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 0 2 (erc-test x))))
+ (erc--merge-prop 1 3 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x)))))
+
+ ;; Multiple intervals.
+ (goto-char (point-min))
+ (insert "def\n")
+ (erc--merge-prop 1 2 'erc-test 'x)
+ (erc--merge-prop 2 3 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("def" 0 1 (erc-test x) 1 2 (erc-test y))))
+ (erc--merge-prop 1 3 'erc-test 'z)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y)))))
+
+ ;; New val as list.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (erc--merge-prop 2 3 'erc-test '(y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z)))))
+ (erc--merge-prop 1 3 'erc-test '(w x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
@@ -1488,12 +1532,6 @@ erc-message
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
-(defmacro erc-tests--equal-including-properties (a b)
- (list (if (< emacs-major-version 29)
- 'ert-equal-including-properties
- 'equal-including-properties)
- a b))
-
(ert-deftest erc-format-privmessage ()
;; Basic PRIVMSG
(should (erc-tests--equal-including-properties
--
2.41.0
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#64301: 30.0.50; ERC 5.6: Make speaker labels easier to work with
[not found] ` <871qh2iudy.fsf@neverwas.me>
@ 2023-07-23 14:00 ` J.P.
0 siblings, 0 replies; 7+ messages in thread
From: J.P. @ 2023-07-23 14:00 UTC (permalink / raw)
To: 64301; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> v2 (invisibility API). Move primary message-hiding function to erc.el.
> Invert meaning of invisible-bounds switch and make old non-nil behavior
> new default.
This was added as af547c4bbe8 "Improve ERC's internal invisibility API".
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2023-07-23 14:00 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
[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.
[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.
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).