* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
@ 2023-01-18 14:38 J.P.
2023-02-19 15:04 ` J.P.
` (6 more replies)
0 siblings, 7 replies; 9+ messages in thread
From: J.P. @ 2023-01-18 14:38 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5445 bytes --]
Tags: patch
ERC could really benefit from a more efficient, convenient, and flexible
means of modifying how words (mainly nicks) are buttonized in messages.
The approach being proposed here involves replacing the preferred type
of the third, "form" field in `erc-button-alist' entries. It's currently
an arbitrary "guard"-like sexp, which I'd like to deprecate in favor of
a function capable of rewriting the button itself. The deprecated form
would still be usable but would trigger a warning, going forward. A
special accommodation would be made for the constant t as well as for
special variables, whose values would be treated as booleans. This would
cover all existing default entries as currently used in client code.
The idea is for this new "rewriter" function to expect the bounds of the
button under consideration as input and to return something similar, or
nil, to indicate that the candidate ought to be skipped (as in not
buttonized). A separate variant with a different signature will be
required for nicknames since they're already treated specially. It'll be
passed additional arguments, such as `erc-server-user' and
`erc-channel-user' objects and a casemapped nickname, all of which are
already present in the caller's environment. Additionally, the values of
user options containing faces to be applied, such as
`erc-button-nickname-face' and `erc-button-face' will be free for the
changing, with all damage limited to the current button alone.
As an example of a possible application for this, I have included a
helper for displaying messages involving `substitute-command-keys'.
Other applications include button colorization and alternate display
text. Practical implementations of both are available on request.
The second patch contains the actual changes proposed above. The first
is only somewhat related but trivial enough to smuggle in with this set
(IMO). The last one I threw in on a whim. It adds additional flexibility
for third parties but will most likely be dropped or held back because
there's no immediate use for it in ERC's client code.
Thanks.
In GNU Emacs 30.0.50 (build 2, x86_64-pc-linux-gnu, GTK+ Version
3.24.35, cairo version 1.17.6) of 2023-01-17 built on localhost
Repository revision: 281f48f19ecad706a639d57cb937afb0b97eded7
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 36 (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 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 iso8601 time-date
auth-source cl-seq eieio eieio-core cl-macs password-cache json subr-x
map thingatpt pp format-spec cl-loaddefs cl-lib erc-backend erc-goodies
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 64390 6319)
(symbols 48 8639 0)
(strings 32 23673 1623)
(string-bytes 1 685926)
(vectors 16 15259)
(vector-slots 8 209777 7692)
(floats 8 24 35)
(intervals 56 232 0)
(buffers 976 10))
[-- Attachment #2: 0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch --]
[-- Type: text/x-patch, Size: 2246 bytes --]
From 479dc9b345c0e5798505f6699df4f707f8e5ea39 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 1/3] [5.6] Replace Info-goto-node with info in
erc-button-alist
* lisp/erc/erc-button.el (erc-button-alist): Replace `Info-goto-node'
with plain `info', which is autoloaded.
* lisp/erc/erc-networks.el (erc-networks--set-name,
erc-networks--warn-on-connect): Don't require `info'.
---
lisp/erc/erc-button.el | 2 +-
lisp/erc/erc-networks.el | 2 --
2 files changed, 1 insertion(+), 3 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 1be47c3e66..979d6e7e94 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -133,7 +133,7 @@ erc-button-alist
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
1 t erc-button-describe-symbol 1)
;; pseudo links
- ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
+ ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t info 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
0 t (lambda (page)
(browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 95fd8990c9..4337d633cf 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1292,7 +1292,6 @@ erc-networks--set-name
erc-server-announced-name "\" in `erc-networks-alist'"
" or consider calling `erc-tls' with the keyword `:id'."
" See Info:\"(erc) Network Identifier\" for more.")))
- (require 'info)
(erc-display-error-notice parsed m)
(if erc-networks--allow-unknown-network
(progn
@@ -1514,7 +1513,6 @@ erc-networks--warn-on-connect
"Emit warning when the `networks' module hasn't been loaded.
Ideally, do so upon opening the network process."
(unless (or erc--target erc-networks-mode)
- (require 'info nil t)
(let ((m (concat "Required module `networks' not loaded. If this "
" was unexpected, please add it to `erc-modules'.")))
;; Assume the server buffer has been marked as active.
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch --]
[-- Type: text/x-patch, Size: 13170 bytes --]
From 5d97ec5342327e03f042cd88ec24609a73bcdd42 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 2/3] [5.6] Add erc-button helper for substituting command keys
TODO: add ERC-NEWS entry for `erc-button-alist' field-type deprecation
once ERC 5.5 is released and a new section for 5.6 is added.
* lisp/erc/erc-button.el (erc-button-buttonize-nicks): Change type to
include functions.
(erc-button-alist): Deprecate arbitrary sexp form for third item of
entries and offer more useful bounds-modifying function in its place.
(erc-button--maybe-warn-arbitrary-sexp): Add helper for validating
third `erc-button-alist' field.
(erc-button-add-nickname-buttons): Accommodate function variant for
"form" field of `erc-button-alist' entries. Minor optimizations.
(erc-button-add-buttons-1): Show warning when arbitrary sexp for third
"form" field encountered. Accommodate binary function instead.
(erc-button--substitute-command-keys-in-region): Add new function to
serve as default key-substitution function item in `erc-button-alist'.
(erc-button--display-error-notice-with-keys): Add new helper function
for displaying ad hoc warnings that possibly require key substitution.
* lisp/erc/erc-networks.el (erc-networks--ensure-announced,
erc-networks--on-MOTD-end): Use new key-substitutions helper from
erc-button.
* test/lisp/erc/erc-tests.el
(erc-button--display-error-notice-with-keys): New test.
---
lisp/erc/erc-button.el | 94 +++++++++++++++++++++++++++++++++-----
lisp/erc/erc-networks.el | 20 ++++----
test/lisp/erc/erc-tests.el | 55 ++++++++++++++++++++++
3 files changed, 148 insertions(+), 21 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 979d6e7e94..c2fde7c268 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -102,8 +102,15 @@ erc-button-wrap-long-urls
:type '(choice integer boolean))
(defcustom erc-button-buttonize-nicks t
- "Flag indicating whether nicks should be buttonized or not."
- :type 'boolean)
+ "Flag indicating whether nicks should be buttonized or not.
+When the value is a function, it must accept four arguments: the
+bounds of the nick in the current message (as a cons), the nick
+itself (case-mapped and without text properties), the nick's
+`erc-server-users' entry, and a (possibly nil) `erc-channel-user'
+object. It must return replacement bounds when buttonizing
+should proceed and nil otherwise."
+ :package-version '(ERC . "5.6")
+ :type '(choice boolean function))
(defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s"
"URL used to browse RFC references.
@@ -165,8 +172,16 @@ erc-button-alist
BUTTON is the number of the regexp grouping actually matching the
button. This is ignored if REGEXP is `nicknames'.
-FORM is a Lisp expression which must eval to true for the button to
- be added.
+FORM is a Lisp symbol for a special variable whose value must be
+ true for the button to be added. Alternatively, it can be a
+ function whose arguments are BEG and END, the bounds of the
+ button in the current buffer. It's expected to return a cons
+ of (possibly identical) bounds or nil, to deny. For the extent
+ of the call, all face options defined for the button module are
+ re-bound, shadowing themselves, so the function is free to
+ change their values. Important: different arguments are passed
+ when REGEXP is `nickname'; see `erc-button-buttonize-nicks' for
+ details.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -176,7 +191,7 @@ erc-button-alist
CALLBACK. There can be several PAR arguments. If REGEXP is
`nicknames', these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :version "29.1"
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
@@ -275,22 +290,47 @@ erc-button-add-buttons
(concat "\\<" (regexp-quote (car elem)) "\\>")
entry)))))))))))
+(defun erc-button--maybe-warn-arbitrary-sexp (form)
+ (if (and (symbolp form) (special-variable-p form))
+ (symbol-value form)
+ (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
+ (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
+ (lwarn 'erc :warning
+ (concat "Arbitrary sexps for the third FORM"
+ " slot of `erc-button-alist' entries"
+ " have been deprecated.")))
+ (eval form t)))
+
(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))
bounds word)
- (when (or (eq t form)
- (eval form t))
+ (when (eq 'erc-button-buttonize-nicks form)
+ (setq form (symbol-value form)))
+ (when (or (functionp form)
+ (eq t form)
+ (and form (erc-button--maybe-warn-arbitrary-sexp 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)))
- (when (or (and (erc-server-buffer-p) (erc-get-server-user word))
- (and erc-channel-users (erc-get-channel-user word)))
- (erc-button-add-button (car bounds) (cdr bounds)
- fun t (list word))))))))
+ (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)))))
+ (when (and user
+ (or (not (functionp form))
+ (setq bounds
+ (funcall form bounds down user (cdr cuser)))))
+ (erc-button-add-button (car bounds) (cdr bounds)
+ fun t (list word)))))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
@@ -302,7 +342,14 @@ erc-button-add-buttons-1
(fun (nth 3 entry))
(data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
- (eval form t))
+ (and (functionp form)
+ (let* ((erc-button-face erc-button-face)
+ (erc-button-mouse-face erc-button-mouse-face)
+ (erc-button-nickname-face erc-button-nickname-face)
+ (rv (funcall form start end)))
+ (when rv
+ (setq end (cdr rv) start (car rv)))))
+ (erc-button--maybe-warn-arbitrary-sexp form))
(erc-button-add-button start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
@@ -511,6 +558,29 @@ erc-button-beats-to-time
(message "@%s is %d:%02d local time"
beats hours minutes)))
+(defun erc-button--substitute-command-keys-in-region (beg end)
+ "Replace command in region with keys and return new bounds"
+ (let* ((o (buffer-substring beg end))
+ (s (substitute-command-keys o)))
+ (unless (equal o s)
+ (setq erc-button-face nil))
+ (delete-region beg end)
+ (insert s))
+ (cons beg (point)))
+
+(defun erc-button--display-error-notice-with-keys (parsed &rest strings)
+ "Add help keys to STRING for corner-case admonishments."
+ (when (stringp parsed)
+ (push parsed strings)
+ (setq parsed nil))
+ (let ((string (apply #'concat strings))
+ (erc-button-alist
+ `((,(rx "\\[" (group (+ (not "]"))) "]") 0
+ erc-button--substitute-command-keys-in-region
+ erc-button-describe-symbol 1)
+ ,@erc-button-alist)))
+ (erc-display-error-notice parsed string)))
+
(provide 'erc-button)
;;; erc-button.el ends here
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 4337d633cf..dd481032e7 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -67,6 +67,9 @@ erc-session-server
(declare-function erc-server-process-alive "erc-backend" (&optional buffer))
(declare-function erc-set-active-buffer "erc" (buffer))
+(declare-function erc-button--display-error-notice-with-keys
+ (parsed &rest strings))
+
;; Variables
(defgroup erc-networks nil
@@ -1310,12 +1313,11 @@ erc-networks--ensure-announced
Copy source (prefix) from MOTD-ish message as a last resort."
;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
(unless erc-server-announced-name
- (setq erc-server-announced-name (erc-response.sender parsed))
- (erc-display-error-notice
- parsed (concat "Failed to determine server name. Using \""
- erc-server-announced-name "\" instead."
- " If this was unexpected, consider reporting it via "
- (substitute-command-keys "\\[erc-bug]") ".")))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Failed to determine server name. Using \""
+ (setq erc-server-announced-name (erc-response.sender parsed)) "\" instead"
+ ". If this was unexpected, consider reporting it via \\[erc-bug]" "."))
nil)
(defun erc-unset-network-name (_nick _ip _reason)
@@ -1493,9 +1495,9 @@ erc-networks-on-MOTD-end
(memq (erc--target-symbol erc--target)
erc-networks--bouncer-targets)))
proc)
- (let ((m (concat "Unexpected state detected. Please report via "
- (substitute-command-keys "\\[erc-bug]") ".")))
- (erc-display-error-notice parsed m))))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Unexpected state detected. Please report via \\[erc-bug].")))
;; For now, retain compatibility with erc-server-NNN-functions.
(or (erc-networks--ensure-announced proc parsed)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 85506c3d27..cbe9d04d05 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1359,4 +1359,59 @@ define-erc-module--local
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
+
+;; XXX move erc-button tests to new file if more added.
+(require 'erc-button)
+
+;; See also `erc-scenarios-networks-announced-missing' in
+;; erc-scenarios-misc.el for a more realistic example.
+(ert-deftest erc-button--display-error-notice-with-keys ()
+ (with-current-buffer (get-buffer-create "*fake*")
+ (let ((mode erc-button-mode)
+ (inhibit-message noninteractive)
+ erc-modules
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (erc-mode)
+ (erc-button-mode +1)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (erc-tests--send-prep)
+ (erc-button--display-error-notice-with-keys
+ "If \\[erc-bol] fails, "
+ "see \\[erc-bug] or `erc-mode-map'.")
+ (goto-char (point-min))
+
+ (ert-info ("Keymap substitution succeeds")
+ (erc-button-next)
+ (should (looking-at "C-a"))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (erc-button-press-button)
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bol" nil t)))
+ (erc-button-next)
+ (erc-button-previous) ; end of interval correct
+ (should (looking-at "a fails")))
+
+ (ert-info ("Extended command mapping succeeds")
+ (erc-button-next)
+ (should (looking-at "M-x erc-bug"))
+ (erc-button-press-button)
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bug" nil t))))
+
+ (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
+ (erc-button-next)
+ (should (equal (get-text-property (point) 'font-lock-face)
+ '(erc-button erc-error-face)))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (should (eq erc-button-face 'erc-button))) ; extent evaporates
+
+ (when noninteractive
+ (unless mode
+ (erc-button-mode -1))
+ (kill-buffer "*Help*")
+ (kill-buffer)))))
+
;;; erc-tests.el ends here
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch --]
[-- Type: text/x-patch, Size: 3432 bytes --]
From 6df0ae6ab237b72406b5f60ef37679087050916b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 05:13:06 -0800
Subject: [PATCH 3/3] [5.6] Allow erc-button-add-face to take an object
* lisp/erc/erc-button.el
(erc-button--add-nickname-face-function): New internal var.
(erc-button-add-button): Call `erc-button--add-nickname-face-function'
when it's a function for applying `erc-button-nickname-face'.
(erc-button-add-face): Add optional `object' param.
---
lisp/erc/erc-button.el | 19 ++++++++++++-------
1 file changed, 12 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c2fde7c268..478bbb52da 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -364,6 +364,8 @@ erc-button-remove-old-buttons
mouse-face nil
keymap nil)))
+(defvar erc-button--add-nickname-face-function nil)
+
(defun erc-button-add-button (from to fun nick-p &optional data regexp)
"Create a button between FROM and TO with callback FUN and data DATA.
NICK-P specifies if this is a nickname button.
@@ -390,7 +392,10 @@ erc-button-add-button
(move-marker pos (point))))))
(if nick-p
(when erc-button-nickname-face
- (erc-button-add-face from to erc-button-nickname-face))
+ (if erc-button--add-nickname-face-function
+ (funcall erc-button--add-nickname-face-function
+ from to erc-button-nickname-face)
+ (erc-button-add-face from to erc-button-nickname-face)))
(when erc-button-face
(erc-button-add-face from to erc-button-face)))
(add-text-properties
@@ -402,16 +407,16 @@ erc-button-add-button
(list 'rear-nonsticky t)
(and data (list 'erc-data data)))))
-(defun erc-button-add-face (from to face)
+(defun erc-button-add-face (from to face &optional object)
"Add FACE to the region between FROM and TO."
;; If we just use `add-text-property', then this will overwrite any
;; face text property already used for the button. It will not be
;; merged correctly. If we use overlays, then redisplay will be
;; very slow with lots of buttons. This is why we manually merge
;; face text properties.
- (let ((old (erc-list (get-text-property from 'font-lock-face)))
+ (let ((old (erc-list (get-text-property from 'font-lock-face object)))
(pos from)
- (end (next-single-property-change from 'font-lock-face nil to))
+ (end (next-single-property-change from 'font-lock-face object to))
new)
;; old is the face at pos, in list form. It is nil if there is no
;; face at pos. If nil, the new face is FACE. If not nil, the
@@ -419,10 +424,10 @@ erc-button-add-face
;; where this face changes.
(while (< pos to)
(setq new (if old (cons face old) face))
- (put-text-property pos end 'font-lock-face new)
+ (put-text-property pos end 'font-lock-face new object)
(setq pos end
- old (erc-list (get-text-property pos 'font-lock-face))
- end (next-single-property-change pos 'font-lock-face nil to)))))
+ old (erc-list (get-text-property pos 'font-lock-face object))
+ end (next-single-property-change pos 'font-lock-face object to)))))
;; widget-button-click calls with two args, we ignore the first.
;; Since Emacs runs this directly, rather than with
--
2.38.1
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
@ 2023-02-19 15:04 ` J.P.
2023-03-09 14:42 ` J.P.
` (5 subsequent siblings)
6 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-02-19 15:04 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 110 bytes --]
v2. Use dedicated internal function as module interface for modifying
nick buttonizing (via :around advice).
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 8737 bytes --]
From 49c703272cb3d0f4ec035175e94c132fa32eaeba Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Feb 2023 22:40:55 -0800
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Replace Info-goto-node with info in erc-button-alist
[5.6] Add erc-button helper for substituting command keys
[5.6] Allow erc-button-add-face to take an object
lisp/erc/erc-button.el | 158 ++++++++++++++++++++++++++++++++-----
lisp/erc/erc-networks.el | 22 +++---
test/lisp/erc/erc-tests.el | 56 +++++++++++++
3 files changed, 206 insertions(+), 30 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 478bbb52daa..49e3caf49a1 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,7 +52,8 @@ erc-button
;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
- ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+ ((erc-button--check-nicknames-entry)
+ (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-complete-functions #'erc-button-next-function)
(add-hook 'erc-mode-hook #'erc-button-setup))
@@ -102,15 +103,8 @@ erc-button-wrap-long-urls
:type '(choice integer boolean))
(defcustom erc-button-buttonize-nicks t
- "Flag indicating whether nicks should be buttonized or not.
-When the value is a function, it must accept four arguments: the
-bounds of the nick in the current message (as a cons), the nick
-itself (case-mapped and without text properties), the nick's
-`erc-server-users' entry, and a (possibly nil) `erc-channel-user'
-object. It must return replacement bounds when buttonizing
-should proceed and nil otherwise."
- :package-version '(ERC . "5.6")
- :type '(choice boolean function))
+ "Flag indicating whether nicks should be buttonized or not."
+ :type 'boolean)
(defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s"
"URL used to browse RFC references.
@@ -173,15 +167,16 @@ erc-button-alist
button. This is ignored if REGEXP is `nicknames'.
FORM is a Lisp symbol for a special variable whose value must be
- true for the button to be added. Alternatively, it can be a
- function whose arguments are BEG and END, the bounds of the
- button in the current buffer. It's expected to return a cons
- of (possibly identical) bounds or nil, to deny. For the extent
- of the call, all face options defined for the button module are
- re-bound, shadowing themselves, so the function is free to
- change their values. Important: different arguments are passed
- when REGEXP is `nickname'; see `erc-button-buttonize-nicks' for
- details.
+ true for the button to be added. Alternatively, when REGEXP is
+ not `nicknames', FORM can be a function whose arguments are BEG
+ and END, the bounds of the button in the current buffer. It's
+ expected to return a cons of (possibly identical) bounds or
+ nil, to deny. For the extent of the call, all face options
+ defined for the button module are re-bound, shadowing
+ themselves, so the function is free to change their values.
+ When regexp is the special symbol `nicknames', FORM must be the
+ symbol `erc-button-buttonize-nicks'. Specifying anything else
+ is deprecated.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -301,13 +296,45 @@ erc-button--maybe-warn-arbitrary-sexp
" have been deprecated.")))
(eval form t)))
+(defun erc-button--check-nicknames-entry ()
+ ;; This helper exists because the module is defined after its options.
+ (when-let (((eq major-mode 'erc-mode))
+ (entry (alist-get 'nicknames erc-button-alist)))
+ (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+ (erc-button--display-error-notice-with-keys-and-warn
+ "Values other than `erc-button-buttonize-nicks' in the third slot of "
+ "the `nicknames' entry of `erc-button-alist' are deprecated."))))
+
+(defun erc-button--preserve-bounds (bounds _ _ _)
+ "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
+ bounds)
+
+;; This variable is intended to serve as a "core" to be wrapped by
+;; (built-in) modules during setup. It's unclear whether
+;; `add-function's practice of removing existing advice before
+;; re-adding it is desirable when integrating modules since we're
+;; mostly concerned with ensuring one "piece" precedes or follows
+;; another (specific piece), which may not yet (or ever) be present.
+
+(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
+ "Function to possibly modify aspects of nick being buttonized.
+Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
+BOUNDS is a cons of (BEG . END) marking the position of the nick
+in the current message, which occupies the whole of the narrowed
+buffer. NICKNAME is a case-mapped string without text
+properties. SERVER-USER and CHANNEL-USER are the nick's
+`erc-server-users' entry and its associated (though possibly nil)
+`erc-channel-user' object. The function should return BOUNDS or
+a suitable replacement to indicate that buttonizing ought to
+proceed, and nil if it should be inhibited.")
+
(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))
bounds word)
- (when (eq 'erc-button-buttonize-nicks form)
- (setq form (symbol-value form)))
+ (when (eq form 'erc-button-buttonize-nicks)
+ (setq form (and (symbol-value form) erc-button--modify-nick-function)))
(when (or (functionp form)
(eq t form)
(and form (erc-button--maybe-warn-arbitrary-sexp form)))
@@ -574,17 +601,35 @@ erc-button--substitute-command-keys-in-region
(cons beg (point)))
(defun erc-button--display-error-notice-with-keys (parsed &rest strings)
- "Add help keys to STRING for corner-case admonishments."
+ "Add help keys to STRINGS for corner-case admonishments.
+Return inserted result."
(when (stringp parsed)
(push parsed strings)
(setq parsed nil))
- (let ((string (apply #'concat strings))
- (erc-button-alist
- `((,(rx "\\[" (group (+ (not "]"))) "]") 0
- erc-button--substitute-command-keys-in-region
- erc-button-describe-symbol 1)
- ,@erc-button-alist)))
- (erc-display-error-notice parsed string)))
+ (let* ((string (apply #'concat strings))
+ (erc-insert-post-hook
+ (cons (lambda ()
+ (setq string (buffer-substring (point-min) (1- (point-max)))))
+ erc-insert-post-hook))
+ (erc-button-alist
+ `((,(rx "\\[" (group (+ (not "]"))) "]") 0
+ erc-button--substitute-command-keys-in-region
+ erc-button-describe-symbol 1)
+ ,@erc-button-alist)))
+ (erc-display-error-notice parsed string)
+ string))
+
+(defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
+ "Like `erc-button--display-error-notice-with-keys' but also warn."
+ (let ((string (apply #'erc-button--display-error-notice-with-keys args)))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (with-syntax-table lisp-mode-syntax-table
+ (skip-syntax-forward "^-"))
+ (forward-char)
+ (display-warning
+ 'erc (buffer-substring-no-properties (point) (point-max))))))
(provide 'erc-button)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 46bb0c9ba77..4d6fd227518 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1383,12 +1383,13 @@ erc-button--display-error-notice-with-keys
erc-modules
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(erc-mode)
- (erc-button-mode +1)
(erc-tests--set-fake-server-process "sleep" "1")
- (erc-tests--send-prep)
- (erc-button--display-error-notice-with-keys
- "If \\[erc-bol] fails, "
- "see \\[erc-bug] or `erc-mode-map'.")
+ (erc--initialize-markers (point) nil)
+ (erc-button-mode +1)
+ (should (equal (erc-button--display-error-notice-with-keys
+ "If \\[erc-bol] fails, "
+ "see \\[erc-bug] or `erc-mode-map'.")
+ "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
(goto-char (point-min))
(ert-info ("Keymap substitution succeeds")
--
2.39.1
[-- Attachment #3: 0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch --]
[-- Type: text/x-patch, Size: 2264 bytes --]
From 3e8a0cb31d727554369d01bbfbf8c0c29d1c2825 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 1/3] [5.6] Replace Info-goto-node with info in
erc-button-alist
* lisp/erc/erc-button.el (erc-button-alist): Replace `Info-goto-node'
with plain `info', which is autoloaded.
* lisp/erc/erc-networks.el (erc-networks--set-name,
erc-networks--warn-on-connect): Don't require `info'. (Bug#60933.)
---
lisp/erc/erc-button.el | 2 +-
lisp/erc/erc-networks.el | 2 --
2 files changed, 1 insertion(+), 3 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c28dddefa0e..986c2d02053 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -133,7 +133,7 @@ erc-button-alist
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
1 t erc-button-describe-symbol 1)
;; pseudo links
- ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
+ ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t info 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
0 t (lambda (page)
(browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 95fd8990c99..4337d633cfa 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1292,7 +1292,6 @@ erc-networks--set-name
erc-server-announced-name "\" in `erc-networks-alist'"
" or consider calling `erc-tls' with the keyword `:id'."
" See Info:\"(erc) Network Identifier\" for more.")))
- (require 'info)
(erc-display-error-notice parsed m)
(if erc-networks--allow-unknown-network
(progn
@@ -1514,7 +1513,6 @@ erc-networks--warn-on-connect
"Emit warning when the `networks' module hasn't been loaded.
Ideally, do so upon opening the network process."
(unless (or erc--target erc-networks-mode)
- (require 'info nil t)
(let ((m (concat "Required module `networks' not loaded. If this "
" was unexpected, please add it to `erc-modules'.")))
;; Assume the server buffer has been marked as active.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch --]
[-- Type: text/x-patch, Size: 16276 bytes --]
From 0fcfbc0b56ce7f0adebdac35ebbcd0c5ef685b87 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 2/3] [5.6] Add erc-button helper for substituting command keys
TODO: add ERC-NEWS entry for `erc-button-alist' field-type deprecation
once ERC 5.5 is released and a new section for 5.6 is added.
* lisp/erc/erc-button.el (erc-button-mode, erc-button-enable): Warn if
`erc-button-alist' contains deprecated FORM field in `nicknames'
entry.
(erc-button-alist): Deprecate arbitrary sexp form for third item of
entries and offer more useful bounds-modifying function in its place.
Mention that anything other than `erc-button-buttonize-nicks' is
deprecated as the FORM field in a `nicknames' entry.
(erc-button--maybe-warn-arbitrary-sexp): Add helper for validating
third `erc-button-alist' field.
(erc-button--check-nicknames-entry): Add helper to check for
deprecated items in `erc-button-alist'.
(erc-button--modify-nick-function): Add new variable to hold a
function that filters nickname bounds when buttonizing.
(erc-button--preserve-bounds): Add function to serve as default value
for `erc-button--modify-nick-function).
(erc-button-add-nickname-buttons): Accommodate function variant for
"form" field of `erc-button-alist' entries. Minor optimizations.
(erc-button-add-buttons-1): Show warning when arbitrary sexp for third
"form" field encountered. Accommodate binary function instead.
(erc-button--substitute-command-keys-in-region): Add new function to
serve as default key-substitution function item in `erc-button-alist'.
(erc-button--display-error-notice-with-keys): Add new helper function
for displaying ad hoc warnings that possibly require key substitution.
* lisp/erc/erc-networks.el (erc-networks--ensure-announced,
erc-networks--on-MOTD-end): Use new key-substitutions helper from
erc-button.
(erc-button--display-error-notice-with-keys-and-warn): Add new
function to both display an ERC error message and show a warning.
* test/lisp/erc/erc-tests.el
(erc-button--display-error-notice-with-keys): New test. (Bug#60933.)
---
lisp/erc/erc-button.el | 137 ++++++++++++++++++++++++++++++++++---
lisp/erc/erc-networks.el | 20 +++---
test/lisp/erc/erc-tests.el | 56 +++++++++++++++
3 files changed, 193 insertions(+), 20 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 986c2d02053..dd40c588eb5 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,7 +52,8 @@ erc-button
;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
- ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+ ((erc-button--check-nicknames-entry)
+ (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-complete-functions #'erc-button-next-function)
(add-hook 'erc-mode-hook #'erc-button-setup))
@@ -165,8 +166,17 @@ erc-button-alist
BUTTON is the number of the regexp grouping actually matching the
button. This is ignored if REGEXP is `nicknames'.
-FORM is a Lisp expression which must eval to true for the button to
- be added.
+FORM is a Lisp symbol for a special variable whose value must be
+ true for the button to be added. Alternatively, when REGEXP is
+ not `nicknames', FORM can be a function whose arguments are BEG
+ and END, the bounds of the button in the current buffer. It's
+ expected to return a cons of (possibly identical) bounds or
+ nil, to deny. For the extent of the call, all face options
+ defined for the button module are re-bound, shadowing
+ themselves, so the function is free to change their values.
+ When regexp is the special symbol `nicknames', FORM must be the
+ symbol `erc-button-buttonize-nicks'. Specifying anything else
+ is deprecated.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -176,7 +186,7 @@ erc-button-alist
CALLBACK. There can be several PAR arguments. If REGEXP is
`nicknames', these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :package-version '(ERC . "5.5")
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
@@ -275,22 +285,79 @@ erc-button-add-buttons
(concat "\\<" (regexp-quote (car elem)) "\\>")
entry)))))))))))
+(defun erc-button--maybe-warn-arbitrary-sexp (form)
+ (if (and (symbolp form) (special-variable-p form))
+ (symbol-value form)
+ (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
+ (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
+ (lwarn 'erc :warning
+ (concat "Arbitrary sexps for the third FORM"
+ " slot of `erc-button-alist' entries"
+ " have been deprecated.")))
+ (eval form t)))
+
+(defun erc-button--check-nicknames-entry ()
+ ;; This helper exists because the module is defined after its options.
+ (when-let (((eq major-mode 'erc-mode))
+ (entry (alist-get 'nicknames erc-button-alist)))
+ (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+ (erc-button--display-error-notice-with-keys-and-warn
+ "Values other than `erc-button-buttonize-nicks' in the third slot of "
+ "the `nicknames' entry of `erc-button-alist' are deprecated."))))
+
+(defun erc-button--preserve-bounds (bounds _ _ _)
+ "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
+ bounds)
+
+;; This variable is intended to serve as a "core" to be wrapped by
+;; (built-in) modules during setup. It's unclear whether
+;; `add-function's practice of removing existing advice before
+;; re-adding it is desirable when integrating modules since we're
+;; mostly concerned with ensuring one "piece" precedes or follows
+;; another (specific piece), which may not yet (or ever) be present.
+
+(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
+ "Function to possibly modify aspects of nick being buttonized.
+Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
+BOUNDS is a cons of (BEG . END) marking the position of the nick
+in the current message, which occupies the whole of the narrowed
+buffer. NICKNAME is a case-mapped string without text
+properties. SERVER-USER and CHANNEL-USER are the nick's
+`erc-server-users' entry and its associated (though possibly nil)
+`erc-channel-user' object. The function should return BOUNDS or
+a suitable replacement to indicate that buttonizing ought to
+proceed, and nil if it should be inhibited.")
+
(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))
bounds word)
- (when (or (eq t form)
- (eval form t))
+ (when (eq form 'erc-button-buttonize-nicks)
+ (setq form (and (symbol-value form) erc-button--modify-nick-function)))
+ (when (or (functionp form)
+ (eq t form)
+ (and form (erc-button--maybe-warn-arbitrary-sexp 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)))
- (when (or (and (erc-server-buffer-p) (erc-get-server-user word))
- (and erc-channel-users (erc-get-channel-user word)))
- (erc-button-add-button (car bounds) (cdr bounds)
- fun t (list word))))))))
+ (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)))))
+ (when (and user
+ (or (not (functionp form))
+ (setq bounds
+ (funcall form bounds down user (cdr cuser)))))
+ (erc-button-add-button (car bounds) (cdr bounds)
+ fun t (list word)))))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
@@ -302,7 +369,14 @@ erc-button-add-buttons-1
(fun (nth 3 entry))
(data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
- (eval form t))
+ (and (functionp form)
+ (let* ((erc-button-face erc-button-face)
+ (erc-button-mouse-face erc-button-mouse-face)
+ (erc-button-nickname-face erc-button-nickname-face)
+ (rv (funcall form start end)))
+ (when rv
+ (setq end (cdr rv) start (car rv)))))
+ (erc-button--maybe-warn-arbitrary-sexp form))
(erc-button-add-button start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
@@ -511,6 +585,47 @@ erc-button-beats-to-time
(message "@%s is %d:%02d local time"
beats hours minutes)))
+(defun erc-button--substitute-command-keys-in-region (beg end)
+ "Replace command in region with keys and return new bounds"
+ (let* ((o (buffer-substring beg end))
+ (s (substitute-command-keys o)))
+ (unless (equal o s)
+ (setq erc-button-face nil))
+ (delete-region beg end)
+ (insert s))
+ (cons beg (point)))
+
+(defun erc-button--display-error-notice-with-keys (parsed &rest strings)
+ "Add help keys to STRINGS for corner-case admonishments.
+Return inserted result."
+ (when (stringp parsed)
+ (push parsed strings)
+ (setq parsed nil))
+ (let* ((string (apply #'concat strings))
+ (erc-insert-post-hook
+ (cons (lambda ()
+ (setq string (buffer-substring (point-min) (1- (point-max)))))
+ erc-insert-post-hook))
+ (erc-button-alist
+ `((,(rx "\\[" (group (+ (not "]"))) "]") 0
+ erc-button--substitute-command-keys-in-region
+ erc-button-describe-symbol 1)
+ ,@erc-button-alist)))
+ (erc-display-error-notice parsed string)
+ string))
+
+(defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
+ "Like `erc-button--display-error-notice-with-keys' but also warn."
+ (let ((string (apply #'erc-button--display-error-notice-with-keys args)))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (with-syntax-table lisp-mode-syntax-table
+ (skip-syntax-forward "^-"))
+ (forward-char)
+ (display-warning
+ 'erc (buffer-substring-no-properties (point) (point-max))))))
+
(provide 'erc-button)
;;; erc-button.el ends here
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 4337d633cfa..dd481032e7e 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -67,6 +67,9 @@ erc-session-server
(declare-function erc-server-process-alive "erc-backend" (&optional buffer))
(declare-function erc-set-active-buffer "erc" (buffer))
+(declare-function erc-button--display-error-notice-with-keys
+ (parsed &rest strings))
+
;; Variables
(defgroup erc-networks nil
@@ -1310,12 +1313,11 @@ erc-networks--ensure-announced
Copy source (prefix) from MOTD-ish message as a last resort."
;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
(unless erc-server-announced-name
- (setq erc-server-announced-name (erc-response.sender parsed))
- (erc-display-error-notice
- parsed (concat "Failed to determine server name. Using \""
- erc-server-announced-name "\" instead."
- " If this was unexpected, consider reporting it via "
- (substitute-command-keys "\\[erc-bug]") ".")))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Failed to determine server name. Using \""
+ (setq erc-server-announced-name (erc-response.sender parsed)) "\" instead"
+ ". If this was unexpected, consider reporting it via \\[erc-bug]" "."))
nil)
(defun erc-unset-network-name (_nick _ip _reason)
@@ -1493,9 +1495,9 @@ erc-networks-on-MOTD-end
(memq (erc--target-symbol erc--target)
erc-networks--bouncer-targets)))
proc)
- (let ((m (concat "Unexpected state detected. Please report via "
- (substitute-command-keys "\\[erc-bug]") ".")))
- (erc-display-error-notice parsed m))))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Unexpected state detected. Please report via \\[erc-bug].")))
;; For now, retain compatibility with erc-server-NNN-functions.
(or (erc-networks--ensure-announced proc parsed)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..4d6fd227518 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1370,4 +1370,60 @@ define-erc-module--local
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
+
+;; XXX move erc-button tests to new file if more added.
+(require 'erc-button)
+
+;; See also `erc-scenarios-networks-announced-missing' in
+;; erc-scenarios-misc.el for a more realistic example.
+(ert-deftest erc-button--display-error-notice-with-keys ()
+ (with-current-buffer (get-buffer-create "*fake*")
+ (let ((mode erc-button-mode)
+ (inhibit-message noninteractive)
+ erc-modules
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (erc-mode)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (erc--initialize-markers (point) nil)
+ (erc-button-mode +1)
+ (should (equal (erc-button--display-error-notice-with-keys
+ "If \\[erc-bol] fails, "
+ "see \\[erc-bug] or `erc-mode-map'.")
+ "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
+ (goto-char (point-min))
+
+ (ert-info ("Keymap substitution succeeds")
+ (erc-button-next)
+ (should (looking-at "C-a"))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (erc-button-press-button)
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bol" nil t)))
+ (erc-button-next)
+ (erc-button-previous) ; end of interval correct
+ (should (looking-at "a fails")))
+
+ (ert-info ("Extended command mapping succeeds")
+ (erc-button-next)
+ (should (looking-at "M-x erc-bug"))
+ (erc-button-press-button)
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bug" nil t))))
+
+ (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
+ (erc-button-next)
+ (should (equal (get-text-property (point) 'font-lock-face)
+ '(erc-button erc-error-face)))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (should (eq erc-button-face 'erc-button))) ; extent evaporates
+
+ (when noninteractive
+ (unless mode
+ (erc-button-mode -1))
+ (kill-buffer "*Help*")
+ (kill-buffer)))))
+
;;; erc-tests.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch --]
[-- Type: text/x-patch, Size: 3448 bytes --]
From 49c703272cb3d0f4ec035175e94c132fa32eaeba Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 05:13:06 -0800
Subject: [PATCH 3/3] [5.6] Allow erc-button-add-face to take an object
* lisp/erc/erc-button.el
(erc-button--add-nickname-face-function): New internal var.
(erc-button-add-button): Call `erc-button--add-nickname-face-function'
when it's a function for applying `erc-button-nickname-face'.
(erc-button-add-face): Add optional `object' param. (Bug#60933.)
---
lisp/erc/erc-button.el | 19 ++++++++++++-------
1 file changed, 12 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index dd40c588eb5..49e3caf49a1 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -391,6 +391,8 @@ erc-button-remove-old-buttons
mouse-face nil
keymap nil)))
+(defvar erc-button--add-nickname-face-function nil)
+
(defun erc-button-add-button (from to fun nick-p &optional data regexp)
"Create a button between FROM and TO with callback FUN and data DATA.
NICK-P specifies if this is a nickname button.
@@ -417,7 +419,10 @@ erc-button-add-button
(move-marker pos (point))))))
(if nick-p
(when erc-button-nickname-face
- (erc-button-add-face from to erc-button-nickname-face))
+ (if erc-button--add-nickname-face-function
+ (funcall erc-button--add-nickname-face-function
+ from to erc-button-nickname-face)
+ (erc-button-add-face from to erc-button-nickname-face)))
(when erc-button-face
(erc-button-add-face from to erc-button-face)))
(add-text-properties
@@ -429,16 +434,16 @@ erc-button-add-button
(list 'rear-nonsticky t)
(and data (list 'erc-data data)))))
-(defun erc-button-add-face (from to face)
+(defun erc-button-add-face (from to face &optional object)
"Add FACE to the region between FROM and TO."
;; If we just use `add-text-property', then this will overwrite any
;; face text property already used for the button. It will not be
;; merged correctly. If we use overlays, then redisplay will be
;; very slow with lots of buttons. This is why we manually merge
;; face text properties.
- (let ((old (erc-list (get-text-property from 'font-lock-face)))
+ (let ((old (erc-list (get-text-property from 'font-lock-face object)))
(pos from)
- (end (next-single-property-change from 'font-lock-face nil to))
+ (end (next-single-property-change from 'font-lock-face object to))
new)
;; old is the face at pos, in list form. It is nil if there is no
;; face at pos. If nil, the new face is FACE. If not nil, the
@@ -446,10 +451,10 @@ erc-button-add-face
;; where this face changes.
(while (< pos to)
(setq new (if old (cons face old) face))
- (put-text-property pos end 'font-lock-face new)
+ (put-text-property pos end 'font-lock-face new object)
(setq pos end
- old (erc-list (get-text-property pos 'font-lock-face))
- end (next-single-property-change pos 'font-lock-face nil to)))))
+ old (erc-list (get-text-property pos 'font-lock-face object))
+ end (next-single-property-change pos 'font-lock-face object to)))))
;; widget-button-click calls with two args, we ignore the first.
;; Since Emacs runs this directly, rather than with
--
2.39.1
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
2023-02-19 15:04 ` J.P.
@ 2023-03-09 14:42 ` J.P.
[not found] ` <87fsaekmv4.fsf@neverwas.me>
` (4 subsequent siblings)
6 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-03-09 14:42 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 137 bytes --]
v3. Expand `erc-button-alist' pattern to recognize inline (info "...")
forms. Autoload button helpers (locally, in ERC's own loaddefs).
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 3269 bytes --]
From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 9 Mar 2023 06:28:53 -0800
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Replace Info-goto-node with info in erc-button-alist
[5.6] Add erc-button helper for substituting command keys
[5.6] Allow erc-button-add-face to take an object
lisp/erc/erc-button.el | 172 +++++++++++++++++++++++++++++++++----
lisp/erc/erc-networks.el | 22 ++---
test/lisp/erc/erc-tests.el | 56 ++++++++++++
3 files changed, 220 insertions(+), 30 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 49e3caf49a1..c94a412eea8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -134,7 +134,7 @@ erc-button-alist
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
1 t erc-button-describe-symbol 1)
;; pseudo links
- ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t info 1)
+ ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
0 t (lambda (page)
(browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
@@ -600,25 +600,39 @@ erc-button--substitute-command-keys-in-region
(insert s))
(cons beg (point)))
-(defun erc-button--display-error-notice-with-keys (parsed &rest strings)
- "Add help keys to STRINGS for corner-case admonishments.
-Return inserted result."
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
+ &rest strings)
+ "Add help keys to STRINGS for configuration-related admonishments.
+Return inserted result. PARSED can be an `erc-response' object,
+a string, or nil. BUFFER can be a buffer, a string, or nil. As
+a special case, PARSED can also be a buffer as long as BUFFER is
+a string or nil."
+ (when (stringp buffer)
+ (push buffer strings)
+ (setq buffer nil))
(when (stringp parsed)
(push parsed strings)
(setq parsed nil))
+ (when (bufferp parsed)
+ (cl-assert (null buffer))
+ (setq buffer parsed
+ parsed nil))
(let* ((string (apply #'concat strings))
(erc-insert-post-hook
(cons (lambda ()
- (setq string (buffer-substring (point-min) (1- (point-max)))))
+ (setq string (buffer-substring (point-min)
+ (1- (point-max)))))
erc-insert-post-hook))
(erc-button-alist
`((,(rx "\\[" (group (+ (not "]"))) "]") 0
erc-button--substitute-command-keys-in-region
erc-button-describe-symbol 1)
,@erc-button-alist)))
- (erc-display-error-notice parsed string)
+ (erc-display-message parsed '(notice error) (or buffer 'active) string)
string))
+;;;###autoload
(defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
"Like `erc-button--display-error-notice-with-keys' but also warn."
(let ((string (apply #'erc-button--display-error-notice-with-keys args)))
--
2.39.2
[-- Attachment #3: 0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch --]
[-- Type: text/x-patch, Size: 2345 bytes --]
From f61bd6bb6129571327cdb9e68b38e8221b72d91e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 1/3] [5.6] Replace Info-goto-node with info in
erc-button-alist
* lisp/erc/erc-button.el (erc-button-alist): Replace `Info-goto-node'
with plain `info', which is autoloaded. Expand regexp to recognize
inline `info' function calls.
* lisp/erc/erc-networks.el (erc-networks--set-name,
erc-networks--warn-on-connect): Don't require `info'. (Bug#60933.)
---
lisp/erc/erc-button.el | 2 +-
lisp/erc/erc-networks.el | 2 --
2 files changed, 1 insertion(+), 3 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c28dddefa0e..891b453466f 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -133,7 +133,7 @@ erc-button-alist
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
1 t erc-button-describe-symbol 1)
;; pseudo links
- ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
+ ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
0 t (lambda (page)
(browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 95fd8990c99..4337d633cfa 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1292,7 +1292,6 @@ erc-networks--set-name
erc-server-announced-name "\" in `erc-networks-alist'"
" or consider calling `erc-tls' with the keyword `:id'."
" See Info:\"(erc) Network Identifier\" for more.")))
- (require 'info)
(erc-display-error-notice parsed m)
(if erc-networks--allow-unknown-network
(progn
@@ -1514,7 +1513,6 @@ erc-networks--warn-on-connect
"Emit warning when the `networks' module hasn't been loaded.
Ideally, do so upon opening the network process."
(unless (or erc--target erc-networks-mode)
- (require 'info nil t)
(let ((m (concat "Required module `networks' not loaded. If this "
" was unexpected, please add it to `erc-modules'.")))
;; Assume the server buffer has been marked as active.
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch --]
[-- Type: text/x-patch, Size: 16850 bytes --]
From 5fb14bbc6535acfabcec5afe89613528e1b405b5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 2/3] [5.6] Add erc-button helper for substituting command keys
TODO: add ERC-NEWS entry for `erc-button-alist' field-type deprecation
once ERC 5.5 is released and a new section for 5.6 is added.
* lisp/erc/erc-button.el (erc-button-mode, erc-button-enable): Warn if
`erc-button-alist' contains deprecated FORM field in `nicknames'
entry.
(erc-button-alist): Deprecate arbitrary sexp form for third item of
entries and offer more useful bounds-modifying function in its place.
Mention that anything other than `erc-button-buttonize-nicks' is
deprecated as the FORM field in a `nicknames' entry.
(erc-button--maybe-warn-arbitrary-sexp): Add helper for validating
third `erc-button-alist' field.
(erc-button--check-nicknames-entry): Add helper to check for
deprecated items in `erc-button-alist'.
(erc-button--modify-nick-function): Add new variable to hold a
function that filters nickname bounds when buttonizing.
(erc-button--preserve-bounds): Add function to serve as default value
for `erc-button--modify-nick-function).
(erc-button-add-nickname-buttons): Accommodate function variant for
"form" field of `erc-button-alist' entries. Minor optimizations.
(erc-button-add-buttons-1): Show warning when arbitrary sexp for third
"form" field encountered. Accommodate binary function instead.
(erc-button--substitute-command-keys-in-region): Add new function to
serve as default key-substitution function item in `erc-button-alist'.
(erc-button--display-error-notice-with-keys): Add new helper function
for displaying ad hoc warnings that possibly require key substitution.
* lisp/erc/erc-networks.el (erc-networks--ensure-announced,
erc-networks--on-MOTD-end): Use new key-substitutions helper from
erc-button.
(erc-button--display-error-notice-with-keys-and-warn): Add new
function to both display an ERC error message and show a warning.
* test/lisp/erc/erc-tests.el
(erc-button--display-error-notice-with-keys): New test. (Bug#60933.)
---
lisp/erc/erc-button.el | 151 ++++++++++++++++++++++++++++++++++---
lisp/erc/erc-networks.el | 20 ++---
test/lisp/erc/erc-tests.el | 56 ++++++++++++++
3 files changed, 207 insertions(+), 20 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 891b453466f..eca3df44892 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,7 +52,8 @@ erc-button
;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
- ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+ ((erc-button--check-nicknames-entry)
+ (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-complete-functions #'erc-button-next-function)
(add-hook 'erc-mode-hook #'erc-button-setup))
@@ -165,8 +166,17 @@ erc-button-alist
BUTTON is the number of the regexp grouping actually matching the
button. This is ignored if REGEXP is `nicknames'.
-FORM is a Lisp expression which must eval to true for the button to
- be added.
+FORM is a Lisp symbol for a special variable whose value must be
+ true for the button to be added. Alternatively, when REGEXP is
+ not `nicknames', FORM can be a function whose arguments are BEG
+ and END, the bounds of the button in the current buffer. It's
+ expected to return a cons of (possibly identical) bounds or
+ nil, to deny. For the extent of the call, all face options
+ defined for the button module are re-bound, shadowing
+ themselves, so the function is free to change their values.
+ When regexp is the special symbol `nicknames', FORM must be the
+ symbol `erc-button-buttonize-nicks'. Specifying anything else
+ is deprecated.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -176,7 +186,7 @@ erc-button-alist
CALLBACK. There can be several PAR arguments. If REGEXP is
`nicknames', these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :package-version '(ERC . "5.5")
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
@@ -275,22 +285,79 @@ erc-button-add-buttons
(concat "\\<" (regexp-quote (car elem)) "\\>")
entry)))))))))))
+(defun erc-button--maybe-warn-arbitrary-sexp (form)
+ (if (and (symbolp form) (special-variable-p form))
+ (symbol-value form)
+ (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
+ (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
+ (lwarn 'erc :warning
+ (concat "Arbitrary sexps for the third FORM"
+ " slot of `erc-button-alist' entries"
+ " have been deprecated.")))
+ (eval form t)))
+
+(defun erc-button--check-nicknames-entry ()
+ ;; This helper exists because the module is defined after its options.
+ (when-let (((eq major-mode 'erc-mode))
+ (entry (alist-get 'nicknames erc-button-alist)))
+ (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+ (erc-button--display-error-notice-with-keys-and-warn
+ "Values other than `erc-button-buttonize-nicks' in the third slot of "
+ "the `nicknames' entry of `erc-button-alist' are deprecated."))))
+
+(defun erc-button--preserve-bounds (bounds _ _ _)
+ "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
+ bounds)
+
+;; This variable is intended to serve as a "core" to be wrapped by
+;; (built-in) modules during setup. It's unclear whether
+;; `add-function's practice of removing existing advice before
+;; re-adding it is desirable when integrating modules since we're
+;; mostly concerned with ensuring one "piece" precedes or follows
+;; another (specific piece), which may not yet (or ever) be present.
+
+(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
+ "Function to possibly modify aspects of nick being buttonized.
+Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
+BOUNDS is a cons of (BEG . END) marking the position of the nick
+in the current message, which occupies the whole of the narrowed
+buffer. NICKNAME is a case-mapped string without text
+properties. SERVER-USER and CHANNEL-USER are the nick's
+`erc-server-users' entry and its associated (though possibly nil)
+`erc-channel-user' object. The function should return BOUNDS or
+a suitable replacement to indicate that buttonizing ought to
+proceed, and nil if it should be inhibited.")
+
(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))
bounds word)
- (when (or (eq t form)
- (eval form t))
+ (when (eq form 'erc-button-buttonize-nicks)
+ (setq form (and (symbol-value form) erc-button--modify-nick-function)))
+ (when (or (functionp form)
+ (eq t form)
+ (and form (erc-button--maybe-warn-arbitrary-sexp 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)))
- (when (or (and (erc-server-buffer-p) (erc-get-server-user word))
- (and erc-channel-users (erc-get-channel-user word)))
- (erc-button-add-button (car bounds) (cdr bounds)
- fun t (list word))))))))
+ (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)))))
+ (when (and user
+ (or (not (functionp form))
+ (setq bounds
+ (funcall form bounds down user (cdr cuser)))))
+ (erc-button-add-button (car bounds) (cdr bounds)
+ fun t (list word)))))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
@@ -302,7 +369,14 @@ erc-button-add-buttons-1
(fun (nth 3 entry))
(data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
- (eval form t))
+ (and (functionp form)
+ (let* ((erc-button-face erc-button-face)
+ (erc-button-mouse-face erc-button-mouse-face)
+ (erc-button-nickname-face erc-button-nickname-face)
+ (rv (funcall form start end)))
+ (when rv
+ (setq end (cdr rv) start (car rv)))))
+ (erc-button--maybe-warn-arbitrary-sexp form))
(erc-button-add-button start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
@@ -511,6 +585,61 @@ erc-button-beats-to-time
(message "@%s is %d:%02d local time"
beats hours minutes)))
+(defun erc-button--substitute-command-keys-in-region (beg end)
+ "Replace command in region with keys and return new bounds"
+ (let* ((o (buffer-substring beg end))
+ (s (substitute-command-keys o)))
+ (unless (equal o s)
+ (setq erc-button-face nil))
+ (delete-region beg end)
+ (insert s))
+ (cons beg (point)))
+
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
+ &rest strings)
+ "Add help keys to STRINGS for configuration-related admonishments.
+Return inserted result. PARSED can be an `erc-response' object,
+a string, or nil. BUFFER can be a buffer, a string, or nil. As
+a special case, PARSED can also be a buffer as long as BUFFER is
+a string or nil."
+ (when (stringp buffer)
+ (push buffer strings)
+ (setq buffer nil))
+ (when (stringp parsed)
+ (push parsed strings)
+ (setq parsed nil))
+ (when (bufferp parsed)
+ (cl-assert (null buffer))
+ (setq buffer parsed
+ parsed nil))
+ (let* ((string (apply #'concat strings))
+ (erc-insert-post-hook
+ (cons (lambda ()
+ (setq string (buffer-substring (point-min)
+ (1- (point-max)))))
+ erc-insert-post-hook))
+ (erc-button-alist
+ `((,(rx "\\[" (group (+ (not "]"))) "]") 0
+ erc-button--substitute-command-keys-in-region
+ erc-button-describe-symbol 1)
+ ,@erc-button-alist)))
+ (erc-display-message parsed '(notice error) (or buffer 'active) string)
+ string))
+
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
+ "Like `erc-button--display-error-notice-with-keys' but also warn."
+ (let ((string (apply #'erc-button--display-error-notice-with-keys args)))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (with-syntax-table lisp-mode-syntax-table
+ (skip-syntax-forward "^-"))
+ (forward-char)
+ (display-warning
+ 'erc (buffer-substring-no-properties (point) (point-max))))))
+
(provide 'erc-button)
;;; erc-button.el ends here
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 4337d633cfa..dd481032e7e 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -67,6 +67,9 @@ erc-session-server
(declare-function erc-server-process-alive "erc-backend" (&optional buffer))
(declare-function erc-set-active-buffer "erc" (buffer))
+(declare-function erc-button--display-error-notice-with-keys
+ (parsed &rest strings))
+
;; Variables
(defgroup erc-networks nil
@@ -1310,12 +1313,11 @@ erc-networks--ensure-announced
Copy source (prefix) from MOTD-ish message as a last resort."
;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
(unless erc-server-announced-name
- (setq erc-server-announced-name (erc-response.sender parsed))
- (erc-display-error-notice
- parsed (concat "Failed to determine server name. Using \""
- erc-server-announced-name "\" instead."
- " If this was unexpected, consider reporting it via "
- (substitute-command-keys "\\[erc-bug]") ".")))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Failed to determine server name. Using \""
+ (setq erc-server-announced-name (erc-response.sender parsed)) "\" instead"
+ ". If this was unexpected, consider reporting it via \\[erc-bug]" "."))
nil)
(defun erc-unset-network-name (_nick _ip _reason)
@@ -1493,9 +1495,9 @@ erc-networks-on-MOTD-end
(memq (erc--target-symbol erc--target)
erc-networks--bouncer-targets)))
proc)
- (let ((m (concat "Unexpected state detected. Please report via "
- (substitute-command-keys "\\[erc-bug]") ".")))
- (erc-display-error-notice parsed m))))
+ (require 'erc-button)
+ (erc-button--display-error-notice-with-keys
+ parsed "Unexpected state detected. Please report via \\[erc-bug].")))
;; For now, retain compatibility with erc-server-NNN-functions.
(or (erc-networks--ensure-announced proc parsed)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index d6c63934163..05f0de6b195 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1370,4 +1370,60 @@ define-erc-module--local
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
+
+;; XXX move erc-button tests to new file if more added.
+(require 'erc-button)
+
+;; See also `erc-scenarios-networks-announced-missing' in
+;; erc-scenarios-misc.el for a more realistic example.
+(ert-deftest erc-button--display-error-notice-with-keys ()
+ (with-current-buffer (get-buffer-create "*fake*")
+ (let ((mode erc-button-mode)
+ (inhibit-message noninteractive)
+ erc-modules
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (erc-mode)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (erc--initialize-markers (point) nil)
+ (erc-button-mode +1)
+ (should (equal (erc-button--display-error-notice-with-keys
+ "If \\[erc-bol] fails, "
+ "see \\[erc-bug] or `erc-mode-map'.")
+ "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
+ (goto-char (point-min))
+
+ (ert-info ("Keymap substitution succeeds")
+ (erc-button-next)
+ (should (looking-at "C-a"))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (erc-button-press-button)
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bol" nil t)))
+ (erc-button-next)
+ (erc-button-previous) ; end of interval correct
+ (should (looking-at "a fails")))
+
+ (ert-info ("Extended command mapping succeeds")
+ (erc-button-next)
+ (should (looking-at "M-x erc-bug"))
+ (erc-button-press-button)
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bug" nil t))))
+
+ (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
+ (erc-button-next)
+ (should (equal (get-text-property (point) 'font-lock-face)
+ '(erc-button erc-error-face)))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (should (eq erc-button-face 'erc-button))) ; extent evaporates
+
+ (when noninteractive
+ (unless mode
+ (erc-button-mode -1))
+ (kill-buffer "*Help*")
+ (kill-buffer)))))
+
;;; erc-tests.el ends here
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch --]
[-- Type: text/x-patch, Size: 3448 bytes --]
From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 05:13:06 -0800
Subject: [PATCH 3/3] [5.6] Allow erc-button-add-face to take an object
* lisp/erc/erc-button.el
(erc-button--add-nickname-face-function): New internal var.
(erc-button-add-button): Call `erc-button--add-nickname-face-function'
when it's a function for applying `erc-button-nickname-face'.
(erc-button-add-face): Add optional `object' param. (Bug#60933.)
---
lisp/erc/erc-button.el | 19 ++++++++++++-------
1 file changed, 12 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index eca3df44892..c94a412eea8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -391,6 +391,8 @@ erc-button-remove-old-buttons
mouse-face nil
keymap nil)))
+(defvar erc-button--add-nickname-face-function nil)
+
(defun erc-button-add-button (from to fun nick-p &optional data regexp)
"Create a button between FROM and TO with callback FUN and data DATA.
NICK-P specifies if this is a nickname button.
@@ -417,7 +419,10 @@ erc-button-add-button
(move-marker pos (point))))))
(if nick-p
(when erc-button-nickname-face
- (erc-button-add-face from to erc-button-nickname-face))
+ (if erc-button--add-nickname-face-function
+ (funcall erc-button--add-nickname-face-function
+ from to erc-button-nickname-face)
+ (erc-button-add-face from to erc-button-nickname-face)))
(when erc-button-face
(erc-button-add-face from to erc-button-face)))
(add-text-properties
@@ -429,16 +434,16 @@ erc-button-add-button
(list 'rear-nonsticky t)
(and data (list 'erc-data data)))))
-(defun erc-button-add-face (from to face)
+(defun erc-button-add-face (from to face &optional object)
"Add FACE to the region between FROM and TO."
;; If we just use `add-text-property', then this will overwrite any
;; face text property already used for the button. It will not be
;; merged correctly. If we use overlays, then redisplay will be
;; very slow with lots of buttons. This is why we manually merge
;; face text properties.
- (let ((old (erc-list (get-text-property from 'font-lock-face)))
+ (let ((old (erc-list (get-text-property from 'font-lock-face object)))
(pos from)
- (end (next-single-property-change from 'font-lock-face nil to))
+ (end (next-single-property-change from 'font-lock-face object to))
new)
;; old is the face at pos, in list form. It is nil if there is no
;; face at pos. If nil, the new face is FACE. If not nil, the
@@ -446,10 +451,10 @@ erc-button-add-face
;; where this face changes.
(while (< pos to)
(setq new (if old (cons face old) face))
- (put-text-property pos end 'font-lock-face new)
+ (put-text-property pos end 'font-lock-face new object)
(setq pos end
- old (erc-list (get-text-property pos 'font-lock-face))
- end (next-single-property-change pos 'font-lock-face nil to)))))
+ old (erc-list (get-text-property pos 'font-lock-face object))
+ end (next-single-property-change pos 'font-lock-face object to)))))
;; widget-button-click calls with two args, we ignore the first.
;; Since Emacs runs this directly, rather than with
--
2.39.2
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
[not found] ` <87fsaekmv4.fsf@neverwas.me>
@ 2023-04-18 14:11 ` J.P.
[not found] ` <877cu9qnyo.fsf@neverwas.me>
1 sibling, 0 replies; 9+ messages in thread
From: J.P. @ 2023-04-18 14:11 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1632 bytes --]
This bug's main contribution has been the introduction of a function
variant for the FORM field of `erc-button-alist' entries. It was meant
to offer a more natural way to influence buttonizing than the boolean
sexps it was displacing while still retaining enough structure to
encourage maintainability (for example, by highlighting which elements
invite modification, like a button's faces and its bounds, and which are
off limits, like certain required text properties).
However, in the short term, I feel that locking this down too cleverly
will only hamstring us as we inch closer to adopting various protocol
extensions for ERC 5.7. As requirements shift beneath us, the current
design will always end up seeming overly restrictive or permissive. As
such, I think it's best to partially revert these changes and instead
look to an existing interface we already know (but don't love), namely
`erc-button-add-button'. From now on, I think we should just interpret
any function occupying the FORM field as a replacement "buttonizer" to
be called in its place.
The same general thinking applies to the nicks-specific buttonizer as
well, though it being intrinsically special and, for now, internal means
we can take more liberties in inconveniencing its consumers (which are
all built-in modules). Thus, I'm proposing we replace the slightly
unwieldy set of positional params with a single passed-around struct,
which members of the interface's "advice stack" can modify at will. See
implementation for details.
Note that these changes currently require those from "bug#62834: Make
erc-button navigation more flexible". Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Improve-erc-button-modify-nick-function-interfac.patch --]
[-- Type: text/x-patch, Size: 7624 bytes --]
From 190a77266d27e490dad7bda84d6790827f9e3953 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 1/2] [5.6] Improve erc-button--modify-nick-function interface
* lisp/erc/erc-button.el (erc-button--check-nicknames-entry): Remove
unused let binding.
(erc-button--nick): New struct.
(erc-button--preserve-bounds): Rework to expect `erc-button--nick'
object.
(erc-button--modify-nick-function): Reexplain interface base on
`erc-button--nick' object.
(erc-button--add-phantom-speaker): Redo to expect `erc-button--nick'
object.
(erc-button-add-nickname-buttons): Rework slightly to use
`erc-button--nick' when calling `erc-button--modify-nick-function'.
(Bug#60933.)
---
lisp/erc/erc-button.el | 91 +++++++++++++++++++++++++++++-------------
1 file changed, 63 insertions(+), 28 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e2447deecde..5d8fd03615b 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -300,16 +300,42 @@ erc-button--maybe-warn-arbitrary-sexp
(defun erc-button--check-nicknames-entry ()
;; This helper exists because the module is defined after its options.
- (when-let (((eq major-mode 'erc-mode))
- (entry (alist-get 'nicknames erc-button-alist)))
- (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+ (when (eq major-mode 'erc-mode)
+ (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist))
+ 'erc-button-buttonize-nicks)
(erc-button--display-error-notice-with-keys-and-warn
"Values other than `erc-button-buttonize-nicks' in the third slot of "
"the `nicknames' entry of `erc-button-alist' are deprecated."))))
-(defun erc-button--preserve-bounds (bounds _ server-user _)
- "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
- (and server-user bounds))
+(cl-defstruct erc-button--nick
+ ;; Indicates the nick's position in the current message. BEG is
+ ;; normally also point.
+ ( bounds nil :type cons
+ :documentation "A cons of (BEG . END).")
+ ;; NICK is the original, non-casemapped nickname and REST is a
+ ;; possibly empty list of opaque objects. If non-nil, the entire
+ ;; cons should be mutated rather than replaced because it's used as
+ ;; a key in hash tables and text-property searches.
+ ( data nil :type (or null cons)
+ :documentation "A unique cons of (NICK . REST).")
+ ( downcased nil :type (or null string)
+ :documentation "The case-mapped nickname sans text properties.")
+ ;; Not necessarily present in `erc-server-users'.
+ ( user nil :type (or null erc-server-user)
+ :documentation "A possibly nil or spoofed `erc-server-user'.")
+ ;; The CDR of a value from an `erc-channel-users' table.
+ ( cuser nil :type (or null erc-channel-user)
+ :documentation "A possibly nil `erc-channel-user'.")
+ ( erc-button-face erc-button-face :type symbol
+ :documentation "Temp `erc-button-face' while buttonizing.")
+ ( erc-button-nickname-face erc-button-nickname-face :type symbol
+ :documentation "Temp `erc-button-nickname-face' while buttonizing.")
+ ( erc-button-mouse-face erc-button-mouse-face :type symbol
+ :documentation "Temp `erc-button-mouse-face' while buttonizing."))
+
+(defun erc-button--preserve-bounds (nick-object)
+ "Return NICK-OBJECT when its user slot is non-empty."
+ (and (erc-button--nick-user nick-object) nick-object))
;; This variable is intended to serve as a "core" to be wrapped by
;; (built-in) modules during setup. It's unclear whether
@@ -320,29 +346,27 @@ erc-button--preserve-bounds
(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
"Function to possibly modify aspects of nick being buttonized.
-Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
-BOUNDS is a cons of (BEG . END) marking the position of the nick
-in the current message, which occupies the whole of the narrowed
-buffer. BEG is normally also point. NICKNAME is a case-mapped
-string without text properties. SERVER-USER and CHANNEL-USER are
-the nick's `erc-server-users' entry and its associated (though
-possibly nil) `erc-channel-user' object. The function should
-return BOUNDS or a suitable replacement to indicate that
-buttonizing ought to proceed, and nil if it should be inhibited.")
+Called with one argument, an `erc-button--nick' object, or nil.
+The function should return the same (or similar) object when
+buttonizing ought to proceed and nil otherwise. While running,
+all faces defined in `erc-button' are bound temporarily and can
+be updated at will.")
(defvar-local erc-button--phantom-users nil)
(defun erc-button--add-phantom-speaker (args)
"Maybe substitute fake `server-user' for speaker at point."
- (pcase args
- (`(,bounds ,downcased-nick nil ,channel-user)
- (list bounds downcased-nick
- ;; Like `with-memoization' but don't cache when value is nil.
- (or (gethash downcased-nick erc-button--phantom-users)
- (and-let* ((user (erc-button--get-user-from-speaker-naive
- (car bounds))))
- (puthash downcased-nick user erc-button--phantom-users)))
- channel-user))
+ (pcase (car args)
+ ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil)))
+ ;; Like `with-memoization' but don't cache when value is nil.
+ (when-let ((user (or (gethash downcased erc-button--phantom-users)
+ (erc-button--get-user-from-speaker-naive
+ (car bounds)))))
+ (cl-assert (null (erc-button--nick-data obj)))
+ (puthash downcased user erc-button--phantom-users)
+ (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user))
+ (erc-button--nick-user obj) user))
+ (list obj))
(_ args)))
(define-minor-mode erc-button--phantom-users-mode
@@ -402,12 +426,23 @@ erc-button-add-nickname-buttons
(gethash down erc-channel-users)))
(user (or (and cuser (car cuser))
(and erc-server-users
- (gethash down erc-server-users)))))
+ (gethash down erc-server-users))))
+ (data (list word)))
(when (or (not (functionp form))
- (setq bounds
- (funcall form bounds down user (cdr cuser))))
+ (and-let* ((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-erc-button-mouse-face obj)
+ erc-button-nickname-face
+ (erc-button--nick-erc-button-nickname-face obj)
+ erc-button-face
+ (erc-button--nick-erc-button-face obj))))
(erc-button-add-button (car bounds) (cdr bounds)
- fun t (list word)))))))))
+ fun t data))))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
--
2.39.2
[-- Attachment #3: 0002-5.6-Revise-FORM-as-function-interface-in-erc-button-.patch --]
[-- Type: text/x-patch, Size: 13410 bytes --]
From 513ea7d6034d6bc0c44955dcda4c7724699b52b9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 2/2] [5.6] Revise FORM-as-function interface in
erc-button-alist
* lisp/erc/erc-button.el (erc-button-alist): Remove redundant "<URL:
foo>" entry, which adds nothing beyond highlighting the surrounding
bookends at the expense of doubling up on face properties for no
reason. Revise the FORM-as-function interface by removing
the dynamic binding of face options and weird bounds-as-a-cons
parameter. Instead, just treat any such function, when present, as a
replacement for `erc-button-add-button'.
(erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it
handle all accepted FORM types other than booleans.
(erc-button-add-buttons-1): Rework to only check FORM field once.
(erc-button--substitute-command-keys-in-region,
erc-button--display-error-with-buttons): Rename former as latter and
change signature to conform to new `erc-button-add-buttons' interface.
(erc-button--display-error-notice-with-keys): Call renamed helper.
* test/lisp/erc/erc-button-tests.el (erc-button-alist--url,
erc-button-tests--form, erc-button-tests--some-var,
erc-button-tests--erc-button-alist--function-as-form,
erc-button-alist--function-as-form,
erc-button-tests--erc-button-alist--nil-form,
erc-button-alist---nil-form): Add tests and helpers. (Bug#60933.)
---
lisp/erc/erc-button.el | 91 +++++++++++++------------
test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++
2 files changed, 151 insertions(+), 46 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 5d8fd03615b..4829e8b7be2 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -128,7 +128,6 @@ erc-button-alist
;; things hard to maintain.
'((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
(erc-button-url-regexp 0 t browse-url-button-open-url 0)
- ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
@@ -166,17 +165,14 @@ erc-button-alist
BUTTON is the number of the regexp grouping actually matching the
button. This is ignored if REGEXP is `nicknames'.
-FORM is a Lisp symbol for a special variable whose value must be
- true for the button to be added. Alternatively, when REGEXP is
- not `nicknames', FORM can be a function whose arguments are BEG
- and END, the bounds of the button in the current buffer. It's
- expected to return a cons of (possibly identical) bounds or
- nil, to deny. For the extent of the call, all face options
- defined for the button module are re-bound, shadowing
- themselves, so the function is free to change their values.
- When regexp is the special symbol `nicknames', FORM must be the
- symbol `erc-button-buttonize-nicks'. Specifying anything else
- is deprecated.
+FORM is either a boolean or a special variable whose value must
+ be non-nil for the button to be added. When REGEXP is the
+ special symbol `nicknames', FORM must be the symbol
+ `erc-button-buttonize-nicks'. Anything else is deprecated.
+ For all other entries, FORM can also be a function to call in
+ place of `erc-button-add-button' with the exact same arguments.
+ When FORM is also a special variable, ERC disregards the
+ variable and calls the function.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -288,15 +284,18 @@ erc-button-add-buttons
entry)))))))))))
(defun erc-button--maybe-warn-arbitrary-sexp (form)
- (if (and (symbolp form) (special-variable-p form))
- (symbol-value form)
- (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
- (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
- (lwarn 'erc :warning
- (concat "Arbitrary sexps for the third FORM"
- " slot of `erc-button-alist' entries"
- " have been deprecated.")))
- (eval form t)))
+ (cl-assert (not (booleanp form))) ; covered by caller
+ ;; If a special-variable is also a function, favor the function.
+ (cond ((functionp form) form)
+ ((and (symbolp form) (special-variable-p form)) (symbol-value form))
+ (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp
+ 'warned-arbitrary-sexp)
+ (put 'erc-button--maybe-warn-arbitrary-sexp
+ 'warned-arbitrary-sexp t)
+ (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM"
+ " slot of `erc-button-alist' entries"
+ " have been deprecated.")))
+ (eval form t))))
(defun erc-button--check-nicknames-entry ()
;; This helper exists because the module is defined after its options.
@@ -447,22 +446,22 @@ erc-button-add-nickname-buttons
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
(goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let ((start (match-beginning (nth 1 entry)))
- (end (match-end (nth 1 entry)))
- (form (nth 2 entry))
- (fun (nth 3 entry))
- (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
- (when (or (eq t form)
- (and (functionp form)
- (let* ((erc-button-face erc-button-face)
- (erc-button-mouse-face erc-button-mouse-face)
- (erc-button-nickname-face erc-button-nickname-face)
- (rv (funcall form start end)))
- (when rv
- (setq end (cdr rv) start (car rv)))))
- (erc-button--maybe-warn-arbitrary-sexp form))
- (erc-button-add-button start end fun nil data regexp)))))
+ (let (buttonizer)
+ (while
+ (and (re-search-forward regexp nil t)
+ (or buttonizer
+ (setq buttonizer
+ (and-let*
+ ((raw-form (nth 2 entry))
+ (res (or (eq t raw-form)
+ (erc-button--maybe-warn-arbitrary-sexp
+ raw-form))))
+ (if (functionp res) res #'erc-button-add-button)))))
+ (let ((start (match-beginning (nth 1 entry)))
+ (end (match-end (nth 1 entry)))
+ (fun (nth 3 entry))
+ (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
+ (funcall buttonizer start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
"Remove all existing buttons.
@@ -717,15 +716,15 @@ erc-button-beats-to-time
(message "@%s is %d:%02d local time"
beats hours minutes)))
-(defun erc-button--substitute-command-keys-in-region (beg end)
+(defun erc-button--display-error-with-buttons
+ (from to fun nick-p &optional data regexp)
"Replace command in region with keys and return new bounds"
- (let* ((o (buffer-substring beg end))
- (s (substitute-command-keys o)))
- (unless (equal o s)
- (setq erc-button-face nil))
- (delete-region beg end)
- (insert s))
- (cons beg (point)))
+ (let* ((o (buffer-substring from to))
+ (s (substitute-command-keys o))
+ (erc-button-face (and (equal o s) erc-button-face)))
+ (delete-region from to)
+ (insert s)
+ (erc-button-add-button from (point) fun nick-p data regexp)))
;;;###autoload
(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
@@ -762,7 +761,7 @@ erc-button--display-error-notice-with-keys
erc-insert-post-hook))
(erc-button-alist
`((,(rx "\\[" (group (+ (not "]"))) "]") 0
- erc-button--substitute-command-keys-in-region
+ erc-button--display-error-with-buttons
erc-button-describe-symbol 1)
,@erc-button-alist)))
(erc-display-message parsed '(notice error) (or buffer 'active) string)
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index ced08d117bc..6a6f6934389 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -23,6 +23,112 @@
(require 'erc-button)
+(ert-deftest erc-button-alist--url ()
+ (setq erc-server-process
+ (start-process "sleep" (current-buffer) "sleep" "1"))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (with-current-buffer (erc--open-target "#chan")
+ (let ((verify
+ (lambda (p url)
+ (should (equal (get-text-property p 'erc-data) (list url)))
+ (should (equal (get-text-property p 'mouse-face) 'highlight))
+ (should (eq (get-text-property p 'font-lock-face) 'erc-button))
+ (should (eq (get-text-property p 'erc-callback)
+ 'browse-url-button-open-url)))))
+ (goto-char (point-min))
+
+ ;; Most common (unbracketed)
+ (erc-display-message nil nil (current-buffer)
+ "Foo https://example.com bar.")
+ (search-forward "https")
+ (funcall verify (point) "https://example.com")
+
+ ;; The <URL: form> still works despite being removed in ERC 5.6.
+ (erc-display-message nil nil (current-buffer)
+ "Foo <URL: https://gnu.org> bar.")
+ (search-forward "https")
+ (funcall verify (point) "https://gnu.org")
+
+ ;; Bracketed
+ (erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> bar.")
+ (search-forward "ftp")
+ (funcall verify (point) "ftp://gnu.org"))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(defvar erc-button-tests--form nil)
+(defvar erc-button-tests--some-var nil)
+
+(defun erc-button-tests--form (&rest rest)
+ (push rest erc-button-tests--form)
+ (apply #'erc-button-add-button rest))
+
+(defun erc-button-tests--erc-button-alist--function-as-form (func)
+ (setq erc-server-process
+ (start-process "sleep" (current-buffer) "sleep" "1"))
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (erc--open-target "#chan")
+ (let* ((erc-button-tests--form nil)
+ (entry (list (rx "+1") 0 func #'ignore 0))
+ (erc-button-alist (cons entry erc-button-alist)))
+
+ (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+ (erc-display-message nil nil (current-buffer) "+1")
+ (erc-display-message nil 'notice (current-buffer) "Spam")
+ (should (equal (pop erc-button-tests--form)
+ '(53 55 ignore nil ("+1") "\\+1")))
+ (should-not erc-button-tests--form)
+ (goto-char (point-min))
+ (search-forward "+")
+ (should (equal (get-text-property (point) 'erc-data) '("+1")))
+ (should (equal (get-text-property (point) 'mouse-face) 'highlight))
+ (should (eq (get-text-property (point) 'font-lock-face) 'erc-button))
+ (should (eq (get-text-property (point) 'erc-callback) 'ignore)))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc-button-alist--function-as-form ()
+ (erc-button-tests--erc-button-alist--function-as-form
+ #'erc-button-tests--form)
+
+ (erc-button-tests--erc-button-alist--function-as-form
+ (symbol-function #'erc-button-tests--form))
+
+ (erc-button-tests--erc-button-alist--function-as-form
+ (lambda (&rest r) (push r erc-button-tests--form)
+ (apply #'erc-button-add-button r))))
+
+(defun erc-button-tests--erc-button-alist--nil-form (form)
+ (setq erc-server-process
+ (start-process "sleep" (current-buffer) "sleep" "1"))
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (erc--open-target "#chan")
+ (let* ((erc-button-tests--form nil)
+ (entry (list (rx "+1") 0 form #'ignore 0))
+ (erc-button-alist (cons entry erc-button-alist)))
+
+ (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+ (erc-display-message nil nil (current-buffer) "+1")
+ (erc-display-message nil 'notice (current-buffer) "Spam")
+ (should-not erc-button-tests--form)
+ (goto-char (point-min))
+ (search-forward "+")
+ (should-not (get-text-property (point) 'erc-data))
+ (should-not (get-text-property (point) 'mouse-face))
+ (should-not (get-text-property (point) 'font-lock-face))
+ (should-not (get-text-property (point) 'erc-callback)))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc-button-alist--nil-form ()
+ (erc-button-tests--erc-button-alist--nil-form nil)
+ (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var))
+
(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
(let ((msg (erc-format-privmessage speaker
--
2.39.2
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
[not found] ` <877cu9qnyo.fsf@neverwas.me>
@ 2023-04-29 15:56 ` J.P.
0 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-04-29 15:56 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1574 bytes --]
"J.P." <jp@neverwas.me> writes:
> The same general thinking applies to the nicks-specific buttonizer as
> well, though it being intrinsically special and, for now, internal means
> we can take more liberties in inconveniencing its consumers (which are
> all built-in modules). Thus, I'm proposing we replace the slightly
> unwieldy set of positional params with a single passed-around struct,
> which members of the interface's "advice stack" can modify at will. See
> implementation for details.
Previously, consumers of the new nick-buttonizer interface were given a
look at every single word in a message. But they should only really care
about those with an associated `erc-server-user' object, meaning known
nicks. And while it's true that some might want to create these
associations on the fly, I think they're better off doing so earlier on,
both to help separate concerns and to skip the hassle of determining
whether a candidate is a speaker or a mention.
To that end, I've carved out a couple more access points to influence
how nick buttonizing happens. Both use the same pattern of "local advice
around a function-interface variable," which I've come to regard as the
most predictable and flexible for building new internal APIs. The first
lives in `erc-server-PRIVMSG' and integrates with the old
`erc-format-nick-function', which takes the user object it spits out.
The second runs right before the nick buttonizer but only as a fallback
when the usual means of finding an `erc-server-user' object from a
candidate fails. It's set to `ignore' by default.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 10375 bytes --]
From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 29 Apr 2023 08:18:09 -0700
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Revise FORM-as-function interface in erc-button-alist
[5.6] Improve erc-button--modify-nick-function interface
[5.6] Use getter for finding users in erc-server-PRIVMSG
lisp/erc/erc-backend.el | 4 +-
lisp/erc/erc-button.el | 240 +++++++++++++++++-------------
lisp/erc/erc.el | 39 ++++-
test/lisp/erc/erc-button-tests.el | 106 +++++++++++++
4 files changed, 280 insertions(+), 109 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4a394a10d44..f52cc1aaeaf 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -102,6 +102,7 @@
(require 'erc-common)
(defvar erc--target)
+(defvar erc--user-from-nick-function)
(defvar erc-auto-query)
(defvar erc-channel-list)
(defvar erc-channel-users)
@@ -1881,7 +1882,8 @@ define-erc-response-handler
;; at this point.
(erc-update-channel-member (if privp nick tgt) nick nick
privp nil nil nil nil nil host login nil nil t)
- (let ((cdata (erc-get-channel-user nick)))
+ (let ((cdata (funcall erc--user-from-nick-function
+ (erc-downcase nick) sndr parsed)))
(setq fnick (funcall erc-format-nick-function
(car cdata) (cdr cdata))))))
(cond
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 4829e8b7be2..638a2b20239 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -353,55 +353,56 @@ erc-button--modify-nick-function
(defvar-local erc-button--phantom-users nil)
-(defun erc-button--add-phantom-speaker (args)
- "Maybe substitute fake `server-user' for speaker at point."
- (pcase (car args)
- ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil)))
- ;; Like `with-memoization' but don't cache when value is nil.
- (when-let ((user (or (gethash downcased erc-button--phantom-users)
- (erc-button--get-user-from-speaker-naive
- (car bounds)))))
- (cl-assert (null (erc-button--nick-data obj)))
- (puthash downcased user erc-button--phantom-users)
- (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user))
- (erc-button--nick-user obj) user))
- (list obj))
- (_ args)))
-
+(defvar erc-button--fallback-user-function #'ignore
+ "Function to determine `erc-server-user' if not found in the usual places.
+Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when
+`erc-button-add-nickname-buttons' cannot find a user object for
+DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.")
+
+(defun erc-button--add-phantom-speaker (downcased nuh _parsed)
+ "Stash fictitious `erc-server-user' while processing \"PRIVMSG\".
+Expect DOWNCASED to be the downcased nickname, NUH to be a triple
+of (NICK LOGIN HOST), and parsed to be an `erc-response' object."
+ (pcase-let* ((`(,nick ,login ,host) nuh)
+ (user (or (gethash downcased erc-button--phantom-users)
+ (make-erc-server-user
+ :nickname nick
+ :host (and (not (string-empty-p host)) host)
+ :login (and (not (string-empty-p login)) login)))))
+ (list (puthash downcased user erc-button--phantom-users))))
+
+(defun erc-button--get-phantom-user (down _word _bounds)
+ (gethash down erc-button--phantom-users))
+
+;; In the future, we'll most likely create temporary
+;; `erc-channel-users' tables during BATCH chathistory playback, thus
+;; obviating the need for this mode entirely.
(define-minor-mode erc-button--phantom-users-mode
"Minor mode to recognize unknown speakers.
Expect to be used by module setup code for creating placeholder
users on the fly during history playback. Treat an unknown
-PRIVMSG speaker, like <bob>, as if they were present in a 353 and
-are thus a member of the channel. However, don't bother creating
-an actual `erc-channel-user' object because their status prefix
-is unknown. Instead, just spoof an `erc-server-user' by applying
-early (outer), args-filtering advice wrapping
-`erc-button--modify-nick-function'."
+\"PRIVMSG\" speaker, like \"<bob>\", as if they previously
+appeared in a prior \"353\" message and are thus a known member
+of the channel. However, don't bother creating an actual
+`erc-channel-user' object because their status prefix is unknown.
+Instead, just spoof an `erc-server-user' and stash it during
+\"PRIVMSG\" handling via `erc--user-from-nick-function' and
+retrieve it during buttonizing via
+`erc-button--fallback-user-function'."
:interactive nil
(if erc-button--phantom-users-mode
(progn
- (add-function :filter-args (local 'erc-button--modify-nick-function)
- #'erc-button--add-phantom-speaker '((depth . -90)))
+ (add-function :after-until (local 'erc--user-from-nick-function)
+ #'erc-button--add-phantom-speaker '((depth . -50)))
+ (add-function :after-until (local 'erc-button--fallback-user-function)
+ #'erc-button--get-phantom-user '((depth . 50)))
(setq erc-button--phantom-users (make-hash-table :test #'equal)))
- (remove-function (local 'erc-button--modify-nick-function)
+ (remove-function (local 'erc--user-from-nick-function)
#'erc-button--add-phantom-speaker)
+ (remove-function (local 'erc-button--fallback-user-function)
+ #'erc-button--get-phantom-user)
(kill-local-variable 'erc-nicks--phantom-users)))
-;; FIXME replace this after making ERC account-aware.
-(defun erc-button--get-user-from-speaker-naive (point)
- "Return `erc-server-user' object for nick at POINT."
- (when-let*
- (((eql ?< (char-before point)))
- ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face))
- (parsed (erc-get-parsed-vector point)))
- (pcase-let* ((`(,nick ,login ,host)
- (erc-parse-user (erc-response.sender parsed))))
- (make-erc-server-user
- :nickname nick
- :host (and (not (string-empty-p host)) host)
- :login (and (not (string-empty-p login)) login)))))
-
(defun erc-button-add-nickname-buttons (entry)
"Search through the buffer for nicknames, and add buttons."
(let ((form (nth 2 entry))
@@ -425,10 +426,13 @@ erc-button-add-nickname-buttons
(gethash down erc-channel-users)))
(user (or (and cuser (car cuser))
(and erc-server-users
- (gethash down 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* ((obj (funcall form (make-erc-button--nick
+ (and-let* ((user)
+ (obj (funcall form (make-erc-button--nick
:bounds bounds :data data
:downcased down :user user
:cuser (cdr cuser)))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 071bef649b3..56f36a758b8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4947,20 +4947,45 @@ erc-is-message-ctcp-and-not-action-p
(and (erc-is-message-ctcp-p message)
(not (string-match "^\C-aACTION.*\C-a$" message))))
+(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
+possibly nil `erc-channel-user' for formatting a server user's
+nick. Called in the appropriate buffer with the downcased nick,
+the parsed NUH, and the original `erc-response' object.")
+
+(defun erc--examine-nick (downcased _nuh _parsed)
+ (and erc-channel-users (gethash downcased erc-channel-users)))
+
+(defvar erc--format-speaker-functions nil
+ "Abnormal hook for formatting the speaker of a PRIVMSG or NOTICE.
+Called in a temp buffer narrowed to the nick and its surrounding
+adornments, typically angle brackets. Called with two args, BEG
+and END, indicating the bounds of the nick portion, which will
+already have a `font-lock-face' applied.")
+
(defun erc-format-privmessage (nick msg privp msgp)
"Format a PRIVMSG in an insertable fashion."
(let* ((mark-s (if msgp (if privp "*" "<") "-"))
(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))
(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-property (+ (length mark-s) (length nick)) (length str)
- 'font-lock-face msg-face str)
- str))
+ (with-temp-buffer
+ (insert mark-s) ; pretend `mark-s' and `mark-e' might be > length 1
+ (let ((beg (point)) end rest)
+ (insert nick)
+ (setq end (point))
+ (insert mark-e)
+ (setq rest (point))
+ ;; Insert before hook so members can widen to see entire msg.
+ (insert " " msg)
+ (put-text-property 1 (point) 'font-lock-face msg-face)
+ (put-text-property beg end 'font-lock-face nick-face)
+ (save-restriction
+ (narrow-to-region 1 rest)
+ (run-hook-with-args 'erc--format-speaker-functions beg end))
+ (buffer-string)))))
(defcustom erc-format-nick-function 'erc-format-nick
"Function to format a nickname for message display."
--
2.40.0
[-- Attachment #3: 0001-5.6-Revise-FORM-as-function-interface-in-erc-button-.patch --]
[-- Type: text/x-patch, Size: 13409 bytes --]
From 4542ad9bf3776ba92489acf226a70f314b0c1413 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 1/3] [5.6] Revise FORM-as-function interface in
erc-button-alist
* lisp/erc/erc-button.el (erc-button-alist): Remove redundant "<URL:
foo>" entry, which adds nothing beyond highlighting the surrounding
bookends at the expense of doubling up on face properties for no
reason. Revise the FORM-as-function interface by removing
the dynamic binding of face options and weird bounds-as-a-cons
parameter. Instead, just treat any such function, when present, as a
replacement for `erc-button-add-button'.
(erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it
handle all accepted FORM types other than booleans.
(erc-button-add-buttons-1): Rework to only check FORM field once.
(erc-button--substitute-command-keys-in-region,
erc-button--display-error-with-buttons): Rename former as latter and
change signature to conform to new `erc-button-add-buttons' interface.
(erc-button--display-error-notice-with-keys): Call renamed helper.
* test/lisp/erc/erc-button-tests.el (erc-button-alist--url,
erc-button-tests--form, erc-button-tests--some-var,
erc-button-tests--erc-button-alist--function-as-form,
erc-button-alist--function-as-form,
erc-button-tests--erc-button-alist--nil-form,
erc-button-alist---nil-form): Add tests and helpers. (Bug#60933)
---
lisp/erc/erc-button.el | 91 +++++++++++++------------
test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++
2 files changed, 151 insertions(+), 46 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e2447deecde..7376c18ad4c 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -128,7 +128,6 @@ erc-button-alist
;; things hard to maintain.
'((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
(erc-button-url-regexp 0 t browse-url-button-open-url 0)
- ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
@@ -166,17 +165,14 @@ erc-button-alist
BUTTON is the number of the regexp grouping actually matching the
button. This is ignored if REGEXP is `nicknames'.
-FORM is a Lisp symbol for a special variable whose value must be
- true for the button to be added. Alternatively, when REGEXP is
- not `nicknames', FORM can be a function whose arguments are BEG
- and END, the bounds of the button in the current buffer. It's
- expected to return a cons of (possibly identical) bounds or
- nil, to deny. For the extent of the call, all face options
- defined for the button module are re-bound, shadowing
- themselves, so the function is free to change their values.
- When regexp is the special symbol `nicknames', FORM must be the
- symbol `erc-button-buttonize-nicks'. Specifying anything else
- is deprecated.
+FORM is either a boolean or a special variable whose value must
+ be non-nil for the button to be added. When REGEXP is the
+ special symbol `nicknames', FORM must be the symbol
+ `erc-button-buttonize-nicks'. Anything else is deprecated.
+ For all other entries, FORM can also be a function to call in
+ place of `erc-button-add-button' with the exact same arguments.
+ When FORM is also a special variable, ERC disregards the
+ variable and calls the function.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
@@ -288,15 +284,18 @@ erc-button-add-buttons
entry)))))))))))
(defun erc-button--maybe-warn-arbitrary-sexp (form)
- (if (and (symbolp form) (special-variable-p form))
- (symbol-value form)
- (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
- (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
- (lwarn 'erc :warning
- (concat "Arbitrary sexps for the third FORM"
- " slot of `erc-button-alist' entries"
- " have been deprecated.")))
- (eval form t)))
+ (cl-assert (not (booleanp form))) ; covered by caller
+ ;; If a special-variable is also a function, favor the function.
+ (cond ((functionp form) form)
+ ((and (symbolp form) (special-variable-p form)) (symbol-value form))
+ (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp
+ 'warned-arbitrary-sexp)
+ (put 'erc-button--maybe-warn-arbitrary-sexp
+ 'warned-arbitrary-sexp t)
+ (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM"
+ " slot of `erc-button-alist' entries"
+ " have been deprecated.")))
+ (eval form t))))
(defun erc-button--check-nicknames-entry ()
;; This helper exists because the module is defined after its options.
@@ -412,22 +411,22 @@ erc-button-add-nickname-buttons
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
(goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let ((start (match-beginning (nth 1 entry)))
- (end (match-end (nth 1 entry)))
- (form (nth 2 entry))
- (fun (nth 3 entry))
- (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
- (when (or (eq t form)
- (and (functionp form)
- (let* ((erc-button-face erc-button-face)
- (erc-button-mouse-face erc-button-mouse-face)
- (erc-button-nickname-face erc-button-nickname-face)
- (rv (funcall form start end)))
- (when rv
- (setq end (cdr rv) start (car rv)))))
- (erc-button--maybe-warn-arbitrary-sexp form))
- (erc-button-add-button start end fun nil data regexp)))))
+ (let (buttonizer)
+ (while
+ (and (re-search-forward regexp nil t)
+ (or buttonizer
+ (setq buttonizer
+ (and-let*
+ ((raw-form (nth 2 entry))
+ (res (or (eq t raw-form)
+ (erc-button--maybe-warn-arbitrary-sexp
+ raw-form))))
+ (if (functionp res) res #'erc-button-add-button)))))
+ (let ((start (match-beginning (nth 1 entry)))
+ (end (match-end (nth 1 entry)))
+ (fun (nth 3 entry))
+ (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
+ (funcall buttonizer start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
"Remove all existing buttons.
@@ -682,15 +681,15 @@ erc-button-beats-to-time
(message "@%s is %d:%02d local time"
beats hours minutes)))
-(defun erc-button--substitute-command-keys-in-region (beg end)
+(defun erc-button--display-error-with-buttons
+ (from to fun nick-p &optional data regexp)
"Replace command in region with keys and return new bounds"
- (let* ((o (buffer-substring beg end))
- (s (substitute-command-keys o)))
- (unless (equal o s)
- (setq erc-button-face nil))
- (delete-region beg end)
- (insert s))
- (cons beg (point)))
+ (let* ((o (buffer-substring from to))
+ (s (substitute-command-keys o))
+ (erc-button-face (and (equal o s) erc-button-face)))
+ (delete-region from to)
+ (insert s)
+ (erc-button-add-button from (point) fun nick-p data regexp)))
;;;###autoload
(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
@@ -727,7 +726,7 @@ erc-button--display-error-notice-with-keys
erc-insert-post-hook))
(erc-button-alist
`((,(rx "\\[" (group (+ (not "]"))) "]") 0
- erc-button--substitute-command-keys-in-region
+ erc-button--display-error-with-buttons
erc-button-describe-symbol 1)
,@erc-button-alist)))
(erc-display-message parsed '(notice error) (or buffer 'active) string)
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index ced08d117bc..6a6f6934389 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -23,6 +23,112 @@
(require 'erc-button)
+(ert-deftest erc-button-alist--url ()
+ (setq erc-server-process
+ (start-process "sleep" (current-buffer) "sleep" "1"))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (with-current-buffer (erc--open-target "#chan")
+ (let ((verify
+ (lambda (p url)
+ (should (equal (get-text-property p 'erc-data) (list url)))
+ (should (equal (get-text-property p 'mouse-face) 'highlight))
+ (should (eq (get-text-property p 'font-lock-face) 'erc-button))
+ (should (eq (get-text-property p 'erc-callback)
+ 'browse-url-button-open-url)))))
+ (goto-char (point-min))
+
+ ;; Most common (unbracketed)
+ (erc-display-message nil nil (current-buffer)
+ "Foo https://example.com bar.")
+ (search-forward "https")
+ (funcall verify (point) "https://example.com")
+
+ ;; The <URL: form> still works despite being removed in ERC 5.6.
+ (erc-display-message nil nil (current-buffer)
+ "Foo <URL: https://gnu.org> bar.")
+ (search-forward "https")
+ (funcall verify (point) "https://gnu.org")
+
+ ;; Bracketed
+ (erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> bar.")
+ (search-forward "ftp")
+ (funcall verify (point) "ftp://gnu.org"))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(defvar erc-button-tests--form nil)
+(defvar erc-button-tests--some-var nil)
+
+(defun erc-button-tests--form (&rest rest)
+ (push rest erc-button-tests--form)
+ (apply #'erc-button-add-button rest))
+
+(defun erc-button-tests--erc-button-alist--function-as-form (func)
+ (setq erc-server-process
+ (start-process "sleep" (current-buffer) "sleep" "1"))
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (erc--open-target "#chan")
+ (let* ((erc-button-tests--form nil)
+ (entry (list (rx "+1") 0 func #'ignore 0))
+ (erc-button-alist (cons entry erc-button-alist)))
+
+ (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+ (erc-display-message nil nil (current-buffer) "+1")
+ (erc-display-message nil 'notice (current-buffer) "Spam")
+ (should (equal (pop erc-button-tests--form)
+ '(53 55 ignore nil ("+1") "\\+1")))
+ (should-not erc-button-tests--form)
+ (goto-char (point-min))
+ (search-forward "+")
+ (should (equal (get-text-property (point) 'erc-data) '("+1")))
+ (should (equal (get-text-property (point) 'mouse-face) 'highlight))
+ (should (eq (get-text-property (point) 'font-lock-face) 'erc-button))
+ (should (eq (get-text-property (point) 'erc-callback) 'ignore)))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc-button-alist--function-as-form ()
+ (erc-button-tests--erc-button-alist--function-as-form
+ #'erc-button-tests--form)
+
+ (erc-button-tests--erc-button-alist--function-as-form
+ (symbol-function #'erc-button-tests--form))
+
+ (erc-button-tests--erc-button-alist--function-as-form
+ (lambda (&rest r) (push r erc-button-tests--form)
+ (apply #'erc-button-add-button r))))
+
+(defun erc-button-tests--erc-button-alist--nil-form (form)
+ (setq erc-server-process
+ (start-process "sleep" (current-buffer) "sleep" "1"))
+ (set-process-query-on-exit-flag erc-server-process nil)
+
+ (with-current-buffer (erc--open-target "#chan")
+ (let* ((erc-button-tests--form nil)
+ (entry (list (rx "+1") 0 form #'ignore 0))
+ (erc-button-alist (cons entry erc-button-alist)))
+
+ (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+ (erc-display-message nil nil (current-buffer) "+1")
+ (erc-display-message nil 'notice (current-buffer) "Spam")
+ (should-not erc-button-tests--form)
+ (goto-char (point-min))
+ (search-forward "+")
+ (should-not (get-text-property (point) 'erc-data))
+ (should-not (get-text-property (point) 'mouse-face))
+ (should-not (get-text-property (point) 'font-lock-face))
+ (should-not (get-text-property (point) 'erc-callback)))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc-button-alist--nil-form ()
+ (erc-button-tests--erc-button-alist--nil-form nil)
+ (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var))
+
(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
(let ((msg (erc-format-privmessage speaker
--
2.40.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Improve-erc-button-modify-nick-function-interfac.patch --]
[-- Type: text/x-patch, Size: 7664 bytes --]
From 9a3f8710e5aabd0975ea242142600a51bdcc9be7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 2/3] [5.6] Improve erc-button--modify-nick-function interface
* lisp/erc/erc-button.el (erc-button--check-nicknames-entry): Remove
unused let binding.
(erc-button--nick): New struct.
(erc-button--preserve-bounds): Rework to expect `erc-button--nick'
object.
(erc-button--modify-nick-function): Reexplain interface base on
`erc-button--nick' object.
(erc-button--add-phantom-speaker): Redo to expect `erc-button--nick'
object.
(erc-button-add-nickname-buttons): Rework slightly to use
`erc-button--nick' when calling `erc-button--modify-nick-function'.
(Bug#60933)
---
lisp/erc/erc-button.el | 92 +++++++++++++++++++++++++++++-------------
1 file changed, 64 insertions(+), 28 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 7376c18ad4c..b427b72ee5d 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -299,16 +299,42 @@ erc-button--maybe-warn-arbitrary-sexp
(defun erc-button--check-nicknames-entry ()
;; This helper exists because the module is defined after its options.
- (when-let (((eq major-mode 'erc-mode))
- (entry (alist-get 'nicknames erc-button-alist)))
- (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+ (when (eq major-mode 'erc-mode)
+ (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist))
+ 'erc-button-buttonize-nicks)
(erc-button--display-error-notice-with-keys-and-warn
"Values other than `erc-button-buttonize-nicks' in the third slot of "
"the `nicknames' entry of `erc-button-alist' are deprecated."))))
-(defun erc-button--preserve-bounds (bounds _ server-user _)
- "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
- (and server-user bounds))
+(cl-defstruct erc-button--nick
+ ;; Indicates the nick's position in the current message. BEG is
+ ;; normally also point.
+ ( bounds nil :type cons
+ :documentation "A cons of (BEG . END).")
+ ;; NICK is the original, non-casemapped nickname and REST is a
+ ;; possibly empty list of opaque objects. If non-nil, the entire
+ ;; cons should be mutated rather than replaced because it's used as
+ ;; a key in hash tables and text-property searches.
+ ( data nil :type (or null cons)
+ :documentation "A unique cons of (NICK . REST).")
+ ( downcased nil :type (or null string)
+ :documentation "The case-mapped nickname sans text properties.")
+ ;; Not necessarily present in `erc-server-users'.
+ ( user nil :type (or null erc-server-user)
+ :documentation "A possibly nil or spoofed `erc-server-user'.")
+ ;; The CDR of a value from an `erc-channel-users' table.
+ ( cuser nil :type (or null erc-channel-user)
+ :documentation "A possibly nil `erc-channel-user'.")
+ ( erc-button-face erc-button-face :type symbol
+ :documentation "Temp `erc-button-face' while buttonizing.")
+ ( erc-button-nickname-face erc-button-nickname-face :type symbol
+ :documentation "Temp `erc-button-nickname-face' while buttonizing.")
+ ( erc-button-mouse-face erc-button-mouse-face :type symbol
+ :documentation "Temp `erc-button-mouse-face' while buttonizing."))
+
+(defun erc-button--preserve-bounds (nick-object)
+ "Return NICK-OBJECT when its user slot is non-empty."
+ (and (erc-button--nick-user nick-object) nick-object))
;; This variable is intended to serve as a "core" to be wrapped by
;; (built-in) modules during setup. It's unclear whether
@@ -319,29 +345,27 @@ erc-button--preserve-bounds
(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
"Function to possibly modify aspects of nick being buttonized.
-Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
-BOUNDS is a cons of (BEG . END) marking the position of the nick
-in the current message, which occupies the whole of the narrowed
-buffer. BEG is normally also point. NICKNAME is a case-mapped
-string without text properties. SERVER-USER and CHANNEL-USER are
-the nick's `erc-server-users' entry and its associated (though
-possibly nil) `erc-channel-user' object. The function should
-return BOUNDS or a suitable replacement to indicate that
-buttonizing ought to proceed, and nil if it should be inhibited.")
+Called with one argument, an `erc-button--nick' object, or nil.
+The function should return the same (or similar) object when
+buttonizing ought to proceed and nil otherwise. While running,
+all faces defined in `erc-button' are bound temporarily and can
+be updated at will.")
(defvar-local erc-button--phantom-users nil)
(defun erc-button--add-phantom-speaker (args)
"Maybe substitute fake `server-user' for speaker at point."
- (pcase args
- (`(,bounds ,downcased-nick nil ,channel-user)
- (list bounds downcased-nick
- ;; Like `with-memoization' but don't cache when value is nil.
- (or (gethash downcased-nick erc-button--phantom-users)
- (and-let* ((user (erc-button--get-user-from-speaker-naive
- (car bounds))))
- (puthash downcased-nick user erc-button--phantom-users)))
- channel-user))
+ (pcase (car args)
+ ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil)))
+ ;; Like `with-memoization' but don't cache when value is nil.
+ (when-let ((user (or (gethash downcased erc-button--phantom-users)
+ (erc-button--get-user-from-speaker-naive
+ (car bounds)))))
+ (cl-assert (null (erc-button--nick-data obj)))
+ (puthash downcased user erc-button--phantom-users)
+ (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user))
+ (erc-button--nick-user obj) user))
+ (list obj))
(_ args)))
(define-minor-mode erc-button--phantom-users-mode
@@ -401,12 +425,24 @@ erc-button-add-nickname-buttons
(gethash down erc-channel-users)))
(user (or (and cuser (car cuser))
(and erc-server-users
- (gethash down erc-server-users)))))
+ (gethash down erc-server-users))))
+ (data (list word)))
(when (or (not (functionp form))
- (setq bounds
- (funcall form bounds down user (cdr cuser))))
+ (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-erc-button-mouse-face obj)
+ erc-button-nickname-face
+ (erc-button--nick-erc-button-nickname-face obj)
+ erc-button-face
+ (erc-button--nick-erc-button-face obj))))
(erc-button-add-button (car bounds) (cdr bounds)
- fun t (list word)))))))))
+ fun t data))))))))
(defun erc-button-add-buttons-1 (regexp entry)
"Search through the buffer for matches to ENTRY and add buttons."
--
2.40.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Use-getter-for-finding-users-in-erc-server-PRIVM.patch --]
[-- Type: text/x-patch, Size: 11347 bytes --]
From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 28 Apr 2023 06:34:09 -0700
Subject: [PATCH 3/3] [5.6] Use getter for finding users in erc-server-PRIVMSG
* lisp/erc/erc-backend.el (erc-server-PRIVMSG): Call new hook
`erc--user-from-nick-function' for turning the sender's nick into a
channel user, if any.
* lisp/erc/erc-button.el (erc-button--add-phantom-speaker): Redo
completely using simplified API.
(erc-button--fallback-user-function): Add internal function-interface
variable for finding an `erc-server-user' object when the usual places
disappoint.
(erc-button--get-phantom-user): Add new function, a getter for
`erc-button--phantom-users'.
(erc-button--phantom-users-mode): Replace advice subscription for
`erc-button--modify-nick-function' with one for
`erc-button--user-from-nick-function' and one for
`erc-button--fallback-user-function'.
(erc-button--get-user-from-speaker-naive): Remove unused function.
(erc-button--add-nickname-buttons): Call
`erc-button--fallback-user-function' when a user can't be found in
`erc-server-users' or `erc-channel-users'.
* lisp/erc/erc.el (erc--user-from-nick-function): New
function-interface variable for determining an `erc-server-user'
`erc-channel-user' pair from the sender's nick.
(erc--examine-nick): Add new function to serve as default value for
`erc--user-from-nick-function'.
(erc--format-speaker-functions): Add new internal
hook to adjust formatted speaker of a private message.
(erc-format-privmessage): Run hook `erc--format-speaker-functions' in
temporary buffer narrowed to speaker's formatted nick. This and the
hook will likely be removed unless an immediate use case arises. In
the long term, this may be useful for offering alternate styling for
speaker names, e.g., other than "<bob>". (Bug#60933)
---
lisp/erc/erc-backend.el | 4 +-
lisp/erc/erc-button.el | 81 +++++++++++++++++++++--------------------
lisp/erc/erc.el | 39 ++++++++++++++++----
3 files changed, 77 insertions(+), 47 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4a394a10d44..f52cc1aaeaf 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -102,6 +102,7 @@
(require 'erc-common)
(defvar erc--target)
+(defvar erc--user-from-nick-function)
(defvar erc-auto-query)
(defvar erc-channel-list)
(defvar erc-channel-users)
@@ -1881,7 +1882,8 @@ define-erc-response-handler
;; at this point.
(erc-update-channel-member (if privp nick tgt) nick nick
privp nil nil nil nil nil host login nil nil t)
- (let ((cdata (erc-get-channel-user nick)))
+ (let ((cdata (funcall erc--user-from-nick-function
+ (erc-downcase nick) sndr parsed)))
(setq fnick (funcall erc-format-nick-function
(car cdata) (cdr cdata))))))
(cond
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index b427b72ee5d..638a2b20239 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -353,55 +353,56 @@ erc-button--modify-nick-function
(defvar-local erc-button--phantom-users nil)
-(defun erc-button--add-phantom-speaker (args)
- "Maybe substitute fake `server-user' for speaker at point."
- (pcase (car args)
- ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil)))
- ;; Like `with-memoization' but don't cache when value is nil.
- (when-let ((user (or (gethash downcased erc-button--phantom-users)
- (erc-button--get-user-from-speaker-naive
- (car bounds)))))
- (cl-assert (null (erc-button--nick-data obj)))
- (puthash downcased user erc-button--phantom-users)
- (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user))
- (erc-button--nick-user obj) user))
- (list obj))
- (_ args)))
-
+(defvar erc-button--fallback-user-function #'ignore
+ "Function to determine `erc-server-user' if not found in the usual places.
+Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when
+`erc-button-add-nickname-buttons' cannot find a user object for
+DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.")
+
+(defun erc-button--add-phantom-speaker (downcased nuh _parsed)
+ "Stash fictitious `erc-server-user' while processing \"PRIVMSG\".
+Expect DOWNCASED to be the downcased nickname, NUH to be a triple
+of (NICK LOGIN HOST), and parsed to be an `erc-response' object."
+ (pcase-let* ((`(,nick ,login ,host) nuh)
+ (user (or (gethash downcased erc-button--phantom-users)
+ (make-erc-server-user
+ :nickname nick
+ :host (and (not (string-empty-p host)) host)
+ :login (and (not (string-empty-p login)) login)))))
+ (list (puthash downcased user erc-button--phantom-users))))
+
+(defun erc-button--get-phantom-user (down _word _bounds)
+ (gethash down erc-button--phantom-users))
+
+;; In the future, we'll most likely create temporary
+;; `erc-channel-users' tables during BATCH chathistory playback, thus
+;; obviating the need for this mode entirely.
(define-minor-mode erc-button--phantom-users-mode
"Minor mode to recognize unknown speakers.
Expect to be used by module setup code for creating placeholder
users on the fly during history playback. Treat an unknown
-PRIVMSG speaker, like <bob>, as if they were present in a 353 and
-are thus a member of the channel. However, don't bother creating
-an actual `erc-channel-user' object because their status prefix
-is unknown. Instead, just spoof an `erc-server-user' by applying
-early (outer), args-filtering advice wrapping
-`erc-button--modify-nick-function'."
+\"PRIVMSG\" speaker, like \"<bob>\", as if they previously
+appeared in a prior \"353\" message and are thus a known member
+of the channel. However, don't bother creating an actual
+`erc-channel-user' object because their status prefix is unknown.
+Instead, just spoof an `erc-server-user' and stash it during
+\"PRIVMSG\" handling via `erc--user-from-nick-function' and
+retrieve it during buttonizing via
+`erc-button--fallback-user-function'."
:interactive nil
(if erc-button--phantom-users-mode
(progn
- (add-function :filter-args (local 'erc-button--modify-nick-function)
- #'erc-button--add-phantom-speaker '((depth . -90)))
+ (add-function :after-until (local 'erc--user-from-nick-function)
+ #'erc-button--add-phantom-speaker '((depth . -50)))
+ (add-function :after-until (local 'erc-button--fallback-user-function)
+ #'erc-button--get-phantom-user '((depth . 50)))
(setq erc-button--phantom-users (make-hash-table :test #'equal)))
- (remove-function (local 'erc-button--modify-nick-function)
+ (remove-function (local 'erc--user-from-nick-function)
#'erc-button--add-phantom-speaker)
+ (remove-function (local 'erc-button--fallback-user-function)
+ #'erc-button--get-phantom-user)
(kill-local-variable 'erc-nicks--phantom-users)))
-;; FIXME replace this after making ERC account-aware.
-(defun erc-button--get-user-from-speaker-naive (point)
- "Return `erc-server-user' object for nick at POINT."
- (when-let*
- (((eql ?< (char-before point)))
- ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face))
- (parsed (erc-get-parsed-vector point)))
- (pcase-let* ((`(,nick ,login ,host)
- (erc-parse-user (erc-response.sender parsed))))
- (make-erc-server-user
- :nickname nick
- :host (and (not (string-empty-p host)) host)
- :login (and (not (string-empty-p login)) login)))))
-
(defun erc-button-add-nickname-buttons (entry)
"Search through the buffer for nicknames, and add buttons."
(let ((form (nth 2 entry))
@@ -425,7 +426,9 @@ erc-button-add-nickname-buttons
(gethash down erc-channel-users)))
(user (or (and cuser (car cuser))
(and erc-server-users
- (gethash down 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)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 071bef649b3..56f36a758b8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4947,20 +4947,45 @@ erc-is-message-ctcp-and-not-action-p
(and (erc-is-message-ctcp-p message)
(not (string-match "^\C-aACTION.*\C-a$" message))))
+(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
+possibly nil `erc-channel-user' for formatting a server user's
+nick. Called in the appropriate buffer with the downcased nick,
+the parsed NUH, and the original `erc-response' object.")
+
+(defun erc--examine-nick (downcased _nuh _parsed)
+ (and erc-channel-users (gethash downcased erc-channel-users)))
+
+(defvar erc--format-speaker-functions nil
+ "Abnormal hook for formatting the speaker of a PRIVMSG or NOTICE.
+Called in a temp buffer narrowed to the nick and its surrounding
+adornments, typically angle brackets. Called with two args, BEG
+and END, indicating the bounds of the nick portion, which will
+already have a `font-lock-face' applied.")
+
(defun erc-format-privmessage (nick msg privp msgp)
"Format a PRIVMSG in an insertable fashion."
(let* ((mark-s (if msgp (if privp "*" "<") "-"))
(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))
(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-property (+ (length mark-s) (length nick)) (length str)
- 'font-lock-face msg-face str)
- str))
+ (with-temp-buffer
+ (insert mark-s) ; pretend `mark-s' and `mark-e' might be > length 1
+ (let ((beg (point)) end rest)
+ (insert nick)
+ (setq end (point))
+ (insert mark-e)
+ (setq rest (point))
+ ;; Insert before hook so members can widen to see entire msg.
+ (insert " " msg)
+ (put-text-property 1 (point) 'font-lock-face msg-face)
+ (put-text-property beg end 'font-lock-face nick-face)
+ (save-restriction
+ (narrow-to-region 1 rest)
+ (run-hook-with-args 'erc--format-speaker-functions beg end))
+ (buffer-string)))))
(defcustom erc-format-nick-function 'erc-format-nick
"Function to format a nickname for message display."
--
2.40.0
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
` (2 preceding siblings ...)
[not found] ` <87fsaekmv4.fsf@neverwas.me>
@ 2023-05-23 13:35 ` J.P.
2023-06-02 14:07 ` J.P.
` (2 subsequent siblings)
6 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-05-23 13:35 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 479 bytes --]
The new DWIM `erc-tab' command defers to pcomplete inside the prompt
area and runs a hook otherwise. But the hook's interface demands that
implementing members handle a raw prefix arg for no compelling reason.
And most of these members are movement-focused commands whose natural
interactive spec tends to be numeric, making for some roundabout
boilerplate awkwardness. This patch switches to numeric prefixes
everywhere, which is how things likely should have been originally.
[-- Attachment #2: 0001-5.6-Simplify-erc-tab-interface.patch --]
[-- Type: text/x-patch, Size: 4266 bytes --]
From 3ad4da1dc674226339af1437de8c0552316d5b89 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 22 May 2023 23:42:11 -0700
Subject: [PATCH] [5.6] Simplify erc-tab interface
* etc/ERC-NEWS: Improve section mentioning `erc-tab'.
* lisp/erc/erc-button.el (erc-button-alist): Restore a commented out
version of the "<URL ...>" entry, which was dropped in 5adda2f4683
"Revise FORM-as-function interface in erc-button-alist" for being
redundant and hence wasteful. This may help any unlikely objectors
better adapt to the churn.
(erc-button-next, erc-button-previous): Don't bother accommodating raw
prefix arguments; expect numeric arguments only.
* lisp/erc/erc.el (erc-tab): Change interactive spec to lowercase
"p". (Bug#60933)
---
etc/ERC-NEWS | 12 ++++++------
lisp/erc/erc-button.el | 7 +++----
lisp/erc/erc.el | 8 ++++----
3 files changed, 13 insertions(+), 14 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index d257bdcbf51..3d110ca43c6 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -215,12 +215,12 @@ changes are encouraged to voice their concerns on the bug list.
*** Miscellaneous changes
Two helper macros from GNU ELPA's Compat library are now available to
third-party modules as 'erc-compat-call' and 'erc-compat-function'.
-In the area of buttons, 'Info-goto-node' has been supplanted by plain
-old 'info' in 'erc-button-alist', and the bracketed "<URL:...>"
-pattern entry has been removed because it was more or less redundant.
-And the "TAB" key is now bound to a new command, 'erc-tab', that only
-calls 'completion-at-point' when point is in the input area and
-module-specific commands, like 'erc-button-next', otherwise.
+In 'erc-button-alist', 'Info-goto-node' has been supplanted by plain
+old 'info', and the "<URL:...>" entry has been removed because it was
+more or less redundant. In all ERC buffers, the "<TAB>" key is now
+bound to a new command, 'erc-tab', that calls 'completion-at-point'
+inside the input area and otherwise dispatches module-specific
+commands, like 'erc-button-next'.
\f
* Changes in ERC 5.5
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 4307dc3b860..33b93ff6744 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -128,6 +128,7 @@ erc-button-alist
;; things hard to maintain.
'((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
(erc-button-url-regexp 0 t browse-url-button-open-url 0)
+ ;; ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
@@ -629,15 +630,13 @@ erc-button-next
"Go to the ARGth next button."
(declare (advertised-calling-convention (arg) "30.1"))
(interactive "p")
- (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg)))
- (erc--button-next arg))
+ (erc--button-next (or arg 1)))
(defun erc-button-previous (&optional arg)
"Go to ARGth previous button."
(declare (advertised-calling-convention (arg) "30.1"))
(interactive "p")
- (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg)))
- (erc--button-next (- arg)))
+ (erc--button-next (- (or arg 1))))
(defun erc-button-previous-of-nick (arg)
"Go to ARGth previous button for nick at point."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0be9eb69432..b8ad37a55a0 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4773,11 +4773,11 @@ erc--tab-functions
"Functions to try when user hits \\`TAB' outside of input area.
Called with a numeric prefix arg.")
-(defun erc-tab (&optional arg)
+(defun erc-tab (arg)
"Call `completion-at-point' when typing in the input area.
-Otherwise call members of `erc--tab-functions' with raw prefix
-ARG until one of them returns non-nil."
- (interactive "P")
+Otherwise call members of `erc--tab-functions' with a numeric
+prefix ARG until one of them returns non-nil."
+ (interactive "p")
(if (>= (point) erc-input-marker)
(completion-at-point)
(run-hook-with-args-until-success 'erc--tab-functions arg)))
--
2.40.0
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
` (3 preceding siblings ...)
2023-05-23 13:35 ` J.P.
@ 2023-06-02 14:07 ` J.P.
2023-09-13 14:09 ` J.P.
[not found] ` <87wmwuyxjh.fsf@neverwas.me>
6 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-06-02 14:07 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1072 bytes --]
Some of the recent changes to this module were perhaps not handled as
sensibly as they could've been. The broad strokes seem sane enough, but
a few key aspects affecting the user experience were left too rough
around the edges for my taste. My main gripe involves the partial
deprecation of the `nicknames' entry for the option `erc-button-alist'.
After some reflection, I'm now of the opinion that imposing a specific
constraint on a specific slot in a specific default entry that may not
even be present after customization is just too messy a notion to foist
on users or to try and communicate in a doc string.
A better approach, I now feel, is to remove the troublesome `nicknames'
entry altogether and take special care behind the scenes to gracefully
accommodate users who still have it present in their configs. The
attached changes attempt something like this and also tidy up other odds
and ends in erc-button.el. Note that the second patch also appears in
bug#63569 and is only included here for its ERC-NEWS changes, which
touch on some of the above. Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Deprecate-nicknames-entry-in-erc-button-alist.patch --]
[-- Type: text/x-patch, Size: 13426 bytes --]
From 627670ff54fbbd0b5278e538cea34c275ffc249d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 1 Jun 2023 22:07:03 -0700
Subject: [PATCH 1/2] [5.6] Deprecate nicknames entry in erc-button-alist
* lisp/erc/erc-button.el (erc-button-mode, erc-button-enable,
erc-button-disable): Restore running `erc-button-setup' on
`erc-mode-hook' and also immediately in all ERC buffers.
Do this instead of calling `erc-button--check-nicknames-entry.
(erc-button-buttonize-nicks): Mention that this must be non-nil for
all but the most basic client functionality.
(erc-button-alist): Remove `nicknames' entry. Describe deprecation,
replacement behavior, and escape hatches in doc string. Update and
improve custom type definition.
(erc-button-keys-added): Deprecate because unused and misleading: keys
are bound during module init.
(erc-button--has-nickname-entry): New variable to indicate whether to
follow legacy code path when a `nicknames' entry exists in
`erc-button-alist'.
(erc-button-setup): Rewrite to provide warnings about deprecated
values for `erc-button-alist'.
(erc-button-nickname-callback-function): Add escape hatch for those
needing a custom callback for what was the default `nickname' entry in
`erc-button-alist'.
(erc-button-add-buttons): Always run `erc-button-add-nickname-buttons'
unless `erc-button--has-nickname-entry' is non-nil.
(erc-button--maybe-warn-arbitrary-sexp, erc-button--extract-form):
Rename former to latter and abstain from emitting a warning.
(erc-button--check-nicknames-entry): Remove unused function.
(erc-button-add-nickname-buttons): Defer to `erc-button--extract-form'
for determining value of third FORM slot of entry.
(erc-button-add-buttons-1): Call renamed version of
`erc-button--maybe-warn-arbitrary-sexp'. (Bug#60933)
---
lisp/erc/erc-button.el | 134 ++++++++++++++++++++++++-----------------
1 file changed, 78 insertions(+), 56 deletions(-)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 33b93ff6744..22ef3dc4846 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,13 +52,15 @@ erc-button
;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
- ((erc-button--check-nicknames-entry)
- (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+ ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
+ (add-hook 'erc-mode-hook #'erc-button-setup)
+ (unless erc--updating-modules-p (erc-buffer-filter #'erc-button-setup))
(add-hook 'erc--tab-functions #'erc-button-next)
(erc--modify-local-map t "<backtab>" #'erc-button-previous))
((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons)
(remove-hook 'erc-send-modify-hook #'erc-button-add-buttons)
+ (remove-hook 'erc-mode-hook #'erc-button-setup)
(remove-hook 'erc--tab-functions #'erc-button-next)
(erc--modify-local-map nil "<backtab>" #'erc-button-previous)))
@@ -103,7 +105,10 @@ erc-button-wrap-long-urls
:type '(choice integer boolean))
(defcustom erc-button-buttonize-nicks t
- "Flag indicating whether nicks should be buttonized or not."
+ "Flag indicating whether nicks should be buttonized.
+Note that beginning in ERC 5.6, some functionality provided by
+other modules, such as `fill-wrap', may depend on this option
+being non-nil."
:type 'boolean)
(defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s"
@@ -126,8 +131,7 @@ erc-button-alist
;; a button, it makes no sense to optimize performance by
;; bytecompiling lambdas in this alist. On the other hand, it makes
;; things hard to maintain.
- '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
- (erc-button-url-regexp 0 t browse-url-button-open-url 0)
+ '((erc-button-url-regexp 0 t browse-url-button-open-url 0)
;; ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
@@ -159,41 +163,45 @@ erc-button-alist
strings, or an alist with the strings in the car. Note that
entries in lists or alists are considered to be nicks or other
complete words. Therefore they are enclosed in \\< and \\>
- while searching. REGEXP can also be the symbol
- `nicknames', which matches the nickname of any user on the
- current server.
+ while searching. Also, use of the special symbol `nicknames'
+ for this slot was deprecated in ERC 5.6, but users can still
+ use `erc-button-buttonize-nicks' to control whether nicks get
+ buttonized. And because customizing a corresponding CALLBACK
+ is no longer possible, an escape hatch has been provided via
+ the variable `erc-button-nickname-callback-function'.
BUTTON is the number of the regexp grouping actually matching the
- button. This is ignored if REGEXP is `nicknames'.
+ button.
FORM is either a boolean or a special variable whose value must
- be non-nil for the button to be added. When REGEXP is the
- special symbol `nicknames', FORM must be the symbol
- `erc-button-buttonize-nicks'. Anything else is deprecated.
- For all other entries, FORM can also be a function to call in
- place of `erc-button-add-button' with the exact same arguments.
- When FORM is also a special variable, ERC disregards the
- variable and calls the function.
+ be non-nil for the button to be added. It can also be a
+ function to call in place of `erc-button-add-button' with the
+ exact same arguments. When FORM is also a special variable,
+ ERC disregards the variable and calls the function. Note that
+ arbitrary s-expressions were deprecated in ERC 5.6 and may not
+ be respected in the future. If necessary, users can instead
+ supply a function that calls `erc-button-add-button' after
+ first checking some condition.
CALLBACK is the function to call when the user push this button.
CALLBACK can also be a symbol. Its variable value will be used
as the callback function.
PAR is a number of a regexp grouping whose text will be passed to
- CALLBACK. There can be several PAR arguments. If REGEXP is
- `nicknames', these are ignored, and CALLBACK will be called with
- the nickname matched as the argument."
+ CALLBACK. There can be several PAR arguments."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
regexp
(variable :tag "Variable containing regexp")
- (const :tag "Nicknames" nicknames))
+ (repeat :tag "List of words" string)
+ (alist :key-type string :value-type sexp))
(integer :tag "Number of the regexp section that matches")
(choice :tag "When to buttonize"
(const :tag "Always" t)
- (sexp :tag "Only when this evaluates to non-nil"))
+ (function :tag "Alternative buttonizing function")
+ (variable :tag "Variable containing boolean"))
(function :tag "Function to call when button is pressed")
(repeat :tag "Sections of regexp to send to the function"
:inline t
@@ -239,15 +247,37 @@ erc-button-syntax-table
(defvar erc-button-keys-added nil
"Internal variable used to keep track of whether we've added the
global-level ERC button keys yet.")
+(make-obsolete-variable 'erc-button-keys-added "no longer relevant" "30.1")
+
+(defvar-local erc-button--has-nickname-entry nil
+ "Whether `erc-button-alist' contains a legacy `nicknames' entry.")
-;; Maybe deprecate this function and `erc-button-keys-added' if they
-;; continue to go unused for a another version (currently 5.6).
(defun erc-button-setup ()
- "Add ERC mode-level button movement keys. This is only done once."
- ;; Add keys.
- (unless erc-button-keys-added
- (define-key erc-mode-map (kbd "<backtab>") #'erc-button-previous)
- (setq erc-button-keys-added t)))
+ "Perform major-mode setup for ERC's button module.
+Note that prior to ERC 5.6, this function used to modify
+`erc-mode-map', but that's now handled by the mode toggles
+themselves."
+ (setq erc-button-keys-added t)
+ (cl-assert (derived-mode-p 'erc-mode))
+ (dolist (entry erc-button-alist)
+ (pcase entry
+ ((or `(nicknames ,_ ,sym . ,_) `('nicknames ,_ ,sym . ,_))
+ (setq erc-button--has-nickname-entry t)
+ (unless (eq sym 'erc-button-buttonize-nicks)
+ (erc--warn-once-before-connect 'erc-button-mode
+ "The legacy `nicknames' entry in `erc-button-alist'"
+ " is deprecated. See doc string for details.")))
+ ((and `(,_ ,_ ,form . ,_)
+ (guard (not (or (and (symbolp form)
+ (special-variable-p form))
+ (functionp form)))))
+ (erc--warn-once-before-connect 'erc-button-mode
+ "Arbitrary sexps for the third, FORM slot of `erc-button-alist'"
+ " entries are deprecated. Either use a variable or a function"
+ " that conditionally calls `erc-button-add-button'.")))))
+
+(defvar erc-button-nickname-callback-function #'erc-nick-popup
+ "Escape hatch for those needing a different nickname callback.")
(defun erc-button-add-buttons ()
"Find external references in the current buffer and make buttons of them.
@@ -261,6 +291,11 @@ erc-button-add-buttons
(alist erc-button-alist)
regexp)
(erc-button-remove-old-buttons)
+ (unless (or erc-button--has-nickname-entry
+ (not erc-button-buttonize-nicks))
+ (erc-button-add-nickname-buttons
+ `(_ _ erc-button--modify-nick-function
+ ,erc-button-nickname-callback-function)))
(dolist (entry alist)
(if (or (eq (car entry) 'nicknames)
;; Old form retained for backward compatibility.
@@ -284,28 +319,18 @@ erc-button-add-buttons
(concat "\\<" (regexp-quote (car elem)) "\\>")
entry)))))))))))
-(defun erc-button--maybe-warn-arbitrary-sexp (form)
- (cl-assert (not (booleanp form))) ; covered by caller
+(defun erc-button--extract-form (form)
;; If a special-variable is also a function, favor the function.
- (cond ((functionp form) form)
- ((and (symbolp form) (special-variable-p form)) (symbol-value form))
- (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp
- 'warned-arbitrary-sexp)
- (put 'erc-button--maybe-warn-arbitrary-sexp
- 'warned-arbitrary-sexp t)
- (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM"
- " slot of `erc-button-alist' entries"
- " have been deprecated.")))
- (eval form t))))
-
-(defun erc-button--check-nicknames-entry ()
- ;; This helper exists because the module is defined after its options.
- (when (eq major-mode 'erc-mode)
- (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist))
- 'erc-button-buttonize-nicks)
- (erc-button--display-error-notice-with-keys-and-warn
- "Values other than `erc-button-buttonize-nicks' in the third slot of "
- "the `nicknames' entry of `erc-button-alist' are deprecated."))))
+ (cond ((eq t form) t)
+ ((functionp form) form)
+ ((and (symbolp form) (special-variable-p form))
+ (while (let ((val (symbol-value form)))
+ (prog1 (and (not (eq val form))
+ (symbolp val)
+ (special-variable-p val))
+ (setq form val))))
+ form)
+ (t (eval form t))))
(cl-defstruct erc-button--nick
( bounds nil :type cons
@@ -405,12 +430,10 @@ erc-button-add-nickname-buttons
"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 (eq form 'erc-button-buttonize-nicks)
- (setq form (and (symbol-value form) erc-button--modify-nick-function)))
- (when (or (functionp form)
- (eq t form)
- (and form (erc-button--maybe-warn-arbitrary-sexp form)))
+ (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))
@@ -456,8 +479,7 @@ erc-button-add-buttons-1
(and-let*
((raw-form (nth 2 entry))
(res (or (eq t raw-form)
- (erc-button--maybe-warn-arbitrary-sexp
- raw-form))))
+ (erc-button--extract-form raw-form))))
(if (functionp res) res #'erc-button-add-button)))))
(let ((start (match-beginning (nth 1 entry)))
(end (match-end (nth 1 entry)))
--
2.40.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Allow-ERC-modules-to-extend-erc-nick-popup-alist.patch --]
[-- Type: text/x-patch, Size: 6797 bytes --]
From 1c194ad4237d3544df9c6af7567d1764e1ba8411 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 2/2] [5.6] Allow ERC modules to extend erc-nick-popup-alist
* etc/ERC-NEWS: Mention superficial changes to `erc-nick-popup-alist'.
* lisp/erc/erc-button.el (erc-nick-popup-alist): Accept alternate
shape for type with strings associated with functions instead of
arbitrary sexps.
(erc-button-cmd-KICK, erc-button-cmd-MSG): New functions to serve as
wrappers for `erc-cmd-KICK' and `erc-cmd-MSG', respectively. The
first also fixes a bug in which all but the first token of a given
"reason" would be omitted from the ":trailing" portion of an outgoing
KICK message.
(erc-button--nick-popup-alist): New variable to help built-in modules
expose special actions to `erc-nick-popup' without touching
`erc-nick-popup-alist'.
(erc-nick-popup): Present both `erc--nick-popup-alist' and
`erc-nick-popup-alist' to the invoking user. Accommodate functions as
well as arbitrary sexps. (bug#63569)
---
etc/ERC-NEWS | 18 ++++++++----
lisp/erc/erc-button.el | 64 +++++++++++++++++++++++++++++++-----------
2 files changed, 59 insertions(+), 23 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index e9ec9e2caab..836c6ff8ee8 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -116,13 +116,19 @@ asking users who've customized this option to switch to
that some other solution, like automatic migration, is justified,
please make that known on the bug list.
-** The 'nicknames' entry in 'erc-button-alist' is officially exceptional.
+** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
-specially. To simplify ERC's move to next-gen "rich UI" extensions,
-this special treatment is being canonized. From now on, all values
-other than the symbol 'erc-button-buttonize-nicks' appearing in the
-"FORM" field (third element) of this entry are considered deprecated
-and will incur a warning.
+specially. This is perhaps most evident in its treatment of the
+'nicknames' entry in 'erc-button-alist'. Indeed, to simplify ERC's
+move to next-gen "rich UI" extensions, this special treatment is being
+canonized. From here on out, this entry will no longer appear in the
+option's default value but will instead be applied implicitly so long
+as the option 'erc-button-buttonize-nicks' is non-nil, which it is by
+default. Relatedly, the option 'erc-nick-popup-alist' now favors
+functions, which ERC calls non-interactively, over arbitrary
+s-expressions, which ERC will continue to honor. Although the default
+lineup remains functionally equivalent, its members have all been
+updated accordingly.
** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed.
This option was accidentally removed from the default client in ERC
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 22ef3dc4846..374d3fd0201 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -682,20 +682,20 @@ erc-browse-emacswiki-lisp
;;; Nickname buttons:
(defcustom erc-nick-popup-alist
- '(("DeOp" . (erc-cmd-DEOP nick))
- ("Kick" . (erc-cmd-KICK (concat nick " "
- (read-from-minibuffer
- (concat "Kick " nick ", reason: ")))))
- ("Msg" . (erc-cmd-MSG (concat nick " "
- (read-from-minibuffer
- (concat "Message to " nick ": ")))))
- ("Op" . (erc-cmd-OP nick))
- ("Query" . (erc-cmd-QUERY nick))
- ("Whois" . (erc-cmd-WHOIS nick))
- ("Lastlog" . (erc-cmd-LASTLOG nick)))
+ '(("DeOp" . erc-cmd-DEOP)
+ ("Kick" . erc-button-cmd-KICK)
+ ("Msg" . erc-button-cmd-MSG)
+ ("Op" . erc-cmd-OP)
+ ("Query" . erc-cmd-QUERY)
+ ("Whois" . erc-cmd-WHOIS)
+ ("Lastlog" . erc-cmd-LASTLOG))
"An alist of possible actions to take on a nickname.
-An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with
-the variable `nick' bound to the nick in question.
+For all entries (ACTION . FUNC), ERC offers ACTION as a possible
+completion item and calls the selected entry's FUNC with the
+buttonized nickname at point as the only argument. For
+historical reasons, FUNC can also be an arbitrary sexp, in which
+case, ERC binds the nick in question to the variable `nick' and
+evaluates the expression.
Examples:
(\"DebianDB\" .
@@ -703,18 +703,48 @@ erc-nick-popup-alist
(format
\"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
nick)))"
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(repeat (cons (string :tag "Op")
- sexp)))
+ (choice function sexp))))
+
+(defun erc-button-cmd-KICK (nick)
+ "Prompt for a reason, then kick NICK via `erc-cmd-KICK'.
+In server buffers, also prompt for a channel."
+ (erc-cmd-KICK
+ (or (and erc--target (erc-default-target))
+ (let ((targets (mapcar (lambda (b)
+ (cons (erc--target-string
+ (buffer-local-value 'erc--target b))
+ b))
+ (erc-channel-list erc-server-process))))
+ (completing-read (format "Channel (%s): " (caar targets))
+ targets (pcase-lambda (`(,_ . ,buf))
+ (with-current-buffer buf
+ (erc-get-channel-user nick)))
+ t nil t (caar targets))))
+ nick
+ (read-from-minibuffer "Reason: ")))
+
+(defun erc-button-cmd-MSG (nick)
+ "Prompt for a message to NICK, and send it via `erc-cmd-MSG'."
+ (let ((msg (read-from-minibuffer (concat "Message to " nick ": "))))
+ (erc-cmd-MSG (concat nick " " msg))))
+
+(defvar-local erc-button--nick-popup-alist nil
+ "Internally controlled items for `erc-nick-popup-alist'.")
(defun erc-nick-popup (nick)
(let* ((completion-ignore-case t)
+ (alist (append erc-nick-popup-alist erc-button--nick-popup-alist))
(action (completing-read (format-message
"What action to take on `%s'? " nick)
- erc-nick-popup-alist))
- (code (cdr (assoc action erc-nick-popup-alist))))
+ alist))
+ (code (cdr (assoc action alist))))
(when code
(erc-set-active-buffer (current-buffer))
- (eval code `((nick . ,nick))))))
+ (if (functionp code)
+ (funcall code nick)
+ (eval code `((nick . ,nick)))))))
;;; Callback functions
(defun erc-button-describe-symbol (symbol-name)
--
2.40.1
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
` (4 preceding siblings ...)
2023-06-02 14:07 ` J.P.
@ 2023-09-13 14:09 ` J.P.
[not found] ` <87wmwuyxjh.fsf@neverwas.me>
6 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-09-13 14:09 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 624 bytes --]
This feature added an internal interface that allows for creating
ephemeral "phantom" users, which help make nickname buttonizing possible
with protocol bridges and chat-history playback. Unfortunately, the
original design cut a major corner that it shouldn't have. Essentially,
I wanted to avoid adding an `erc-channel-user' to accompany every
phantom `erc-server-user' being spoofed, primarily because it's a waste
of space. However, I've come to believe this shortcut won't be worth the
added maintenance burden of having to check for missing objects when
performing related operations. Attached is a patch to fix this.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Spoof-channel-users-in-erc-button-phantom-users-.patch --]
[-- Type: text/x-patch, Size: 10017 bytes --]
From 784cdaeee6d9b5ca7138b0cde0e251b475414201 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 6 Sep 2023 19:40:11 -0700
Subject: [PATCH] [5.6] Spoof channel users in erc-button--phantom-users-mode
* lisp/erc/erc-backend.el (erc--cmem-from-nick-function): Update
forward declaration.
(erc-server-PRIVMSG): Use new name for `erc--user-from-nick-function',
now `erc--cmem-from-nick-function'.
* lisp/erc/erc-button.el (erc-button--phantom-users,
erc-button--phantom-cmems): Rename former to latter.
(erc-button--fallback-user-function,
erc-button--fallback-cmem-function): Rename former to latter.
(erc--phantom-channel-user, erc--phantom-server-user): New superficial
`cl-struct' objects subclassing `erc-channel-user' and
`erc-server-user', respectively.
(erc-button--add-phantom-speaker): Look for channel member instead of
server user, creating one if necessary. Return a made-up
`erc-channel-user' along with the made-up `erc-server-user'.
(erc-button--get-phantom-user, erc-button--get-phantom-cmem): Rename
former to latter.
(erc-button--phantom-users-mode, erc-button--phantom-users-enable,
erc-button--phantom-users-disable): Use updated names for
function-valued interface vars and their implementing functions.
Remove obsolete comment.
(erc-button-add-nickname-buttons): Attempt to query fallback
function, if non-nil, while populating channel member instead of
server user.
* lisp/erc/erc.el (erc--user-from-nick-function,
erc--cmem-from-nick-function): Rename former to latter.
(erc--examine-nick, erc--get-existing-channel-member): Rename former
to latter. (Bug#60933)
---
lisp/erc/erc-backend.el | 4 +--
lisp/erc/erc-button.el | 66 +++++++++++++++++++++++------------------
lisp/erc/erc.el | 13 ++++----
3 files changed, 46 insertions(+), 37 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9e121ec1e92..fb10ee31c78 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -104,7 +104,7 @@
(defvar erc--called-as-input-p)
(defvar erc--display-context)
(defvar erc--target)
-(defvar erc--user-from-nick-function)
+(defvar erc--cmem-from-nick-function)
(defvar erc-channel-list)
(defvar erc-channel-users)
(defvar erc-default-nicks)
@@ -1944,7 +1944,7 @@ erc--server-determine-join-display-context
;; at this point.
(erc-update-channel-member (if privp nick tgt) nick nick
privp nil nil nil nil nil host login nil nil t)
- (let ((cdata (funcall erc--user-from-nick-function
+ (let ((cdata (funcall erc--cmem-from-nick-function
(erc-downcase nick) sndr parsed)))
(setq fnick (funcall erc-format-nick-function
(car cdata) (cdr cdata))))))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 8c1188e64a2..620ee63fa39 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -380,32 +380,39 @@ erc-button--modify-nick-function
all faces defined in `erc-button' are bound temporarily and can
be updated at will.")
-(defvar-local erc-button--phantom-users nil)
+(defvar-local erc-button--phantom-cmems nil)
-(defvar erc-button--fallback-user-function #'ignore
- "Function to determine `erc-server-user' if not found in the usual places.
+(defvar erc-button--fallback-cmem-function #'ignore
+ "Function to determine channel member if not found in the usual places.
Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when
`erc-button-add-nickname-buttons' cannot find a user object for
DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.")
+;; Historical or fictitious users. As long as these two structs
+;; remain superficial subclasses with the exact same slots and
+;; defaults, they can live here instead of in erc-common.el. Modules
+;; can use the named getters for the superclasses when doing `setf'
+;; modifications without having to `require' this library.
+(cl-defstruct (erc--phantom-channel-user (:include erc-channel-user)))
+(cl-defstruct (erc--phantom-server-user (:include erc-server-user)))
+
(defun erc-button--add-phantom-speaker (downcased nuh _parsed)
- "Stash fictitious `erc-server-user' while processing \"PRIVMSG\".
-Expect DOWNCASED to be the downcased nickname, NUH to be a triple
-of (NICK LOGIN HOST), and parsed to be an `erc-response' object."
(pcase-let* ((`(,nick ,login ,host) nuh)
- (user (or (gethash downcased erc-button--phantom-users)
- (make-erc-server-user
+ (cmem (gethash downcased erc-button--phantom-cmems))
+ (user (or (car cmem)
+ (make-erc--phantom-server-user
:nickname nick
:host (and (not (string-empty-p host)) host)
- :login (and (not (string-empty-p login)) login)))))
- (list (puthash downcased user erc-button--phantom-users))))
+ :login (and (not (string-empty-p login)) login))))
+ (cuser (or (cdr cmem)
+ (make-erc--phantom-channel-user
+ :last-message-time (current-time)))))
+ (puthash downcased (cons user cuser) erc-button--phantom-cmems)
+ (cons user cuser)))
-(defun erc-button--get-phantom-user (down _word _bounds)
- (gethash down erc-button--phantom-users))
+(defun erc-button--get-phantom-cmem (down _word _bounds)
+ (gethash down erc-button--phantom-cmems))
-;; In the future, we'll most likely create temporary
-;; `erc-channel-users' tables during BATCH chathistory playback, thus
-;; obviating the need for this mode entirely.
(define-minor-mode erc-button--phantom-users-mode
"Minor mode to recognize unknown speakers.
Expect to be used by module setup code for creating placeholder
@@ -415,22 +422,22 @@ erc-button--phantom-users-mode
of the channel. However, don't bother creating an actual
`erc-channel-user' object because their status prefix is unknown.
Instead, just spoof an `erc-server-user' and stash it during
-\"PRIVMSG\" handling via `erc--user-from-nick-function' and
+\"PRIVMSG\" handling via `erc--cmem-from-nick-function' and
retrieve it during buttonizing via
`erc-button--fallback-user-function'."
:interactive nil
(if erc-button--phantom-users-mode
(progn
- (add-function :after-until (local 'erc--user-from-nick-function)
- #'erc-button--add-phantom-speaker '((depth . -50)))
- (add-function :after-until (local 'erc-button--fallback-user-function)
- #'erc-button--get-phantom-user '((depth . 50)))
- (setq erc-button--phantom-users (make-hash-table :test #'equal)))
- (remove-function (local 'erc--user-from-nick-function)
+ (add-function :after-until (local 'erc--cmem-from-nick-function)
+ #'erc-button--add-phantom-speaker '((depth . 30)))
+ (add-function :after-until (local 'erc-button--fallback-cmem-function)
+ #'erc-button--get-phantom-cmem '((depth . 50)))
+ (setq erc-button--phantom-cmems (make-hash-table :test #'equal)))
+ (remove-function (local 'erc--cmem-from-nick-function)
#'erc-button--add-phantom-speaker)
- (remove-function (local 'erc-button--fallback-user-function)
- #'erc-button--get-phantom-user)
- (kill-local-variable 'erc-nicks--phantom-users)))
+ (remove-function (local 'erc-button--fallback-cmem-function)
+ #'erc-button--get-phantom-cmem)
+ (kill-local-variable 'erc-button--phantom-cmems)))
(defun erc-button-add-nickname-buttons (entry)
"Search through the buffer for nicknames, and add buttons."
@@ -451,11 +458,12 @@ erc-button-add-nickname-buttons
(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)))
+ (cuser (and erc-channel-users
+ (or (gethash down erc-channel-users)
+ (funcall erc-button--fallback-cmem-function
+ down word bounds))))
(user (or (and cuser (car cuser))
- (and erc-server-users (gethash down erc-server-users))
- (funcall erc-button--fallback-user-function
- down word bounds)))
+ (and erc-server-users (gethash down erc-server-users))))
(data (list word)))
(when (or (not (functionp form))
(and-let* ((user)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 07ba32d1cca..ba0733f0ee5 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5262,14 +5262,15 @@ erc--get-speaker-bounds
(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.
+(defvar erc--cmem-from-nick-function #'erc--get-existing-channel-member
+ "Function returning an `erc-channel-members' object from a nick.
Must return either nil or a cons of an `erc-server-user' and a
-possibly nil `erc-channel-user' for formatting a server user's
-nick. Called in the appropriate buffer with the downcased nick,
-the parsed NUH, and the original `erc-response' object.")
+`erc-channel-user' object for formatting a user's nick for
+insertion. Called in the appropriate target buffer with the
+downcased nick, the parsed NUH, and the current `erc-response'
+object.")
-(defun erc--examine-nick (downcased _nuh _parsed)
+(defun erc--get-existing-channel-member (downcased _nuh _parsed)
(and erc-channel-users (gethash downcased erc-channel-users)))
(defun erc-format-privmessage (nick msg privp msgp)
--
2.41.0
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible
[not found] ` <87wmwuyxjh.fsf@neverwas.me>
@ 2023-09-19 13:28 ` J.P.
0 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-09-19 13:28 UTC (permalink / raw)
To: 60933; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> This feature added an internal interface that allows for creating
> ephemeral "phantom" users, which help make nickname buttonizing possible
> with protocol bridges and chat-history playback. Unfortunately, the
> original design cut a major corner that it shouldn't have. Essentially,
> I wanted to avoid adding an `erc-channel-user' to accompany every
> phantom `erc-server-user' being spoofed, primarily because it's a waste
> of space. However, I've come to believe this shortcut won't be worth the
> added maintenance burden of having to check for missing objects when
> performing related operations. Attached is a patch to fix this.
A version of this was installed as
a0ed463baba Spoof channel users in erc-button--phantom-users-mode
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2023-09-19 13:28 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-18 14:38 bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible J.P.
2023-02-19 15:04 ` J.P.
2023-03-09 14:42 ` J.P.
[not found] ` <87fsaekmv4.fsf@neverwas.me>
2023-04-18 14:11 ` J.P.
[not found] ` <877cu9qnyo.fsf@neverwas.me>
2023-04-29 15:56 ` J.P.
2023-05-23 13:35 ` J.P.
2023-06-02 14:07 ` J.P.
2023-09-13 14:09 ` J.P.
[not found] ` <87wmwuyxjh.fsf@neverwas.me>
2023-09-19 13:28 ` 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).