Subject: 30.0.50; ERC 5.6: Make speaker labels easier to work with
From: "J.P." <[email-masked]>
To: [email-masked]
Date: Mon, 26 Jun 2023 06:50:17 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

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

From 41e15143e16a842fc4ae072d28a647f25c58fdb8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email-masked]>
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