[Emacs-diffs] /srv/bzr/emacs/trunk r109157: Compact buffers when idle.

[Dmitry Antipov]

------------------------------------------------------------
revno: 109157
committer: Dmitry Antipov <address@hidden>
branch nick: trunk
timestamp: Thu 2012-07-19 12:56:53 +0400
message:
  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.
added:
  lisp/compact.el
modified:
  lisp/ChangeLog
  src/ChangeLog
  src/alloc.c
  src/buffer.c
  src/buffer.h

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-19 06:24:04 +0000
+++ b/lisp/ChangeLog    2012-07-19 08:56:53 +0000
@@ -1,3 +1,8 @@
+2012-07-19  Dmitry Antipov  <address@hidden>
+
+       Compact buffers when idle.
+       * compact.el: New file.
+
 2012-07-19  Stefan Monnier  <address@hidden>
 
        * subr.el (eventp): Presume that if it looks vaguely like an event,

=== added file 'lisp/compact.el'
--- a/lisp/compact.el   1970-01-01 00:00:00 +0000
+++ b/lisp/compact.el   2012-07-19 08:56:53 +0000
@@ -0,0 +1,60 @@
+;;; 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 <address@hidden>.
+
+;;; 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

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2012-07-19 03:55:59 +0000
+++ b/src/ChangeLog     2012-07-19 08:56:53 +0000
@@ -1,5 +1,14 @@
 2012-07-19  Dmitry Antipov  <address@hidden>
 
+       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  <address@hidden>
+
        New macro to iterate over all buffers, miscellaneous cleanups.
        * lisp.h (all_buffers): Remove declaration.
        * buffer.h (all_buffers): Add declaration, with comment.

=== modified file 'src/alloc.c'
--- a/src/alloc.c       2012-07-19 03:55:59 +0000
+++ b/src/alloc.c       2012-07-19 08:56:53 +0000
@@ -5413,33 +5413,7 @@
   /* 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 ();
 

=== modified file 'src/buffer.c'
--- a/src/buffer.c      2012-07-19 03:55:59 +0000
+++ b/src/buffer.c      2012-07-19 08:56:53 +0000
@@ -1434,14 +1434,59 @@
   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\
-
-Functions run by this hook are supposed to not change the current
-buffer.  See `kill-buffer'."
-*/
+/* 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;
+}
+
 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 @@
   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 @@
   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);

=== modified file 'src/buffer.h'
--- a/src/buffer.h      2012-07-19 03:55:59 +0000
+++ b/src/buffer.h      2012-07-19 08:56:53 +0000
@@ -436,6 +436,9 @@
 
     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 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,