X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=c7fbad9433c410a5e90ba481853a63f9b6c5df86;hb=f3f2fe724c3d2e84aa6a9f579465c30da46b75ca;hp=51875272ad5663c9edfa3921d9795590f6be8a26;hpb=9d57619f75a7178c9b107867f02369a6ed468a08;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 5187527..c7fbad9 100644
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -1,6 +1,7 @@
 ;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -666,6 +667,7 @@ simple manner.")
   "r" gnus-group-rename-group
   "R" gnus-group-make-rss-group
   "c" gnus-group-customize
+  "z" gnus-group-compact-group
   "x" gnus-group-nnimap-expunge
   "\177" gnus-group-delete-group
   [delete] gnus-group-delete-group)
@@ -844,6 +846,8 @@ simple manner.")
 	(gnus-group-group-name)]
        ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
        ["Customize" gnus-group-customize (gnus-group-group-name)]
+       ["Compact" gnus-group-compact-group
+	:active (gnus-group-group-name)]
        ("Edit"
 	["Parameters" gnus-group-edit-group-parameters
 	 :included (not (gnus-topic-mode-p))
@@ -1738,7 +1742,7 @@ If FIRST-TOO, the current line is also eligible as a target."
 	 (size (+ size-in-cache size-in-agent))
 	 (suffix '("B" "K" "M" "G"))
 	 (scale 1024.0)
-	 (cutoff (* 10 scale)))
+	 (cutoff scale))
     (while (> size cutoff)
       (setq size (/ size scale)
 	    suffix (cdr suffix)))
@@ -4384,6 +4388,40 @@ This command may read the active file."
 	(gnus-add-marked-articles
 	 group 'expire (list article))))))
 
+
+;;;
+;;; Group compaction. -- dvl
+;;;
+
+(defun gnus-group-compact-group (group)
+  "Compact the current group.
+Compaction means removing gaps between article numbers.  Hence, this
+operation is only meaningful for back ends using one file per article
+\(e.g. nnml).
+
+Note: currently only implemented in nnml."
+  (interactive (list (gnus-group-group-name)))
+  (unless group
+    (error "No group to compact"))
+  (unless (gnus-check-backend-function 'request-compact-group group)
+    (error "This back end does not support group compaction"))
+  (let ((group-decoded (gnus-group-decoded-name group)))
+    (gnus-message 6 "\
+Compacting group %s... (this may take a long time)"
+		  group-decoded)
+    (prog1
+	(if (not (gnus-request-compact-group group))
+	    (gnus-error 3 "Couldn't compact group %s" group-decoded)
+	  (gnus-message 6 "Compacting group %s...done" group-decoded)
+	  t)
+      ;; Invalidate the "original article" buffer which might be out of date.
+      ;; #### NOTE: Yes, this might be a bit rude, but since compaction
+      ;; #### will not happen very often, I think this is acceptable.
+      (let ((original (get-buffer gnus-original-article-buffer)))
+	(and original (gnus-kill-buffer original)))
+      ;; Update the group line to reflect new information (art number etc).
+      (gnus-group-update-group-line))))
+
 (provide 'gnus-group)
 
 ;;; gnus-group.el ends here