mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
Use marker for max pos in erc--traverse-inserted
* lisp/erc/erc-stamp.el (erc-stamp--propertize-left-date-stamp): Run `erc-stamp--insert-date-hook' separately here instead of via `erc-insert-modify-hook'. (erc-stamp--insert-date-stamp-as-phony-message): Don't include value of `erc-stamp--insert-date-hook' in let-bound `erc-insert-modify-hook' because its members can run twice if buffer-local. Remove `erc-send-modify-hook' because it only runs via `erc-display-msg'. Shadow "pre" and "done" hooks because they don't expect to run in a narrowed buffer. Call getter for `erc-stamp--current-time'. (erc-stamp--lr-date-on-pre-modify, erc-insert-timestamp-left-and-right): Use function form of `erc-stamp--current-time' for determining current time stamp. * lisp/erc/erc.el (erc--get-inserted-msg-bounds): Fix off-by-one like thinko. (erc--traverse-inserted): Create temporary marker when END is a buffer position so that insertions and deletions are accounted for in the terminating condition. (erc--delete-inserted-message): New function. * test/lisp/erc/erc-tests.el (erc--delete-inserted-message): New test. (erc--update-modules/unknown): Improve readability slightly. * test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-make-expecter): Indicate assertion flavor in error message. (Bug#60936)
This commit is contained in:
parent
a4ba236e56
commit
5c4a9b7303
4 changed files with 119 additions and 19 deletions
|
|
@ -638,7 +638,8 @@ printed just after each line's text (no alignment)."
|
|||
(defun erc-stamp--propertize-left-date-stamp ()
|
||||
(add-text-properties (point-min) (1- (point-max))
|
||||
'(field erc-timestamp erc-stamp-type date-left))
|
||||
(erc--hide-message 'timestamp))
|
||||
(erc--hide-message 'timestamp)
|
||||
(run-hooks 'erc-stamp--insert-date-hook))
|
||||
|
||||
;; A kludge to pass state from insert hook to nested insert hook.
|
||||
(defvar erc-stamp--current-datestamp-left nil)
|
||||
|
|
@ -665,19 +666,18 @@ printed just after each line's text (no alignment)."
|
|||
(cl-assert string)
|
||||
(let ((erc-stamp--skip t)
|
||||
(erc--msg-props (map-into `((erc-msg . datestamp)
|
||||
(erc-ts . ,erc-stamp--current-time))
|
||||
(erc-ts . ,(erc-stamp--current-time)))
|
||||
'hash-table))
|
||||
(erc-send-modify-hook `(,@erc-send-modify-hook
|
||||
erc-stamp--propertize-left-date-stamp
|
||||
,@erc-stamp--insert-date-hook))
|
||||
(erc-insert-modify-hook `(,@erc-insert-modify-hook
|
||||
erc-stamp--propertize-left-date-stamp
|
||||
,@erc-stamp--insert-date-hook)))
|
||||
erc-stamp--propertize-left-date-stamp))
|
||||
;; Don't run hooks that aren't expecting a narrowed buffer.
|
||||
(erc-insert-pre-hook nil)
|
||||
(erc-insert-done-hook nil))
|
||||
(erc-display-message nil nil (current-buffer) string)
|
||||
(setq erc-timestamp-last-inserted-left string)))
|
||||
|
||||
(defun erc-stamp--lr-date-on-pre-modify (_)
|
||||
(when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
|
||||
(when-let ((ct (erc-stamp--current-time))
|
||||
(rendered (erc-stamp--format-date-stamp ct))
|
||||
((not (string-equal rendered erc-timestamp-last-inserted-left)))
|
||||
(erc-stamp--current-datestamp-left rendered)
|
||||
|
|
@ -723,7 +723,7 @@ left-sided stamps and date stamps inserted by this function."
|
|||
(narrow-to-region erc--insert-marker end-marker)
|
||||
(set-marker end-marker nil)
|
||||
(set-marker erc--insert-marker nil)))
|
||||
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
|
||||
(let* ((ct (erc-stamp--current-time))
|
||||
(ts-right (with-suppressed-warnings
|
||||
((obsolete erc-timestamp-format-right))
|
||||
(if erc-timestamp-format-right
|
||||
|
|
|
|||
|
|
@ -2980,7 +2980,7 @@ POINT, search from POINT instead of `point'."
|
|||
(and-let*
|
||||
((p (previous-single-property-change point
|
||||
'erc-msg)))
|
||||
(if (= p (1- point)) point (1- p)))))))
|
||||
(if (= p (1- point)) p (1- p)))))))
|
||||
,@(and (member only '(nil 'end))
|
||||
'((e (1- (next-single-property-change
|
||||
(if at-start-p (1+ point) point)
|
||||
|
|
@ -3005,8 +3005,12 @@ Expect callers to know that this doesn't wrap BODY in
|
|||
,@body)))
|
||||
|
||||
(defun erc--traverse-inserted (beg end fn)
|
||||
"Visit messages between BEG and END and run FN in narrowed buffer."
|
||||
(setq end (min end (marker-position erc-insert-marker)))
|
||||
"Visit messages between BEG and END and run FN in narrowed buffer.
|
||||
If END is a marker, possibly update its position."
|
||||
(unless (markerp end)
|
||||
(setq end (set-marker (make-marker) (or end erc-insert-marker))))
|
||||
(unless (eq end erc-insert-marker)
|
||||
(set-marker end (min erc-insert-marker end)))
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(let ((b (if (get-text-property (point) 'erc-msg)
|
||||
|
|
@ -3018,7 +3022,9 @@ Expect callers to know that this doesn't wrap BODY in
|
|||
(save-restriction
|
||||
(narrow-to-region b e)
|
||||
(funcall fn))
|
||||
(setq b e)))))
|
||||
(setq b e))))
|
||||
(unless (eq end erc-insert-marker)
|
||||
(set-marker end nil)))
|
||||
|
||||
(defvar erc--insert-marker nil
|
||||
"Internal override for `erc-insert-marker'.")
|
||||
|
|
@ -3240,6 +3246,27 @@ don't bother including the preceding newline."
|
|||
(cl-incf beg))
|
||||
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
|
||||
|
||||
(defun erc--delete-inserted-message (beg-or-point &optional end)
|
||||
"Remove message between BEG and END.
|
||||
Expect BEG and END to match bounds as returned by the macro
|
||||
`erc--get-inserted-msg-bounds'. Ensure all markers residing at
|
||||
the start of the deleted message end up at the beginning of the
|
||||
subsequent message."
|
||||
(let ((beg beg-or-point))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(unless end
|
||||
(setq end (erc--get-inserted-msg-bounds nil beg-or-point)
|
||||
beg (pop end)))
|
||||
(with-silent-modifications
|
||||
(if erc-legacy-invisible-bounds-p
|
||||
(delete-region beg (1+ end))
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(insert-before-markers
|
||||
(substring (delete-and-extract-region (1- (point)) (1+ end))
|
||||
-1))))))))
|
||||
|
||||
(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
|
||||
|
||||
(defun erc--order-text-properties-from-hash (table)
|
||||
|
|
|
|||
|
|
@ -1432,6 +1432,80 @@
|
|||
|
||||
(should-not calls))))))
|
||||
|
||||
(ert-deftest erc--delete-inserted-message ()
|
||||
(erc-mode)
|
||||
(erc--initialize-markers (point) nil)
|
||||
;; Put unique invisible properties on the line endings.
|
||||
(erc-display-message nil 'notice nil "one")
|
||||
(put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a)
|
||||
(let ((erc--msg-prop-overrides '((erc-msg . datestamp) (erc-ts . 0))))
|
||||
(erc-display-message nil nil nil
|
||||
(propertize "\n[date]" 'field 'erc-timestamp)))
|
||||
(put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b)
|
||||
(erc-display-message nil 'notice nil "two")
|
||||
|
||||
(ert-info ("Date stamp deleted cleanly")
|
||||
(goto-char 11)
|
||||
(should (looking-at (rx "\n[date]")))
|
||||
(should (eq 'datestamp (get-text-property (point) 'erc-msg)))
|
||||
(should (eq (point) (field-beginning (1+ (point)))))
|
||||
|
||||
(erc--delete-inserted-message (point))
|
||||
|
||||
;; Preceding line ending clobbered, replaced by trailing.
|
||||
(should (looking-back (rx "*** one\n")))
|
||||
(should (looking-at (rx "*** two")))
|
||||
(should (eq 'b (get-text-property (1- (point)) 'invisible))))
|
||||
|
||||
(ert-info ("Markers at pos-bol preserved")
|
||||
(erc-display-message nil 'notice nil "three")
|
||||
(should (looking-at (rx "*** two")))
|
||||
|
||||
(let ((m (point-marker))
|
||||
(n (point-marker))
|
||||
(p (point)))
|
||||
(set-marker-insertion-type m t)
|
||||
(goto-char (point-max))
|
||||
(erc--delete-inserted-message p)
|
||||
(should (= (marker-position n) p))
|
||||
(should (= (marker-position m) p))
|
||||
(goto-char p)
|
||||
(set-marker m nil)
|
||||
(set-marker n nil)
|
||||
(should (looking-back (rx "*** one\n")))
|
||||
(should (looking-at (rx "*** three")))))
|
||||
|
||||
(ert-info ("Compat")
|
||||
(erc-display-message nil 'notice nil "four")
|
||||
(should (looking-at (rx "*** three\n")))
|
||||
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
|
||||
(let ((erc-legacy-invisible-bounds-p t))
|
||||
(erc--delete-inserted-message (point))))
|
||||
(should (looking-at (rx "*** four\n"))))
|
||||
|
||||
(ert-info ("Deleting most recent message preserves markers")
|
||||
(let ((m (point-marker))
|
||||
(n (point-marker))
|
||||
(p (point)))
|
||||
(should (equal "*** four\n" (buffer-substring p erc-insert-marker)))
|
||||
(set-marker-insertion-type m t)
|
||||
(goto-char (point-max))
|
||||
(erc--delete-inserted-message p)
|
||||
(should (= (marker-position m) p))
|
||||
(should (= (marker-position n) p))
|
||||
(goto-char p)
|
||||
(should (looking-back (rx "*** one\n")))
|
||||
(should (looking-at erc-prompt))
|
||||
(erc--assert-input-bounds)
|
||||
|
||||
;; However, `m' is now forever "trapped" at `erc-insert-marker'.
|
||||
(erc-display-message nil 'notice nil "two")
|
||||
(should (= m erc-insert-marker))
|
||||
(goto-char n)
|
||||
(should (looking-at (rx "*** two\n")))
|
||||
(set-marker m nil)
|
||||
(set-marker n nil))))
|
||||
|
||||
(ert-deftest erc--order-text-properties-from-hash ()
|
||||
(let ((table (map-into '((a . 1)
|
||||
(erc-ts . 0)
|
||||
|
|
@ -2617,8 +2691,8 @@
|
|||
(obarray (obarray-make))
|
||||
(err (should-error (erc--update-modules erc-modules))))
|
||||
(should (equal (cadr err) "`foo' is not a known ERC module"))
|
||||
(should (equal (funcall get-calls)
|
||||
`((req . ,(intern-soft "erc-foo")))))))
|
||||
(should (equal (mapcar #'prin1-to-string (funcall get-calls))
|
||||
'("(req . erc-foo)")))))
|
||||
|
||||
;; Module's mode command exists but lacks an associated file.
|
||||
(ert-info ("Bad autoload flagged as suspect")
|
||||
|
|
@ -2627,10 +2701,8 @@
|
|||
(obarray (obarray-make))
|
||||
(erc-modules (list (intern "foo"))))
|
||||
|
||||
;; Create a mode activation command.
|
||||
;; Create a mode-activation command and make mode-var global.
|
||||
(funcall mk-cmd "foo")
|
||||
|
||||
;; Make the mode var global.
|
||||
(funcall mk-global "foo")
|
||||
|
||||
;; No local modules to return.
|
||||
|
|
@ -2639,7 +2711,7 @@
|
|||
'("foo")))
|
||||
;; ERC requires the library via prefixed module name.
|
||||
(should (equal (mapcar #'prin1-to-string (funcall get-calls))
|
||||
`("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
|
||||
'("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
|
||||
|
||||
;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
|
||||
;; load its defining library, first via the symbol property
|
||||
|
|
|
|||
|
|
@ -157,6 +157,7 @@ ON-SUCCESS, is nonexistent. To reset, specify a FROM argument."
|
|||
(let (positions)
|
||||
(lambda (timeout text &optional reset-from)
|
||||
(let* ((pos (cdr (assq (current-buffer) positions)))
|
||||
(erc-d-t--wait-message-prefix (and (< timeout 0) "Sustaining: "))
|
||||
(cb (lambda ()
|
||||
(unless pos
|
||||
(push (cons (current-buffer) (setq pos (make-marker)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue