X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=a34987d97346172f1001b0e7377e5b8b8b0df194;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=403728abc53e4394fba744b73aae9a9ff884e7b8;hpb=5bb4be177ea7af2fc460eb1d259182f3e721501b;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 403728a..a34987d 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:
 
@@ -314,50 +315,50 @@ variable."
 (defcustom gnus-group-highlight
   '(;; Mail.
     ((and mailp (= unread 0) (eq level 1)) .
-     gnus-group-mail-1-empty-face)
+     gnus-group-mail-1-empty)
     ((and mailp (eq level 1)) .
-     gnus-group-mail-1-face)
+     gnus-group-mail-1)
     ((and mailp (= unread 0) (eq level 2)) .
-     gnus-group-mail-2-empty-face)
+     gnus-group-mail-2-empty)
     ((and mailp (eq level 2)) .
-     gnus-group-mail-2-face)
+     gnus-group-mail-2)
     ((and mailp (= unread 0) (eq level 3)) .
-     gnus-group-mail-3-empty-face)
+     gnus-group-mail-3-empty)
     ((and mailp (eq level 3)) .
-     gnus-group-mail-3-face)
+     gnus-group-mail-3)
     ((and mailp (= unread 0)) .
-     gnus-group-mail-low-empty-face)
+     gnus-group-mail-low-empty)
     ((and mailp) .
-     gnus-group-mail-low-face)
+     gnus-group-mail-low)
     ;; News.
     ((and (= unread 0) (eq level 1)) .
-     gnus-group-news-1-empty-face)
+     gnus-group-news-1-empty)
     ((and (eq level 1)) .
-     gnus-group-news-1-face)
+     gnus-group-news-1)
     ((and (= unread 0) (eq level 2)) .
-     gnus-group-news-2-empty-face)
+     gnus-group-news-2-empty)
     ((and (eq level 2)) .
-     gnus-group-news-2-face)
+     gnus-group-news-2)
     ((and (= unread 0) (eq level 3)) .
-     gnus-group-news-3-empty-face)
+     gnus-group-news-3-empty)
     ((and (eq level 3)) .
-     gnus-group-news-3-face)
+     gnus-group-news-3)
     ((and (= unread 0) (eq level 4)) .
-     gnus-group-news-4-empty-face)
+     gnus-group-news-4-empty)
     ((and (eq level 4)) .
-     gnus-group-news-4-face)
+     gnus-group-news-4)
     ((and (= unread 0) (eq level 5)) .
-     gnus-group-news-5-empty-face)
+     gnus-group-news-5-empty)
     ((and (eq level 5)) .
-     gnus-group-news-5-face)
+     gnus-group-news-5)
     ((and (= unread 0) (eq level 6)) .
-     gnus-group-news-6-empty-face)
+     gnus-group-news-6-empty)
     ((and (eq level 6)) .
-     gnus-group-news-6-face)
+     gnus-group-news-6)
     ((and (= unread 0)) .
-     gnus-group-news-low-empty-face)
+     gnus-group-news-low-empty)
     (t .
-       gnus-group-news-low-face))
+       gnus-group-news-low))
   "*Controls the highlighting of group buffer lines.
 
 Below is a list of `Form'/`Face' pairs.  When deciding how a a
@@ -387,7 +388,7 @@ ticked: The number of ticked articles."
   :type 'character)
 
 (defgroup gnus-group-icons nil
-  "Add Icons to your group buffer.  "
+  "Add Icons to your group buffer."
   :group 'gnus-group-visual)
 
 (defcustom gnus-group-icon-list
@@ -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))
@@ -4384,6 +4388,32 @@ This command may read the active file."
 	(gnus-add-marked-articles
 	 group 'expire (list article))))))
 
+
+;;;
+;;; Group compaction
+;;;
+
+(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)."
+  (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)
+      (gnus-group-update-group-line))))
+
 (provide 'gnus-group)
 
 ;;; gnus-group.el ends here