1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
emacs/lisp/erc/erc-truncate.el

119 lines
4.1 KiB
EmacsLisp
Raw Normal View History

;;; erc-truncate.el --- Functions for truncating ERC buffers
2013-01-01 09:11:05 +00:00
;; Copyright (C) 2003-2004, 2006-2013 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: FSF
;; Keywords: IRC, chat, client, Internet, logging
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This implements buffer truncation (and optional log file writing
;; support for the Emacs IRC client. Use `erc-truncate-mode' to switch
;; on. Use `erc-enable-logging' to enable logging of the stuff which
;; is getting truncated.
;;; Code:
(require 'erc)
(defgroup erc-truncate nil
"Truncate buffers when they reach a certain size"
:group 'erc)
(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')."
:group 'erc-truncate
:type 'integer)
;;;###autoload (autoload 'erc-truncate-mode "erc-truncate" nil t)
(define-erc-module truncate nil
"Truncate a query buffer if it gets too large.
This prevents the query buffer from getting too large, which can
2006-11-06 02:07:52 +00:00
bring any grown Emacs to its knees after a few days worth of
tracking heavy-traffic channels."
;;enable
((add-hook 'erc-insert-post-hook 'erc-truncate-buffer))
;; disable
((remove-hook 'erc-insert-post-hook 'erc-truncate-buffer)))
;;;###autoload
(defun erc-truncate-buffer-to-size (size &optional buffer)
"Truncates the buffer to the size SIZE.
If BUFFER is not provided, the current buffer is assumed. The deleted
region is logged if `erc-logging-enabled' returns non-nil."
;; If buffer is non-nil, but get-buffer does not return anything,
;; then this is a bug. If buffer is a buffer name, get the buffer
;; object. If buffer is nil, use the current buffer.
(if (not buffer)
(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))
* url-util.el (url-insert-entities-in-string): * url-nfs.el (url-nfs-unescape): * url-ldap.el (url-ldap): * url-imap.el (url-imap): * url-cid.el (url-cid-gnus, url-cid): Use with-current-buffer. * erc.el (erc-display-line-1, erc-process-away): * erc-truncate.el (erc-truncate-buffer-to-size): Use with-current-buffer. * term/ns-win.el (ns-scroll-bar-move, ns-face-at-pos): * play/mpuz.el (mpuz-create-buffer): * play/landmark.el (lm-prompt-for-move, lm-print-wts, lm-print-smell) (lm-print-y,s,noise, lm-print-w0, lm-init): * play/gomoku.el (gomoku-prompt-for-move): * play/fortune.el (fortune-in-buffer): * play/dissociate.el (dissociated-press): * play/decipher.el (decipher-adjacency-list, decipher-display-regexp) (decipher-analyze-buffer, decipher-stats-buffer,decipher-stats-buffer): * mail/supercite.el (sc-eref-show): * mail/smtpmail.el (smtpmail-send-it): * mail/rmailsum.el (rmail-summary-next-labeled-message) (rmail-summary-previous-labeled-message, rmail-summary-wipe) (rmail-summary-undelete-many, rmail-summary-rmail-update) (rmail-summary-goto-msg, rmail-summary-expunge) (rmail-summary-get-new-mail, rmail-summary-search-backward) (rmail-summary-add-label, rmail-summary-output-menu) (rmail-summary-output-body): * mail/rfc822.el (rfc822-addresses): * mail/reporter.el (reporter-dump-variable, reporter-dump-state): * mail/mailpost.el (post-mail-send-it): * mail/hashcash.el (hashcash-generate-payment): * mail/feedmail.el (feedmail-run-the-queue) (feedmail-queue-send-edit-prompt-help-first) (feedmail-send-it-immediately, feedmail-give-it-to-buffer-eater) (feedmail-deduce-address-list): * eshell/esh-ext.el (eshell-remote-command): * eshell/em-unix.el (eshell-occur-mode-mouse-goto): * emulation/viper-util.el (viper-glob-unix-files, viper-save-setting) (viper-wildcard-to-regexp, viper-glob-mswindows-files) (viper-save-string-in-file, viper-valid-marker): * emulation/viper-keym.el (viper-toggle-key): * emulation/viper-ex.el (ex-expand-filsyms, viper-get-ex-file) (ex-edit, ex-global, ex-mark, ex-next-related-buffer, ex-quit) (ex-get-inline-cmd-args, ex-tag, ex-command, ex-compile): * emulation/viper-cmd.el (viper-exec-form-in-vi) (viper-exec-form-in-emacs, viper-brac-function): * emulation/viper.el (viper-delocalize-var): * emulation/vip.el (vip-mode, vip-get-ex-token, vip-ex, vip-get-ex-pat) (vip-get-ex-command, vip-get-ex-opt-gc, vip-get-ex-buffer) (vip-get-ex-count, vip-get-ex-file, ex-edit, ex-global, ex-mark) (ex-map, ex-unmap, ex-quit, ex-read, ex-tag, ex-command): * emulation/vi.el (vi-switch-mode, vi-ex-cmd): * emulation/edt.el (edt-electric-helpify): * emulation/cua-rect.el (cua--rectangle-aux-replace): * emulation/cua-gmrk.el (cua--insert-at-global-mark) (cua--delete-at-global-mark, cua--copy-rectangle-to-global-mark) (cua-indent-to-global-mark-column): * calendar/diary-lib.el (calendar-mark-1): * calendar/cal-hebrew.el (calendar-hebrew-mark-date-pattern): Use with-current-buffer. * emulation/viper.el (viper-delocalize-var): Use dolist.
2009-11-03 02:04:29 +00:00
(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.
2008-06-27 07:34:53 +00:00
;; 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 line boundaries
(goto-char end)
(beginning-of-line)
(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?
(when (and (boundp 'erc-enable-logging)
erc-enable-logging
(erc-logging-enabled buffer))
(erc-save-buffer-in-logs))
;; disable undoing for the truncating
(buffer-disable-undo)
(let ((inhibit-read-only t))
(delete-region (point-min) end)))
(buffer-enable-undo)))))
;;;###autoload
(defun erc-truncate-buffer ()
"Truncates the current buffer to `erc-max-buffer-size'.
Meant to be used in hooks, like `erc-insert-post-hook'."
(interactive)
(erc-truncate-buffer-to-size erc-max-buffer-size))
(provide 'erc-truncate)
;;; erc-truncate.el ends here
;;
;; Local Variables:
;; indent-tabs-mode: t
;; tab-width: 8
;; End: