1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

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)
This commit is contained in:
F. Jason Park 2023-11-18 23:04:50 -08:00
parent 4064985b80
commit 3c9cba9df3
2 changed files with 78 additions and 21 deletions

View file

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

View file

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