* 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)
(cherry picked from commit
fee637468b5e72fd6fcd2c96c42622455db5fb16)
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
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)))
(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))
(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--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)))))
+(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)))))))
+
+(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
(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
(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)))
(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
: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
((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
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
"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.
(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'.")
(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)))
(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")
(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
(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)
(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)
(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"
(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
(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
projects / emacs.git / commitdiff