master 3c9cba9df3d 3/7: Don't inherit properties when refreshing ERC's prompt

[F. Jason Park]

branch: master
commit 3c9cba9df3d392a89314e06a6396c4157065f3b0
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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 the end of existing list-valued text
    properties.
    (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 `erc-prompt-face' behind any applied by a
    customized `erc-prompt' function value.  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 the tail 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 0654da5e16d..8cd69d1431e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2993,23 +2993,70 @@ debugging purposes, try `erc-debug-irc-protocol'."
           (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 (and erc--refresh-prompt-continue-request
+             (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 (1- erc-input-marker))
+          ;; 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))
+                (p (point))
+                (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)
+            (delete-region erc-insert-marker p))))
+      (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 @@ value.  See also `erc-button-add-face'."
         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 @@ If FACE is non-nil, it will be used to propertize the 
prompt.  If it is nil,
         ;; 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 59ad65d65b4..8c85f37dfe5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1881,6 +1881,18 @@
              (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))))