mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
Redo ERC truncation and /CLEAR hook mechanism
* 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)
This commit is contained in:
F. Jason Park
parent
08f662da11
commit
51d5419fdc
@ -20,6 +20,12 @@ purposes. Modules can instead use the function 'erc-sync-banlist' to
|
||||
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.
|
||||
|
||||
|
||||
* Changes in ERC 5.6
|
||||
|
||||
|
||||
@ -547,6 +547,9 @@ via `erc-fill-wrap-mode-hook'."
|
||||
(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)
|
||||
@ -557,6 +560,8 @@ via `erc-fill-wrap-mode-hook'."
|
||||
(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
|
||||
@ -674,6 +679,24 @@ Also cover region with text prop `erc-fill--wrap-merge' set to t."
|
||||
(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."
|
||||
|
||||
@ -231,7 +231,7 @@ also be a predicate function. To only log when you are not set away, use:
|
||||
(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 @@ also be a predicate function. To only log when you are not set away, use:
|
||||
(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 @@ The current buffer is given by BUFFER."
|
||||
(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 @@ The current buffer is given by BUFFER."
|
||||
"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 @@ You can save every individual message by putting this function on
|
||||
(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 @@ You can save every individual message by putting this function on
|
||||
(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)
|
||||
|
||||
@ -182,13 +182,11 @@ from entering them and instead jump over them."
|
||||
(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 @@ Return P or, if found, a position less than P."
|
||||
;; 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 @@ non-nil."
|
||||
(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 @@ For `erc-hide-timestamps, modify `buffer-invisibility-spec'."
|
||||
(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 @@ enabled when the message was inserted."
|
||||
|
||||
(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,81 @@ with the option `erc-echo-timestamps', see the companion option
|
||||
(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--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 (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--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.
|
||||
|
||||
@ -36,11 +36,17 @@
|
||||
: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.
|
||||
@ -49,10 +55,31 @@ bring any grown Emacs to its knees after a few days worth of
|
||||
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,46 +117,60 @@ present in `erc-modules'."
|
||||
(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
|
||||
|
||||
@ -1794,7 +1794,9 @@ Defaults to the server buffer."
|
||||
(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
|
||||
|
||||
@ -2690,6 +2692,9 @@ side effect of setting the current buffer to the one it returns. Use
|
||||
(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))
|
||||
@ -3387,7 +3392,8 @@ a history backlog."
|
||||
(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)))
|
||||
@ -3703,7 +3709,8 @@ them from the previous newline, and add them to the newline suffixing
|
||||
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)))))
|
||||
@ -4475,21 +4482,42 @@ of `erc-ignore-list'."
|
||||
(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)
|
||||
|
||||
|
||||
@ -76,16 +76,26 @@
|
||||
(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")
|
||||
@ -113,14 +123,18 @@
|
||||
(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
|
||||
@ -129,7 +143,7 @@
|
||||
(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"
|
||||
@ -145,11 +159,84 @@
|
||||
(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))
|
||||
@ -157,6 +244,7 @@
|
||||
(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))
|
||||
@ -179,8 +267,8 @@
|
||||
(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")
|
||||
@ -198,14 +286,47 @@
|
||||
(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))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user