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#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network" Date: Mon, 20 Nov 2023 13:17:09 -0800 Message-ID: <875y1wi0q2.fsf__48246.7941985064$1700515102$gmane$org@neverwas.me> References: 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="15913"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Amin Bandali , Lars Ingebrigtsen , emacs-erc@gnu.org, Stefan Kangas To: 51082@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Nov 20 22:18:13 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 1r5Ben-0003to-2x for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 20 Nov 2023 22:18:13 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1r5Bec-0005w2-1G; Mon, 20 Nov 2023 16:18:02 -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 1r5BeZ-0005uu-T8 for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 16:17:59 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1r5BeZ-0007Pm-Jt for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 16:17:59 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1r5Beb-0007jr-PO for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 16:18:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 20 Nov 2023 21:18:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51082 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 51082-submit@debbugs.gnu.org id=B51082.170051506929724 (code B ref 51082); Mon, 20 Nov 2023 21:18:01 +0000 Original-Received: (at 51082) by debbugs.gnu.org; 20 Nov 2023 21:17:49 +0000 Original-Received: from localhost ([127.0.0.1]:54769 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r5BeN-0007jL-HF for submit@debbugs.gnu.org; Mon, 20 Nov 2023 16:17:49 -0500 Original-Received: from mail-108-mta49.mxroute.com ([136.175.108.49]:35635) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r5BeJ-0007jA-N8 for 51082@debbugs.gnu.org; Mon, 20 Nov 2023 16:17:46 -0500 Original-Received: from filter006.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta49.mxroute.com (ZoneMTA) with ESMTPSA id 18bee988b1a000190b.001 for <51082@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Mon, 20 Nov 2023 21:17:36 +0000 X-Zone-Loop: 6e1fa8d81b93f05341aa215aa67f233793635b360464 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=/CFiUatJ+iC+jPSuN3sivIFcz42Btc6qNd6aGY8yI7o=; b=LkA0g9+3ESvYDjCEoRRYmXts8/ gjZ2jEmOkWcqtmE8UqVxbfDCABwGUcBG5R944TmSL9aC9z/PZxkI0aMdcfAsoPcS++31l/r3HPzzp ZZ7uSKmtI8LzvSK9PM3Xe1ubJOaBZZPvEe5tQo3BnhyGrtyEFt+YnFUwt0o8XGVyoptjQGjO97B9n Fqq5YTtJ7byEm/FqGVNWYl32b8WSfgYg3mcqLTxUrNF3GsFVDN+QZxzR1OaN+TtCW6iFucsNNMezU Y9fWSJ+Y5zLcZ8PzJSNt3cftGMTIPIyLT3ndk9xoEzWkP1bnHc6wVWjjdhOgcWShJYxIiGIbqlSwL qj3moAsQ==; In-Reply-To: (Stefan Kangas's message of "Thu, 7 Oct 2021 09:05:02 -0400") 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:274690 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi people, I'd like to take this feature over, in case anyone cares. To summarize, it initially stalled out because an underlying facility to support the dynamic updating of rich UI elements wasn't available at the time. Most of it has since been added, and the attached changes (once complete) should fill in any remaining gaps. Thus, I've gone ahead and integrated everyone's suggestions, for the most part, with the only caveat being the feature won't be enabled by default. Rather, there's an added step involved where a user must first (setopt erc-prompt #erc-prompt-format) before ERC will consider the companion option that contains the actual template (also called `erc-prompt-format'). Such indirection may be regrettable from a UX standpoint, but I'd rather hold off on improving things until we've brought batch processing fully into the fold and have tuned it to perform respectably with ERC's default configuration. For anyone unfamiliar, ERC will soon be needing to process incoming messages in rapid succession all the way to insertion as fast as it can manage. Like normal messages, these will also influence the state of UI elements, like the prompt, the mode line, etc. Because such processing will be foundational to ERC's basic operations going forward, it's important to prioritize =C3=BCber alles. To that end, I'm hoping we can revisit this feature again at some later date if folks end up wanting to expand `erc-prompt' to accommodate format specifiers directly, as originally envisioned. Thanks. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Don-t-inherit-properties-when-refreshing-ERC-s-p.patch >From d29cd6fd8db3c9f1b78f273994022e0a1e1b29c1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 18 Nov 2023 23:04:50 -0800 Subject: [PATCH 1/4] [5.6] Don't inherit properties when refreshing ERC's prompt * lisp/erc/erc.el (erc--merge-prop-behind-p): New variable to be dynamically bound around rare calls to `erc--merge-props' when the latter should append to existing list-valued text properties instead of push. (erc--inhibit-prompt-display-property-p): New variable to be non-nil in buffers where an active module needs to reserve all uses of the `display' text property in the prompt region for itself. (erc--prompt-properties): Collect all common prompt properties in one place for code reuse and maintenance purposes. (erc--refresh-prompt-continue, erc--refresh-prompt-continue-request): New function and state variable for custom `erc-prompt' functions to indicate to ERC that they need the prompt to be refreshed in all buffers and not just the current one. (erc--refresh-prompt): Merge `font-lock-face' to support legacy code that uses `font-lock-face' to detect the prompt. Crucially, don't inherit properties at the beginning of the prompt because doing so may clobber any added by a custom `erc-prompt' function. Instead, apply known properties from `erc-display-prompt' manually. Integrate `erc--refresh-prompt-continue' logic. (erc--merge-prop): Recognize flag to activate `append' behavior in which new prop values are appended to lists of existing ones rather than consed in front. This functionality could be extended to arbitrary splices as well. (erc-display-prompt): Use common text properties defined elsewhere. * test/lisp/erc/erc-tests.el (erc--merge-prop): Add assertion for `erc--merge-prop-behind-p' non-nil behavior. (Bug#51082) --- lisp/erc/erc.el | 87 +++++++++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 12 ++++++ 2 files changed, 78 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f4c3f77593c..0fbf6976d45 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2993,23 +2993,70 @@ erc--assert-input-bounds (cl-assert (< erc-insert-marker erc-input-marker)) (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) -(defvar erc--refresh-prompt-hook nil) +(defvar erc--merge-prop-behind-p nil + "When non-nil, put merged prop(s) behind existing.") + +(defvar erc--refresh-prompt-hook nil + "Hook called after refreshing the prompt in the affected buffer.") + +(defvar-local erc--inhibit-prompt-display-property-p nil + "Tell `erc-prompt' related functions to avoid the `display' text prop. +Modules can enable this when needing to reserve the prompt's +display property for some other purpose, such as displaying it +elsewhere, abbreviating it, etc.") + +(defconst erc--prompt-properties '( rear-nonsticky t + erc-prompt t ; t or `hidden' + field erc-prompt + front-sticky t + read-only t) + "Mandatory text properties added to ERC's prompt.") + +(defvar erc--refresh-prompt-continue-request nil + "State flag for refreshing prompt in all buffers. +When the value is zero, functions assigned to the variable +`erc-prompt' can set this to run `erc--refresh-prompt-hook' (1) +or `erc--refresh-prompt' (2) in all buffers of the server.") + +(defun erc--refresh-prompt-continue (&optional hooks-only-p) + "Ask ERC to refresh the prompt in all buffers. +Functions assigned to `erc-prompt' can call this if needing to +recreate the prompt in other buffers as well. With HOOKS-ONLY-P, +run `erc--refresh-prompt-hook' in other buffers instead of doing +a full refresh." + (when (zerop erc--refresh-prompt-continue-request) + (setq erc--refresh-prompt-continue-request (if hooks-only-p 1 2)))) (defun erc--refresh-prompt () "Re-render ERC's prompt when the option `erc-prompt' is a function." (erc--assert-input-bounds) (unless (erc--prompt-hidden-p) - (when (functionp erc-prompt) - (save-excursion - (goto-char erc-insert-marker) - (set-marker-insertion-type erc-insert-marker nil) - ;; Avoid `erc-prompt' (the named function), which appends a - ;; space, and `erc-display-prompt', which propertizes all but - ;; that space. - (insert-and-inherit (funcall erc-prompt)) - (set-marker-insertion-type erc-insert-marker t) - (delete-region (point) (1- erc-input-marker)))) - (run-hooks 'erc--refresh-prompt-hook))) + (let ((erc--refresh-prompt-continue-request + (or erc--refresh-prompt-continue-request 0))) + (when (functionp erc-prompt) + (save-excursion + (goto-char erc-insert-marker) + (set-marker-insertion-type erc-insert-marker nil) + ;; Avoid `erc-prompt' (the named function), which appends a + ;; space, and `erc-display-prompt', which propertizes all + ;; but that space. + (let ((s (funcall erc-prompt)) + (erc--merge-prop-behind-p t)) + (erc--merge-prop 0 (length s) 'font-lock-face 'erc-prompt-face s) + (add-text-properties 0 (length s) erc--prompt-properties s) + (insert s)) + (set-marker-insertion-type erc-insert-marker t) + (delete-region (point) (1- erc-input-marker)))) + (run-hooks 'erc--refresh-prompt-hook) + (when-let (((> erc--refresh-prompt-continue-request 0)) + (n erc--refresh-prompt-continue-request) + (erc--refresh-prompt-continue-request -1) + (b (current-buffer))) + (erc-with-all-buffers-of-server erc-server-process + (lambda () (not (eq b (current-buffer)))) + (if (= n 1) + (run-hooks 'erc--refresh-prompt-hook) + (erc--refresh-prompt))))))) (defun erc--check-msg-prop (prop &optional val) "Return PROP's value in `erc--msg-props' when populated. @@ -3247,9 +3294,12 @@ erc--merge-prop new) (while (< pos to) (setq new (if old - (if (listp val) - (append val (ensure-list old)) - (cons val (ensure-list old))) + ;; Can't `nconc' without more info. + (if erc--merge-prop-behind-p + `(,@(ensure-list old) ,@(ensure-list val)) + (if (listp val) + (append val (ensure-list old)) + (cons val (ensure-list old)))) val)) (put-text-property pos end prop new object) (setq pos end @@ -5209,12 +5259,7 @@ erc-display-prompt ;; Do not extend the text properties when typing at the end ;; of the prompt, but stuff typed in front of the prompt ;; shall remain part of the prompt. - (setq prompt (propertize prompt - 'rear-nonsticky t - 'erc-prompt t ; t or `hidden' - 'field 'erc-prompt - 'front-sticky t - 'read-only t)) + (setq prompt (apply #'propertize prompt erc--prompt-properties)) (erc-put-text-property 0 (1- (length prompt)) 'font-lock-face (or face 'erc-prompt-face) prompt) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8dbe44ce5ed..af80194352c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1838,6 +1838,18 @@ erc--merge-prop (buffer-substring 1 4) #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z))))) + ;; Flag `erc--merge-prop-behind-p'. + (goto-char (point-min)) + (insert "jkl\n") + (erc--merge-prop 2 3 'erc-test '(y z)) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) #("jkl" 1 2 (erc-test (y z))))) + (let ((erc--merge-prop-behind-p t)) + (erc--merge-prop 1 3 'erc-test '(w x))) + (should (erc-tests--equal-including-properties + (buffer-substring 1 4) + #("jkl" 0 1 (erc-test (w x)) 1 2 (erc-test (y z w x))))) + (when noninteractive (kill-buffer)))) -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Use-overlay-instead-of-text-prop-to-hide-ERC-pro.patch >From b16774c76ee16cb342098a0e69a2b1688a44813b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 18 Nov 2023 23:44:20 -0800 Subject: [PATCH 2/4] [5.6] Use overlay instead of text prop to hide ERC prompt * lisp/erc/erc-backend.el (erc--hidden-prompt-overlay): New variable, a buffer-local handle for the prompt overlay. (erc--reveal-prompt): Delete overlay instead of text prop. (erc--conceal-prompt): Add overlay instead of text prop. (erc--unhide-prompt): Run `erc--refresh-prompt-hook' after revealing. (erc--hide-prompt): Run `erc--refresh-prompt-hook' after hiding. * lisp/erc/erc-stamp.el (erc-stamp--adjust-margin): Attempt a more accurate estimate of the prompt's width in columns when setting left-margin. (erc-stamp--skip-left-margin-prompt-p): New variable to inhibit normal behavior of displaying prompt in left margin. (erc-stamp--display-margin-mode): Allow opting out of prompt-in-left-margin behavior. (erc--reveal-prompt): Delete unneeded implementation. (erc--conceal-prompt): Put overlay in margin. * test/lisp/erc/erc-tests.el (erc-hide-prompt): Use `get-char-property' instead of `get-text-property' in order to accommodate overlay-based prompt hiding. (Bug#51082) --- lisp/erc/erc-backend.el | 21 ++++++++++++----- lisp/erc/erc-stamp.el | 38 +++++++++++++++++++++---------- test/lisp/erc/erc-tests.el | 46 +++++++++++++++++++------------------- 3 files changed, 64 insertions(+), 41 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 371b4591915..7ff55de0d0c 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1043,13 +1043,20 @@ erc-process-sentinel-1 ;; unexpected disconnect (erc-process-sentinel-2 event buffer)))) +(defvar-local erc--hidden-prompt-overlay nil + "Overlay for hiding the prompt when disconnected.") + (cl-defmethod erc--reveal-prompt () - (remove-text-properties erc-insert-marker erc-input-marker - '(display nil))) + (when erc--hidden-prompt-overlay + (delete-overlay erc--hidden-prompt-overlay) + (setq erc--hidden-prompt-overlay nil))) (cl-defmethod erc--conceal-prompt () - (add-text-properties erc-insert-marker (1- erc-input-marker) - `(display ,erc-prompt-hidden))) + (when-let (((null erc--hidden-prompt-overlay)) + (ov (make-overlay erc-insert-marker (1- erc-input-marker) + nil 'front-advance))) + (overlay-put ov 'display erc-prompt-hidden) + (setq erc--hidden-prompt-overlay ov))) (defun erc--prompt-hidden-p () (and (marker-position erc-insert-marker) @@ -1061,7 +1068,8 @@ erc--unhide-prompt (marker-position erc-input-marker)) (with-silent-modifications (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t) - (erc--reveal-prompt)))) + (erc--reveal-prompt) + (run-hooks 'erc--refresh-prompt-hook)))) (defun erc--unhide-prompt-on-self-insert () (when (and (eq this-command #'self-insert-command) @@ -1086,7 +1094,8 @@ erc--hide-prompt (with-silent-modifications (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt 'hidden) - (erc--conceal-prompt)) + (erc--conceal-prompt) + (run-hooks 'erc--refresh-prompt-hook)) (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t)))) (defun erc-process-sentinel (cproc event) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 6eeb7706a61..e6a8f36c332 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -360,7 +360,18 @@ erc-stamp--adjust-margin (if resetp (or (and (not (zerop cols)) cols) erc-stamp--margin-width - (max (if leftp (string-width (erc-prompt)) 0) + (max (if leftp + (cond ((fboundp 'erc-fill--wrap-measure) + (let* ((b erc-insert-marker) + (e (1- erc-input-marker)) + (w (erc-fill--wrap-measure b e))) + (/ (if (consp w) (car w) w) + (frame-char-width)))) + ((fboundp 'string-pixel-width) + (/ (string-pixel-width (erc-prompt)) + (frame-char-width))) + (t (string-width (erc-prompt)))) + 0) (1+ (string-width (or (if leftp erc-timestamp-last-inserted @@ -407,6 +418,9 @@ erc-stamp-prefix-log-filter (defvar erc-stamp--inherited-props '(line-prefix wrap-prefix) "Extant properties at the start of a message inherited by the stamp.") +(defvar-local erc-stamp--skip-left-margin-prompt-p nil + "Don't display prompt in left margin.") + (declare-function erc--remove-text-properties "erc" (string)) ;; Currently, `erc-insert-timestamp-right' hard codes its display @@ -437,7 +451,8 @@ erc-stamp--display-margin-mode #'erc--remove-text-properties) (add-hook 'erc--setup-buffer-hook #'erc-stamp--refresh-left-margin-prompt nil t) - (when erc-stamp--margin-left-p + (when (and erc-stamp--margin-left-p + (not erc-stamp--skip-left-margin-prompt-p)) (add-hook 'erc--refresh-prompt-hook #'erc-stamp--display-prompt-in-left-margin nil t))) (remove-function (local 'filter-buffer-substring-function) @@ -451,6 +466,7 @@ erc-stamp--display-margin-mode (kill-local-variable (if erc-stamp--margin-left-p 'left-margin-width 'right-margin-width)) + (kill-local-variable 'erc-stamp--skip-left-margin-prompt-p) (kill-local-variable 'fringes-outside-margins) (kill-local-variable 'erc-stamp--margin-left-p) (kill-local-variable 'erc-stamp--margin-width) @@ -485,18 +501,16 @@ erc-stamp--refresh-left-margin-prompt (setq erc-stamp--last-prompt nil)) (erc--refresh-prompt))) -(cl-defmethod erc--reveal-prompt - (&context (erc-stamp--display-margin-mode (eql t)) - (erc-stamp--margin-left-p (eql t))) - (put-text-property erc-insert-marker (1- erc-input-marker) - 'display `((margin left-margin) ,erc-stamp--last-prompt))) - (cl-defmethod erc--conceal-prompt (&context (erc-stamp--display-margin-mode (eql t)) - (erc-stamp--margin-left-p (eql t))) - (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))) - (put-text-property erc-insert-marker (1- erc-input-marker) - 'display `((margin left-margin) ,prompt)))) + (erc-stamp--margin-left-p (eql t)) + (erc-stamp--skip-left-margin-prompt-p null)) + (when-let (((null erc--hidden-prompt-overlay)) + (prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)) + (ov (make-overlay erc-insert-marker (1- erc-input-marker) + nil 'front-advance))) + (overlay-put ov 'display `((margin left-margin) ,prompt)) + (setq erc--hidden-prompt-overlay ov))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index af80194352c..2782460eec8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -187,101 +187,101 @@ erc-hide-prompt (with-current-buffer "ServNet" (should (= (point) erc-insert-marker)) (erc--hide-prompt erc-server-process) - (should (string= ">" (get-text-property (point) 'display)))) + (should (string= ">" (get-char-property (point) 'display)))) (with-current-buffer "#chan" (goto-char erc-insert-marker) - (should (string= ">" (get-text-property (point) 'display))) + (should (string= ">" (get-char-property (point) 'display))) (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) (goto-char erc-input-marker) (ert-simulate-command '(self-insert-command 1 ?/)) (goto-char erc-insert-marker) - (should-not (get-text-property (point) 'display)) + (should-not (get-char-property (point) 'display)) (should-not (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))) (with-current-buffer "bob" (goto-char erc-insert-marker) - (should (string= ">" (get-text-property (point) 'display))) + (should (string= ">" (get-char-property (point) 'display))) (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) (goto-char erc-input-marker) (ert-simulate-command '(self-insert-command 1 ?/)) (goto-char erc-insert-marker) - (should-not (get-text-property (point) 'display)) + (should-not (get-char-property (point) 'display)) (should-not (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))) (with-current-buffer "ServNet" - (should (get-text-property erc-insert-marker 'display)) + (should (get-char-property erc-insert-marker 'display)) (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) (erc--unhide-prompt) (should-not (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: server") (setq erc-hide-prompt '(server)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) - (should (string= ">" (get-text-property erc-insert-marker 'display)))) + (should (string= ">" (get-char-property erc-insert-marker 'display)))) (with-current-buffer "#chan" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "ServNet" (erc--unhide-prompt) (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: channel") (setq erc-hide-prompt '(channel)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "#chan" - (should (string= ">" (get-text-property erc-insert-marker 'display))) + (should (string= ">" (get-char-property erc-insert-marker 'display))) (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (erc--unhide-prompt) (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: query") (setq erc-hide-prompt '(query)) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should (string= ">" (get-text-property erc-insert-marker 'display))) + (should (string= ">" (get-char-property erc-insert-marker 'display))) (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) (erc--unhide-prompt) (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "#chan" - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (ert-info ("Value: nil") (setq erc-hide-prompt nil) (with-current-buffer "ServNet" (erc--hide-prompt erc-server-process) - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "bob" - (should-not (get-text-property erc-insert-marker 'display))) + (should-not (get-char-property erc-insert-marker 'display))) (with-current-buffer "#chan" - (should-not (get-text-property erc-insert-marker 'display)) + (should-not (get-char-property erc-insert-marker 'display)) (erc--unhide-prompt) ; won't blow up when prompt already showing - (should-not (get-text-property erc-insert-marker 'display)))) + (should-not (get-char-property erc-insert-marker 'display)))) (when noninteractive (kill-buffer "#chan") -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Optionally-align-prompt-to-prefix-in-erc-fill-wr.patch >From 723ac8a094709ffbebb39d0cb3222516d72c0791 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 19 Nov 2023 17:18:29 -0800 Subject: [PATCH 3/4] [5.6] Optionally align prompt to prefix in erc-fill-wrap * lisp/erc/erc-fill.el (erc-fill-wrap-align-prompt): New option for aligning prompt with leading portion of messages at the common "static center" pivot column, so it appears "dedented" along with all the speakers. (erc-fill-wrap-mode, erc-fill-wrap-enable): Take care to disable prompt-in-left-margin behavior when option `erc-fill-wrap-align-prompt' is non-nil. (erc-fill--wrap-measure): Improve doc string. (erc-fill--wrap-indent-prompt): New function to massage prompt `line-prefix' after updates, such as changes to away status. (Bug#51082) --- lisp/erc/erc-fill.el | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index e48d5540c86..adbe1c4e5f2 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -138,6 +138,11 @@ erc-fill-wrap-margin-side :package-version '(ERC . "5.6") :type '(choice (const nil) (const left) (const right))) +(defcustom erc-fill-wrap-align-prompt nil + "Whether to align the prompt at the common `wrap-prefix'." + :package-version '(ERC . "5.6") + :type 'boolean) + (defcustom erc-fill-line-spacing nil "Extra space between messages on graphical displays. Its value should be larger than that of the variable @@ -448,6 +453,13 @@ fill-wrap (or (eq erc-fill-wrap-margin-side 'left) (eq (default-value 'erc-insert-timestamp-function) #'erc-insert-timestamp-left))) + (when erc-fill-wrap-align-prompt + (add-hook 'erc--refresh-prompt-hook + #'erc-fill--wrap-indent-prompt nil t)) + (when erc-stamp--margin-left-p + (if erc-fill-wrap-align-prompt + (setq erc-stamp--skip-left-margin-prompt-p t) + (setq erc--inhibit-prompt-display-property-p t))) (setq erc-fill--function #'erc-fill-wrap) (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions @@ -460,6 +472,9 @@ fill-wrap (kill-local-variable 'erc-fill--function) (kill-local-variable 'erc-fill--wrap-visual-keys) (kill-local-variable 'erc-fill--wrap-last-msg) + (kill-local-variable 'erc--inhibit-prompt-display-property-p) + (remove-hook 'erc--refresh-prompt-hook + #'erc-fill--wrap-indent-prompt) (remove-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p t)) 'local) @@ -515,7 +530,10 @@ erc-fill--wrap-continued-message-p (defun erc-fill--wrap-measure (beg end) "Return display spec width for inserted region between BEG and END. -Ignore any `invisible' props that may be present when figuring." +Ignore any `invisible' props that may be present when figuring. +Expect the target region to be free of `line-prefix' and +`wrap-prefix' properties, and expect `display-line-numbers-mode' +to be disabled." (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size)) ;; `buffer-text-pixel-size' can move point! (save-excursion @@ -575,6 +593,21 @@ erc-fill-wrap 'erc-fill--wrap-value)) wrap-prefix (space :width erc-fill--wrap-value)))))) +(defun erc-fill--wrap-indent-prompt () + "Recompute the `line-prefix' of the prompt." + ;; Clear an existing `line-prefix' before measuring (bug#64971). + (remove-text-properties erc-insert-marker erc-input-marker + '(line-prefix nil wrap-prefix nil)) + ;; Restoring window configuration seems to prevent unwanted + ;; recentering reminiscent of `scrolltobottom'-related woes. + (let ((c (and (get-buffer-window) (current-window-configuration))) + (len (erc-fill--wrap-measure erc-insert-marker erc-input-marker))) + (when c + (set-window-configuration c)) + (put-text-property erc-insert-marker erc-input-marker + 'line-prefix + `(space :width (- erc-fill--wrap-value ,len))))) + (defvar erc-fill--wrap-rejigger-last-message nil "Temporary working instance of `erc-fill--wrap-last-msg'.") -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6-Optionally-allow-substitution-patterns-in-erc-pr.patch >From cb28b38e96b873f210b128065901578aad69f4f5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 7 Oct 2021 14:26:36 +0200 Subject: [PATCH 4/4] [5.6] Optionally allow substitution patterns in erc-prompt * etc/ERC-NEWS: Add entry for `erc-prompt-format'. * lisp/erc/erc-compat.el (erc-compat--format-spec-function-values-in-current-buffer): New convenience macro to wrap prompt-format substitutions in functions that remember the current buffer. * lisp/erc/erc.el (erc-prompt): Add predefined choice for function `erc-prompt-format'. (erc-prompt-format-face-example): New example value for option `erc-prompt-format'. (erc-prompt-format): New companion option for `erc-prompt' choice `erc-prompt-format'. New function of the same name to perform format substitutions and serve as a Custom choice value for `erc-prompt'. (erc--away-indicator, erc-away-status-indicator, erc--format-away-indicator): New formatting function for away status and helper variables. (erc--user-modes-indicator): New variable. (erc--format-user-modes): New function. (erc--format-channel-status-prefix): New function. (Bug#51082) Co-authored-by: F. Jason Park --- etc/ERC-NEWS | 10 ++++ lisp/erc/erc-compat.el | 24 +++++++++ lisp/erc/erc.el | 118 ++++++++++++++++++++++++++++++++++++++++- 3 files changed, 151 insertions(+), 1 deletion(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3bb9a30cfb2..04e9e99a0fd 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -191,6 +191,16 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. +** A smarter, more responsive prompt. +ERC's prompt can be told to respond dynamically to incoming and +outgoing messages by leveraging the familiar function variant of the +option 'erc-prompt'. With this release, only predefined functions can +take full advantage of this new dynamism, but an interface to empower +third-parties with the same possibilities may follow suit. To get +started, customize 'erc-prompt' to 'erc-prompt-format', and see the +option of the same name ('erc-prompt-format') for a rudimentary +templating facility reminiscent of 'erc-mode-line-format'. + ** Module 'scrolltobottom' now optionally more aggressive. Enabling the experimental option 'erc-scrolltobottom-all' makes ERC more vigilant about staking down the input area in all ERC windows. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 4c376cfbc22..fe1fc328c7d 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -459,6 +459,30 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) +(defmacro erc-compat--format-spec-function-values-in-current-buffer + (format specification &rest rest) + "Call `format-spec' with SPECIFICATION function values in current buffer. +For simplicity, expect the SPECIFICATION alist (1) to only have +function values and (2) to be quoted, so the entire form looks +like a normal `format-spec' function call, with FORMAT and REST +being passed along unmolested. For convenience, ensure functions +return \"\" as a fallback and that each runs in the current +buffer when deferred for lazy invocation on Emacs 29 and greater." + (cl-check-type (car specification) symbol) + (cl-check-type (cadr specification) cons) + (cl-check-type (nth 2 specification) null) + (let* ((buffer (make-symbol "buffer")) + (specs (mapcar (pcase-lambda (`(,k . ,v)) + (cons k (list '\, (if (>= emacs-major-version 29) + `(lambda () + (with-current-buffer ,buffer + (or (,v) ""))) + `(or (,v) ""))))) + (cadr specification)))) + `(format-spec ,format + (let ((,buffer (current-buffer))) + ,(list '\` specs)) + ,@rest))) (provide 'erc-compat) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0fbf6976d45..64179cd3408 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -751,7 +751,76 @@ erc-string-no-properties (defcustom erc-prompt "ERC>" "Prompt used by ERC. Trailing whitespace is not required." :group 'erc-display - :type '(choice string function)) + :type '(choice string + (function-item :tag "Interpret format specifiers" + erc-prompt-format) + function)) + +(defvar erc-prompt-format-face-example + #("%p%u%a\u00b7%b>" + 0 2 (font-lock-face erc-my-nick-prefix-face) + 2 4 (font-lock-face font-lock-keyword-face) + 4 6 (font-lock-face erc-error-face) + 6 7 (font-lock-face shadow) + 7 9 (font-lock-face font-lock-constant-face) + 9 10 (font-lock-face shadow)) + "An example value for option `erc-prompt-format' with faces.") + +(defcustom erc-prompt-format "%p[%b]%a" + "Format string when `erc-prompt' is `erc-prompt-format'. +ERC recognizes these substitution specifiers: + + %a - away indicator + %b - buffer name + %t - channel or query target, server domain, or dialed address + %T - target@network or buffer name + %s - target@server or server + %N - current network, like Libera.Chat + %p - channel membership prefix, like @ or + + %n - current nickname + %c - channel modes traditional + %u - user modes + +To pick your own colors, do something like: + + (setopt erc-prompt-format + (concat + (propertize \"%p\" \\='font-lock-face \\='erc-notice-face) + (propertize \"%b\" \\='font-lock-face \\='erc-input-face) + (propertize \"%a\" \\='font-lock-face \\='erc-error-face))) + +For a quick preview of this effect, try setting this option to +`erc-prompt-format-face-example' and loading a theme that sets +`erc-prompt-face' to a light or unspecified background. Lastly, +please remember that ERC ignores this option completely unless +the \"parent\" option `erc-prompt' is set to `erc-prompt-format'." + :package-version '(ERC . "5.6") + :group 'erc-display + :type '(choice (const :tag "prefix[buffer]away" "%p[%b]%a") + (variable-item :tag "Example with varied faces" + erc-prompt-format-face-example) + string)) + +(defun erc-prompt-format () + "Make predefined `format-spec' substitutions. + +See option `erc-prompt-format' and option `erc-prompt'." + (erc-compat--format-spec-function-values-in-current-buffer + (if (and (symbolp erc-prompt-format) + (special-variable-p erc-prompt-format)) + (symbol-value erc-prompt-format) + erc-prompt-format) + '((?N . erc-format-network) + (?T . erc-format-target-and/or-network) + (?a . erc--format-away-indicator) + (?b . buffer-name) + (?c . erc-format-channel-modes) + (?n . erc-current-nick) + (?p . erc--format-channel-status-prefix) + (?s . erc-format-target-and/or-server) + (?t . erc-format-target) + (?u . erc--format-user-modes)) + 'ignore-missing)) ; formerly `only-present' (defun erc-prompt () "Return the input prompt as a string. @@ -8245,6 +8314,53 @@ erc-format-away-status (format-time-string erc-mode-line-away-status-format a) ""))) +(defvar-local erc--away-indicator nil + "Cons containing an away indicator for the connection.") + +(defvar erc-away-status-indicator "A" + "String shown by various formatting facilities to indicate away status. +Currently only used by the option `erc-prompt-format'.") + +(defun erc--format-away-indicator () + "Return char with `display' property of `erc--away-indicator'." + (and-let* ((indicator (erc-with-server-buffer + (or erc--away-indicator + (setq erc--away-indicator (list ""))))) + (newcar (if (erc-away-time) erc-away-status-indicator ""))) + ;; Inform other buffers of the change when necessary. + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (eq newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(away?)" 'display indicator) + newcar)))) + +(defvar-local erc--user-modes-indicator nil + "Cons containing connection-wide indicator for user modes.") + +;; If adding more of these functions, should factor out commonalities. +;; As of ERC 5.6, this is identical to the away variant aside from +;; the var names and `eq', which isn't important. +(defun erc--format-user-modes () + "Return server's user modes as a string" + (and-let* ((indicator (erc-with-server-buffer + (or erc--user-modes-indicator + (setq erc--user-modes-indicator (list ""))))) + (newcar (erc--user-modes 'string))) + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (string= newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(user-modes?)" 'display indicator) + newcar)))) + +(defun erc--format-channel-status-prefix () + "Return the current channel membership prefix." + (and (erc--target-channel-p erc--target) + (erc-get-user-mode-prefix (erc-current-nick)))) + (defun erc-format-channel-modes () "Return the current channel's modes." (concat (apply #'concat -- 2.41.0 --=-=-=--