Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-group.el
index 0442d94..82f3bc8 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.
@@ -398,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"))))
 
@@ -544,6 +551,7 @@ simple manner.")
     "l" gnus-group-list-groups
     "L" gnus-group-list-all-groups
     "m" gnus-group-mail
+    "i" gnus-group-news
     "g" gnus-group-get-new-news
     "\M-g" gnus-group-get-new-news-this-group
     "R" gnus-group-restart
@@ -594,6 +602,10 @@ simple manner.")
     "r" gnus-group-mark-regexp
     "U" gnus-group-unmark-all-groups)
 
+  (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
+    "u" gnus-sieve-update
+    "g" gnus-sieve-generate)
+
   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
     "d" gnus-group-make-directory-group
     "h" gnus-group-make-help-group
@@ -602,6 +614,7 @@ simple manner.")
     "k" gnus-group-make-kiboze-group
     "l" gnus-group-nnimap-edit-acl
     "m" gnus-group-make-group
+    "n" gnus-group-make-shimbun-group
     "E" gnus-group-edit-group
     "e" gnus-group-edit-group-method
     "p" gnus-group-edit-group-parameters
@@ -821,6 +834,7 @@ simple manner.")
        ["Kill all groups on level..." gnus-group-kill-level t])
        ("Foreign groups"
        ["Make a foreign group" gnus-group-make-group t]
+       ["Make a shimbun group" gnus-group-make-shimbun-group t]
        ["Add a directory group" gnus-group-make-directory-group t]
        ["Add the help group" gnus-group-make-help-group t]
        ["Add the archive group" gnus-group-make-archive-group t]
@@ -846,6 +860,9 @@ simple manner.")
        ["Jump to group" gnus-group-jump-to-group t]
        ["First unread group" gnus-group-first-unread-group t]
        ["Best unread group" gnus-group-best-unread-group t])
+       ("Sieve"
+       ["Generate" gnus-sieve-generate t]
+       ["Generate and update" gnus-sieve-update t])
        ["Delete bogus groups" gnus-group-check-bogus-groups t]
        ["Find new newsgroups" gnus-group-find-new-groups t]
        ["Transpose" gnus-group-transpose-groups
@@ -863,11 +880,16 @@ simple manner.")
        ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
        ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
        ["Send a mail" gnus-group-mail t]
-       ["Post an article..." gnus-group-post-news t]
+       ["Send a message (mail or news)" gnus-group-post-news t]
+       ["Create a local message" gnus-group-news t]
        ["Check for new news" gnus-group-get-new-news
        ,@(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]
@@ -1004,7 +1026,7 @@ The following commands are available:
     (when gnus-carpal
       (gnus-carpal-setup-buffer 'group))))
 
-(defsubst gnus-group-name-charset (method group)
+(defun gnus-group-name-charset (method group)
   (if (null method)
       (setq method (gnus-find-method-for-group group)))
   (let ((item (assoc method gnus-group-name-charset-method-alist))
@@ -1018,8 +1040,9 @@ The following commands are available:
                  result (cdr item))))
       result)))
 
-(defsubst gnus-group-name-decode (string charset)
-  (if (and string charset (featurep 'mule))
+(defun gnus-group-name-decode (string charset)
+  (if (and string charset (featurep 'mule)
+          (not (mm-multibyte-string-p string)))
       (decode-coding-string string charset)
     string))
 
@@ -1340,7 +1363,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)
@@ -2149,7 +2174,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
@@ -2319,20 +2344,33 @@ and NEW-NAME will be prompted for."
       (setcar entry (eval (cadar entry)))))
   (gnus-group-make-group group method))
 
-(defun gnus-group-make-help-group ()
-  "Create the Gnus documentation group."
+(defun gnus-group-make-help-group (&optional noerror)
+  "Create the Gnus documentation group.
+Optional argument NOERROR modifies the behavior of this function when the
+group already exists:
+- if not given, and error is signaled,
+- if t, stay silent,
+- if anything else, just print a message."
   (interactive)
   (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
        (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
-    (when (gnus-gethash name gnus-newsrc-hashtb)
-      (error "Documentation group already exists"))
-    (if (not file)
-       (gnus-message 1 "Couldn't find doc group")
-      (gnus-group-make-group
-       (gnus-group-real-name name)
-       (list 'nndoc "gnus-help"
-            (list 'nndoc-address file)
-            (list 'nndoc-article-type 'mbox)))))
+    (if (gnus-gethash name gnus-newsrc-hashtb)
+       (cond ((eq noerror nil)
+              (error "Documentation group already exists"))
+             ((eq noerror t)
+              ;; stay silent
+              )
+             (t
+              (gnus-message 1 "Documentation group already exists")))
+      ;; else:
+      (if (not file)
+         (gnus-message 1 "Couldn't find doc group")
+       (gnus-group-make-group
+        (gnus-group-real-name name)
+        (list 'nndoc "gnus-help"
+              (list 'nndoc-address file)
+              (list 'nndoc-article-type 'mbox))))
+      ))
   (gnus-group-position-point))
 
 (defun gnus-group-make-doc-group (file type)
@@ -2797,10 +2835,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))))
 
@@ -2921,31 +2959,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."
@@ -3618,7 +3659,7 @@ group."
 
 (defun gnus-group-find-new-groups (&optional arg)
   "Search for new groups and add them.
-Each new group will be treated with `gnus-subscribe-newsgroup-method.'
+Each new group will be treated with `gnus-subscribe-newsgroup-method'.
 With 1 C-u, use the `ask-server' method to query the server for new
 groups.
 With 2 C-u's, use most complete method possible to query the server