Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-group.el
index 263d5a6..4bbeee7 100644 (file)
@@ -126,15 +126,20 @@ the most significant sort function should be the last function in the
 list."
   :group 'gnus-group-listing
   :link '(custom-manual "(gnus)Sorting Groups")
-  :type '(radio (function-item gnus-group-sort-by-alphabet)
-               (function-item gnus-group-sort-by-real-name)
-               (function-item gnus-group-sort-by-unread)
-               (function-item gnus-group-sort-by-level)
-               (function-item gnus-group-sort-by-score)
-               (function-item gnus-group-sort-by-method)
-               (function-item gnus-group-sort-by-server)
-               (function-item gnus-group-sort-by-rank)
-               (function :tag "other" nil)))
+  :type '(repeat :value-to-internal (lambda (widget value)
+                                     (if (listp value) value (list value)))
+                :match (lambda (widget value)
+                         (or (symbolp value)
+                             (widget-editable-list-match widget value)))
+                (choice (function-item gnus-group-sort-by-alphabet)
+                        (function-item gnus-group-sort-by-real-name)
+                        (function-item gnus-group-sort-by-unread)
+                        (function-item gnus-group-sort-by-level)
+                        (function-item gnus-group-sort-by-score)
+                        (function-item gnus-group-sort-by-method)
+                        (function-item gnus-group-sort-by-server)
+                        (function-item gnus-group-sort-by-rank)
+                        (function :tag "other" nil))))
 
 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
   "*Format of group lines.
@@ -153,6 +158,7 @@ with some simple extensions.
 %y    Number of unread, unticked articles (integer)
 %G    Group name (string)
 %g    Qualified group name (string)
+%c    Short (collapsed) group name.  See `gnus-group-uncollapsed-levels'.
 %D    Group description (string)
 %s    Select method (string)
 %o    Moderated group (char, \"m\")
@@ -201,12 +207,6 @@ with some simple extensions:
   :group 'gnus-group-visual
   :type 'string)
 
-(defcustom gnus-group-mode-hook nil
-  "Hook for Gnus group mode."
-  :group 'gnus-group-various
-  :options '(gnus-topic-mode)
-  :type 'hook)
-
 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 (when (featurep 'xemacs)
   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
@@ -296,52 +296,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
@@ -403,21 +403,23 @@ ticked: The number of ticked articles."
   :type '(repeat (cons (sexp :tag "Form") file)))
 
 (defcustom gnus-group-name-charset-method-alist nil
-  "*Alist of method and the charset for group names.
+  "Alist of method and the charset for group names.
 
 For example:
-    (((nntp \"news.com.cn\") . cn-gb-2312))
-"
+    (((nntp \"news.com.cn\") . cn-gb-2312))"
   :version "21.1"
   :group 'gnus-charset
   :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
 
-(defcustom gnus-group-name-charset-group-alist nil
-  "*Alist of group regexp and the charset for group names.
+(defcustom gnus-group-name-charset-group-alist
+  (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
+         (and (fboundp 'coding-system-p) (coding-system-p 'utf-8)))
+      '((".*" . utf-8))
+    nil)
+  "Alist of group regexp and the charset for group names.
 
 For example:
-    ((\"\\.com\\.cn:\" . cn-gb-2312))
-"
+    ((\"\\.com\\.cn:\" . cn-gb-2312))"
   :group 'gnus-charset
   :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
 
@@ -428,7 +430,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.
@@ -483,10 +485,10 @@ simple manner.")
     (?l gnus-tmp-grouplens ?s)
     (?z gnus-tmp-news-method-string ?s)
     (?m (gnus-group-new-mail gnus-tmp-group) ?c)
-    (?w (if (gnus-news-group-p gnus-tmp-group) 
+    (?w (if (gnus-news-group-p gnus-tmp-group)
            ""
-         (int-to-string 
-          (length 
+         (int-to-string
+          (length
            (nnmail-new-mail-numbers (gnus-group-real-name gnus-tmp-group))
            )))
        ?s)
@@ -583,6 +585,7 @@ simple manner.")
     "<" beginning-of-buffer
     ">" end-of-buffer
     "\C-c\C-b" gnus-bug
+    "\C-c\C-n" gnus-namazu-search
     "\C-c\C-s" gnus-group-sort-groups
     "t" gnus-topic-mode
     "\C-c\M-g" gnus-activate-all-groups
@@ -613,6 +616,7 @@ simple manner.")
     "V" gnus-group-make-empty-virtual
     "D" gnus-group-enter-directory
     "f" gnus-group-make-doc-group
+    "G" gnus-group-make-nnir-group
     "w" gnus-group-make-web-group
     "r" gnus-group-rename-group
     "c" gnus-group-customize
@@ -737,7 +741,7 @@ simple manner.")
        (gnus-group-group-name)]
        ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
        ,@(if (featurep 'xemacs) nil
-             '(:help "Kill (remove) current group"))]
+           '(:help "Kill (remove) current group"))]
        ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
        ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
        ,@(if (featurep 'xemacs) nil
@@ -857,7 +861,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
@@ -871,6 +875,10 @@ simple manner.")
        ,@(if (featurep 'xemacs) '(t)
            '(:help "Get newly arrived articles"))
        ]
+       ["Send delayed articles" gnus-delay-send-drafts
+       ,@(if (featurep 'xemacs) '(t)
+           '(:help "Send all articles that are scheduled to be sent now"))
+       ]
        ["Activate all groups" gnus-activate-all-groups t]
        ["Restart Gnus" gnus-group-restart t]
        ["Read init file" gnus-group-read-init-file t]
@@ -965,6 +973,7 @@ The following commands are available:
 (defun gnus-update-group-mark-positions ()
   (save-excursion
     (let ((gnus-process-mark ?\200)
+         (gnus-group-update-hook nil)
          (gnus-group-marked '("dummy.group"))
          (gnus-active-hashtb (make-vector 10 0))
          (topic ""))
@@ -1342,7 +1351,9 @@ if it is a string, only list groups matching REGEXP."
      (point)
      (prog1 (1+ (point))
        ;; Insert the text.
-       (eval gnus-group-line-format-spec))
+       (let ((gnus-tmp-group (gnus-group-name-decode
+                             gnus-tmp-group group-name-charset)))
+        (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)
@@ -1372,9 +1383,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))))
@@ -2147,7 +2162,7 @@ doing the deletion."
    (list (gnus-group-group-name)
         current-prefix-arg))
   (unless group
-    (error "No group to rename"))
+    (error "No group to delete"))
   (unless (gnus-check-backend-function 'request-delete-group group)
     (error "This backend does not support group deletion"))
   (prog1
@@ -2246,7 +2261,17 @@ and NEW-NAME will be prompted for."
        (t "group info"))
       (gnus-group-decoded-name group))
      `(lambda (form)
-       (gnus-group-edit-group-done ',part ,group form)))))
+       (gnus-group-edit-group-done ',part ,group form)))
+    (local-set-key
+     "\C-c\C-i"
+     (gnus-create-info-command
+      (cond
+       ((eq part 'method)
+       "(gnus)Select Methods")
+       ((eq part 'params)
+       "(gnus)Group Parameters")
+       (t
+       "(gnus)Group Info"))))))
 
 (defun gnus-group-edit-group-method (group)
   "Edit the select method of GROUP."
@@ -2618,6 +2643,7 @@ If REVERSE (the prefix), reverse the sorting order."
   (interactive (list gnus-group-sort-function current-prefix-arg))
   (funcall gnus-group-sort-alist-function
           (gnus-make-sort-function func) reverse)
+  (gnus-group-unmark-all-groups)
   (gnus-group-list-groups)
   (gnus-dribble-touch))
 
@@ -2684,7 +2710,9 @@ If REVERSE, sort in reverse order."
   (let ((groups (gnus-group-process-prefix n)))
     (funcall gnus-group-sort-selected-function
             groups (gnus-make-sort-function func) reverse)
-    (gnus-group-list-groups)))
+    (gnus-group-unmark-all-groups)
+    (gnus-group-list-groups)
+    (gnus-dribble-touch)))
 
 (defun gnus-group-sort-selected-flat (groups func reverse)
   (let (entries infos)
@@ -2782,10 +2810,10 @@ sort in reverse order."
 
 (defun gnus-group-sort-by-server (info1 info2)
   "Sort alphabetically by server name."
-  (string< (gnus-method-to-server-name
+  (string< (gnus-method-to-full-server-name
            (gnus-find-method-for-group
             (gnus-info-group info1) info1))
-          (gnus-method-to-server-name
+          (gnus-method-to-full-server-name
            (gnus-find-method-for-group
             (gnus-info-group info2) info2))))
 
@@ -2831,13 +2859,22 @@ sort in reverse order."
 
 (defun gnus-info-clear-data (info)
   "Clear all marks and read ranges from INFO."
-  (let ((group (gnus-info-group info)))
+  (let ((group (gnus-info-group info))
+       action)
+    (dolist (el (gnus-info-marks info))
+      (push `(,(cdr el) add (,(car el))) action))
+    (push `(,(gnus-info-read info) add (read)) action)
     (gnus-undo-register
       `(progn
+        (gnus-request-set-mark ,group ',action)
         (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
         (gnus-info-set-read ',info ',(gnus-info-read info))
         (when (gnus-group-goto-group ,group)
+          (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
           (gnus-group-update-group-line))))
+    (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
+                        action))
+    (gnus-request-set-mark group action)
     (gnus-info-set-read info nil)
     (when (gnus-info-marks info)
       (gnus-info-set-marks info nil))))
@@ -2897,31 +2934,34 @@ If ALL is non-nil, all articles are marked as read.
 The return value is the number of articles that were marked as read,
 or nil if no action could be taken."
   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
-        (num (car entry)))
+        (num (car entry))
+        (marks (nth 3 (nth 2 entry)))
+        (unread (gnus-list-of-unread-articles group)))
     ;; Remove entries for this group.
     (nnmail-purge-split-history (gnus-group-real-name group))
     ;; Do the updating only if the newsgroup isn't killed.
     (if (not (numberp (car entry)))
        (gnus-message 1 "Can't catch up %s; non-active group" group)
+      (gnus-update-read-articles group nil)
+      (when all
+       ;; Nix out the lists of marks and dormants.
+       (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
+                                                'del '(tick))
+                                          (list (cdr (assq 'dormant marks))
+                                                'del '(dormant))))
+       (setq unread (gnus-uncompress-range
+                     (gnus-range-add (gnus-range-add
+                                      unread (cdr (assq 'dormant marks)))
+                                     (cdr (assq 'tick marks)))))
+       (gnus-add-marked-articles group 'tick nil nil 'force)
+       (gnus-add-marked-articles group 'dormant nil nil 'force))
       ;; Do auto-expirable marks if that's required.
       (when (gnus-group-auto-expirable-p group)
-       (gnus-add-marked-articles
-        group 'expire (gnus-list-of-unread-articles group))
-       (when all
-         (let ((marks (nth 3 (nth 2 entry))))
-           (gnus-add-marked-articles
-            group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
-           (gnus-add-marked-articles
-            group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
-      (when entry
-       (gnus-update-read-articles group nil)
-       ;; Also nix out the lists of marks and dormants.
-       (when all
-         (gnus-add-marked-articles group 'tick nil nil 'force)
-         (gnus-add-marked-articles group 'dormant nil nil 'force))
-       (let ((gnus-newsgroup-name group))
-         (gnus-run-hooks 'gnus-group-catchup-group-hook))
-       num))))
+       (gnus-add-marked-articles group 'expire unread)
+       (gnus-request-set-mark group (list (list unread 'add '(expire)))))
+      (let ((gnus-newsgroup-name group))
+       (gnus-run-hooks 'gnus-group-catchup-group-hook))
+      num)))
 
 (defun gnus-group-expire-articles (&optional n)
   "Expire all expirable articles in the current newsgroup."
@@ -3548,7 +3588,7 @@ This command may read the active file."
             (> (prefix-numeric-value level) gnus-level-killed))
     (gnus-get-killed-groups))
   (funcall gnus-group-prepare-function
-   (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
+          (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
   (goto-char (point-min))
   (gnus-group-position-point))
 
@@ -3686,8 +3726,8 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
     (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)))))
+                            (set-buffer gnus-dribble-buffer)
+                            (buffer-size)))))
       (gnus-dribble-enter
        ";;; Gnus was exited on purpose without saving the .newsrc files."))
     (gnus-dribble-save)
@@ -3846,7 +3886,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))))
 
@@ -3954,7 +3994,7 @@ This command may read the active file."
     (gnus-group-list-plus args)))
 
 (defun gnus-group-mark-article-read (group article)
-  "Mark ARTICLE read." 
+  "Mark ARTICLE read."
   (gnus-activate-group group)
   (let ((buffer (gnus-summary-buffer-name group))
        (mark gnus-read-mark))