From 0dcac98dc08d74454a33c81e516f2e721675600c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 18 Nov 2023 23:44:20 -0800 Subject: [PATCH 3/5] [5.6] 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 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 cd8e6ca7b24..06485bafabc 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