(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)
(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)
(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
(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)
,@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)
(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'.")
(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)
(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)
(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")
(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.
'("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
projects / emacs.git / commitdiff