X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-group.el;h=c7fbad9433c410a5e90ba481853a63f9b6c5df86;hb=f3f2fe724c3d2e84aa6a9f579465c30da46b75ca;hp=d9719cee9a954efc8c50cb742f0243e08fe5e5f3;hpb=97615c9dc04939ab73c454a25cf6c64bbe35607b;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index d9719ce..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 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; 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: @@ -41,7 +42,7 @@ (require 'time-date) (require 'gnus-ems) -(eval-when-compile +(eval-when-compile (require 'mm-url) (let ((features (cons 'gnus-group features))) (require 'gnus-sum)) @@ -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)) @@ -1070,7 +1074,7 @@ The following commands are available: (gnus-undo-mode 1)) (when gnus-slave (gnus-slave-mode)) - (gnus-run-hooks 'gnus-group-mode-hook)) + (gnus-run-mode-hooks 'gnus-group-mode-hook)) (defun gnus-update-group-mark-positions () (save-excursion @@ -1505,7 +1509,7 @@ if it is a string, only list groups matching REGEXP." (eval gnus-group-line-format-spec))) `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) gnus-unread ,(if (numberp number) - (string-to-int gnus-tmp-number-of-unread) + (string-to-number gnus-tmp-number-of-unread) t) gnus-marked ,gnus-tmp-marked-mark gnus-indentation ,gnus-group-indentation @@ -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))) @@ -3331,7 +3335,7 @@ Uses the process/prefix convention." (progn (unless (gnus-group-process-prefix current-prefix-arg) (error "No group on the current line")) - (string-to-int + (string-to-number (let ((s (read-string (format "Level (default %s): " (or (gnus-group-group-level) @@ -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