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.

4 files changed, 67 insertions, 35 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 73632c26bff..7a0942f9c7e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 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.
         * lisp.h (all_buffers): Remove declaration.
         * buffer.h (all_buffers): Add declaration, with comment.
diff --git a/src/alloc.c b/src/alloc.c
index 166f5b72449..233137e368e 100644
--- a/src/alloc.c
+++ b/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 ();
 
diff --git a/src/buffer.c b/src/buffer.c
index 40370460b9f..0fc5dd0b9c3 100644
--- a/src/buffer.c
+++ b/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);
diff --git a/src/buffer.h b/src/buffer.h
index 8c596835fcc..6f090479a24 100644
--- a/src/buffer.h
+++ b/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,