From 05f6fdb9e7893329baff675bd31fb36ad64c756d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 19 Feb 2023 21:33:36 -0800 Subject: [PATCH] Preserve ERC prompt and its bounding markers * lisp/erc/erc.el (erc--assert-input-bounds): Add possibly temporary helper function to sync `process-mark' to `erc-insert-marker' in server buffer. (erc-display-line-1): Expect `erc-insert-marker' to always be initialized. Assert some essential invariants regarding insert markers. (erc-send-current-line): Delete typed input but not the prompt. (erc-display-msg): Rework slightly to respect existing markers. * test/lisp/erc/erc-dcc-tests.el (erc-dcc-tests--dcc-handle-ctcp-send): Set insert marker. * test/lisp/erc/erc-networks-tests.el (erc-networks--rename-server-buffer--existing-live): Initialize markers to appease `erc--assert-input-bounds'. * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Fix sloppy mock. (Bug#60936.) --- lisp/erc/erc.el | 49 ++++++++++++++++------------- test/lisp/erc/erc-dcc-tests.el | 2 ++ test/lisp/erc/erc-networks-tests.el | 10 ++++-- test/lisp/erc/erc-tests.el | 4 +-- 4 files changed, 39 insertions(+), 26 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 85f0416f44b..6e14f4780e4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2632,6 +2632,16 @@ this option to nil." :type 'boolean :group 'erc) +(define-inline erc--assert-input-bounds () + (inline-quote + (progn (when (and (processp erc-server-process) + (eq (current-buffer) (process-buffer erc-server-process))) + ;; It's believed that these only need syncing immediately + ;; following the first two insertions in a server buffer. + (set-marker (process-mark erc-server-process) erc-insert-marker)) + (cl-assert (< erc-insert-marker erc-input-marker)) + (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) + (defun erc-display-line-1 (string buffer) "Display STRING in `erc-mode' BUFFER. Auxiliary function used in `erc-display-line'. The line gets filtered to @@ -2641,8 +2651,7 @@ Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called. If STRING is nil, the function does nothing." (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) - (let ((insert-position (or (marker-position erc-insert-marker) - (point-max)))) + (let ((insert-position (marker-position erc-insert-marker))) (let ((string string) ;; FIXME! Can this be removed? (buffer-undo-list t) (inhibit-read-only t)) @@ -2667,6 +2676,7 @@ If STRING is nil, the function does nothing." (widen) (goto-char insert-position) (insert-before-markers string) + (erc--assert-input-bounds) ;; run insertion hook, with point at restored location (save-restriction (narrow-to-region insert-position (point)) @@ -2674,7 +2684,8 @@ If STRING is nil, the function does nothing." (run-hooks 'erc-insert-post-hook) (when erc-remove-parsed-property (remove-text-properties (point-min) (point-max) - '(erc-parsed nil)))))))) + '(erc-parsed nil)))) + (erc--assert-input-bounds))))) (run-hooks 'erc-insert-done-hook) (erc-update-undo-list (- (or (marker-position erc-insert-marker) (point-max)) @@ -6006,8 +6017,7 @@ When the returned value is a string, pass it to `erc-error'.") (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt - (delete-region (erc-beg-of-input-line) - (erc-end-of-input-line)) + (delete-region erc-input-marker (erc-end-of-input-line)) (unwind-protect (erc-send-input str 'skip-ws-chk) ;; Fix the buffer if the command didn't kill it @@ -6015,12 +6025,7 @@ When the returned value is a string, pass it to `erc-error'.") (with-current-buffer old-buf (save-restriction (widen) - (goto-char (point-max)) - (when (processp erc-server-process) - (set-marker (process-mark erc-server-process) (point))) - (set-marker erc-insert-marker (point)) (let ((buffer-modified (buffer-modified-p))) - (erc-display-prompt) (set-buffer-modified-p buffer-modified)))))) ;; Only when last hook has been run... @@ -6106,21 +6111,21 @@ Return non-nil only if we actually send anything." (defun erc-display-msg (line) "Display LINE as a message of the user to the current target at point." (when erc-insert-this - (let ((insert-position (point))) - (insert (erc-format-my-nick)) - (let ((beg (point))) - (insert line) - (erc-put-text-property beg (point) - 'font-lock-face 'erc-input-face)) - (insert "\n") - (when (processp erc-server-process) - (set-marker (process-mark erc-server-process) (point))) - (set-marker erc-insert-marker (point)) - (save-excursion + (save-excursion + (erc--assert-input-bounds) + (let ((insert-position (marker-position erc-insert-marker)) + beg) + (goto-char insert-position) + (insert-before-markers (erc-format-my-nick)) + (setq beg (point)) + (insert-before-markers line) + (erc-put-text-property beg (point) 'font-lock-face 'erc-input-face) + (insert-before-markers "\n") (save-restriction (narrow-to-region insert-position (point)) (run-hooks 'erc-send-modify-hook) - (run-hooks 'erc-send-post-hook)))))) + (run-hooks 'erc-send-post-hook)) + (erc--assert-input-bounds))))) (defun erc-command-symbol (command) "Return the ERC command symbol for COMMAND if it exists and is bound." diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index fed86eff2c5..7fb5f82e784 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -60,6 +60,8 @@ erc-input-marker (make-marker) erc-insert-marker (make-marker) erc-server-current-nick "dummy") + (erc-display-prompt) + (set-marker erc-insert-marker (pos-bol)) (set-process-query-on-exit-flag erc-server-process nil) (should-not erc-dcc-list) (erc-ctcp-query-DCC erc-server-process diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 96836c29aed..b9d216f217b 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1475,10 +1475,16 @@ (erc-mode) (setq erc-network 'FooNet erc-server-current-nick "tester" - erc-insert-marker (set-marker (make-marker) (point-max)) + erc-insert-marker (make-marker) + erc-input-marker (make-marker) erc-server-process (erc-networks-tests--create-live-proc) erc-networks--id (erc-networks--id-create nil)) - (should-not (erc-networks--rename-server-buffer erc-server-process)) + (set-process-sentinel erc-server-process #'ignore) + (erc-display-prompt nil (point-max)) + (set-marker erc-insert-marker (pos-bol)) + (erc-display-message nil 'notice (current-buffer) "notice") + (with-silent-modifications + (should-not (erc-networks--rename-server-buffer erc-server-process))) (should (eq erc-active-buffer old-buf)) (should-not (erc-server-process-alive)) (should (string= (buffer-name) "irc.foonet.org")) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 795864a2cc2..b2f24aa718e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -559,8 +559,8 @@ ;; (cl-letf (((symbol-function 'erc-process-input-line) (lambda (&rest _) - (insert-before-markers - (erc-display-message-highlight 'notice "echo: one\n")))) + (erc-display-message + nil 'notice (current-buffer) "echo: one\n"))) ((symbol-function 'erc-command-no-process-p) (lambda (&rest _) t))) (ert-info ("Create ring, populate, recall") -- 2.39.2