From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 5 Sep 2024 14:22:11 -0700 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): [5.6.1] ; Rename internal variable in erc-fill [5.6.1] Store one string per user in erc--spkr msg prop [5.6.1] Bind current erc-response around all handlers [5.6.1] Fix inconsistent handling of ban lists in ERC [5.6.1] Fix overlooked case in erc--get-inserted-msg-beg-at [5.6.1] Redo ERC truncation and /CLEAR hook mechanism etc/ERC-NEWS | 9 + lisp/erc/erc-backend.el | 10 +- lisp/erc/erc-fill.el | 14 +- lisp/erc/erc-log.el | 10 +- lisp/erc/erc-pcomplete.el | 8 + lisp/erc/erc-stamp.el | 101 ++++-- lisp/erc/erc-truncate.el | 103 +++--- lisp/erc/erc.el | 299 ++++++++++-------- test/lisp/erc/erc-fill-tests.el | 2 +- test/lisp/erc/erc-goodies-tests.el | 5 + test/lisp/erc/erc-scenarios-log.el | 22 +- test/lisp/erc/erc-tests.el | 94 +++++- .../erc/resources/erc-scenarios-common.el | 2 +- test/lisp/erc/resources/erc-tests-common.el | 16 +- 14 files changed, 474 insertions(+), 221 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5dd72e6f1b3..0b5385f0589 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -17,7 +17,7 @@ GNU Emacs since Emacs version 22.1. ** Reliable library access for ban lists. Say goodbye to continually running "/BANLIST" for programmatic purposes. Modules can instead use the function 'erc-sync-banlist' to -guarantee that the variable 'erc-channel-banlist' remain synced for +guarantee that the variable 'erc-channel-banlist' remains synced for the remainder of an IRC session. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index fa9d2071ccd..6f3d51f6937 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -547,6 +547,8 @@ fill-wrap (when erc-fill-wrap-merge (add-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p nil t)) + (add-function :after (local 'erc--clear-function) + #'erc-stamp--redo-right-stamp-post-clear '((depth . 50))) (erc-stamp--display-margin-mode +1) (visual-line-mode +1)) ((visual-line-mode -1) @@ -557,6 +559,8 @@ fill-wrap (kill-local-variable 'erc-fill--wrap-last-msg) (kill-local-variable 'erc--inhibit-prompt-display-property-p) (kill-local-variable 'erc-fill--wrap-merge-indicator-pre) + (remove-function (local 'erc--clear-function) + #'erc-stamp--redo-right-stamp-post-clear) (remove-hook 'erc--refresh-prompt-hook #'erc-fill--wrap-indent-prompt t) (remove-hook 'erc-button--prev-next-predicate-functions diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 66420662c23..6bb240f56d7 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -231,7 +231,7 @@ log (add-hook 'erc-part-hook #'erc-conditional-save-buffer) ;; append, so that 'erc-initialize-log-marker runs first (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append) - (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs 50) + ;; FIXME use proper local "setup" function and major-mode hook. (dolist (buffer (erc-buffer-list)) (erc-log-setup-logging buffer)) (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs)) @@ -244,7 +244,6 @@ log (remove-hook 'erc-quit-hook #'erc-conditional-save-queries) (remove-hook 'erc-part-hook #'erc-conditional-save-buffer) (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging) - (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs) (dolist (buffer (erc-buffer-list)) (erc-log-disable-logging buffer)) (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs))) @@ -259,6 +258,8 @@ erc-log-setup-logging (auto-save-mode -1) (setq buffer-file-name nil) (add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t) + (add-function :before (local 'erc--clear-function) + #'erc-log--save-on-clear '((depth . 50))) (when erc-log-insert-log-on-open (ignore-errors (save-excursion @@ -271,6 +272,7 @@ erc-log-disable-logging "Disable logging in BUFFER." (when (erc-logging-enabled buffer) (with-current-buffer buffer + (remove-function (local 'erc--clear-function) #'erc-log--save-on-clear) (setq buffer-offer-save nil erc-enable-logging nil)))) @@ -415,6 +417,7 @@ erc-save-buffer-in-logs (widen) ;; early on in the initialization, don't try and write the log out (when (and (markerp erc-last-saved-position) + (null erc--insert-marker) ; suppress when splicing (> erc-insert-marker (1+ erc-last-saved-position))) (let ((start (1+ (marker-position erc-last-saved-position))) (end (marker-position erc-insert-marker))) @@ -446,6 +449,9 @@ erc-save-buffer-in-logs (set-buffer-modified-p nil)))))) t) +(defun erc-log--save-on-clear (_ end) + (erc-save-buffer-in-logs end)) + ;; This is a kludge to avoid littering erc-truncate.el with forward ;; declarations needed only for a corner-case compatibility check. (defun erc-log--call-when-logging-enabled-sans-module (fn) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index bebc1d0be38..7d773c8f4b2 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -182,13 +182,11 @@ stamp (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40) (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) ((remove-hook 'erc-mode-hook #'erc-stamp--setup) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear) (erc-buffer-do #'erc-stamp--setup))) (defvar erc-stamp--invisible-property nil @@ -707,7 +705,8 @@ erc-stamp--find-insertion-point ;; Continue searching after encountering a message without a ;; timestamp because date stamps must be unique, and ;; "Re-establishing connection" messages should have stamps. - (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (while-let ((pp (max (1- p) (point-min))) + (q (previous-single-property-change pp 'erc--ts)) (qq (erc--get-inserted-msg-beg q)) (ts (get-text-property qq 'erc--ts)) ((not (time-less-p ts target-time)))) @@ -753,7 +752,7 @@ erc-stamp--defer-date-insertion-on-post-modify (set-marker marker (point-min)) (set-marker-insertion-type marker t) (erc--hide-message 'timestamp)) - ,@erc-insert-post-hook)) + ,@(ensure-list erc-insert-post-hook))) (erc-insert-timestamp-function #'erc-stamp--propertize-left-date-stamp) (pos (erc-stamp--find-insertion-point marker aligned)) @@ -980,11 +979,16 @@ erc-stamp--add-csf-on-post-modify (defun erc-stamp--setup () "Enable or disable buffer-local `erc-stamp-mode' modifications." (if erc-stamp-mode - (erc-stamp--manage-local-options-state) + (progn + (erc-stamp--manage-local-options-state) + (add-function :around (local 'erc--clear-function) + #'erc-stamp--reset-on-clear '((depth . 40)))) (let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible) (erc-stamp--manage-local-options-state)) ;; Undo local mods from `erc-insert-timestamp-left-and-right'. (erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left' + (remove-function (local 'erc--clear-function) + #'erc-stamp--reset-on-clear) (kill-local-variable 'erc-stamp--last-stamp) (kill-local-variable 'erc-timestamp-last-inserted) (kill-local-variable 'erc-timestamp-last-inserted-right) @@ -1023,6 +1027,8 @@ erc-toggle-timestamps (defvar-local erc-stamp--last-stamp nil) +;; FIXME rename this to avoid confusion with IRC messages. +;; Something like `erc-stamp--on-clear-echo-area-message'. (defun erc-stamp--on-clear-message (&rest _) "Return `dont-clear-message' when operating inside the same stamp." (and erc-stamp--last-stamp erc-echo-timestamps @@ -1052,25 +1058,74 @@ erc-echo-timestamp (defun erc--echo-ts-csf (_window _before dir) (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts))) -(defun erc-stamp--update-saved-position (&rest _) - (remove-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position t) - (move-marker erc-last-saved-position (1- (point-max)))) - -(defun erc-stamp--reset-on-clear (pos) - "Forget last-inserted stamps when POS is at insert marker. +(defun erc-stamp--redo-right-stamp-post-clear (_ end) + "Append new right stamp to first inserted message after END." + ;; During truncation, the last existing right stamp is often deleted + ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6, + ;; recreating inserted messages from scratch isn't doable. (Although, + ;; attempting surgery like this is likely unwise.) + (when-let ((erc-stamp--date-mode) + ((< end erc-insert-marker)) + (bounds (erc--get-inserted-msg-bounds (1+ end))) + (ts (get-text-property (car bounds) 'erc--ts)) + (format (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (or erc-timestamp-format-right erc-timestamp-format))) + (rendered (erc-format-timestamp ts format)) + ((not (equal rendered erc-timestamp-last-inserted-right))) + (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table))) + (save-excursion + (save-restriction + (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted) + (erc-timestamp-last-inserted-right + erc-timestamp-last-inserted-right)) + (narrow-to-region (car bounds) (cdr bounds)) + (erc-add-timestamp)))))) + +(defun erc-stamp--reset-on-clear (orig beg end) + "Forget stamps older than POS. And discard stale references in `erc-stamp--date-stamps'." - (when erc-stamp--date-stamps - (setq erc-stamp--date-stamps - (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos)) - erc-stamp--date-stamps))) - (when (= pos (1- erc-insert-marker)) - (when erc-stamp--date-mode - (add-hook 'erc-stamp--insert-date-hook - #'erc-stamp--update-saved-position 0 t)) - (setq erc-timestamp-last-inserted nil - erc-timestamp-last-inserted-left nil - erc-timestamp-last-inserted-right nil))) + (let (culled) + (when erc-stamp--date-stamps + (setq erc-stamp--date-stamps + ;; This assumes `seq-filter' visits items in order. + (seq-filter (lambda (o) + (or (> (erc-stamp--date-marker o) end) + (ignore + (set-marker (erc-stamp--date-marker o) nil) + (push o culled)))) + erc-stamp--date-stamps))) + (funcall orig beg end) + (when-let ((culled) + ((not (or (erc--memq-msg-prop 'erc--skip 'stamp) + (and erc--msg-prop-overrides + (memq 'stamp + (alist-get 'erc--skip + erc--msg-prop-overrides)))))) + (ct (erc-stamp--date-ts (car culled)))) + (cl-assert erc-stamp--date-mode) + (let ((hook (make-symbol "temporary-hook")) + (rendered (erc-stamp--format-date-stamp ct)) + (want-rhs-p (= end erc-insert-marker))) + ;; Object successfully removed from model but snapshot remains. + (cl-assert (null (cl-find rendered erc-stamp--date-stamps + :test #'string= + :key #'erc-stamp--date-str))) + ;; When it's midnight, `rendered' may still be yesterday while + ;; `erc-timestamp-last-inserted-left' is already today. + (let* ((data (make-erc-stamp--date :ts ct :str rendered)) + (erc-stamp--deferred-date-stamp data) + (erc-timestamp-last-inserted-left nil)) + (erc-stamp--defer-date-insertion-on-post-modify hook) + (set-marker (erc-stamp--date-marker data) end) + (run-hooks hook) + (unless (= ?\n (char-after erc-last-saved-position)) + (cl-assert (or erc--called-as-input-p (null erc--msg-props))) + (cl-assert (= erc-last-saved-position erc-insert-marker)) + (set-marker erc-last-saved-position (1- erc-insert-marker)))) + (when want-rhs-p + (setq erc-timestamp-last-inserted-right nil + erc-timestamp-last-inserted nil)))))) (defun erc-stamp--dedupe-date-stamps (old-stamps) "Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS. diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 4b602074ebb..c471d7a72ad 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -38,7 +38,7 @@ erc-truncate (defcustom erc-max-buffer-size 30000 "Maximum size in chars of each ERC buffer. Used only when auto-truncation is enabled. -\(see `erc-truncate-buffer' and `erc-insert-post-hook')." +\(Also see `erc-truncate-buffer'.)" :type 'integer) ;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -49,10 +49,31 @@ truncate tracking heavy-traffic channels." ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging)) + (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (add-hook 'erc-mode-hook #'erc-truncate--setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) - (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging))) + (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) + (remove-hook 'erc-mode-hook #'erc-truncate--setup) + (erc-buffer-do #'erc-truncate--setup))) + +(defvar-local erc-truncate--buffer-size nil + "Temporary buffer-local override for `erc-max-buffer-size'.") + +(defun erc-truncate--setup () + "Enable or disable buffer-local `erc-truncate-mode' modifications." + (if erc-truncate-mode + (progn + (when-let ((priors (or erc--server-reconnecting erc--target-priors)) + (val (alist-get 'erc-truncate--buffer-size priors))) + (setq erc-truncate--buffer-size val)) + (add-function :before (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive + '((depth . 20)))) + (remove-function (local 'erc--clear-function) + #'erc-truncate--inhibit-when-local-and-interactive) + (kill-local-variable 'erc-truncate--buffer-size))) (defun erc-truncate--warn-about-logging (&rest _) (when (and (not erc--target) @@ -90,49 +111,51 @@ erc-truncate-buffer-to-size (setq buffer (current-buffer)) (unless (get-buffer buffer) (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) - (when (> (buffer-size buffer) (+ size 512)) - (with-current-buffer buffer - ;; Note that when erc-insert-post-hook runs, the buffer is - ;; narrowed to the new message. So do this delicate widening. - ;; I am not sure, I think this was not recommended behavior in - ;; Emacs 20. - (save-restriction - (widen) - (let ((end (- erc-insert-marker size))) - ;; Truncate at message boundary (formerly line boundary - ;; before 5.6). - (goto-char end) - (goto-char (or (erc--get-inserted-msg-beg end) - (pos-bol))) - (setq end (point)) - ;; try to save the current buffer using - ;; `erc-save-buffer-in-logs'. We use this, in case the - ;; user has both `erc-save-buffer-in-logs' and - ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If - ;; this is the case, only the non-saved part of the current - ;; buffer should be saved. Rather than appending the - ;; deleted part of the buffer to the log file. - ;; - ;; Alternatively this could be made conditional on: - ;; (not (memq 'erc-save-buffer-in-logs - ;; erc-insert-post-hook)) - ;; Comments? - ;; The comments above concern pre-5.6 behavior and reflect - ;; an obsolete understanding of how `erc-logging-enabled' - ;; behaves in practice. - (run-hook-with-args 'erc--pre-clear-functions end) - ;; disable undoing for the truncating - (buffer-disable-undo) - (let ((inhibit-read-only t)) - (delete-region (point-min) end))) - (buffer-enable-undo))))) + (with-current-buffer buffer + (when (and (not erc--inhibit-clear-p) + (> (buffer-size) + (+ (if (and erc-truncate--buffer-size + (> erc-truncate--buffer-size size)) + (setq size erc-truncate--buffer-size) + size) + 512))) + ;; Though unneeded, widen anyway to preserve pre-5.5 behavior. + (save-excursion + (save-restriction + (widen) + (let ((beg (point-min-marker)) + (end (goto-char (- erc-insert-marker size)))) + ;; Truncate at message boundary (formerly line boundary + ;; before 5.6). + (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol))) + (setq end (point-marker)) + (with-silent-modifications + (funcall erc--clear-function beg end)) + (set-marker beg nil) + (set-marker end nil))))))) ;;;###autoload (defun erc-truncate-buffer () "Truncate current buffer to `erc-max-buffer-size'." (interactive) + ;; This `save-excursion' only exists for historical reasons because + ;; `erc-truncate-buffer-to-size' normally runs in a different buffer. (save-excursion - (erc-truncate-buffer-to-size erc-max-buffer-size))) + (if (and erc--parsed-response erc--msg-props) + (let ((symbol (make-symbol "erc-truncate--buffer-deferred")) + (buffer (current-buffer))) + (fset symbol + (lambda (&rest _) + (remove-hook 'erc-timer-hook symbol t) + (erc-truncate-buffer-to-size erc-max-buffer-size buffer))) + (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t))) + (erc-truncate-buffer-to-size erc-max-buffer-size)))) + +(defun erc-truncate--inhibit-when-local-and-interactive (&rest _) + "Ensure `erc-truncate--buffer-size' is nil on /CLEAR." + (when (and erc--called-as-input-p erc-truncate--buffer-size) + (message "Resetting max buffer size to %d" erc-max-buffer-size) + (setq erc-truncate--buffer-size nil))) (provide 'erc-truncate) ;;; erc-truncate.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ef8515790cd..8938db81c20 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1793,7 +1793,9 @@ erc-mode (setq-local completion-ignore-case t) (add-hook 'post-command-hook #'erc-check-text-conversion nil t) (add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t) - (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)) + (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t) + (add-function :before (local 'erc--clear-function) + #'erc--skip-past-headroom-on-clear '((depth . 30)))) ;; activation @@ -3323,10 +3325,14 @@ erc--get-inserted-msg-beg-at (macroexp-let2* nil ((point point) (at-start-p at-start-p)) `(or (and ,at-start-p ,point) - (and-let* ((p (previous-single-property-change ,point 'erc--msg))) - (if (and (= p (1- ,point)) (get-text-property p 'erc--msg)) - p - (1- p)))))) + (let ((p (previous-single-property-change ,point 'erc--msg))) + (cond + ((and p (= p (1- ,point)) (get-text-property p 'erc--msg)) p) + (p (1- p)) + ((and (null p) + (> ,point (point-min)) + (get-text-property (1- point) 'erc--msg)) + (1- point))))))) (defmacro erc--get-inserted-msg-end-at (point at-start-p) (macroexp-let2 nil point point @@ -3355,9 +3361,9 @@ erc--get-inserted-msg-bounds (and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p))) (cons b (erc--get-inserted-msg-end-at point at-start-p))))) -(defun erc--get-inserted-msg-prop (prop) +(defun erc--get-inserted-msg-prop (prop &optional point) "Return the value of text property PROP for some message at point." - (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) + (and-let* ((stack-pos (erc--get-inserted-msg-beg (or point (point))))) (get-text-property stack-pos prop))) ;; FIXME improve this nascent "message splicing" facility to include a @@ -3382,7 +3388,8 @@ erc--with-spliced-insertion (declare (indent 1)) (let ((marker (make-symbol "marker"))) `(progn - (cl-assert (= ?\n (char-before ,marker-or-pos))) + (cl-assert (or (= ,marker-or-pos (point-min)) + (= ?\n (char-before ,marker-or-pos)))) (cl-assert (null erc--insert-line-function)) (let* ((,marker (and (not (markerp ,marker-or-pos)) (copy-marker ,marker-or-pos))) @@ -3698,7 +3705,8 @@ erc--insert-before-markers-transplanting-hidden the inserted version of STRING." (let* ((after (and (not erc-legacy-invisible-bounds-p) (get-text-property (point) 'erc--hide))) - (before (and after (get-text-property (1- (point)) 'invisible))) + (before (and after (> (point) (point-min)) + (get-text-property (1- (point)) 'invisible))) (a (and after (ensure-list after))) (b (and before (ensure-list before))) (new (and before (erc--solo (cl-intersection b a))))) @@ -4470,21 +4478,37 @@ erc--unignore-user (when-let ((existing (erc--find-ignore-timer user buffer))) (cancel-timer existing))))) -(defvar erc--pre-clear-functions nil - "Abnormal hook run when truncating buffers. -Called with position indicating boundary of interval to be excised.") +(defvar erc--clear-function #'delete-region + "Function to truncate buffer. +Called with two markers, LOWER and UPPER, indicating the bounds of the +interval to be excised. LOWER <= UPPER <= `erc-insert-marker'.") + +(defun erc--skip-past-headroom-on-clear (lower _) + "Move marker LOWER past the 2 newlines added by `erc--initialize-markers'." + (when (and (not (buffer-narrowed-p)) (= lower (point-min))) + (save-excursion + (goto-char (point-min)) + (set-marker lower (1+ (skip-chars-forward "\n" 3)))))) + +(defvar erc--inhibit-clear-p nil + "When non-nil, inhbiit buffer truncation.") (defun erc-cmd-CLEAR () "Clear messages in current buffer after informing active modules. Expect modules to perform housekeeping tasks to withstand the disruption. When called from Lisp code, only clear messages up to but not including the one occupying the current line." + (when erc--inhibit-clear-p + (user-error "Truncation currently inhibited")) (with-silent-modifications - (let ((max (if (>= (point) erc-insert-marker) - (1- erc-insert-marker) - (or (erc--get-inserted-msg-beg (point)) (pos-bol))))) - (run-hook-with-args 'erc--pre-clear-functions max) - (delete-region (point-min) max))) + (let ((end (copy-marker + (cond ((>= (point) erc-insert-marker) erc-insert-marker) + ((erc--get-inserted-msg-beg (point))) + ((pos-bol))))) + (beg (point-min-marker))) + (funcall erc--clear-function beg end) + (set-marker beg nil) + (set-marker end nil))) t) (put 'erc-cmd-CLEAR 'process-not-needed t) @@ -5555,29 +5579,28 @@ erc-cmd-CLEARTOPIC (defvar-local erc-channel-banlist nil "A list of bans seen for the current channel. - -Entries are cons cells of the form (WHOSET . MASK), where WHOSET is the -channel operator who issued the ban. Modules needing such a list should -call `erc-sync-banlist' once per session in the channel before accessing -the variable. Interactive users need only issue a /BANLIST. Note that +Entries are cons cells of the form (OP . MASK), where OP is the channel +operator who issued the ban. Modules needing such a list should call +`erc-sync-banlist' once per session in the channel before accessing the +variable. Interactive users need only issue a /BANLIST. Note that older versions of ERC relied on a deprecated convention involving a property of the symbol `erc-channel-banlist' to indicate whether a ban -list had been received in full, but this was found to be unreliable.") +list had been received in full; this was found to be unreliable.") (put 'erc-channel-banlist 'received-from-server nil) (defvar-local erc--channel-banlist-synchronized-p nil - "Whether the channel banlist has been fetched since joining.") + "Whether the full channel ban list has been fetched since joining.") (defun erc-sync-banlist (&optional done-fn) "Initialize syncing of current channel's `erc-channel-banlist'. Arrange for it to remain synced for the rest of the IRC session. When -DONE-FN is non-nil, call it with no args once fully updated, and expect -it to return non-nil, if necessary, to inhibit further processing." +DONE-FN is non-nil, call it with no args once fully updated. Expect it +to return non-nil, if necessary, to inhibit further processing." (unless (erc-channel-p (current-buffer)) (error "Not a channel buffer")) (let ((channel (erc-target)) (buffer (current-buffer)) - (hook (lambda (&rest r) (always (apply #'erc-banlist-store r))))) + (hook (lambda (&rest r) (apply #'erc-banlist-store r) t))) (setq erc-channel-banlist nil) (erc-with-server-buffer (add-hook 'erc-server-367-functions hook -98 t) @@ -6673,7 +6696,7 @@ erc--banlist-update (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 - (declare (obsolete "`erc-channel-banlist' always updated on MODE" "31.1")) + (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1")) (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) @@ -7758,8 +7781,8 @@ erc--handle-channel-mode ;; We could specialize on type A, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg) - ;; Add or remove a ban from `erc-channel-banlist'. - (erc--banlist-update state arg)) + "Update `erc-channel-banlist' when synchronized." + (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg))) ;; We could specialize on type C, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 038434b3880..1d74025c5ce 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -597,6 +597,11 @@ erc--get-inserted-msg-beg/readonly #'erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/readonly () (erc-tests-common-assert-get-inserted-msg-readonly-with #'erc-tests-common-assert-get-inserted-msg/basic diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index 3c738822f96..76d3b74222d 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -117,10 +117,12 @@ erc-scenarios-log--clear-stamp (should (file-exists-p logfile)) (funcall expect 10 "please your lordship") (ert-info ("Buffer truncated") - (goto-char (point-min)) - (funcall expect 10 "@@STAMP@@" (point)) ; reset + (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset (funcall expect -0.1 "Grows, lives") - (funcall expect 1 "For these two"))) + (funcall expect 1 "For these two") + ;; Stamp resides just before `erc-last-saved-position'. + (should (looking-back (rx "]\n alice: For these two"))) + (should (= erc-last-saved-position (1- (pos-bol)))))) (ert-info ("Current contents saved") (with-temp-buffer @@ -129,7 +131,7 @@ erc-scenarios-log--clear-stamp (funcall expect 1 "You have joined") (funcall expect 1 "Playback Complete.") (funcall expect 1 "Grows, lives") - (funcall expect -0.01 "please your lordship"))) + (funcall expect -0.001 "alice: For these two hours"))) (ert-info ("Remainder saved, timestamp printed when option non-nil") (with-current-buffer "foonet" @@ -180,7 +182,7 @@ erc-scenarios-log--truncate (should-not (file-exists-p logserv)) (should-not (file-exists-p logchan)) (funcall expect 10 "*** MAXLIST=beI:60") - (should (= (pos-bol) (point-min))) + (should (= (pos-bol) 22)) (should (file-exists-p logserv)))) (ert-info ("Log file ahead of truncation point") @@ -198,9 +200,13 @@ erc-scenarios-log--truncate (with-temp-buffer (insert-file-contents logchan) (funcall expect 1 "You have joined") - (funcall expect 1 "[07:04:37] alice: Here,") - (funcall expect 1 "loathed enemy") - (funcall expect -0.1 "please your lordship"))) + ;; No unwanted duplicates. + (funcall expect 1 " [07:04:37] alice: Here,") + (funcall expect -0.001 " [07:04:37] alice: Here,") + (funcall expect 1 " [07:04:42] bob: By my troth") + (funcall expect -0.001 " [07:04:42] bob: By my troth") + (funcall expect 1 "I will grant it") + (funcall expect -0.001 "loathed enemy"))) (erc-log-mode -1) (erc-truncate-mode -1) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 560d3bbb3d0..eddb3a5b2c8 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -929,6 +929,7 @@ erc--channel-modes (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) @@ -985,6 +986,7 @@ erc--channel-modes/graphic-p (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) @@ -1932,6 +1934,10 @@ erc--get-inserted-msg-beg/basic (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) +(ert-deftest erc--get-inserted-msg-beg/truncated () + (erc-tests-common-assert-get-inserted-msg/truncated + (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg)))))) + (ert-deftest erc--get-inserted-msg-end/basic () (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index b5bb1fb09c3..1cd54a1f715 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -184,6 +184,13 @@ erc-tests-common-assert-get-inserted-msg/basic (should (looking-back " hi")) (erc-tests-common-assert-get-inserted-msg 3 11 test-fn)) +(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn) + (erc-tests-common-get-inserted-msg-setup) + (with-silent-modifications (delete-region 1 3)) + (goto-char 9) + (should (looking-back " hi")) + (erc-tests-common-assert-get-inserted-msg 1 9 test-fn)) + ;; This is a "mixin" and requires a base assertion function, like ;; `erc-tests-common-assert-get-inserted-msg/basic', to work. (defun erc-tests-common-assert-get-inserted-msg-readonly-with -- 2.46.0