From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs,gmane.emacs.erc.general Subject: bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible Date: Wed, 18 Jan 2023 06:38:51 -0800 Message-ID: <878rhzc3gk.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="6895"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 60933@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Jan 18 15:40:17 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pI9bs-0001WY-3T for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 18 Jan 2023 15:40:16 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pI9bh-0001Va-9R; Wed, 18 Jan 2023 09:40:05 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pI9bf-0001SU-9G; Wed, 18 Jan 2023 09:40:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pI9bd-0003Jr-UF; Wed, 18 Jan 2023 09:40:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pI9bd-0004dA-PE; Wed, 18 Jan 2023 09:40:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: emacs-erc@gnu.org, bug-gnu-emacs@gnu.org Resent-Date: Wed, 18 Jan 2023 14:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 60933 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: emacs-erc@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.167405275417717 (code B ref -1); Wed, 18 Jan 2023 14:40:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 18 Jan 2023 14:39:14 +0000 Original-Received: from localhost ([127.0.0.1]:39943 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pI9aq-0004bf-MC for submit@debbugs.gnu.org; Wed, 18 Jan 2023 09:39:13 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:46730) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pI9ao-0004bW-Fp for submit@debbugs.gnu.org; Wed, 18 Jan 2023 09:39:11 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pI9an-0000U7-BK for bug-gnu-emacs@gnu.org; Wed, 18 Jan 2023 09:39:09 -0500 Original-Received: from mail-108-mta211.mxroute.com ([136.175.108.211]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pI9aj-0003CX-TP for bug-gnu-emacs@gnu.org; Wed, 18 Jan 2023 09:39:09 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta211.mxroute.com (ZoneMTA) with ESMTPSA id 185c5518f84000011e.001 for (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Wed, 18 Jan 2023 14:38:54 +0000 X-Zone-Loop: 9464736528e21a03c9f6f2a72c3d75981d9b56193f35 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:Subject:To:From:Sender: Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=x8ejFyYV7MR7brDUuXtErWIJV+0Nxv2yAhubSMzsVqo=; b=KDSxkV2TTNBh4neLyIsfDxJAKS 0zoUpxNt6/26fWwiGmARMSSRX1wxXZrw0MFAZQSFsaUBn3BDou1D5XI/fbHmS+3SUyCZNOGet/a8b HWTN6wIdqZiqxWBJkSYqp4P40FIc05ZI+4U/8UCAa0wY/Ibu4EwF3FUoX9POmd5OIJXKjaTgpzcmm 4REjAbkE0gPOvKUFv0Wwo9z7JVrpLxZ02qTC04zSptXz5gF5XDFi6c1xyVQkWGKDw3Ksk444BRS92 nipLKVpermfLZEARfWlYRET2b/1tVGVeOuUZ1DfFES94hXnREBbtvk1HGq1fzGjzjLjQtOragnM3s +gbx/GeQ==; X-Authenticated-Id: masked@neverwas.me Received-SPF: pass client-ip=136.175.108.211; envelope-from=jp@neverwas.me; helo=mail-108-mta211.mxroute.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:253638 gmane.emacs.erc.general:2052 Archived-At: --=-=-= Content-Type: text/plain 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)) --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch Content-Transfer-Encoding: quoted-printable >From 479dc9b345c0e5798505f6699df4f707f8e5ea39 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 ("[`=E2=80=98]\\([a-zA-Z][-a-zA-Z_0-9!*<=3D>+]+\\)['=E2=80=99]" 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. --=20 2.38.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch >From 5d97ec5342327e03f042cd88ec24609a73bcdd42 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch >From 6df0ae6ab237b72406b5f60ef37679087050916b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-=--