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.

lisp/ChangeLog

+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,

lisp/compact.el

+;;; 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

src/ChangeLog

+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.

src/alloc.c

@@ -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 ();
 

src/buffer.c

@@ -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);

src/buffer.h

@@ -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,