unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 51082@debbugs.gnu.org
Cc: Amin Bandali <bandali@gnu.org>,
	Lars Ingebrigtsen <larsi@gnus.org>,
	emacs-erc@gnu.org, Stefan Kangas <stefan@marxist.se>
Subject: bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
Date: Mon, 20 Nov 2023 13:17:09 -0800	[thread overview]
Message-ID: <875y1wi0q2.fsf__48246.7941985064$1700515102$gmane$org@neverwas.me> (raw)
In-Reply-To: <CADwFkmkXoy-=4MBALshitVO7wDYeDve7SNmB1Mf3N6z6TGaVaw@mail.gmail.com> (Stefan Kangas's message of "Thu, 7 Oct 2021 09:05:02 -0400")

[-- Attachment #1: Type: text/plain, Size: 1558 bytes --]

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 über 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Don-t-inherit-properties-when-refreshing-ERC-s-p.patch --]
[-- Type: text/x-patch, Size: 8368 bytes --]

From d29cd6fd8db3c9f1b78f273994022e0a1e1b29c1 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Use-overlay-instead-of-text-prop-to-hide-ERC-pro.patch --]
[-- Type: text/x-patch, Size: 13752 bytes --]

From b16774c76ee16cb342098a0e69a2b1688a44813b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6-Optionally-align-prompt-to-prefix-in-erc-fill-wr.patch --]
[-- Type: text/x-patch, Size: 4262 bytes --]

From 723ac8a094709ffbebb39d0cb3222516d72c0791 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-5.6-Optionally-allow-substitution-patterns-in-erc-pr.patch --]
[-- Type: text/x-patch, Size: 9647 bytes --]

From cb28b38e96b873f210b128065901578aad69f4f5 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
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 <jp@neverwas.me>
---
 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


  parent reply	other threads:[~2023-11-20 21:17 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-10-07 13:05 bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network" Stefan Kangas
2021-10-09  0:53 ` Amin Bandali
     [not found] ` <871r4vc92w.fsf@gnu.org>
2021-10-09  8:03   ` J.P.
2022-09-10  5:20 ` Lars Ingebrigtsen
2023-11-20 21:17 ` J.P. [this message]
     [not found] ` <875y1wi0q2.fsf@neverwas.me>
2023-11-20 21:22   ` J.P.
2023-11-22 19:25   ` J.P.
     [not found]   ` <87pm01d1yy.fsf@neverwas.me>
2023-11-24 22:12     ` J.P.
     [not found]     ` <87plzy2433.fsf@neverwas.me>
2023-12-15  1:18       ` Stefan Kangas

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='875y1wi0q2.fsf__48246.7941985064$1700515102$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=51082@debbugs.gnu.org \
    --cc=bandali@gnu.org \
    --cc=emacs-erc@gnu.org \
    --cc=larsi@gnus.org \
    --cc=stefan@marxist.se \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).