X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-group.el;h=82f3bc8619c3ac6ea0ae2ba2acb78a52072feb25;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=0442d9451a367b6813beb5950f9d1c68e7a2f0c8;hpb=cd1e2a6b8c45abd9b701753cedffa6581c2ff35d;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 0442d94..82f3bc8 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -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