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)
This commit is contained in:
F. Jason Park 2023-11-18 23:44:20 -08:00
parent 3c9cba9df3
commit 0d6c8d41ab
3 changed files with 64 additions and 41 deletions

View file

@ -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)

View file

@ -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."

View file

@ -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")