If nnmail-expiry-wait is immediate, then expire all articles.

[gnus] / lisp / gnus-group.el

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index fa6ae51..5934a19 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -292,13 +292,14 @@ If you want to modify the group buffer, you can use this hook."
   :group 'gnus-exit
   :type 'hook)
 
-(defcustom gnus-group-update-hook '(gnus-group-highlight-line)
+(defcustom gnus-group-update-hook '(gnus-group-highlight-line gnus-group-add-icon)
   "Hook called when a group line is changed.
 The hook will not be called if `gnus-visual' is nil.
 
-The default function `gnus-group-highlight-line' will
-highlight the line according to the `gnus-group-highlight'
-variable."
+The default functions `gnus-group-highlight-line' will highlight
+the line according to the `gnus-group-highlight' variable, and
+`gnus-group-add-icon' will add an icon according to
+`gnus-group-icon-list'"
   :group 'gnus-group-visual
   :type 'hook)
 
@@ -509,7 +510,10 @@ simple manner.")
                   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
              (t number)) ?s)
     (?R gnus-tmp-number-of-read ?s)
-    (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
+    (?U (if (gnus-active gnus-tmp-group)
+           (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
+         "*")
+       ?s)
     (?t gnus-tmp-number-total ?d)
     (?y gnus-tmp-number-of-unread ?s)
     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
@@ -675,7 +679,7 @@ simple manner.")
   "R" gnus-group-make-rss-group
   "c" gnus-group-customize
   "z" gnus-group-compact-group
-  "x" gnus-group-nnimap-expunge
+  "x" gnus-group-expunge-group
   "\177" gnus-group-delete-group
   [delete] gnus-group-delete-group)
 
@@ -1575,7 +1579,7 @@ if it is a string, only list groups matching REGEXP."
              ?m ? ))
         (gnus-tmp-moderated-string
          (if (eq gnus-tmp-moderated ?m) "(m)" ""))
-        (gnus-tmp-group-icon "==&&==")
+         (gnus-tmp-group-icon (propertize " " 'gnus-group-icon t))
         (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
         (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
         (gnus-tmp-news-method-string
@@ -1684,6 +1688,47 @@ if it is a string, only list groups matching REGEXP."
        (gnus-extent-start-open beg)))
     (goto-char p)))
 
+(defun gnus-group-add-icon ()
+  "Add an icon to the current line according to `gnus-group-icon-list'."
+  (save-excursion
+    (let* ((end (line-end-position))
+           ;; now find out where the line starts and leave point there.
+           (beg (line-beginning-position)))
+      (save-restriction
+        (narrow-to-region beg end)
+        (goto-char beg)
+        (let ((mystart (text-property-any beg end 'gnus-group-icon t)))
+          (when mystart
+            (let* ((group (gnus-group-group-name))
+                   (entry (gnus-group-entry group))
+                   (unread (if (numberp (car entry)) (car entry) 0))
+                   (active (gnus-active group))
+                   (total (if active (1+ (- (cdr active) (car active))) 0))
+                   (info (nth 2 entry))
+                   (method (gnus-server-get-method group (gnus-info-method info)))
+                   (marked (gnus-info-marks info))
+                   (mailp (memq 'mail (assoc (symbol-name
+                                              (car (or method gnus-select-method)))
+                                             gnus-valid-select-methods)))
+                   (level (or (gnus-info-level info) gnus-level-killed))
+                   (score (or (gnus-info-score info) 0))
+                   (ticked (gnus-range-length (cdr (assq 'tick marked))))
+                   (group-age (gnus-group-timestamp-delta group))
+                   (inhibit-read-only t)
+                   (list gnus-group-icon-list)
+                   (myend (next-single-property-change
+                           mystart 'gnus-group-icon)))
+              (while (and list
+                          (not (eval (caar list))))
+                (setq list (cdr list)))
+              (when list
+                (put-text-property
+                 mystart myend
+                 'display
+                 (append
+                  (gnus-create-image (expand-file-name (cdar list)))
+                  '(:ascent center)))))))))))
+
 (defun gnus-group-update-group (group &optional visible-only)
   "Update all lines where GROUP appear.
 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
@@ -3163,21 +3208,17 @@ mail messages or news articles in files that have numeric names."
                       'summary 'group)))
       (error "Couldn't enter %s" dir))))
 
-(autoload 'nnimap-expunge "nnimap")
-(autoload 'nnimap-acl-get "nnimap")
-(autoload 'nnimap-acl-edit "nnimap")
-
-(defun gnus-group-nnimap-expunge (group)
+(defun gnus-group-expunge-group (group)
   "Expunge deleted articles in current nnimap GROUP."
   (interactive (list (gnus-group-group-name)))
-  (let ((mailbox (gnus-group-real-name group)) method)
-    (unless group
-      (error "No group on current line"))
-    (unless (gnus-get-info group)
-      (error "Killed group; can't be edited"))
-    (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
-      (error "%s is not an nnimap group" group))
-    (nnimap-expunge mailbox (cadr method))))
+  (let ((method (gnus-find-method-for-group group)))
+    (if (not (gnus-check-backend-function
+             'request-expunge-group (car method)))
+       (error "%s does not support expunging" (car method))
+      (gnus-request-expunge-group group method))))
+
+(autoload 'nnimap-acl-get "nnimap")
+(autoload 'nnimap-acl-edit "nnimap")
 
 (defun gnus-group-nnimap-edit-acl (group)
   "Edit the Access Control List of current nnimap GROUP."