X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=inline;f=lisp%2Fgnus-group.el;h=fe44b7dbd53d1dacd20558fdd288c9869959a5eb;hb=2a2ef844ddbe24bd212011237d512cd97c3dc6b8;hp=64be54397325e7d15883a255313779e1b288a882;hpb=4305c2ea86b2e1d044bfb8b98e5558504bc09781;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 64be543..fe44b7d 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,5 +1,5 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -39,6 +39,8 @@ (require 'time-date) (require 'gnus-ems) +(eval-when-compile (require 'mm-url)) + (defcustom gnus-group-archive-directory "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives." @@ -126,17 +128,22 @@ 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))) - -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" + :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 %O\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -153,6 +160,8 @@ 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'. +%C Group comment (string) %D Group description (string) %s Select method (string) %o Moderated group (char, \"m\") @@ -168,13 +177,10 @@ with some simple extensions. %E Icon as defined by `gnus-group-icon-list'. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the buffer just like information from any other - group specifier. - -Text between %( and %) will be highlighted with `gnus-mouse-face' when -the mouse point move inside the area. There can only be one such area. + where X is the letter following %u. The function will be passed a + single dummy parameter as argument.. The function should return a + string, which will be inserted into the buffer just like information + from any other group specifier. Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification @@ -186,7 +192,11 @@ If you use %o or %O, reading the active file will be slower and quite a bit of extra memory will be used. %D will also worsen performance. Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into -effect." +effect. + +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-group-visual :type 'string) @@ -201,12 +211,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) @@ -341,7 +345,7 @@ variable." ((and (= unread 0)) . gnus-group-news-low-empty-face) (t . - gnus-group-news-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 +407,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))) + '(("[^\000-\177]" . 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")))) @@ -472,6 +478,7 @@ simple manner.") (?g gnus-tmp-group ?s) (?G gnus-tmp-qualified-group ?s) (?c (gnus-short-group-name gnus-tmp-group) ?s) + (?C gnus-tmp-comment ?s) (?D gnus-tmp-newsgroup-description ?s) (?o gnus-tmp-moderated ?c) (?O gnus-tmp-moderated-string ?s) @@ -549,6 +556,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 @@ -583,6 +591,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 @@ -598,6 +607,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 @@ -606,6 +619,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 @@ -613,6 +627,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 @@ -634,7 +649,8 @@ simple manner.") "l" gnus-group-sort-groups-by-level "v" gnus-group-sort-groups-by-score "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method) + "m" gnus-group-sort-groups-by-method + "n" gnus-group-sort-groups-by-real-name) (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) "s" gnus-group-sort-selected-groups @@ -643,7 +659,8 @@ simple manner.") "l" gnus-group-sort-selected-groups-by-level "v" gnus-group-sort-selected-groups-by-score "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method) + "m" gnus-group-sort-selected-groups-by-method + "n" gnus-group-sort-selected-groups-by-real-name) (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) "k" gnus-group-list-killed @@ -699,6 +716,8 @@ simple manner.") "f" gnus-score-flush-cache) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control "d" gnus-group-describe-group "f" gnus-group-fetch-faq "v" gnus-version) @@ -737,12 +756,18 @@ 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 '(:help "Display description of the current group"))] ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] + ["Fetch charter" gnus-group-fetch-charter :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display the charter of the current group"))] + ["Fetch control message" gnus-group-fetch-control :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) ["Expire articles" gnus-group-expire-articles @@ -750,7 +775,7 @@ simple manner.") (gnus-check-backend-function 'request-expire-articles (gnus-group-group-name))) gnus-group-marked)] - ["Set group level" gnus-group-set-current-level + ["Set group level..." gnus-group-set-current-level (gnus-group-group-name)] ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] ["Customize" gnus-group-customize (gnus-group-group-name)] @@ -787,7 +812,8 @@ simple manner.") ["Sort by score" gnus-group-sort-groups-by-score t] ["Sort by level" gnus-group-sort-groups-by-level t] ["Sort by unread" gnus-group-sort-groups-by-unread t] - ["Sort by name" gnus-group-sort-groups-by-alphabet t]) + ["Sort by name" gnus-group-sort-groups-by-alphabet t] + ["Sort by real name" gnus-group-sort-groups-by-real-name t]) ("Sort process/prefixed" ["Default sort" gnus-group-sort-selected-groups (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] @@ -802,6 +828,8 @@ simple manner.") ["Sort by unread" gnus-group-sort-selected-groups-by-unread (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ["Sort by name" gnus-group-sort-selected-groups-by-alphabet + (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] + ["Sort by real name" gnus-group-sort-selected-groups-by-real-name (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) ("Mark" ["Mark group" gnus-group-mark-group @@ -817,22 +845,23 @@ simple manner.") ["Execute command" gnus-group-universal-argument (or gnus-group-marked (gnus-group-group-name))]) ("Subscribe" - ["Subscribe to a group" gnus-group-unsubscribe-group t] + ["Subscribe to a group..." gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ["Kill all zombie groups" gnus-group-kill-all-zombies gnus-zombie-list] ["Kill all groups on level..." gnus-group-kill-level t]) ("Foreign groups" - ["Make a foreign group" gnus-group-make-group t] - ["Add a directory group" gnus-group-make-directory-group t] + ["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] - ["Make a doc group" gnus-group-make-doc-group t] - ["Make a web group" gnus-group-make-web-group t] - ["Make a kiboze group" gnus-group-make-kiboze-group t] - ["Make a virtual group" gnus-group-make-empty-virtual t] - ["Add a group to a virtual" gnus-group-add-to-virtual t] - ["Rename group" gnus-group-rename-group + ["Make a doc group..." gnus-group-make-doc-group t] + ["Make a web group..." gnus-group-make-web-group t] + ["Make a kiboze group..." gnus-group-make-kiboze-group t] + ["Make a virtual group..." gnus-group-make-empty-virtual t] + ["Add a group to a virtual..." gnus-group-add-to-virtual t] + ["Rename group..." gnus-group-rename-group (gnus-check-backend-function 'request-rename-group (gnus-group-group-name))] ["Delete group" gnus-group-delete-group @@ -846,9 +875,12 @@ simple manner.") ["Next unread same level" gnus-group-next-unread-group-same-level t] ["Previous unread same level" gnus-group-prev-unread-group-same-level t] - ["Jump to group" gnus-group-jump-to-group t] + ["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 @@ -857,7 +889,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 @@ -866,15 +898,20 @@ 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 queued messages" gnus-delay-send-queue + ,@(if (featurep 'xemacs) '(t) + '(:help "Send all messages 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] - ["Browse foreign server" gnus-group-browse-foreign-server t] + ["Browse foreign server..." gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ["Expire all expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] @@ -897,9 +934,11 @@ simple manner.") ;; Emacs 21 tool bar. Should be no-op otherwise. (defun gnus-group-make-tool-bar () - (if (and (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-group-toolbar-map)) + (if (and + (condition-case nil (require 'tool-bar) (error nil)) + (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-group-toolbar-map)) (setq gnus-group-toolbar-map (let ((tool-bar-map (make-sparse-keymap)) (load-path (mm-image-load-path))) @@ -965,6 +1004,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 "")) @@ -1006,7 +1046,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)) @@ -1020,7 +1060,7 @@ The following commands are available: result (cdr item)))) result))) -(defsubst gnus-group-name-decode (string charset) +(defun gnus-group-name-decode (string charset) (if (and string charset (featurep 'mule)) (decode-coding-string string charset) string)) @@ -1029,6 +1069,35 @@ The following commands are available: (let ((charset (gnus-group-name-charset nil string))) (gnus-group-name-decode string charset))) +(defun gnus-group-name-encode (string charset) + (if (and string charset (featurep 'mule)) + (encode-coding-string string charset) + string)) + +(defun gnus-group-encoded-name (string) + (let ((charset (gnus-group-name-charset nil string))) + (gnus-group-name-encode string charset))) + +(defun gnus-group-completing-read-group-name + (prompt table &optional predicate require-match initial-contents history) + (if (vectorp table) + (mapatoms + (lambda (group) + (push (list (gnus-group-decoded-name (symbol-name group))) table)) + (prog1 + table + (setq table nil))) + (dolist (entry (prog1 + table + (setq table nil))) + (push (list (gnus-group-decoded-name (car entry))) table))) + (gnus-group-encoded-name + (completing-read + prompt table predicate + require-match + initial-contents + history))) + (defun gnus-group-list-groups (&optional level unread lowest) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. @@ -1304,6 +1373,9 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-qualified-group (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) group-name-charset)) + (gnus-tmp-comment + (or (gnus-group-get-parameter gnus-tmp-group 'comment t) + gnus-tmp-group)) (gnus-tmp-newsgroup-description (if gnus-description-hashtb (or (gnus-group-name-decode @@ -1342,7 +1414,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) @@ -1699,7 +1773,7 @@ Take into consideration N (the prefix) and the list of marked groups." (setq n (1- n)) (gnus-group-next-group way))) (nreverse groups))) - ((gnus-region-active-p) + ((and (gnus-region-active-p) (mark)) ;; Work on the region between point and mark. (let ((max (max (point) (mark))) groups) @@ -1830,13 +1904,14 @@ be permanent." (gnus-group-prefixed-name group method) method))) ;;;###autoload -(defun gnus-fetch-group (group) +(defun gnus-fetch-group (group &optional articles) "Start Gnus if necessary and enter GROUP. Returns whether the fetching was successful or not." - (interactive (list (completing-read "Group name: " gnus-active-hashtb))) + (interactive (list (gnus-group-completing-read-group-name + "Group name: " gnus-active-hashtb))) (unless (get-buffer gnus-group-buffer) (gnus-no-server)) - (gnus-group-read-group nil nil group)) + (gnus-group-read-group articles nil group)) ;;;###autoload (defun gnus-fetch-group-other-frame (group) @@ -1857,13 +1932,15 @@ Returns whether the fetching was successful or not." ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only - select-articles) + select-articles + parameters) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. If QUIT-CONFIG, use that window configuration when exiting from the ephemeral group. If REQUEST-ONLY, don't actually read the group; just request it. If SELECT-ARTICLES, only select those articles. +If PARAMETERS, use those as the group parameters. Return the name of the group if selection was successful." ;; Transform the select method into a unique server. @@ -1874,15 +1951,19 @@ Return the name of the group if selection was successful." (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method))) (let ((group (if (gnus-group-foreign-p group) group - (gnus-group-prefixed-name group method)))) + (gnus-group-prefixed-name (gnus-group-real-name group) + method)))) (gnus-sethash group `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method - ((quit-config . - ,(if quit-config quit-config - (cons gnus-summary-buffer - gnus-current-window-configuration)))))) + ,(cons + (if quit-config + (cons 'quit-config quit-config) + (cons 'quit-config + (cons gnus-summary-buffer + gnus-current-window-configuration))) + parameters))) gnus-newsrc-hashtb) (push method gnus-ephemeral-servers) (set-buffer gnus-group-buffer) @@ -1906,7 +1987,7 @@ Return the name of the group if selection was successful." (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." (interactive - (list (completing-read + (list (gnus-group-completing-read-group-name "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) gnus-group-jump-to-group-prompt @@ -2055,7 +2136,7 @@ If EXCLUDE-GROUP, do not go to that group." (forward-line 1)) (when best-point (goto-char best-point)) - (gnus-summary-position-point) + (gnus-group-position-point) (and best-point (gnus-group-group-name)))) (defun gnus-group-first-unread-group () @@ -2151,7 +2232,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 @@ -2168,6 +2249,10 @@ doing the deletion." (gnus-group-goto-group group) (gnus-group-kill-group 1 t) (gnus-sethash group nil gnus-active-hashtb) + (when (and (boundp 'gnus-cache-active-hashtb) + gnus-cache-active-hashtb) + (gnus-sethash group nil gnus-cache-active-hashtb) + (setq gnus-cache-active-altered t)) t)) (gnus-group-position-point))) @@ -2250,7 +2335,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." @@ -2311,20 +2406,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) @@ -2622,6 +2730,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)) @@ -2644,6 +2753,12 @@ If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) +(defun gnus-group-sort-groups-by-real-name (&optional reverse) + "Sort the group buffer alphabetically by real (unprefixed) group name. +If REVERSE, sort in reverse order." + (interactive "P") + (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse)) + (defun gnus-group-sort-groups-by-unread (&optional reverse) "Sort the group buffer by number of unread articles. If REVERSE, sort in reverse order." @@ -2688,7 +2803,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) @@ -2720,6 +2837,13 @@ sort in reverse order." (interactive (gnus-interactive "P\ny")) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) +(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse) + "Sort the group buffer alphabetically by real group name. +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse)) + (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) "Sort the group buffer by number of unread articles. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), @@ -2779,17 +2903,17 @@ sort in reverse order." (defun gnus-group-sort-by-method (info1 info2) "Sort alphabetically by backend name." - (string< (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info1) info1))) - (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info2) info2))))) + (string< (car (gnus-find-method-for-group + (gnus-info-group info1) info1)) + (car (gnus-find-method-for-group + (gnus-info-group info2) info2)))) (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)))) @@ -2835,13 +2959,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)))) @@ -2901,31 +3034,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." @@ -3050,7 +3186,7 @@ If given numerical prefix, toggle the N next groups." Killed newsgroups are subscribed. If SILENT, don't try to update the group line." (interactive - (list (completing-read + (list (gnus-group-completing-read-group-name "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) nil @@ -3416,7 +3552,7 @@ to use." (gnus-group-group-name) (when current-prefix-arg (completing-read - "Faq dir: " (and (listp gnus-group-faq-directory) + "FAQ dir: " (and (listp gnus-group-faq-directory) (mapcar #'list gnus-group-faq-directory)))))) (unless group @@ -3435,6 +3571,51 @@ to use." (find-file file) (setq found t)))))) +(defun gnus-group-fetch-charter (group) + "Fetch the charter for the current group. +If given a prefix argument, prompt for a group." + (interactive + (list (or (when current-prefix-arg + (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-group-name) + gnus-newsgroup-name))) + (unless group + (error "No group name given")) + (require 'mm-url) + (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) + url hierarchy) + (when (string-match "\\(^[^\\.]+\\)\\..*" name) + (setq hierarchy (match-string 1 name)) + (if (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) + (browse-url (eval url)) + (gnus-group-fetch-control group))))) + +(defun gnus-group-fetch-control (group) + "Fetch the archived control messages for the current group. +If given a prefix argument, prompt for a group." + (interactive + (list (or (when current-prefix-arg + (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-group-name) + gnus-newsgroup-name))) + (unless group + (error "No group name given")) + (let ((name (gnus-group-real-name group)) + hierarchy) + (when (string-match "\\(^[^\\.]+\\)\\..*" name) + (setq hierarchy (match-string 1 name)) + (if gnus-group-fetch-control-use-browse-url + (browse-url (concat "ftp://ftp.isc.org/usenet/control/" + hierarchy "/" name ".Z")) + (let ((enable-local-variables nil)) + (gnus-group-read-ephemeral-group + group + `(nndoc ,group (nndoc-address + ,(find-file-noselect + (concat "/ftp@ftp.isc.org:/usenet/control/" + hierarchy "/" name ".Z"))) + (nndoc-article-type mbox)) t nil nil)))))) + (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) @@ -3552,7 +3733,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)) @@ -3598,7 +3779,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 @@ -3639,7 +3820,11 @@ The hook gnus-suspend-gnus-hook is called before actually suspending." ;; Kill Gnus buffers except for group mode buffer. (let ((group-buf (get-buffer gnus-group-buffer))) (mapcar (lambda (buf) - (unless (member buf (list group-buf gnus-dribble-buffer)) + (unless (or (member buf (list group-buf gnus-dribble-buffer)) + (progn + (save-excursion + (set-buffer buf) + (eq major-mode 'message-mode)))) (gnus-kill-buffer buf))) (gnus-buffers)) (gnus-kill-gnus-frames) @@ -3690,8 +3875,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) @@ -3959,22 +4144,30 @@ This command may read the active file." (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))) + (mark gnus-read-mark) + active n) + (if (get-buffer buffer) + (with-current-buffer buffer + (setq active gnus-newsgroup-active) + (gnus-activate-group group) + (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)) + (when active + (setq n (1+ (cdr active))) + (while (<= n (cdr gnus-newsgroup-active)) + (unless (eq n article) + (push n gnus-newsgroup-unselected)) + (setq n (1+ n))) + (setq gnus-newsgroup-unselected + (nreverse gnus-newsgroup-unselected))))) + (gnus-activate-group group) (gnus-group-make-articles-read group (list article)) (when (gnus-group-auto-expirable-p group)