* lisp/compact.el: New file.
* src/buffer.c (compact_buffer, Fcompact_buffer): New function.
(syms_of_buffer): Register Fcompact_buffer.
* src/alloc.c (Fgarbage_collect): Use compact_buffer.
* src/buffer.h (compact_buffer): New prototype.
(struct buffer_text): New member.
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Compact buffers when idle.
+ * compact.el: New file.
+
2012-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (eventp): Presume that if it looks vaguely like an event,
--- /dev/null
+;;; compact.el --- compact buffers when idle
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Package: emacs
+
+;; 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 package provides the ability to compact buffers when Emacs is idle.
+;; Initially written by Dmitry Antipov <dmantipov@yandex.ru>.
+
+;;; Code:
+
+(require 'timer)
+
+(defun compact-buffers ()
+ "Run `compact-buffer' for each buffer except current buffer.
+Schedule next compaction if `compact-buffers-when-idle' is greater than zero."
+ (mapc (lambda (buffer)
+ (and (not (eq buffer (current-buffer)))
+ (compact-buffer buffer)))
+ (buffer-list))
+ (compact-buffers-idle))
+
+(defun compact-buffers-idle ()
+ "Compact buffers if `compact-buffers-when-idle' is greater than zero."
+ (and (floatp compact-buffers-when-idle)
+ (> compact-buffers-when-idle 0.0)
+ (run-with-idle-timer compact-buffers-when-idle nil 'compact-buffers)))
+
+(defcustom compact-buffers-when-idle 1.0
+ "Compact all buffers when Emacs is idle more than this period of time.
+Compaction is done by truncating `buffer-undo-list' and shrinking the gap.
+Value less than or equal to zero disables idle compaction."
+ :type 'float
+ :group 'alloc
+ :set (lambda (symbol value)
+ (progn (set-default symbol value)
+ (compact-buffers-idle)))
+ :version "24.2")
+
+(provide 'compact)
+
+;;; compact.el ends here
+2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Buffer compaction primitive which may be used from Lisp.
+ * buffer.c (compact_buffer, Fcompact_buffer): New function.
+ (syms_of_buffer): Register Fcompact_buffer.
+ * alloc.c (Fgarbage_collect): Use compact_buffer.
+ * buffer.h (compact_buffer): New prototype.
+ (struct buffer_text): New member.
+
2012-07-19 Dmitry Antipov <dmantipov@yandex.ru>
New macro to iterate over all buffers, miscellaneous cleanups.
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
for_each_buffer (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name))
- && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
- truncate_undo_list (nextb);
-
- /* Shrink buffer gaps, but skip indirect and dead buffers. */
- if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
- && ! nextb->text->inhibit_shrinking)
- {
- /* If a buffer's gap size is more than 10% of the buffer
- size, or larger than 2000 bytes, then shrink it
- accordingly. Keep a minimum size of 20 bytes. */
- int size = min (2000, max (20, (nextb->text->z_byte / 10)));
-
- if (nextb->text->gap_size > size)
- {
- struct buffer *save_current = current_buffer;
- current_buffer = nextb;
- make_gap (-(nextb->text->gap_size - size));
- current_buffer = save_current;
- }
- }
- }
+ compact_buffer (nextb);
t1 = current_emacs_time ();
return Qnil;
}
-/*
- DEFVAR_LISP ("kill-buffer-hook", ..., "\
-Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
-The buffer being killed will be current while the hook is running.\n\
+/* Truncate undo list and shrink the gap of BUFFER. */
+
+int
+compact_buffer (struct buffer *buffer)
+{
+ /* Skip dead buffers, indirect buffers and buffers
+ which aren't changed since last compaction. */
+ if (!NILP (buffer->BUFFER_INTERNAL_FIELD (name))
+ && (buffer->base_buffer == NULL)
+ && (buffer->text->compact != buffer->text->modiff))
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (!EQ (buffer->BUFFER_INTERNAL_FIELD (undo_list), Qt))
+ truncate_undo_list (buffer);
+
+ /* Shrink buffer gaps. */
+ if (!buffer->text->inhibit_shrinking)
+ {
+ /* If a buffer's gap size is more than 10% of the buffer
+ size, or larger than 2000 bytes, then shrink it
+ accordingly. Keep a minimum size of 20 bytes. */
+ int size = min (2000, max (20, (buffer->text->z_byte / 10)));
+
+ if (buffer->text->gap_size > size)
+ {
+ struct buffer *save_current = current_buffer;
+ current_buffer = buffer;
+ make_gap (-(buffer->text->gap_size - size));
+ current_buffer = save_current;
+ }
+ }
+ buffer->text->compact = buffer->text->modiff;
+ return 1;
+ }
+ return 0;
+}
+
+DEFUN ("compact-buffer", Fcompact_buffer, Scompact_buffer, 0, 1, 0,
+ doc: /* Compact BUFFER by truncating undo list and shrinking the gap.
+If buffer is nil, compact current buffer. Compaction is performed
+only if buffer was changed since last compaction. Return t if
+buffer compaction was performed, and nil otherwise. */)
+ (Lisp_Object buffer)
+{
+ if (NILP (buffer))
+ XSETBUFFER (buffer, current_buffer);
+ CHECK_BUFFER (buffer);
+ return compact_buffer (XBUFFER (buffer)) ? Qt : Qnil;
+}
-Functions run by this hook are supposed to not change the current
-buffer. See `kill-buffer'."
-*/
DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
doc: /* Kill the buffer specified by BUFFER-OR-NAME.
The argument may be a buffer or the name of an existing buffer.
defsubr (&Smake_indirect_buffer);
defsubr (&Sgenerate_new_buffer_name);
defsubr (&Sbuffer_name);
-/*defsubr (&Sbuffer_number);*/
defsubr (&Sbuffer_file_name);
defsubr (&Sbuffer_base_buffer);
defsubr (&Sbuffer_local_value);
defsubr (&Srename_buffer);
defsubr (&Sother_buffer);
defsubr (&Sbuffer_enable_undo);
+ defsubr (&Scompact_buffer);
defsubr (&Skill_buffer);
defsubr (&Sbury_buffer_internal);
defsubr (&Sset_buffer_major_mode);
EMACS_INT overlay_modiff; /* Counts modifications to overlays. */
+ EMACS_INT compact; /* Set to modiff each time when compact_buffer
+ is called for this buffer. */
+
/* Minimum value of GPT - BEG since last redisplay that finished. */
ptrdiff_t beg_unchanged;
\f
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
+extern int compact_buffer (struct buffer *);
extern void evaporate_overlays (ptrdiff_t);
extern ptrdiff_t overlays_at (EMACS_INT pos, int extend, Lisp_Object **vec_ptr,
ptrdiff_t *len_ptr, ptrdiff_t *next_ptr,
projects / emacs.git / commitdiff