* etc/ERC-NEWS: Mention option `erc-truncate-padding-size'.
* lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable)
(erc-fill-wrap-disable): Manage membership in the `erc--clear-function'
advice stack for own function that massages a buffer's oldest inserted
message, post truncation.
(erc-fill--wrap-massage-initial-message-post-clear): New function.
* lisp/erc/erc-log.el (erc-log-mode, erc-log-enable): Don't add
`erc-save-buffer-in-logs' to `erc--pre-clear-functions'. Use local
advice around common interface variable instead, as noted below.
(erc-log-disable): Likewise, don't remove `erc-save-buffer-in-logs' from
`erc--pre-clear-functions'.
(erc-log-setup-logging): Add `erc-log--save-on-clear' to
`erc--clear-function'.
(erc-log-disable-logging): Remove `erc-log--save-on-clear' to
`erc-clear-function'.
(erc-save-buffer-in-logs): Abort when `erc--insert-marker' is non-nil.
(erc-log--save-on-clear): New function, a thin wrapper around
`erc-save-buffer-in-logs', adapting it to the `erc--clear-function'
advice interface.
* lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable): Don't
add `erc-stamp--reset-on-clear' to `erc--pre-clear-functions'.
(erc-stamp-disable): Don't remove `erc-stamp--reset-on-clear' from
`erc--pre-clear-functions'.
(erc-stamp--find-insertion-point): Account for initial position being
`bobp'.
(erc-stamp--defer-date-insertion-on-post-modify): Accommodate the rare
non-list `erc-insert-post-hook' when shadowing.
(erc-stamp--setup): Add and remove `erc-stamp--reset-on-clear' to and
from `erc--clear-function' advice stack.
(erc-stamp--redo-right-stamp-post-clear): New function.
(erc-stamp--update-saved-position): Remove unused function. This was
originally added along with `erc-stamp--reset-on-clear' as part of
bug#60936.
(erc-stamp--reset-on-clear): Expect end of truncation boundary to be at
`erc-insert-marker'. Rework to use new `erc--clear-function' interface
and run on `erc-timer-hook' instead of `erc-insert-done-hook'.
* lisp/erc/erc-truncate.el (erc-truncate-padding-size): New option to
help tamp down on disruptions when reading scroll back caused by overly
frequent truncation.
(erc-truncate-enable, erc-truncate-disable): Add and remove
`erc-truncate--setup' to and from `erc-mode-hook', and run it when
needed.
(erc-truncate--buffer-size): New variable.
(erc-truncate--setup): New function.
(erc-truncate-buffer-to-size): Guard execution with
`erc-truncate--padding-size' and `erc--inhibit-clear-p'. Reflow for
readability, removing obsolete comments. Call hooks with marker instead
of buffer position, as per the new `erc--clear-function' interface.
(erc-truncate-buffer): Defer execution to `erc-timer-hook' when running
post-insertion via a response handler.
(erc-truncate--inhibit-when-local-and-interactive): New function.
* lisp/erc/erc.el (erc-mode): Add `erc--skip-past-headroom-on-clear'
to `erc--clear-function' in all ERC buffers.
(erc--with-spliced-insertion): Account for marker being `bobp'.
(erc--insert-before-markers-transplanting-hidden): Make more robust by
accommodating initial `point' possibly being `bobp'.
(erc--clear-function): New variable, a function-valued local-advice
interface to replace `erc--pre-clear-functions'.
(erc--pre-clear-functions): Remove unused variable.
(erc--skip-past-headroom-on-clear): New function.
(erc--inhibit-clear-p): New variable.
(erc-cmd-CLEAR): Call hooks with markers instead of position. Signal
`user-error' when `erc--inhbiit-clear-p' is non-nil.
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp)
(erc-scenarios-log--cmd-clear/date-stamps): Rename former to latter,
update assertions, and use common helper.
(erc-scenarios-log--cmd-clear/left-stamps): New test.
(erc-scenarios-log--truncate): Move body to function of the same name,
and update assertions.
(erc-scenarios-log--truncate/left-stamps): New test. (Bug#72736)
(cherry picked from commit
51d5419fdc3805a95190f8913e8ea349f243f11d)
guarantee that the variable 'erc-channel-banlist' remains synced for
the remainder of an IRC session.
+** Option 'erc-truncate-padding-size' controls truncation frequency.
+In fast-moving channels and in queries with long-winded bots, the
+'truncate' module has historically been asked to work overtime, mostly
+on account of a rather stingy buffering threshold of 512 characters.
+Now configurable, its default has been relaxed eightfold to 4096.
+
\f
* Changes in ERC 5.6
(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-fill--wrap-massage-initial-message-post-clear
+ '((depth . 50)))
(erc-stamp--display-margin-mode +1)
(visual-line-mode +1))
((visual-line-mode -1)
(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-fill--wrap-massage-initial-message-post-clear)
(remove-hook 'erc--refresh-prompt-hook
#'erc-fill--wrap-indent-prompt t)
(remove-hook 'erc-button--prev-next-predicate-functions
(erc-fill--wrap-continued-predicate #'ignore))
(erc-fill--wrap-rejigger-region (1- beg) (1+ end) nil 'repairp))))))
+(defun erc-fill--wrap-massage-initial-message-post-clear (beg end)
+ "Maybe reveal hidden speaker or add stamp on initial message after END."
+ (if erc-stamp--date-mode
+ (erc-stamp--redo-right-stamp-post-clear beg end)
+ ;; With other non-date stamp-insertion functions, remove hidden
+ ;; speaker continuation on first spoken message in buffer.
+ (when-let (((< end (1- erc-insert-marker)))
+ (next (text-property-not-all end (min erc-insert-marker
+ (+ 4096 end))
+ 'erc--msg nil))
+ (bounds (erc--get-inserted-msg-bounds next))
+ (found (text-property-not-all (car bounds) (cdr bounds)
+ 'erc-fill--wrap-merge nil))
+ (erc-fill--wrap-continued-predicate #'ignore))
+ (erc-fill--wrap-rejigger-region (max (1- (car bounds)) (point-min))
+ (min (1+ (cdr bounds)) erc-insert-marker)
+ nil 'repairp))))
+
(defun erc-fill-wrap ()
"Use text props to mimic the effect of `erc-fill-static'.
See `erc-fill-wrap-mode' for details."
(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))
(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)))
(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
"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))))
(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)))
(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)
(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
;; 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))))
(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))
(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)
(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
(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.
-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)))
+(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 (1- erc-insert-marker))) ; not a /CLEAR
+ (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)))
+ ((not (eq 'erc-timestamp (field-at-pos (1- (cdr bounds))))))
+ (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) (1+ (cdr bounds)))
+ (cl-assert (= ?\n (char-before (point-max))))
+ (erc-add-timestamp))))))
+
+(defun erc-stamp--reset-on-clear (orig beg end)
+ "Forget date stamps older than POS and remake newest culled.
+Call ORIG, an `erc--clear-function', with BEG and END markers."
+ (let ((fullp (= (1- erc-insert-marker) end)) ; /CLEAR-p
+ (skipp (or (erc--memq-msg-prop 'erc--skip 'stamp)
+ (and erc--msg-prop-overrides
+ (memq 'stamp (alist-get 'erc--skip
+ erc--msg-prop-overrides)))))
+ (culled ()))
+ (when erc-stamp--date-stamps
+ (setq erc-stamp--date-stamps
+ ;; Assume `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)))
+ ;; Before /CLEAR'ing a data stamp, skip past last blank in headroom.
+ (when (and fullp culled (not skipp) (< 1 beg 3 end))
+ (set-marker beg 3))
+ (funcall orig beg end)
+ (when-let ((culled)
+ ((not skipp))
+ (ct (erc-stamp--date-ts (car culled)))
+ (hook (make-symbol "temporary-hook"))
+ (rendered (erc-stamp--format-date-stamp ct))
+ (data (make-erc-stamp--date :ts ct :str rendered)))
+ (cl-assert erc-stamp--date-mode)
+ ;; 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)))
+ (let ((erc-stamp--deferred-date-stamp data)
+ ;; At midnight, `rendered' may still be yesterday while
+ ;; `erc-timestamp-last-inserted-left' is already today.
+ (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)
+ ;; After /CLEAR'ing, remove new date stamp's trailing newline
+ ;; because one resides between `end' and `erc-input-marker'
+ ;; (originally meant to protect `erc-last-saved-position').
+ (when (and fullp (= end erc-last-saved-position))
+ (cl-assert (or erc--called-as-input-p (null erc--msg-props)))
+ (delete-region (1- end) end)))
+ (when fullp
+ (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.
:group 'erc)
(defcustom erc-max-buffer-size 30000
- "Maximum size in chars of each ERC buffer.
-Used only when auto-truncation is enabled.
-\(Also see `erc-truncate-buffer'.)"
+ "Buffer size in characters after truncation.
+Only applies when the `truncate' module is enabled."
:type 'integer)
+(defcustom erc-truncate-padding-size 4096
+ "Headroom threshold triggering truncation and determining its frequency.
+Truncation occurs when the buffer's size meets or exceeds this value
+plus `erc-max-buffer-size'."
+ :type 'integer
+ :package-version '(ERC . "5.6.1"))
+
;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t)
(define-erc-module truncate nil
"Truncate a query buffer if it gets too large.
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)
(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))
+ (when (and (> (buffer-size buffer) (+ size erc-truncate-padding-size))
+ (not (buffer-local-value 'erc--inhibit-clear-p buffer)))
(with-current-buffer buffer
- ;; Though unneeded, widen anyway to preserve pre-5.5 behavior.
- (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)))))
+ (let ((wc (and (get-buffer-window) (current-window-configuration))))
+ (save-excursion
+ ;; Widen to preserve pre-5.5 behavior.
+ (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
+ (let ((erc--inhibit-clear-p t))
+ (funcall erc--clear-function beg end)))
+ (set-marker beg nil)
+ (set-marker end nil))))
+ (when wc
+ (set-window-configuration wc))))))
;;;###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)
+ (when-let
+ (((not erc--inhibit-clear-p))
+ ((not (erc--memq-msg-prop 'erc--skip 'truncate)))
+ ;; Determine here because this may be a target buffer and
+ ;; the hook always runs in the server buffer.
+ (size (if (and erc-truncate--buffer-size
+ (> erc-truncate--buffer-size erc-max-buffer-size))
+ erc-truncate--buffer-size
+ erc-max-buffer-size))
+ (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 size buffer)))
+ (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t)))
+ (unless erc--inhibit-clear-p
+ (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
(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
(defun erc-initialize-log-marker (buffer)
"Initialize the `erc-last-saved-position' marker to a sensible position.
BUFFER is the current buffer."
+ ;; Note that in 5.6, `erc-input-marker' itself became a "sensible
+ ;; position" when its insertion type changed to t. However,
+ ;; decrementing still makes sense for compatibility.
(with-current-buffer buffer
(unless (markerp erc-last-saved-position)
(setq erc-last-saved-position (make-marker))
(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)))
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)))))
(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 (beg end)
+ "Move marker BEG past the two newlines added by `erc--initialize-markers'."
+ (when (and (not (buffer-narrowed-p)) (= beg (point-min)))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((pos (skip-chars-forward "\n" (if erc--called-as-input-p 2 3))))
+ (set-marker beg (min (1+ pos) end erc-input-marker))))))
+
+(defvar erc--inhibit-clear-p nil
+ "When non-nil, ERC inhibits 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
+ ;; Leave a final newline for compatibility, even though
+ ;; it complicates `erc--clear-function' handling.
+ (cond ((>= (point) erc-insert-marker)
+ (max (point-min) (1- erc-insert-marker)))
+ ((erc--get-inserted-msg-beg (point)))
+ ((pos-bol)))))
+ (beg (point-min-marker)))
+ (let ((erc--inhibit-clear-p t))
+ (funcall erc--clear-function beg end))
+ (set-marker beg nil)
+ (set-marker end nil)))
t)
(put 'erc-cmd-CLEAR 'process-not-needed t)
(add-hook 'kill-emacs-hook
(lambda () (delete-directory tempdir :recursive))))))
-;; This shows that, in addition to truncating the buffer, /clear also
-;; syncs the log.
-
-(ert-deftest erc-scenarios-log--clear-stamp ()
+;; These next tests show that, in addition to truncating the buffer,
+;; /CLEAR also syncs the log. They differ from the tests further below
+;; involving the `truncate' module in that, here, the upper truncation
+;; boundary doesn't reside on an `erc--msg' char but rather on a newline
+;; (the final one before `erc-insert-marker'). This was initially done
+;; to safeguard `erc-last-saved-position' because `erc-insert-marker'
+;; originally had a nil insertion type. This staggered alignment means
+;; truncation resulting from a /CLEAR actually demands more twiddling
+;; and care than that triggered by the `truncate' module.
+(ert-deftest erc-scenarios-log--cmd-clear/date-stamps ()
:tags '(:expensive-test)
(require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
(tempdir (make-temp-file "erc-tests-log." t nil nil))
+ (erc-scenarios-common-extra-teardown
+ (and noninteractive
+ (lambda ()
+ (run-at-time 0 nil #'delete-directory tempdir :recursive))))
(erc-log-channels-directory tempdir)
(erc-modules (cons 'log erc-modules))
(erc-timestamp-format-left "\n[%a %b %e %Y @@STAMP@@]\n")
(funcall expect 10 "Grows, lives")
(should-not (file-exists-p logfile))
(goto-char (point-max))
- (erc-cmd-CLEAR)
+ (erc-scenarios-common-say "/clear")
(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
+ ;; Requisite two blank lines plus date stamp are present.
+ (should (string-prefix-p "\n\n\n[" (buffer-string)))
(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<bob> alice: For these two")))
+ (should (= erc-last-saved-position (1- (pos-bol))))))
(ert-info ("Current contents saved")
(with-temp-buffer
(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"
(should (looking-at (rx "<bob> alice: For these two hours,")))
(funcall expect 1 "please your lordship")))
- (erc-log-mode -1)
- (when noninteractive (delete-directory tempdir :recursive))))
+ (erc-log-mode -1)))
-(ert-deftest erc-scenarios-log--truncate ()
- :tags '(:expensive-test :unstable)
+(ert-deftest erc-scenarios-log--cmd-clear/left-stamps ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
+ (dumb-server (erc-d-run "localhost" t 'foonet))
+ (tempdir (make-temp-file "erc-tests-log." t nil nil))
+ (erc-scenarios-common-extra-teardown
+ (and noninteractive
+ (lambda ()
+ (run-at-time 0 nil #'delete-directory tempdir :recursive))))
+ (erc-log-channels-directory tempdir)
+ (erc-modules (cons 'log erc-modules))
+ (erc-insert-timestamp-function #'erc-insert-timestamp-left)
+ (erc-timestamp-only-if-changed-flag nil)
+ (port (process-contact dumb-server :service))
+ (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
+ tempdir))
+ (erc-server-flood-penalty 0.1)
+ (expect (erc-d-t-make-expecter)))
+
+ (unless noninteractive
+ (add-hook 'kill-emacs-hook
+ (lambda () (delete-directory tempdir :recursive))))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "foonet:changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+ (funcall expect 5 "foonet")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (funcall expect 10 "Grows, lives")
+ (should (string-prefix-p "\n\n[" (buffer-string)))
+ (should-not (file-exists-p logfile))
+ (goto-char (point-max))
+ (erc-scenarios-common-say "/clear")
+ (should (file-exists-p logfile))
+ (funcall expect 10 "please your lordship")
+
+ ;; During truncation, `erc--clear-function' inserts exactly two
+ ;; blanks, regardless of the following content.
+ (ert-info ("Buffer truncated")
+ (funcall expect -0.1 "Grows, lives")
+ (funcall expect 1 "For these two" (goto-char (point-min)))
+ (should (string-prefix-p "\n\n[" (buffer-string)))
+ (should (looking-back (rx "]<bob> alice: For these two")))
+ (should (= erc-last-saved-position 2))))
+
+ (ert-info ("Current contents saved")
+ (with-temp-buffer
+ (insert-file-contents logfile)
+ (should (string-prefix-p "[" (buffer-string)))
+ (funcall expect 1 "]*** You have joined")
+ (funcall expect 1 "Playback Complete.")
+ (funcall expect 1 "]<alice> bob: Grows, lives")
+ (funcall expect -0.001 "<bob> alice: For these two hours")))
+
+ (ert-info ("Remainder saved, timestamp printed when option non-nil")
+ (with-current-buffer "foonet"
+ (delete-process erc-server-process)
+ (funcall expect 5 "failed"))
+ (kill-buffer "#chan")
+ (with-temp-buffer
+ (insert-file-contents logfile)
+ (funcall expect 1 "]<alice> bob: Grows, lives")
+ (forward-line 1) ; no blank, no timestamp
+ (should (looking-at (rx "[" (+ (in ":0-9"))
+ "]<bob> alice: For these two hours,")))
+ (funcall expect 1 "]<alice> bob: As't please your lordship")))
+
+ (erc-log-mode -1)))
+
+(defun erc-scenarios-log--truncate (assert-truncation assert-log)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
(erc-log-channels-directory tempdir)
(erc-modules (cons 'truncate (cons 'log erc-modules)))
(erc-max-buffer-size 512)
+ (erc-truncate-padding-size 512)
(port (process-contact dumb-server :service))
(logchan (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
tempdir))
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))
(should-not (file-exists-p logserv))
(should-not (file-exists-p logchan))
- (funcall expect 10 "*** MAXLIST=beI:60")
- (should (= (pos-bol) (point-min)))
+ ;; Verify that truncation actally happens where it should.
+ (funcall assert-truncation expect)
(should (file-exists-p logserv))))
(ert-info ("Log file ahead of truncation point")
(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 "<bob> [07:04:37] alice: Here,")
+ (funcall expect -0.001 "<bob> [07:04:37] alice: Here,")
+ (funcall expect 1 "<alice> [07:04:42] bob: By my troth")
+ (funcall expect -0.001 "<alice> [07:04:42] bob: By my troth")
+ (funcall expect 1 "I will grant it")
+ (funcall assert-log expect)))
(erc-log-mode -1)
(erc-truncate-mode -1)
(when noninteractive (delete-directory tempdir :recursive))))
+(ert-deftest erc-scenarios-log--truncate ()
+ :tags '(:expensive-test :unstable)
+ (erc-scenarios-log--truncate
+
+ (lambda (expect)
+ (funcall expect 10 "*** MAXLIST=beI:60")
+ (should (= (pos-bol) 22))
+ ;; Exactly two + 1 (for date stamp) newlines preserved.
+ (should (string-prefix-p "\n\n\n[" (buffer-string))))
+
+ (lambda (expect)
+ (funcall expect -0.001 "loathed enemy"))))
+
+(ert-deftest erc-scenarios-log--truncate/left-stamps ()
+ :tags '(:expensive-test :unstable)
+ (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left)
+ (erc-timestamp-only-if-changed-flag nil))
+
+ (erc-scenarios-log--truncate
+
+ (lambda (expect)
+ ;; Exactly two leading newlines preserved.
+ (funcall expect 10
+ '(: "\n\n[" (= 5 (in "0-9:")) "]*** There are 0 users")))
+
+ (lambda (expect)
+ (funcall expect 1 "loathed enemy")
+ (funcall expect -0.001 "please your lordship")))))
+
(defvar erc-insert-timestamp-function)
(declare-function erc-insert-timestamp-left "erc-stamp" (string))
projects / emacs.git / commitdiff