2001-08-19 Simon Josefsson <jas@extundo.com>
[gnus] / lisp / gnus-group.el
index 9c69f19..7f15f7d 100644 (file)
@@ -295,52 +295,52 @@ variable."
                       (sexp :tag "Method"))))
 
 (defcustom gnus-group-highlight
-  '(;; News.
-    ((and (= unread 0) (not mailp) (eq level 1)) .
+  '(;; Mail.
+    ((and mailp (= unread 0) (eq level 1)) .
+     gnus-group-mail-1-empty-face)
+    ((and mailp (eq level 1)) .
+     gnus-group-mail-1-face)
+    ((and mailp (= unread 0) (eq level 2)) .
+     gnus-group-mail-2-empty-face)
+    ((and mailp (eq level 2)) .
+     gnus-group-mail-2-face)
+    ((and mailp (= unread 0) (eq level 3)) .
+     gnus-group-mail-3-empty-face)
+    ((and mailp (eq level 3)) .
+     gnus-group-mail-3-face)
+    ((and mailp (= unread 0)) .
+     gnus-group-mail-low-empty-face)
+    ((and mailp) .
+     gnus-group-mail-low-face)
+    ;; News.
+    ((and (= unread 0) (eq level 1)) .
      gnus-group-news-1-empty-face)
-    ((and (not mailp) (eq level 1)) .
+    ((and (eq level 1)) .
      gnus-group-news-1-face)
-    ((and (= unread 0) (not mailp) (eq level 2)) .
+    ((and (= unread 0) (eq level 2)) .
      gnus-group-news-2-empty-face)
-    ((and (not mailp) (eq level 2)) .
+    ((and (eq level 2)) .
      gnus-group-news-2-face)
-    ((and (= unread 0) (not mailp) (eq level 3)) .
+    ((and (= unread 0) (eq level 3)) .
      gnus-group-news-3-empty-face)
-    ((and (not mailp) (eq level 3)) .
+    ((and (eq level 3)) .
      gnus-group-news-3-face)
-    ((and (= unread 0) (not mailp) (eq level 4)) .
+    ((and (= unread 0) (eq level 4)) .
      gnus-group-news-4-empty-face)
-    ((and (not mailp) (eq level 4)) .
+    ((and (eq level 4)) .
      gnus-group-news-4-face)
-    ((and (= unread 0) (not mailp) (eq level 5)) .
+    ((and (= unread 0) (eq level 5)) .
      gnus-group-news-5-empty-face)
-    ((and (not mailp) (eq level 5)) .
+    ((and (eq level 5)) .
      gnus-group-news-5-face)
-    ((and (= unread 0) (not mailp) (eq level 6)) .
+    ((and (= unread 0) (eq level 6)) .
      gnus-group-news-6-empty-face)
-    ((and (not mailp) (eq level 6)) .
+    ((and (eq level 6)) .
      gnus-group-news-6-face)
-    ((and (= unread 0) (not mailp)) .
+    ((and (= unread 0)) .
      gnus-group-news-low-empty-face)
-    ((and (not mailp)) .
-     gnus-group-news-low-face)
-    ;; Mail.
-    ((and (= unread 0) (eq level 1)) .
-     gnus-group-mail-1-empty-face)
-    ((eq level 1) .
-     gnus-group-mail-1-face)
-    ((and (= unread 0) (eq level 2)) .
-     gnus-group-mail-2-empty-face)
-    ((eq level 2) .
-     gnus-group-mail-2-face)
-    ((and (= unread 0) (eq level 3)) .
-     gnus-group-mail-3-empty-face)
-    ((eq level 3) .
-     gnus-group-mail-3-face)
-    ((= unread 0) .
-     gnus-group-mail-low-empty-face)
     (t .
-       gnus-group-mail-low-face))
+     gnus-group-news-low-face))
   "*Controls the highlighting of group buffer lines.
 
 Below is a list of `Form'/`Face' pairs.  When deciding how a a
@@ -427,7 +427,7 @@ in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
 in the minibuffer prompt."
   :group 'gnus-group-various
   :type '(choice (string :tag "Prompt string")
-                 (const :tag "Empty" nil)))
+                (const :tag "Empty" nil)))
 
 (defvar gnus-group-listing-limit 1000
   "*A limit of the number of groups when listing.
@@ -849,7 +849,7 @@ simple manner.")
 
     (easy-menu-define
      gnus-group-misc-menu gnus-group-mode-map ""
-     `("Misc"
+     `("Gnus"
        ("SOUP"
        ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
        ["Send replies" gnus-soup-send-replies
@@ -1203,9 +1203,7 @@ if it is a string, only list groups matching REGEXP."
            (gnus-add-text-properties
             (point) (prog1 (1+ (point))
                       (insert " " mark "     *: "
-                              (gnus-group-name-decode group
-                                                      (gnus-group-name-charset
-                                                       nil group))
+                              (gnus-group-decoded-name group)
                               "\n"))
             (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
                   'gnus-unread t
@@ -1366,9 +1364,13 @@ if it is a string, only list groups matching REGEXP."
         (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)))
+        (mailp (apply 'append
+                      (mapcar
+                       (lambda (x)
+                         (memq x (assoc (symbol-name
+                                         (car (or method gnus-select-method)))
+                                        gnus-valid-select-methods)))
+                       '(mail post-mail))))
         (level (or (gnus-info-level info) gnus-level-killed))
         (score (or (gnus-info-score info) 0))
         (ticked (gnus-range-length (cdr (assq 'tick marked))))
@@ -1774,6 +1776,7 @@ group."
 (defun gnus-group-select-group (&optional all)
   "Select this newsgroup.
 No article is selected automatically.
+If the group is opened, just switch the summary buffer.
 If ALL is non-nil, already read articles become readable.
 If ALL is a number, fetch this number of articles."
   (interactive "P")
@@ -3297,9 +3300,7 @@ entail asking the server for the groups."
       (gnus-add-text-properties
        (point) (prog1 (1+ (point))
                 (insert "       *: "
-                        (gnus-group-name-decode group
-                                                (gnus-group-name-charset
-                                                 nil group))
+                        (gnus-group-decoded-name group)
                         "\n"))
        (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
             'gnus-unread t
@@ -3676,6 +3677,12 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
                     (file-name-nondirectory gnus-current-startup-file))))
     (gnus-run-hooks 'gnus-exit-gnus-hook)
     (gnus-configure-windows 'group t)
+    (when (and (gnus-buffer-live-p gnus-dribble-buffer)
+              (not (zerop (save-excursion
+                           (set-buffer gnus-dribble-buffer)
+                           (buffer-size)))))
+      (gnus-dribble-enter
+       ";;; Gnus was exited on purpose without saving the .newsrc files."))
     (gnus-dribble-save)
     (gnus-close-backends)
     (gnus-clear-system)
@@ -3832,7 +3839,7 @@ or `gnus-group-catchup-group-hook'."
   "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
   (let* ((time (or (gnus-group-timestamp group)
                   (list 0 0)))
-         (delta (subtract-time (current-time) time)))
+        (delta (subtract-time (current-time) time)))
     (+ (* (nth 0 delta) 65536.0)
        (nth 1 delta))))
 
@@ -3939,6 +3946,30 @@ This command may read the active file."
   (let ((gnus-group-list-option 'limit))
     (gnus-group-list-plus args)))
 
+(defun gnus-group-mark-article-read (group article)
+  "Mark ARTICLE read."
+  (gnus-activate-group group)
+  (let ((buffer (gnus-summary-buffer-name group))
+       (mark gnus-read-mark))
+    (unless
+       (and
+        (get-buffer buffer)
+        (with-current-buffer buffer
+          (when gnus-newsgroup-prepared
+            (when (and gnus-newsgroup-auto-expire
+                       (memq mark gnus-auto-expirable-marks))
+              (setq mark gnus-expirable-mark))
+            (setq mark (gnus-request-update-mark
+                        group article mark))
+            (gnus-mark-article-as-read article mark)
+            (setq gnus-newsgroup-active (gnus-active group))
+            t)))
+      (gnus-group-make-articles-read group
+                                    (list article))
+      (when (gnus-group-auto-expirable-p group)
+       (gnus-add-marked-articles
+        group 'expire (list article))))))
+
 (provide 'gnus-group)
 
 ;;; gnus-group.el ends here