Commit 9cd47b72 authored by Dmitry Antipov's avatar Dmitry Antipov

Compact buffers when idle.

* 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.
parent 1d6fc0df
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,
......
;;; 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.
......
......@@ -5413,33 +5413,7 @@ See Info node `(elisp)Garbage Collection'. */)
/* 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 ();
......
......@@ -1434,14 +1434,59 @@ No argument or nil as argument means do this for the current buffer. */)
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.
......@@ -5992,7 +6037,6 @@ and `bury-buffer-internal'. */);
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);
......@@ -6004,6 +6048,7 @@ and `bury-buffer-internal'. */);
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);
......
......@@ -436,6 +436,9 @@ struct buffer_text
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;
......@@ -903,6 +906,7 @@ extern struct buffer buffer_local_symbols;
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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment