From d29cd6fd8db3c9f1b78f273994022e0a1e1b29c1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 18 Nov 2023 23:04:50 -0800 Subject: [PATCH 1/4] [5.6] 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 existing list-valued text properties instead of push. (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 `font-lock-face' to support legacy code that uses `font-lock-face' to detect the prompt. 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 lists 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) --- lisp/erc/erc.el | 87 +++++++++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 12 ++++++ 2 files changed, 78 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f4c3f77593c..0fbf6976d45 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2993,23 +2993,70 @@ erc--assert-input-bounds (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 (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 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. + (let ((s (funcall erc-prompt)) + (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)) + (set-marker-insertion-type erc-insert-marker t) + (delete-region (point) (1- erc-input-marker)))) + (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 @@ erc--merge-prop 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 @@ erc-display-prompt ;; 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) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8dbe44ce5ed..af80194352c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1838,6 +1838,18 @@ erc--merge-prop (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)))) -- 2.41.0