master 0d6c8d41ab7 4/7: Use overlay instead of text prop to hide ERC's prompt

[F. Jason Park]

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

    Use overlay instead of text prop to hide ERC's 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 initially
    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 method 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 @@ Conditionally try to reconnect and take appropriate 
action."
       ;; 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 @@ Conditionally try to reconnect and take appropriate 
action."
              (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 @@ Change value of property `erc-prompt' from t to `hidden'."
       (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 @@ prompt is wider, use its width instead."
           (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 @@ non-nil."
 (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 @@ and `erc-stamp--margin-left-p', before activating the 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 @@ and `erc-stamp--margin-left-p', before activating the 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 @@ and `erc-stamp--margin-left-p', before activating the 
mode."
       (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 8c85f37dfe5..980928aceac 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -187,101 +187,101 @@
       (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")