lisp/ChangeLog addition:

[gnus] / lisp / gnus-group.el

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 39ee5de..b4f8347 100644 (file)
--- 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:
 
@@ -656,6 +657,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)
@@ -834,6 +836,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))
@@ -4338,6 +4342,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)
+  "Conpact 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)
 
 ;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6