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 Subject: bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible Date: Sat, 29 Apr 2023 08:56:06 -0700 Message-ID: <87v8he65t5.fsf__14190.6096063153$1682783849$gmane$org@neverwas.me> References: <878rhzc3gk.fsf@neverwas.me> <87fsaekmv4.fsf@neverwas.me> <877cu9qnyo.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="28244"; 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 Sat Apr 29 17:57:21 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 1psmwq-00079C-M4 for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 29 Apr 2023 17:57:21 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1psmwa-0003yz-Ui; Sat, 29 Apr 2023 11:57:04 -0400 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 1psmwZ-0003yd-1E for bug-gnu-emacs@gnu.org; Sat, 29 Apr 2023 11:57:03 -0400 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 1psmwY-0003Tb-Nt for bug-gnu-emacs@gnu.org; Sat, 29 Apr 2023 11:57:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1psmwY-000644-7t for bug-gnu-emacs@gnu.org; Sat, 29 Apr 2023 11:57:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 29 Apr 2023 15:57:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 60933 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 60933-submit@debbugs.gnu.org id=B60933.168278378823265 (code B ref 60933); Sat, 29 Apr 2023 15:57:02 +0000 Original-Received: (at 60933) by debbugs.gnu.org; 29 Apr 2023 15:56:28 +0000 Original-Received: from localhost ([127.0.0.1]:36411 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1psmvx-000639-VC for submit@debbugs.gnu.org; Sat, 29 Apr 2023 11:56:27 -0400 Original-Received: from mail-108-mta82.mxroute.com ([136.175.108.82]:41005) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1psmvt-00062r-PG for 60933@debbugs.gnu.org; Sat, 29 Apr 2023 11:56:24 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta82.mxroute.com (ZoneMTA) with ESMTPSA id 187cdba98d6000becb.001 for <60933@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Sat, 29 Apr 2023 15:56:10 +0000 X-Zone-Loop: 10adfeddce07621a524bdf5fe210838c3375ec61b15a 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:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=2fKBn83sAO/jdSJUGx9QeJwWZK0i3AWT5vw0AndF9Ys=; b=iXPOEYD3JNdjD4BLVpmubrvxxw e9Hnc43YOlyLQOugx1zSxPksh+BWIF2EDdPXVC2ZlSJiRIIKqRI7NxTBJI+jkAq3pmrZxfQeTd0dT fTmqBPHT3BtvDP3UvNUJm3Pqbt6qVHg2txEj/RCAxiuTpANnqDeMcHMidFSbgDmF3SfxnqeSlWORO cDd8yJu7CJUgjG+jjIFAOhHk8jTV0a65e6xbIvxPDSrhJYW7f3O0JJe3gmGGl+dTcp4qXf7zX9/63 qU+3RPxvp3CYey5ri2kAz/WKVLkxccKU+iuUJMT7Ktacd+u5z17H8McNjTcMFyLXI2OlJva0/Wj0P XK2UUnZw==; In-Reply-To: <877cu9qnyo.fsf@neverwas.me> (J. P.'s message of "Tue, 18 Apr 2023 07:11:59 -0700") X-Authenticated-Id: masked@neverwas.me 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:260820 Archived-At: --=-=-= Content-Type: text/plain "J.P." 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 , 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 \"\", 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 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-5.6-Revise-FORM-as-function-interface-in-erc-button-.patch Content-Transfer-Encoding: quoted-printable >From 4542ad9bf3776ba92489acf226a70f314b0c1413 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 "" 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) - (" ]+\\) *>" 0 t browse-url-button-open-url 1) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger = 2 3) ;; emacs internal ("[`=E2=80=98]\\([a-zA-Z][-a-zA-Z_0-9!*<=3D>+]+\\)['=E2=80=99]" @@ -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'. =20 -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. =20 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))))))))))) =20 (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 F= ORM" + " slot of `erc-button-alist' ent= ries" + " have been deprecated."))) + (eval form t)))) =20 (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))))) =20 (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))) =20 -(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))) =20 ;;;###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-t= ests.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 @@ =20 (require 'erc-button) =20 +(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 still works despite being removed in ERC 5.6. + (erc-display-message nil nil (current-buffer) + "Foo bar.") + (search-forward "https") + (funcall verify (point) "https://gnu.org") + + ;; Bracketed + (erc-display-message nil nil (current-buffer) "Foo b= ar.") + (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-va= r)) + (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) (let ((msg (erc-format-privmessage speaker --=20 2.40.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Improve-erc-button-modify-nick-function-interfac.patch >From 9a3f8710e5aabd0975ea242142600a51bdcc9be7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Use-getter-for-finding-users-in-erc-server-PRIVM.patch >From 63440ff3f23ef6c3d67fea598c748723ee5f32ac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 "". (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 , 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 \"\", 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 --=-=-=--