Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

Fix more missing faces on ERC margin strings

Browse source 
* lisp/erc/erc-goodies.el (keep-place-indicator): Add
`erc-keep-place-indicator-arrow' face to overlay arrow.
* lisp/erc/erc-stamp.el (erc-stamp--display-prompt-in-left-margin)
(erc--conceal-prompt): Add `erc-prompt-face' to entire `left-margin'
string.  See also 9ba65aa9 "Fix missing margin face on display prop in
erc-stamp".
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): Update
expected text properties on prompt.  (Bug#80693)
This commit is contained in:
F. Jason Park 2026-05-31 19:44:26 -07:00
parent 3229d6f0e3
commit 05f89d711d
3 changed files with 41 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
lisp/erc/erc-goodies.el
View file

@ -399,16 +399,18 @@ This module is local to individual buffers."
(progn (progn
(erc--restore-initialize-priors erc-keep-place-indicator-mode (erc--restore-initialize-priors erc-keep-place-indicator-mode
erc--keep-place-indicator-overlay (make-overlay 0 0)) erc--keep-place-indicator-overlay (make-overlay 0 0))
(when-let* (((memq erc-keep-place-indicator-style '(t arrow))) (when (memq erc-keep-place-indicator-style '(t arrow))
(ov-property (if (zerop (fringe-columns 'left)) (overlay-put
'after-string erc--keep-place-indicator-overlay
'before-string)) (if (zerop (fringe-columns 'left)) 'after-string 'before-string)
(display (if (zerop (fringe-columns 'left)) (propertize " " 'display
`((margin left-margin) ,overlay-arrow-string) (if (zerop (fringe-columns 'left))
'(left-fringe right-triangle `((margin left-margin)
erc-keep-place-indicator-arrow))) ,(propertize overlay-arrow-string
(bef (propertize " " 'display display))) 'font-lock-face
(overlay-put erc--keep-place-indicator-overlay ov-property bef)) 'erc-keep-place-indicator-arrow))
'(left-fringe right-triangle
erc-keep-place-indicator-arrow)))))
(when (memq erc-keep-place-indicator-style '(t face)) (when (memq erc-keep-place-indicator-style '(t face))
(overlay-put erc--keep-place-indicator-overlay 'face (overlay-put erc--keep-place-indicator-overlay 'face
'erc-keep-place-indicator-line))) 'erc-keep-place-indicator-line)))

21
lisp/erc/erc-stamp.el
View file

@ -478,7 +478,7 @@ and `erc-stamp--margin-left-p', before activating the mode."
(defun erc-stamp--display-prompt-in-left-margin () (defun erc-stamp--display-prompt-in-left-margin ()
"Show prompt in the left margin with padding." "Show prompt in the left margin with padding."
(when (or (not erc-stamp--last-prompt) (functionp erc-prompt) (when (or (null erc-stamp--last-prompt) (functionp erc-prompt)
(> (string-width erc-stamp--last-prompt) left-margin-width)) (> (string-width erc-stamp--last-prompt) left-margin-width))
(let ((s (buffer-substring erc-insert-marker (1- erc-input-marker)))) (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker))))
;; Prevent #("abc" n m (display ((...) #("abc" p q (display...)))) ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...))))
@ -489,7 +489,9 @@ and `erc-stamp--margin-left-p', before activating the mode."
;; This papers over a subtle off-by-1 bug here. ;; This papers over a subtle off-by-1 bug here.
(unless (equal sm s) (unless (equal sm s)
(setq s (concat sm (substring s -1)))))) (setq s (concat sm (substring s -1))))))
(setq erc-stamp--last-prompt (string-pad s left-margin-width nil t)))) (setq erc-stamp--last-prompt
(propertize (string-pad s left-margin-width nil t)
'font-lock-face 'erc-prompt-face))))
(put-text-property erc-insert-marker (1- erc-input-marker) (put-text-property erc-insert-marker (1- erc-input-marker)
'display `((margin left-margin) ,erc-stamp--last-prompt)) 'display `((margin left-margin) ,erc-stamp--last-prompt))
erc-stamp--last-prompt) erc-stamp--last-prompt)
@ -505,12 +507,15 @@ and `erc-stamp--margin-left-p', before activating the mode."
(&context (erc-stamp--display-margin-mode (eql t)) (&context (erc-stamp--display-margin-mode (eql t))
(erc-stamp--margin-left-p (eql t)) (erc-stamp--margin-left-p (eql t))
(erc-stamp--skip-left-margin-prompt-p null)) (erc-stamp--skip-left-margin-prompt-p null))
(when-let* (((null erc--hidden-prompt-overlay)) (unless erc--hidden-prompt-overlay
(prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)) (let ((ov (make-overlay erc-insert-marker (1- erc-input-marker)
(ov (make-overlay erc-insert-marker (1- erc-input-marker) nil 'front-advance)))
nil 'front-advance))) (overlay-put ov 'display
(overlay-put ov 'display `((margin left-margin) ,prompt)) `((margin left-margin)
(setq erc--hidden-prompt-overlay ov))) ,(propertize (string-pad erc-prompt-hidden
left-margin-width nil 'start)
'font-lock-face 'erc-prompt-face)))
(setq erc--hidden-prompt-overlay ov))))
(defun erc-insert-timestamp-left (string) (defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line." "Insert timestamps at the beginning of the line."

30
test/lisp/erc/erc-fill-tests.el
View file

@ -421,13 +421,14 @@
(pcase-let ((`((margin left-margin) ,displayed) (pcase-let ((`((margin left-margin) ,displayed)
(get-text-property erc-insert-marker 'display))) (get-text-property erc-insert-marker 'display)))
(should (equal-including-properties (should (equal-including-properties
displayed #(" ERC>" 4 8 displayed #(" ERC>"
( read-only t 0 4 (font-lock-face erc-prompt-face)
front-sticky t 4 8 ( read-only t
field erc-prompt front-sticky t
erc-prompt t field erc-prompt
rear-nonsticky t erc-prompt t
font-lock-face erc-prompt-face))))) rear-nonsticky t
font-lock-face erc-prompt-face)))))
(erc-fill-tests--compare "stamps-left-01") (erc-fill-tests--compare "stamps-left-01")
(ert-info ("Shrink left margin by 1 col") (ert-info ("Shrink left margin by 1 col")
@ -437,13 +438,14 @@
(pcase-let ((`((margin left-margin) ,displayed) (pcase-let ((`((margin left-margin) ,displayed)
(get-text-property erc-insert-marker 'display))) (get-text-property erc-insert-marker 'display)))
(should (equal-including-properties (should (equal-including-properties
displayed #(" ERC>" 3 7 displayed #(" ERC>"
( read-only t 0 3 (font-lock-face erc-prompt-face)
front-sticky t 3 7 ( read-only t
field erc-prompt front-sticky t
erc-prompt t field erc-prompt
rear-nonsticky t erc-prompt t
font-lock-face erc-prompt-face)))))))))) rear-nonsticky t
font-lock-face erc-prompt-face))))))))))
(ert-deftest erc-fill--wrap-massage-legacy-indicator-type () (ert-deftest erc-fill--wrap-massage-legacy-indicator-type ()
(let (calls (let (calls