Reconcile erc-stamp--date-stamps when merging buffers
* etc/ERC-NEWS: Mention new face `erc-information'. * lisp/erc/erc-button.el (erc-button-add-buttons): Skip buttonization when the "msg prop" `erc--skip' is present and contains the symbol `button'. Set `alist' to nil in the same guard condition as a roundabout way of suppressing further processing. * lisp/erc/erc-networks.el (erc--insert-admin-message): Forward declaration. (erc-networks--insert-transplanted-content) (erc-networks--transplant-buffer-content): Replace former with latter. Change signature to take source and destination buffers as parameters. (erc-networks--transplant-target-buffer-function): New function-valued variable. (erc-networks--target-transplant-in-progress-p): New variable, a flag for downstream code to detect when a transplant is underway. (erc-networks--reclaim-orphaned-target-buffers): Defer to `erc-networks--transplant-target-buffer-function' to handle the actual transplant business. Crucially, kill the buffer afterwards instead of beforehand. If new buffer-association bugs emerge related to the combining of old or renamed target buffers, this reordering may be at fault. (erc-networks--copy-over-server-buffer-contents): Pass old and new buffers to `erc-networks--insert-transplanted-content'. * lisp/erc/erc-stamp.el (erc-stamp--defer-date-insertion-on-post-modify): Set `fn' slot of `erc-stamp--date' instance to `ignore' when running the actual callback in order to conserve a little space. (erc-stamp--date-mode): Add and remove hook members for `erc-networks--copy-server-buffer-functions' and `erc-networks--transplant-target-buffer-function'. (erc-insert-timestamp-left-and-right): Always clear `erc-timestamp-last-inserted-right' to ensure a right stamp accompanies every date stamp. (erc-stamp--dedupe-date-stamps) (erc-stamp--dedupe-date-stamps-from-buffer) (erc-stamp--dedupe-date-stamps-from-target-buffer): New functions. Date stamp behavior was revamped as part of bug#60936. * lisp/erc/erc.el (erc-informational): New face. (erc--insert-admin-message): New function to hide some "msg prop" complexity from "upstream" libraries, like `erc-networks', and thus avoid more forward-declarations. A less smelly approach would be to devise a general interface owned by such libraries, or erc-common, that `erc-mode' could then hook into on init. (erc-display-message-highlight): Make face matching more limber to accommodate the convention of face names lacking a "-face" suffix. (erc-message-english-graft): New variable. (erc-kill-channel): Inhibit execution of hook when `erc-networks--target-transplant-in-progress-p' is non-nil. * test/lisp/erc/erc-networks-tests.el (erc-networks--rename-server-buffer--no-existing--orphan) (erc-networks--rename-server-buffer--existing--reuse) (erc-networks--rename-server-buffer--local-match) (erc-networks--rename-server-buffer--local-nomatch): Use helper to initialize markers. * test/lisp/erc/erc-stamp-tests.el (erc-stamp--dedupe-date-stamps): New test. (Bug#70928)
This commit is contained in:
F. Jason Park
parent
cf7cc4c630
commit
fee637468b
7 changed files with 258 additions and 44 deletions
|
|
@ -339,6 +339,13 @@ Also available as the library functions 'erc-cmd-AME', 'erc-cmd-GME',
|
|||
and 'erc-cmd-GMSG', these new slash commands can prove handy in test
|
||||
environments.
|
||||
|
||||
** New face 'erc-information' for local administrative messages.
|
||||
Messages not originating from a server have historically been shown in
|
||||
'erc-notice-face', sometimes in combination with 'erc-error-face'.
|
||||
Neither are well suited for local messages of moderate importance.
|
||||
From now on, such messages will appear in a more muted color but
|
||||
retain the familiar 'erc-notice-prefix' stars.
|
||||
|
||||
** Miscellaneous UX changes.
|
||||
Some minor quality-of-life niceties have finally made their way to
|
||||
ERC. For example, fool visibility has become togglable with the new
|
||||
|
|
|
|||
|
|
@ -309,7 +309,9 @@ specified by `erc-button-alist'."
|
|||
regexp)
|
||||
(erc-button-remove-old-buttons)
|
||||
(unless (or erc-button--has-nickname-entry
|
||||
(not erc-button-buttonize-nicks))
|
||||
(not erc-button-buttonize-nicks)
|
||||
(and (erc--memq-msg-prop 'erc--skip 'button)
|
||||
(not (setq alist nil))))
|
||||
(erc-button-add-nickname-buttons
|
||||
`(_ _ erc-button--modify-nick-function
|
||||
,erc-button-nickname-callback-function)))
|
||||
|
|
|
|||
|
|
@ -50,6 +50,7 @@
|
|||
(defvar erc-server-process)
|
||||
|
||||
(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
|
||||
(declare-function erc--insert-admin-message "erc" (&rest args))
|
||||
(declare-function erc-buffer-filter "erc" (predicate &optional proc))
|
||||
(declare-function erc-current-nick "erc" nil)
|
||||
(declare-function erc-display-error-notice "erc" (parsed string))
|
||||
|
|
@ -1345,24 +1346,38 @@ Copy source (prefix) from MOTD-ish message as a last resort."
|
|||
(setq erc-network nil)
|
||||
nil)
|
||||
|
||||
;; TODO add note in Commentary saying that this module is considered a
|
||||
;; core module and that it's as much about buffer naming and network
|
||||
;; identity as anything else.
|
||||
(defun erc-networks--transplant-buffer-content (src dest)
|
||||
"Insert buffer SRC's contents into DEST, above its contents."
|
||||
(with-silent-modifications
|
||||
(let ((content (with-current-buffer src
|
||||
(cl-assert (not (buffer-narrowed-p)))
|
||||
(erc--insert-admin-message 'graft ?n dest ?o src)
|
||||
(buffer-substring (point-min) erc-insert-marker))))
|
||||
(with-current-buffer dest
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(cl-assert (not (buffer-narrowed-p)))
|
||||
(goto-char (point-min))
|
||||
(while (and (eql ?\n (char-after (point)))
|
||||
(null (text-properties-at (point))))
|
||||
(delete-char 1))
|
||||
(insert-before-markers content)))))))
|
||||
|
||||
(defun erc-networks--insert-transplanted-content (content)
|
||||
(let ((inhibit-read-only t)
|
||||
(buffer-undo-list t))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(insert-before-markers content)))))
|
||||
(defvar erc-networks--transplant-target-buffer-function
|
||||
#'erc-networks--transplant-buffer-content
|
||||
"Function to rename and merge the contents of two target buffers.
|
||||
Called with the donating buffer to be killed and buffer to receive the
|
||||
transplant. Consuming modules can leave a marker at the beginning of
|
||||
the latter buffer to access the insertion point, if needing to do things
|
||||
like adjust invisibility properties, etc.")
|
||||
|
||||
(defvar erc-networks--target-transplant-in-progress-p nil
|
||||
"Non-nil when merging target buffers.")
|
||||
|
||||
;; This should run whenever a network identity is updated.
|
||||
|
||||
(defun erc-networks--reclaim-orphaned-target-buffers (new-proc nid announced)
|
||||
"Visit disowned buffers for same NID and associate with NEW-PROC.
|
||||
ANNOUNCED is the server's reported host name."
|
||||
Expect ANNOUNCED to be the server's reported host name."
|
||||
(erc-buffer-filter
|
||||
(lambda ()
|
||||
(when (and erc--target
|
||||
|
|
@ -1372,20 +1387,26 @@ ANNOUNCED is the server's reported host name."
|
|||
(string= erc-server-announced-name announced)))
|
||||
;; If a target buffer exists for the current process, kill this
|
||||
;; stale one after transplanting its content; else reinstate.
|
||||
(if-let ((existing (erc-get-buffer
|
||||
(erc--target-string erc--target) new-proc)))
|
||||
(if-let ((actual (erc-get-buffer (erc--target-string erc--target)
|
||||
new-proc))
|
||||
(erc-networks--target-transplant-in-progress-p t))
|
||||
(progn
|
||||
(widen)
|
||||
(let ((content (buffer-substring (point-min)
|
||||
erc-insert-marker)))
|
||||
(kill-buffer) ; allow target-buf renaming hook to run
|
||||
(with-current-buffer existing
|
||||
(erc-networks--ensure-unique-target-buffer-name)
|
||||
(erc-networks--insert-transplanted-content content))))
|
||||
(funcall erc-networks--transplant-target-buffer-function
|
||||
(current-buffer) actual)
|
||||
(kill-buffer (current-buffer))
|
||||
(with-current-buffer actual
|
||||
(erc-networks--ensure-unique-target-buffer-name)))
|
||||
(setq erc-server-process new-proc
|
||||
erc-server-connected t
|
||||
erc-networks--id nid))))))
|
||||
|
||||
;; For existing buffers, `erc-open' reinitializes a core set of local
|
||||
;; variables in addition to some text, such as the prompt. It expects
|
||||
;; module activation functions to do the same for assets they manage.
|
||||
;; However, "stateful" modules, whose functionality depends on the
|
||||
;; evolution of a buffer's content, may need to reconcile state during
|
||||
;; a merge. An example might be a module that provides consistent
|
||||
;; timestamps: it should ensure time values don't decrease.
|
||||
(defvar erc-networks--copy-server-buffer-functions nil
|
||||
"Abnormal hook run in new server buffers when deduping.
|
||||
Passed the existing buffer to be killed, whose contents have
|
||||
|
|
@ -1393,26 +1414,18 @@ already been copied over to the current, replacement buffer.")
|
|||
|
||||
(defun erc-networks--copy-over-server-buffer-contents (existing name)
|
||||
"Kill off existing server buffer after copying its contents.
|
||||
Must be called from the replacement buffer."
|
||||
Expect to be called from the replacement buffer."
|
||||
(defvar erc-kill-buffer-hook)
|
||||
(defvar erc-kill-server-hook)
|
||||
;; ERC expects `erc-open' to be idempotent when setting up local
|
||||
;; vars and other context properties for a new identity. Thus, it's
|
||||
;; unlikely we'll have to copy anything else over besides text. And
|
||||
;; no reconciling of user tables, etc. happens during a normal
|
||||
;; reconnect, so we should be fine just sticking to text. (Right?)
|
||||
(let ((text (with-current-buffer existing
|
||||
;; This `erc-networks--id' should be
|
||||
;; `erc-networks--id-equal-p' to caller's network
|
||||
;; identity and older if not eq.
|
||||
;;
|
||||
;; `erc-server-process' should be set but dead
|
||||
;; and eq `get-buffer-process' unless latter nil
|
||||
(delete-process erc-server-process)
|
||||
(buffer-substring (point-min) erc-insert-marker)))
|
||||
erc-kill-server-hook
|
||||
erc-kill-buffer-hook)
|
||||
(erc-networks--insert-transplanted-content text)
|
||||
;; The following observations from ERC 5.5 regarding the buffer
|
||||
;; `existing' were thought at the time to be invariants:
|
||||
;; - `erc-networks--id' is `erc-networks--id-equal-p' to the
|
||||
;; caller's network identity and older if not `eq'.
|
||||
;; - `erc-server-process' should be set (local) but dead and `eq' to
|
||||
;; the result of `get-buffer-process' unless the latter is nil.
|
||||
(delete-process (buffer-local-value 'erc-server-process existing))
|
||||
(erc-networks--transplant-buffer-content existing (current-buffer))
|
||||
(let (erc-kill-server-hook erc-kill-buffer-hook)
|
||||
(run-hook-with-args 'erc-networks--copy-server-buffer-functions existing)
|
||||
(kill-buffer name)))
|
||||
|
||||
|
|
|
|||
|
|
@ -730,6 +730,7 @@ non-nil."
|
|||
(fset symbol
|
||||
(lambda (&rest _)
|
||||
(remove-hook hook-var symbol)
|
||||
(setf (erc-stamp--date-fn data) #'ignore)
|
||||
(when (buffer-live-p buffer)
|
||||
(with-current-buffer buffer
|
||||
(setq erc-stamp--date-stamps
|
||||
|
|
@ -773,11 +774,20 @@ non-nil."
|
|||
:interactive nil
|
||||
(if erc-stamp--date-mode
|
||||
(progn
|
||||
(add-function :around
|
||||
(local 'erc-networks--transplant-target-buffer-function)
|
||||
#'erc-stamp--dedupe-date-stamps-from-target-buffer)
|
||||
(add-hook 'erc-networks--copy-server-buffer-functions
|
||||
#'erc-stamp--dedupe-date-stamps-from-buffer 0 t)
|
||||
(add-hook 'erc-insert-post-hook
|
||||
#'erc-stamp--defer-date-insertion-on-post-insert 0 t)
|
||||
(add-hook 'erc-send-post-hook
|
||||
#'erc-stamp--defer-date-insertion-on-post-send 0 t))
|
||||
(kill-local-variable 'erc-timestamp-last-inserted-left)
|
||||
(remove-function (local 'erc-networks--transplant-target-buffer-function)
|
||||
#'erc-stamp--dedupe-date-stamps-from-target-buffer)
|
||||
(remove-hook 'erc-networks--copy-server-buffer-functions
|
||||
#'erc-stamp--dedupe-date-stamps-from-buffer t)
|
||||
(remove-hook 'erc-insert-post-hook
|
||||
#'erc-stamp--defer-date-insertion-on-post-insert t)
|
||||
(remove-hook 'erc-send-post-hook
|
||||
|
|
@ -841,6 +851,8 @@ and date stamps inserted by this function."
|
|||
((not (string-equal rendered erc-timestamp-last-inserted-left)))
|
||||
((null (cl-find rendered erc-stamp--date-stamps
|
||||
:test #'string= :key #'erc-stamp--date-str))))
|
||||
;; Force `erc-insert-timestamp-right' to stamp this message.
|
||||
(setq erc-timestamp-last-inserted-right nil)
|
||||
(setq erc-stamp--deferred-date-stamp
|
||||
(make-erc-stamp--date :ts ct :str rendered))))
|
||||
;; insert right timestamp
|
||||
|
|
@ -1040,6 +1052,47 @@ And discard stale references in `erc-stamp--date-stamps'."
|
|||
erc-timestamp-last-inserted-left nil
|
||||
erc-timestamp-last-inserted-right nil)))
|
||||
|
||||
(defun erc-stamp--dedupe-date-stamps (old-stamps)
|
||||
"Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS.
|
||||
Assume the contents of the buffer for OLD-STAMPS have just been inserted
|
||||
above the current buffer's and that the old buffer still exists so that
|
||||
markers still point somewhere. For each duplicate, update the existing
|
||||
marker to match the transplanted timestamp with the same date. Also
|
||||
copy non-duplicate `erc-stamp--date' objects from OLD-STAMPS to the
|
||||
current buffer's, maintaining order."
|
||||
(let (need)
|
||||
(dolist (old old-stamps)
|
||||
(if-let ((new (cl-find (erc-stamp--date-str old) erc-stamp--date-stamps
|
||||
:test #'string= :key #'erc-stamp--date-str))
|
||||
(new-marker (erc-stamp--date-marker new)))
|
||||
;; The new buffer now has a duplicate stamp, so remove the
|
||||
;; "newer" one from the buffer.
|
||||
(progn
|
||||
(erc--delete-inserted-message-naively new-marker)
|
||||
(set-marker new-marker (erc-stamp--date-marker old)))
|
||||
;; The new buffer doesn't have this stamp, so add its data
|
||||
;; object to the sorted list.
|
||||
(push old need)
|
||||
;; Update the old marker position to point to the new buffer.
|
||||
(set-marker (erc-stamp--date-marker old)
|
||||
(erc-stamp--date-marker old))))
|
||||
;; These *should* already be sorted.
|
||||
(setq erc-stamp--date-stamps
|
||||
(nconc (nreverse need) erc-stamp--date-stamps))))
|
||||
|
||||
(defun erc-stamp--dedupe-date-stamps-from-buffer (old-buffer)
|
||||
"Merge date stamps from OLD-BUFFER into in the current buffer."
|
||||
(let ((old-stamps (buffer-local-value 'erc-stamp--date-stamps old-buffer)))
|
||||
(erc-stamp--dedupe-date-stamps old-stamps)))
|
||||
|
||||
(defun erc-stamp--dedupe-date-stamps-from-target-buffer (orig old-buffer
|
||||
new-buffer)
|
||||
"Merge date stamps from OLD-BUFFER into NEW-BUFFER after calling ORIG."
|
||||
(let ((old-stamps (buffer-local-value 'erc-stamp--date-stamps old-buffer)))
|
||||
(prog1 (funcall orig old-buffer new-buffer)
|
||||
(with-current-buffer new-buffer
|
||||
(erc-stamp--dedupe-date-stamps old-stamps)))))
|
||||
|
||||
(provide 'erc-stamp)
|
||||
|
||||
;;; erc-stamp.el ends here
|
||||
|
|
|
|||
|
|
@ -1521,6 +1521,10 @@ This will only be used if `erc-header-line-face-method' is non-nil."
|
|||
"ERC face for errors."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-information '((t :inherit shadow))
|
||||
"Face for local administrative messages of low to moderate importance."
|
||||
:group 'erc-faces)
|
||||
|
||||
;; same default color as `erc-input-face'
|
||||
(defface erc-my-nick-face '((t :weight bold :foreground "brown"))
|
||||
"ERC face for your current nickname in messages sent by you.
|
||||
|
|
@ -3526,6 +3530,14 @@ being equivalent to a `erc-display-message' TYPE of `notice'."
|
|||
(push '(erc--msg . notice) erc--msg-prop-overrides)))
|
||||
(erc-display-message nil nil buffer string)))
|
||||
|
||||
(defun erc--insert-admin-message (msg &rest args)
|
||||
"Print MSG with ARGS as a local notice.
|
||||
Inhibit all stamps and buttonizing."
|
||||
(let ((erc--msg-prop-overrides `((erc--skip . (stamp track button))
|
||||
,@erc--msg-prop-overrides)))
|
||||
(apply #'erc-display-message nil '(notice information)
|
||||
(current-buffer) msg args)))
|
||||
|
||||
(defvar erc--merge-text-properties-p nil
|
||||
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
|
||||
|
||||
|
|
@ -3732,9 +3744,12 @@ See also `erc-make-notice'."
|
|||
(t
|
||||
(erc-put-text-property
|
||||
0 (length string)
|
||||
'font-lock-face (or (intern-soft
|
||||
(concat "erc-" (symbol-name type) "-face"))
|
||||
'erc-default-face)
|
||||
'font-lock-face
|
||||
(let* ((name (symbol-name type))
|
||||
(symbol (or (intern-soft (concat "erc-" name "-face"))
|
||||
(intern-soft (concat "erc-" name))
|
||||
type)))
|
||||
(or (and (facep symbol) symbol) 'erc-default-face))
|
||||
string)
|
||||
string)))
|
||||
|
||||
|
|
@ -9434,6 +9449,7 @@ SOFTP, only do so when defined as a variable."
|
|||
(finished . "\n\n*** ERC finished ***\n")
|
||||
(terminated . "\n\n*** ERC terminated: %e\n")
|
||||
(login . "Logging in as `%n'...")
|
||||
(graft . "Grafting buffer `%n' onto `%o'...") ; {new} onto {old}
|
||||
(nick-in-use . "%n is in use. Choose new nickname: ")
|
||||
(nick-too-long
|
||||
. "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server")
|
||||
|
|
@ -9672,6 +9688,7 @@ This function should be on `erc-kill-server-hook'."
|
|||
(defun erc-part-channel-on-kill ()
|
||||
"Send a \"PART\" when killing a channel buffer."
|
||||
(when (and (not erc-killing-buffer-on-part-p)
|
||||
(not erc-networks--target-transplant-in-progress-p)
|
||||
(erc-server-process-alive))
|
||||
(let ((tgt (erc-default-target)))
|
||||
(if tgt
|
||||
|
|
|
|||
|
|
@ -1243,6 +1243,7 @@
|
|||
|
||||
(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-server-process (erc-networks-tests--create-live-proc)
|
||||
|
|
@ -1282,6 +1283,7 @@
|
|||
(ert-info ("New buffer steals name, content")
|
||||
(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-server-process (erc-networks-tests--create-live-proc)
|
||||
|
|
@ -1522,6 +1524,7 @@
|
|||
(ert-info ("New server buffer steals name, content")
|
||||
(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-server-announced-name "us-east.foonet.org"
|
||||
|
|
@ -1574,6 +1577,7 @@
|
|||
(ert-info ("New server buffer steals name, content")
|
||||
(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-server-announced-name "us-east.foonet.org" ; east
|
||||
|
|
|
|||
|
|
@ -349,4 +349,122 @@
|
|||
(lambda (arg)
|
||||
(should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
|
||||
|
||||
(ert-deftest erc-stamp--dedupe-date-stamps-from-target-buffer ()
|
||||
(unless (>= emacs-major-version 29)
|
||||
(ert-skip "Requires hz-ticks lisp time format"))
|
||||
(let ((erc-modules erc-modules)
|
||||
(erc-stamp--tz t))
|
||||
(erc-tests-common-make-server-buf)
|
||||
(erc-stamp-mode +1)
|
||||
|
||||
;; Create two buffers with an overlapping date stamp.
|
||||
(with-current-buffer (erc--open-target "#chan@old")
|
||||
(let ((erc-stamp--current-time '(1690761600001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer)
|
||||
"2023-07-31T00:00:00.001Z"))
|
||||
(let ((erc-stamp--current-time '(1690761601001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "0.0"))
|
||||
|
||||
(let ((erc-stamp--current-time '(1690848000001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer)
|
||||
"2023-08-01T00:00:00.001Z"))
|
||||
(let ((erc-stamp--current-time '(1690848001001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "1.0"))
|
||||
(let ((erc-stamp--current-time '(1690848060001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "1.1"))
|
||||
|
||||
(let ((erc-stamp--current-time '(1690934400001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer)
|
||||
"2023-08-02T00:00:00.001Z"))
|
||||
(let ((erc-stamp--current-time '(1690934401001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "2.0"))
|
||||
(let ((erc-stamp--current-time '(1690956000001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "2.6")))
|
||||
|
||||
(with-current-buffer (erc--open-target "#chan@new")
|
||||
(let ((erc-stamp--current-time '(1690956001001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer)
|
||||
"2023-08-02T06:00:01.001Z"))
|
||||
(let ((erc-stamp--current-time '(1690963200001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "2.8"))
|
||||
|
||||
(let ((erc-stamp--current-time '(1691020800001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer)
|
||||
"2023-08-03T00:00:00.001Z"))
|
||||
(let ((erc-stamp--current-time '(1691020801001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "3.0"))
|
||||
(let ((erc-stamp--current-time '(1691053200001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "3.9"))
|
||||
|
||||
(let ((erc-stamp--current-time '(1691107200001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer)
|
||||
"2023-08-04T00:00:00.001Z"))
|
||||
(let ((erc-stamp--current-time '(1691107201001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "4.0"))
|
||||
(let ((erc-stamp--current-time '(1691110800001 . 1000)))
|
||||
(erc-tests-common-display-message nil 'notice (current-buffer) "4.1")))
|
||||
|
||||
(erc-stamp--dedupe-date-stamps-from-target-buffer
|
||||
#'erc-networks--transplant-buffer-content
|
||||
(get-buffer "#chan@old")
|
||||
(get-buffer "#chan@new"))
|
||||
|
||||
;; Ensure the "model", `erc-stamp--date-stamps', matches reality
|
||||
;; in the buffer's contents.
|
||||
(with-current-buffer "#chan@new"
|
||||
(let ((stamps erc-stamp--date-stamps))
|
||||
(goto-char 3)
|
||||
(should (looking-at (rx "\n[Mon Jul 31 2023]")))
|
||||
(should (= (erc--get-inserted-msg-beg (point))
|
||||
(erc-stamp--date-marker (pop stamps))))
|
||||
(goto-char (1+ (match-end 0)))
|
||||
(should (looking-at (rx "*** 2023-07-31T00:00:00.001Z")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 0.0")))
|
||||
(forward-line 1)
|
||||
|
||||
(should (looking-at (rx "\n[Tue Aug 1 2023]")))
|
||||
(should (= (erc--get-inserted-msg-beg (point))
|
||||
(erc-stamp--date-marker (pop stamps))))
|
||||
(goto-char (1+ (match-end 0)))
|
||||
(should (looking-at (rx "*** 2023-08-01T00:00:00.001Z")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 1.0")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 1.1")))
|
||||
(forward-line 1)
|
||||
|
||||
(should (looking-at (rx "\n[Wed Aug 2 2023]")))
|
||||
(should (= (erc--get-inserted-msg-beg (point))
|
||||
(erc-stamp--date-marker (pop stamps))))
|
||||
(goto-char (1+ (match-end 0)))
|
||||
(should (looking-at (rx "*** 2023-08-02T00:00:00.001Z")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 2.0")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 2.6")))
|
||||
(forward-line 1)
|
||||
(should (looking-at
|
||||
(rx "*** Grafting buffer `#chan@new' onto `#chan@old'")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 2023-08-02T06:00:01.001Z")))
|
||||
(forward-line 1)
|
||||
(should (looking-at (rx "*** 2.8")))
|
||||
(forward-line 1)
|
||||
|
||||
(should (looking-at (rx "\n[Thu Aug 3 2023]")))
|
||||
(should (= (erc--get-inserted-msg-beg (point))
|
||||
(erc-stamp--date-marker (pop stamps))))
|
||||
(goto-char (1+ (match-end 0)))
|
||||
(should (looking-at (rx "*** 2023-08-03T00:00:00.001Z")))
|
||||
(forward-line 3) ; ...
|
||||
|
||||
(should (looking-at (rx "\n[Fri Aug 4 2023]")))
|
||||
(should (= (erc--get-inserted-msg-beg (point))
|
||||
(erc-stamp--date-marker (pop stamps))))
|
||||
(should-not stamps))))
|
||||
|
||||
(when noninteractive
|
||||
(erc-tests-common-kill-buffers)))
|
||||
|
||||
;;; erc-stamp-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue