*** empty log message ***
[gnus] / lisp / gnus-group.el
index 736ad53..0af00bd 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -35,6 +35,7 @@
 (require 'gnus-range)
 (require 'gnus-win)
 (require 'gnus-undo)
+(require 'time-date)
 
 (defcustom gnus-group-archive-directory
   "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
@@ -298,6 +299,18 @@ variable."
      gnus-group-news-3-empty-face)
     ((and (not mailp) (eq level 3)) .
      gnus-group-news-3-face)
+    ((and (= unread 0) (not mailp) (eq level 4)) .
+     gnus-group-news-4-empty-face)
+    ((and (not mailp) (eq level 4)) .
+     gnus-group-news-4-face)
+    ((and (= unread 0) (not mailp) (eq level 5)) .
+     gnus-group-news-5-empty-face)
+    ((and (not mailp) (eq level 5)) .
+     gnus-group-news-5-face)
+    ((and (= unread 0) (not mailp) (eq level 6)) .
+     gnus-group-news-6-empty-face)
+    ((and (not mailp) (eq level 6)) .
+     gnus-group-news-6-face)
     ((and (= unread 0) (not mailp)) .
      gnus-group-news-low-empty-face)
     ((and (not mailp)) .
@@ -763,14 +776,12 @@ The following commands are available:
   (gnus-group-set-mode-line)
   (setq mode-line-process nil)
   (use-local-map gnus-group-mode-map)
-  (buffer-disable-undo (current-buffer))
+  (buffer-disable-undo)
   (setq truncate-lines t)
   (setq buffer-read-only t)
   (gnus-set-default-directory)
   (gnus-update-format-specifications nil 'group 'group-mode)
   (gnus-update-group-mark-positions)
-  (make-local-hook 'post-command-hook)
-  (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
   (when gnus-use-undo
     (gnus-undo-mode 1))
   (when gnus-slave
@@ -791,9 +802,6 @@ The following commands are available:
            (list (cons 'process (and (search-forward "\200" nil t)
                                      (- (point) 2))))))))
 
-(defun gnus-clear-inboxes-moved ()
-  (setq nnmail-moved-inboxes nil))
-
 (defun gnus-mouse-pick-group (e)
   "Enter the group under the mouse pointer."
   (interactive "e")
@@ -838,8 +846,6 @@ Also see the `gnus-group-use-permanent-levels' variable."
            (gnus-group-default-level nil t)
            gnus-group-default-list-level
            gnus-level-subscribed))))
-  ;; Just do this here, for no particular good reason.
-  (gnus-clear-inboxes-moved)
   (unless level
     (setq level (car gnus-group-list-mode)
          unread (cdr gnus-group-list-mode)))
@@ -1327,7 +1333,7 @@ If FIRST-TOO, the current line is also eligible as a target."
        (beginning-of-line)
        (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
        (subst-char-in-region
-        (point) (1+ (point)) (following-char)
+        (point) (1+ (point)) (char-after)
         (if unmark
             (progn
               (setq gnus-group-marked (delete group gnus-group-marked))
@@ -1802,7 +1808,7 @@ ADDRESS."
     (gnus-read-method "From method: ")))
 
   (when (stringp method)
-    (setq method (gnus-server-to-method method)))
+    (setq method (or (gnus-server-to-method method) method)))
   (let* ((meth (when (and method
                          (not (gnus-server-equal method gnus-select-method)))
                 (if address (list (intern method) address)
@@ -2440,7 +2446,8 @@ The number of newsgroups that this function was unable to catch
 up is returned."
   (interactive "P")
   (let ((groups (gnus-group-process-prefix n))
-       (ret 0))
+       (ret 0)
+       group)
     (unless groups (error "No groups selected"))
     (if (not
         (or (not gnus-interactive-catchup) ;Without confirmation?
@@ -2454,21 +2461,20 @@ up is returned."
                   (car groups)
                 (format "these %d groups" (length groups)))))))
        n
-      (while groups
+      (while (setq group (pop groups))
        ;; Virtual groups have to be given special treatment.
-       (let ((method (gnus-find-method-for-group (car groups))))
+       (let ((method (gnus-find-method-for-group group)))
          (when (eq 'nnvirtual (car method))
            (nnvirtual-catchup-group
-            (gnus-group-real-name (car groups)) (nth 1 method) all)))
-       (gnus-group-remove-mark (car groups))
-       (if (>= (gnus-group-group-level) gnus-level-zombie)
+            (gnus-group-real-name group) (nth 1 method) all)))
+       (if (>= (gnus-info-level (gnus-get-info group))
+               gnus-level-zombie)
            (gnus-message 2 "Dead groups can't be caught up")
          (if (prog1
-                 (gnus-group-goto-group (car groups))
-               (gnus-group-catchup (car groups) all))
+                 (gnus-group-goto-group group)
+               (gnus-group-catchup group all))
              (gnus-group-update-group-line)
-           (setq ret (1+ ret))))
-       (setq groups (cdr groups)))
+           (setq ret (1+ ret)))))
       (gnus-group-next-unread-group 1)
       ret)))
 
@@ -2569,7 +2575,7 @@ or nil if no action could be taken."
                              gnus-level-default-subscribed))
         s)))))
   (unless (and (>= level 1) (<= level gnus-level-killed))
-    (error "Illegal level: %d" level))
+    (error "Invalid level: %d" level))
   (let ((groups (gnus-group-process-prefix n))
        group)
     (while (setq group (pop groups))
@@ -2811,7 +2817,7 @@ yanked) a list of yanked groups is returned."
       (gnus-make-hashtable-from-newsrc-alist)
       (gnus-group-list-groups)))
    (t
-    (error "Can't kill; illegal level: %d" level))))
+    (error "Can't kill; invalid level: %d" level))))
 
 (defun gnus-group-list-all-groups (&optional arg)
   "List all newsgroups with level ARG or lower.
@@ -2946,8 +2952,9 @@ If N is negative, this group and the N-1 previous groups will be checked."
             (gnus-get-info group) (gnus-active group) t)
            (unless (gnus-virtual-group-p group)
              (gnus-close-group group))
-           (gnus-agent-save-group-info
-            method (gnus-group-real-name group) (gnus-active group))
+           (when gnus-agent
+             (gnus-agent-save-group-info
+              method (gnus-group-real-name group) (gnus-active group)))
            (gnus-group-update-group group))
        (if (eq (gnus-server-status (gnus-find-method-for-group group))
                'denied)
@@ -3054,7 +3061,6 @@ to use."
       (mapatoms
        (lambda (group)
         (and (string-match regexp (symbol-value group))
-             (gnus-active (symbol-name group))
              (push (symbol-name group) groups)))
        gnus-description-hashtb))
     (if (not groups)
@@ -3062,7 +3068,7 @@ to use."
       ;; Print out all the groups.
       (save-excursion
        (pop-to-buffer "*Gnus Help*")
-       (buffer-disable-undo (current-buffer))
+       (buffer-disable-undo)
        (erase-buffer)
        (setq groups (sort groups 'string<))
        (while groups
@@ -3334,26 +3340,26 @@ and the second element is the address."
 
 (defun gnus-add-marked-articles (group type articles &optional info force)
   ;; Add ARTICLES of TYPE to the info of GROUP.
-  ;; If INFO is non-nil, use that info.         If FORCE is non-nil, don't
+  ;; If INFO is non-nil, use that info.         If FORCE is non-nil, don't
   ;; add, but replace marked articles of TYPE with ARTICLES.
   (let ((info (or info (gnus-get-info group)))
        marked m)
     (or (not info)
        (and (not (setq marked (nthcdr 3 info)))
             (or (null articles)
-                (setcdr (nthcdr 2 info)
-                        (list (list (cons type (gnus-compress-sequence
-                                                articles t)))))))
+                (setcdr (nthcdr 2 info)
+                        (list (list (cons type (gnus-compress-sequence
+                                                articles t)))))))
        (and (not (setq m (assq type (car marked))))
             (or (null articles)
-                (setcar marked
-                        (cons (cons type (gnus-compress-sequence articles t) )
-                              (car marked)))))
+                (setcar marked
+                        (cons (cons type (gnus-compress-sequence articles t) )
+                              (car marked)))))
        (if force
            (if (null articles)
-               (setcar (nthcdr 3 info)
-                       (gnus-delete-alist type (car marked)))
-             (setcdr m (gnus-compress-sequence articles t)))
+               (setcar (nthcdr 3 info)
+                       (gnus-delete-alist type (car marked)))
+             (setcdr m (gnus-compress-sequence articles t)))
          (setcdr m (gnus-compress-sequence
                     (sort (nconc (gnus-uncompress-range (cdr m))
                                  (copy-sequence articles)) '<) t))))))