Don't insert prompt input before markers in ERC

* etc/ERC-NEWS: Update entry in 5.6 section announcing a persistent
prompt.
* lisp/erc/erc-dcc.el (erc-dcc-chat-setup): Use helper
`erc--initialize-markers' to set up prompt.
* lisp/erc/erc.el (erc--initialize-markers): Change
`erc-insert-marker' type to t.  Do this to spare modules that want to
remember the current message location from resorting to workarounds,
like leaving a marker one char before the end of a message, which is
not foolproof.
(erc--refresh-prompt): Temporarily change type of `erc-insert-marker'
when inserting prompt.
(erc-display-line-1): Insert incoming message normally instead of
forcing before markers, thus respecting markers left by third parties.
Strictly speaking, this is a breaking change.
(erc-display-msg): Insert normally instead of calling
`insert-before-markers', which was a regression introduced by 05f6fdb9
"Preserve ERC prompt and its bounding markers".
* test/lisp/erc/erc-dcc-tests.el
(erc-dcc-tests--dcc-handle-ctcp-send,
erc-dcc-tests--erc-dcc-do-GET-command): Use helper to initialize
prompt and markers.
* test/lisp/erc/erc-networks-tests.el
(erc-networks--ensure-announced,
erc-networks--rename-server-buffer--existing--reuse,
erc-networks--rename-server-buffer--existing--noreuse,
erc-networks--rename-server-buffer--reconnecting,
erc-networks--rename-server-buffer--id,
erc-networks--rename-server-buffer--existing--live,
erc-networks--rename-server-buffer--local-match,
erc-networks--rename-server-buffer--local-nomatch): Use helper to
initialize prompt and bounding markers.
* test/lisp/erc/erc-stamp-tests.el (erc-stamp-tests--insert-right):
Use `erc--initialize-markers' for setting up prompt.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt): Adjust assertions
for expected prompt content.  (Bug#60936)
This commit is contained in:
F. Jason Park 2023-06-10 00:17:44 -07:00
parent d880a08f95
commit 2daa71f932
7 changed files with 58 additions and 60 deletions

View file

@ -244,7 +244,14 @@ running hooks during message insertion, and the position of its
"insert marker" (ERC's per-buffer process mark) was inconsistent
during these spells. To make insertion handling more predictable in
preparation for incorporating various protocol extensions, the prompt
and its bounding markers have become perennial fixtures. In rare
and its bounding markers have become perennial fixtures. To effect
this change, small behavioral differences in message insertion have
been adopted. Crucially, 'erc-insert-marker' now has an "insertion
type" of t, and 'erc-display-line-1' now calls 'insert' instead of
'insert-before-prompt'. This allows user code to leave its own
markers via 'erc-insert-modify-hook' and 'erc-insert-post-hook'
instead of having to resort to workarounds. Message insertion for
outgoing messages, in 'erc-display-msg', remains as before. In rare
cases, these changes may mean third-party code needs tweaking, for
example, requiring the use of 'insert-before-markers' instead of
'insert'. As always, users feeling unduly inconvenienced by these

View file

@ -1213,9 +1213,8 @@ other client."
erc-dcc-from nick
erc-dcc-entry-data entry
erc-dcc-unprocessed-output ""
erc-insert-marker (point-max-marker)
erc-input-marker (make-marker))
(erc-display-prompt buffer (point-max))
(erc--initialize-markers (point) nil)
(set-process-buffer proc buffer)
(add-hook 'kill-buffer-hook #'erc-dcc-chat-buffer-killed nil t)
(run-hook-with-args 'erc-dcc-chat-connect-hook proc))

View file

@ -2214,8 +2214,8 @@ nil."
(alist-get 'erc-insert-marker continued-session))
(set-marker erc-input-marker
(alist-get 'erc-input-marker continued-session))
(goto-char erc-insert-marker)
(cl-assert (= (field-end) erc-input-marker))
(set-marker-insertion-type erc-insert-marker t)
(cl-assert (= (field-end erc-insert-marker) erc-input-marker))
(goto-char old-point)
(erc--unhide-prompt))
(cl-assert (not (get-text-property (point) 'erc-prompt)))
@ -2226,6 +2226,7 @@ nil."
(insert "\n\n")
(set-marker erc-insert-marker (point))
(erc-display-prompt)
(set-marker-insertion-type erc-insert-marker t)
(cl-assert (= (point) (point-max)))))
(defun erc-open (&optional server port nick full-name
@ -2821,10 +2822,12 @@ this option to nil."
(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)))))
(defun erc-display-line-1 (string buffer)
@ -2860,7 +2863,7 @@ If STRING is nil, the function does nothing."
(save-restriction
(widen)
(goto-char insert-position)
(insert-before-markers string)
(insert string)
(erc--assert-input-bounds)
;; run insertion hook, with point at restored location
(save-restriction
@ -6490,15 +6493,14 @@ Return non-nil only if we actually send anything."
(when erc-insert-this
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position erc-insert-marker))
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
beg)
(goto-char insert-position)
(insert-before-markers (erc-format-my-nick))
(insert (erc-format-my-nick))
(setq beg (point))
(insert-before-markers line)
(insert line)
(erc-put-text-property beg (point) 'font-lock-face 'erc-input-face)
(erc-put-text-property insert-position (point) 'erc-command 'PRIVMSG)
(insert-before-markers "\n")
(insert "\n")
(save-restriction
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)

View file

@ -57,11 +57,8 @@
(erc-mode)
(setq erc-server-process
(start-process "fake" (current-buffer) "sleep" "10")
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))
(erc--initialize-markers (point) nil)
(set-process-query-on-exit-flag erc-server-process nil)
(should-not erc-dcc-list)
(erc-ctcp-query-DCC erc-server-process
@ -121,17 +118,14 @@
calls)
(erc-mode)
(setq erc-server-process proc
erc-input-marker (make-marker)
erc-insert-marker (make-marker)
erc-server-current-nick "dummy")
(erc--initialize-markers (point) nil)
(set-process-query-on-exit-flag proc nil)
(cl-letf (((symbol-function 'read-file-name)
(lambda (&rest _) file))
((symbol-function 'erc-dcc-get-file)
(lambda (&rest r) (push r calls))))
(goto-char (point-max))
(set-marker erc-insert-marker (point-max))
(erc-display-prompt)
(ert-info ("No turbo")
(should-not (plist-member elt :turbo))

View file

@ -1233,10 +1233,7 @@
:contents "MOTD File is missing")))
(erc-mode) ; boilerplate displayable start (needs `erc-server-process')
(insert "\n\n")
(setq erc-input-marker (make-marker) erc-insert-marker (make-marker))
(set-marker erc-insert-marker (point-max))
(erc-display-prompt) ; boilerplate displayable end
(erc--initialize-markers (point) nil)
(erc-networks--ensure-announced erc-server-process parsed)
(goto-char (point-min))
@ -1277,9 +1274,9 @@
(with-current-buffer old-buf
(erc-mode)
(insert "*** Old buf")
(erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc
erc-networks--id (erc-networks--id-create nil)))
@ -1328,10 +1325,10 @@
erc-reuse-buffers)
(with-current-buffer old-buf
(erc-mode)
(erc--initialize-markers (point) nil)
(insert "*** Old buf")
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc
erc-networks--id (erc-networks--id-create nil)))
(with-current-buffer (get-buffer-create "#chan")
@ -1377,10 +1374,10 @@
(with-current-buffer old-buf
(erc-mode)
(erc--initialize-markers (point) nil)
(insert "*** Old buf")
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc
erc-networks--id (erc-networks--id-create nil)))
@ -1415,10 +1412,10 @@
(with-current-buffer old-buf
(erc-mode)
(erc--initialize-markers (point) nil)
(insert "*** Old buf")
(setq erc-network 'FooNet
erc-networks--id (erc-networks--id-create 'MySession)
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc))
(with-current-buffer (get-buffer-create "#chan")
@ -1454,10 +1451,10 @@
(with-current-buffer old-buf
(erc-mode)
(erc--initialize-markers (point) nil)
(insert "*** Old buf")
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc
erc-networks--id (erc-networks--id-create nil))
(should (erc-server-process-alive)))
@ -1473,15 +1470,12 @@
(ert-info ("New buffer rejected, abandoned, not killed")
(with-current-buffer (get-buffer-create "irc.foonet.org")
(erc-mode)
(erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
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))
(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)))
@ -1514,10 +1508,10 @@
(with-current-buffer old-buf
(erc-mode)
(insert "*** Old buf")
(erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-server-announced-name "us-east.foonet.org"
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc
erc--isupport-params (make-hash-table)
erc-networks--id (erc-networks--id-create nil))
@ -1566,10 +1560,10 @@
(with-current-buffer old-buf
(erc-mode)
(insert "*** Old buf")
(erc--initialize-markers (point) nil)
(setq erc-network 'FooNet
erc-server-current-nick "tester"
erc-server-announced-name "us-west.foonet.org"
erc-insert-marker (set-marker (make-marker) (point-max))
erc-server-process old-proc
erc--isupport-params (make-hash-table)
erc-networks--id (erc-networks--id-create nil))

View file

@ -43,13 +43,10 @@
(with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
(erc-mode)
(erc-munge-invisibility-spec)
(erc--initialize-markers (point) nil)
(setq erc-server-process (start-process "p" (current-buffer)
"sleep" "1")
erc-input-marker (make-marker)
erc-insert-marker (make-marker))
"sleep" "1"))
(set-process-query-on-exit-flag erc-server-process nil)
(set-marker erc-insert-marker (point-max))
(erc-display-prompt)
(funcall test)

View file

@ -294,16 +294,19 @@
(set-process-query-on-exit-flag erc-server-process nil)
;; Incoming message redraws prompt
(erc-display-message nil 'notice nil "Welcome")
(should (looking-at-p (rx "*** Welcome")))
(forward-line)
(should (looking-at-p "ServNet 4>"))
;; Say something
(save-excursion (goto-char erc-input-marker)
(insert "Howdy")
(erc-send-current-line)
(forward-line -1)
(goto-char erc-input-marker)
(insert "Howdy")
(erc-send-current-line)
(save-excursion (forward-line -1)
(should (looking-at "No target"))
(forward-line -1)
(should (looking-at "<tester> Howdy")))
(should (looking-at-p "ServNet 6>"))
(should (looking-back "ServNet 6> "))
(should (= erc-input-marker (point)))
;; Space after prompt is unpropertized
(should (get-text-property (1- erc-input-marker) 'erc-prompt))
(should-not (get-text-property erc-input-marker 'erc-prompt))
@ -317,6 +320,7 @@
(erc-tests--send-prep)
(goto-char erc-insert-marker)
(should (looking-at-p "#chan 9>"))
(goto-char erc-input-marker)
(setq erc-server-process (buffer-local-value 'erc-server-process
(get-buffer "ServNet"))
erc-networks--id (erc-with-server-buffer erc-networks--id)
@ -328,18 +332,18 @@
(erc-update-current-channel-member "tester" "tester")
(erc-display-message nil nil (current-buffer)
(erc-format-privmessage "alice" "Hi" nil t))
(should (looking-at-p "#chan@ServNet 10>"))
(save-excursion (goto-char erc-input-marker)
(insert "Howdy")
(erc-send-current-line)
(forward-line -1)
(should (looking-back "#chan@ServNet 10> "))
(goto-char erc-input-marker)
(insert "Howdy")
(erc-send-current-line)
(save-excursion (forward-line -1)
(should (looking-at "<tester> Howdy")))
(should (looking-at-p "#chan@ServNet 11>"))
(save-excursion (goto-char erc-input-marker)
(insert "/query bob")
(erc-send-current-line))
(should (looking-back "#chan@ServNet 11> "))
(should (= (point) erc-input-marker))
(insert "/query bob")
(erc-send-current-line)
;; Query does not redraw (nor /help, only message input)
(should (looking-at-p "#chan@ServNet 11>"))
(should (looking-back "#chan@ServNet 11> "))
;; No sign of old prompts
(save-excursion
(goto-char (point-min))
@ -349,15 +353,16 @@
(with-current-buffer (get-buffer "bob")
(goto-char erc-insert-marker)
(should (looking-at-p "bob@ServNet 14>"))
(goto-char erc-input-marker)
(erc-display-message nil nil (current-buffer)
(erc-format-privmessage "bob" "Hi" nil t))
(should (looking-at-p "bob@ServNet 15>"))
(save-excursion (goto-char erc-input-marker)
(insert "Howdy")
(erc-send-current-line)
(forward-line -1)
(should (looking-back "bob@ServNet 15> "))
(goto-char erc-input-marker)
(insert "Howdy")
(erc-send-current-line)
(save-excursion (forward-line -1)
(should (looking-at "<tester> Howdy")))
(should (looking-at-p "bob@ServNet 16>"))
(should (looking-back "bob@ServNet 16> "))
;; No sign of old prompts
(save-excursion
(goto-char (point-min))