X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=c8e3e24d10af03e204136a5c5f8ed02a031a9d54;hb=a68ff150ceabdf1b37cf9efe3f3d8e2d2e048ca1;hp=4995820649af8903b55fb262db467c8051ccdefd;hpb=15bca14d69bdc8f35f4ddfc5bd4881872661889c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus.el b/lisp/gnus.el index 4995820..c8e3e24 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,5 +1,5 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 2001, ;; 1997, 1998, 2000, 2001 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -34,6 +34,8 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'static)) +(require 'wid-edit) + (require 'gnus-vers) (defgroup gnus nil @@ -41,6 +43,11 @@ :group 'news :group 'mail) +(defgroup gnus-format nil + "Dealing with formatting issues." + :group 'news + :group 'mail) + (defgroup gnus-charset nil "Group character set issues." :link '(custom-manual "(gnus)Charsets") @@ -236,6 +243,11 @@ "Options related to newsservers and other servers used by Gnus." :group 'gnus) +(defgroup gnus-server-visual nil + "Highlighting and menus in the server buffer." + :group 'gnus-visual + :group 'gnus-server) + (defgroup gnus-message '((message custom-group)) "Composing replies and followups in Gnus." :group 'gnus) @@ -745,7 +757,7 @@ be set in `.emacs' instead." (:foreground "Brown")) (t ())) - "Face of the splash screen.") + "Face for the splash screen.") (defun gnus-splash () (save-excursion @@ -818,23 +830,23 @@ be set in `.emacs' instead." t)))) (t (insert " - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ " ) @@ -877,19 +889,22 @@ be set in `.emacs' instead." (require 'gnus-util) (require 'nnheader) -(defvar gnus-parameters nil +(defcustom gnus-parameters nil "Alist of group parameters. For example: ((\"mail\\\\..*\" (gnus-show-threads nil) - (gnus-use-scoring nil) - (gnus-summary-line-format - \"%U%R%z%I%(%[%d:%ub%-20,20f%]%) %s\\n\") - (gcc-self . t) - (display . all)) + (gnus-use-scoring nil) + (gnus-summary-line-format + \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\") + (gcc-self . t) + (display . all)) (\"mail\\\\.me\" (gnus-use-scoring t)) (\"list\\\\..*\" (total-expire . t) - (broken-reply-to . t)))") + (broken-reply-to . t)))" + :group 'gnus-group-various + :type '(repeat (cons regexp + (repeat sexp)))) (defvar gnus-group-parameters-more nil) @@ -908,11 +923,11 @@ defaults to a proper value only if this file is byte-compiled by make.") REST is a plist of following: :type One of `bool', `list' or `nil'. :function The name of the function. -:function-document The document of the function. +:function-document The documentation of the function. :parameter-type The type for customizing the parameter. -:parameter-document The document for the parameter. +:parameter-document The documentation for the parameter. :variable The name of the variable. -:variable-document The document for the variable. +:variable-document The documentation for the variable. :variable-group The group for customizing the variable. :variable-type The type for customizing the variable. :variable-default The default value of the variable." @@ -927,8 +942,9 @@ REST is a plist of following: (variable-document (or (plist-get rest :variable-document) "")) (variable-group (plist-get rest :variable-group)) (variable-type (or (plist-get rest :variable-type) - `(quote (repeat (list (regexp :tag "Group") - ,parameter-type))))) + `(quote (repeat + (list (regexp :tag "Group") + ,(car (cdr parameter-type))))))) (variable-default (plist-get rest :variable-default))) (list 'progn @@ -1079,23 +1095,9 @@ see the manual for details." :group 'gnus-server :type 'gnus-select-method) -(defcustom gnus-message-archive-method - (progn - ;; Don't require it at top level to avoid circularity. - (require 'message) - `(nnfolder - "archive" - (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t))) +(defcustom gnus-message-archive-method "archive" "*Method used for archiving messages you've sent. -This should be a mail method. - -It's probably not very effective to change this variable once you've -run Gnus once. After doing that, you must edit this server from the -server buffer." +This should be a mail method." :group 'gnus-server :group 'gnus-message :type 'gnus-select-method) @@ -1111,9 +1113,9 @@ If you want to save your mail in one group and the news articles you write in another group, you could say something like: \(setq gnus-message-archive-group - '((if (message-news-p) - \"misc-news\" - \"misc-mail\"))) + '((if (message-news-p) + \"misc-news\" + \"misc-mail\"))) Normally the group names returned by this variable should be unprefixed -- which implicitly means \"store on the archive server\". @@ -1200,10 +1202,10 @@ list, Gnus will try all the methods in the list until it finds a match." (defcustom gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.auc.dk:/pub/usenet/" "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" + "/ftp@ftp.pasteur.fr:/pub/FAQ/" "/ftp@rtfm.mit.edu:/pub/usenet/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" "/ftp@ftp.sunet.se:/pub/usenet/" @@ -1228,9 +1230,9 @@ If the default site is too slow, try one of these: ftp.seas.gwu.edu /pub/rtfm rtfm.mit.edu /pub/usenet Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS + src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet - sunsite.auc.dk /pub/usenet + ftp.pasteur.fr /pub/FAQ Asia: nctuccca.edu.tw /USENET/FAQ hwarang.postech.ac.kr /pub/usenet ftp.hk.super.net /mirror/faqs" @@ -1258,7 +1260,8 @@ newsgroups." (defcustom gnus-large-newsgroup 200 "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup." +confirmation is required for selecting the newsgroup. +If it is `nil', no confirmation is required." :group 'gnus-group-select :type 'integer) @@ -1414,7 +1417,7 @@ slower, and `std11-extract-address-components'." ("nnspool" post address) ("nnvirtual" post-mail virtual prompt-address) ("nnmbox" mail respool address) - ("nnml" mail respool address) + ("nnml" post-mail respool address) ("nnmh" mail respool address) ("nndir" post-mail prompt-address physical-address) ("nneething" none address prompt-address physical-address) @@ -1498,14 +1501,18 @@ to be desirable; see the manual for further details." :type '(choice (const nil) integer)) +;; There should be special validation for this. +(define-widget 'gnus-email-address 'string + "An email address") + (gnus-define-group-parameter to-address :function-document "Return GROUP's to-address." :variable-document - "*Alist of group regexps and correspondent to-addresses." - :parameter-type '(gnus-email-address :tag "To Address") - :parameter-document "\ + "*Alist of group regexps and correspondent to-addresses." + :parameter-type '(gnus-email-address :tag "To Address") + :parameter-document "\ This will be used when doing followups and posts. This is primarily useful in mail groups that represent closed @@ -1550,15 +1557,15 @@ address was listed in gnus-group-split Addresses (see below).") :variable gnus-auto-expirable-newsgroups :variable-default nil :variable-document - "*Groups in which to automatically mark read articles as expirable. + "*Groups in which to automatically mark read articles as expirable. If non-nil, this should be a regexp that should match all groups in which to perform auto-expiry. This only makes sense for mail groups." - :variable-group nnmail-expire - :variable-type '(choice (const nil) - regexp) - :parameter-type '(const :tag "Automatic Expire" t) - :parameter-document - "All articles that are read will be marked as expirable.") + :variable-group nnmail-expire + :variable-type '(choice (const nil) + regexp) + :parameter-type '(const :tag "Automatic Expire" t) + :parameter-document + "All articles that are read will be marked as expirable.") (gnus-define-group-parameter total-expire @@ -1574,12 +1581,12 @@ Use with extreme caution. All groups that match this regexp will be expiring - which means that all read articles will be deleted after \(say) one week. (This only goes for mail groups and the like, of course.)" - :variable-group nnmail-expire - :variable-type '(choice (const nil) - regexp) - :parameter-type '(const :tag "Total Expire" t) - :parameter-document - "All read articles will be put through the expiry process + :variable-group nnmail-expire + :variable-type '(choice (const nil) + regexp) + :parameter-type '(const :tag "Total Expire" t) + :parameter-document + "All read articles will be put through the expiry process This happens even if they are not marked as expirable. Use with caution.") @@ -1589,7 +1596,7 @@ Use with caution.") :function-document "Return the default charset of GROUP." :variable gnus-group-charset-alist - :variable-default + :variable-default '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\" cn-big5) ("\\(^\\|:\\)cn\\>\\|\\" cn-gb-2312) ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2) @@ -1604,14 +1611,35 @@ Use with caution.") ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) (".*" iso-8859-1)) :variable-document - "Alist of regexps (to match group names) and default charsets to be used when reading." - :variable-group gnus-charset - :variable-type '(repeat (list (regexp :tag "Group") - (symbol :tag "Charset"))) - :parameter-type '(symbol :tag "Charset") - :parameter-document "\ + "Alist of regexps (to match group names) and default charsets to be used when reading." + :variable-group gnus-charset + :variable-type '(repeat (list (regexp :tag "Group") + (symbol :tag "Charset"))) + :parameter-type '(symbol :tag "Charset") + :parameter-document "\ The default charset to use in the group.") +(gnus-define-group-parameter + post-method + :type list + :function-document + "Return a posting method for GROUP." + :variable gnus-post-method-alist + :variable-document + "Alist of regexps (to match group names) and method to be used when +posting an article." + :variable-group gnus-group-foreign + :parameter-type + '(choice :tag "Posting Method" + (const :tag "Use native server" native) + (const :tag "Use current server" current) + (list :convert-widget + (lambda (widget) + (list 'sexp :tag "Methods" + :value gnus-select-method)))) + :parameter-document + "Posting method for this group.") + (defcustom gnus-group-uncollapsed-levels 1 "Number of group name elements to leave alone when making a short group name." :group 'gnus-group-visual @@ -1701,6 +1729,18 @@ and `grouplens-menu'." (const pick-menu) (const grouplens-menu))) +;; Byte-compiler warning. +(defvar gnus-visual) +;; Find out whether the gnus-visual TYPE is wanted. +(defun gnus-visual-p (&optional type class) + (and gnus-visual ; Has to be non-nil, at least. + (if (not type) ; We don't care about type. + gnus-visual + (if (listp gnus-visual) ; It's a list, so we check it. + (or (memq type gnus-visual) + (memq class gnus-visual)) + t)))) + (defcustom gnus-mouse-face (condition-case () (if (gnus-visual-p 'mouse-face 'highlight) @@ -1795,7 +1835,27 @@ covered by that variable." (bookmarks . bookmark) (dormant . dormant) (scored . score) (saved . save) (cached . cache) (downloadable . download) - (unsendable . unsend) (forwarded . forward))) + (unsendable . unsend) (forwarded . forward) + (recent . recent) (seen . seen))) + +(defconst gnus-article-special-mark-lists + '((seen range) + (killed range) + (bookmark tuple) + (score tuple))) + +;; Propagate flags to server, with the following exceptions: +;; `seen' is private to each gnus installation +;; `cache' is a internal gnus flag for each gnus installation +;; `download' is a agent flag private to each gnus installation +;; `unsend' are for nndraft groups only +;; `score' is not a proper mark +(defconst gnus-article-unpropagated-mark-lists + '(seen cache download unsend score) + "Marks that shouldn't be propagated to backends. +Typical marks are those that make no sense in a standalone backend, +such as a mark that says whether an article is stored in the cache +(which doesn't make sense in a standalone backend).") (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) @@ -2123,13 +2183,22 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (subrp (symbol-function 'base64-encode-string))) (require 'base64)) +;; To search articles with Namazu. +(autoload 'gnus-namazu-search "gnus-namazu" nil t) + +;; To make nnir groups. +(autoload 'gnus-group-make-nnir-group "nnir" nil t) + +;; To make shimbun groups. +(autoload 'gnus-group-make-shimbun-group "nnshimbun" nil t) + ;; A tool for the developers. (autoload 'find-cl-run-time-functions "gnus-clfns" nil t) ;;; gnus-sum.el thingies -(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" +(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23n%]%) %s\n" "*The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, @@ -2146,11 +2215,14 @@ with some simple extensions. %x Contents of the Xref: header (string) %D Date of the article (string) %d Date of the article (string) in DD-MMM format +%o Date of the article (string) in YYYYMMDD`T'HHMMSS format %M Message-id of the article (string) %r References of the article (string) %c Number of characters in the article (integer) %L Number of lines in the article (integer) %I Indentation based on thread level (a string of spaces) +%B A complex trn-style thread tree (string) + The variables `gnus-sum-thread-*' can be used for customization. %T A string with two possible values: 80 spaces if the article is on thread level two or larger and 0 spaces on level one %R \"A\" if this article has been replied to, \" \" otherwise (character) @@ -2317,18 +2389,6 @@ This restriction may disappear in later versions of Gnus." (defmacro gnus-get-info (group) `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) -;; Byte-compiler warning. -(defvar gnus-visual) -;; Find out whether the gnus-visual TYPE is wanted. -(defun gnus-visual-p (&optional type class) - (and gnus-visual ; Has to be non-nil, at least. - (if (not type) ; We don't care about type. - gnus-visual - (if (listp gnus-visual) ; It's a list, so we check it. - (or (memq type gnus-visual) - (memq class gnus-visual)) - t)))) - ;;; Load the compatability functions. (require 'gnus-ems) @@ -2357,6 +2417,21 @@ This restriction may disappear in later versions of Gnus." ;;; Gnus Utility Functions ;;; +(defun gnus-find-subscribed-addresses () + "Return a regexp matching the addresses of all subscribed mail groups. +It consists of the `to-address' or `to-list' parameter of all groups +with a `subscribed' parameter." + (let ((addresses)) + (mapc (lambda (entry) + (let ((group (car entry))) + (when (gnus-group-find-parameter group 'subscribed) + (let ((address (or + (gnus-group-fast-parameter group 'to-address) + (gnus-group-fast-parameter group 'to-list)))) + (when address + (setq addresses (cons address addresses))))))) + (cdr gnus-newsrc-alist)) + (list (mapconcat 'regexp-quote addresses "\\|")))) (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. @@ -2372,7 +2447,7 @@ STRINGS will be evaluated in normal `or' order." (setq strings nil))) string)) -(defun gnus-info-find-node () +(defun gnus-info-find-node (&optional nodename) "Find Info documentation of Gnus." (interactive) ;; Enlarge info window if needed. @@ -2382,7 +2457,8 @@ STRINGS will be evaluated in normal `or' order." (or gnus-info-filename (get-language-info current-language-environment 'gnus-info) "gnus") - (or (cadr (assq major-mode gnus-info-nodes)) + (or nodename + (cadr (assq major-mode gnus-info-nodes)) (and (eq (current-buffer) (get-buffer gnus-article-buffer)) (cadr (assq 'gnus-article-mode gnus-info-nodes)))))) (setq gnus-info-buffer (current-buffer)) @@ -2533,16 +2609,18 @@ that that variable is buffer-local to the summary buffers." (defun gnus-news-group-p (group &optional article) "Return non-nil if GROUP (and ARTICLE) come from a news server." - (or (gnus-member-of-valid 'post group) ; Ordinary news group. - (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (if (or (null article) - (not (< article 0))) - (eq (gnus-request-type group article) 'news) - (if (not (vectorp article)) - nil - ;; It's a real article. - (eq (gnus-request-type group (mail-header-id article)) - 'news)))))) + (cond ((gnus-member-of-valid 'post group) ;Ordinary news group + t) ;is news of course. + ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined. + nil) ;must be mail then. + ((vectorp article) ;Has header info. + (eq (gnus-request-type group (mail-header-id article)) 'news)) + ((null article) ;Hasn't header info + (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) + ((< article 0) ;Virtual message + nil) ;we don't know, guess mail. + (t ;Has positive number + (eq (gnus-request-type group article) 'news)))) ;use it. ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2713,6 +2791,9 @@ that that variable is buffer-local to the summary buffers." (not (string= (nth 1 method) ""))) (concat "+" (nth 1 method))))) +(defsubst gnus-method-to-full-server-name (method) + (format "%s+%s" (car method) (nth 1 method))) + (defun gnus-group-prefixed-name (group method) "Return the whole name from GROUP and METHOD." (and (stringp method) (setq method (gnus-server-to-method method))) @@ -2802,28 +2883,83 @@ You should probably use `gnus-find-method-for-group' instead." (defun gnus-parameters-get-parameter (group) "Return the group parameters for GROUP from `gnus-parameters'." - (let ((alist gnus-parameters) - params-list) - (while alist - (when (string-match (caar alist) group) - (setq params-list - (nconc (copy-sequence (cdar alist)) - params-list))) - (pop alist)) + (let (params-list) + (dolist (elem gnus-parameters) + (when (string-match (car elem) group) + (setq params-list + (nconc (gnus-expand-group-parameters + (car elem) (cdr elem) group) + params-list)))) params-list)) +(defun gnus-expand-group-parameter (match value group) + "Use MATCH to expand VALUE in GROUP." + (with-temp-buffer + (insert group) + (goto-char (point-min)) + (while (re-search-forward match nil t) + (replace-match value)) + (buffer-string))) + +(defun gnus-expand-group-parameters (match parameters group) + "Go through PARAMETERS and expand them according to the match data." + (let (new) + (dolist (elem parameters) + (if (and (stringp (cdr elem)) + (string-match "\\\\" (cdr elem))) + (push (cons (car elem) + (gnus-expand-group-parameter match (cdr elem) group)) + new) + (push elem new))) + new)) + +(defun gnus-group-fast-parameter (group symbol &optional allow-list) + "For GROUP, return the value of SYMBOL. + +You should call this in the `gnus-group-buffer' buffer. +The function `gnus-group-find-parameter' will do that for you." + ;; The speed trick: No cons'ing and quit early. + (or (let ((params (funcall gnus-group-get-parameter-function group))) + ;; Start easy, check the "real" group parameters. + (gnus-group-parameter-value params symbol allow-list)) + ;; We didn't found it there, try `gnus-parameters'. + (let ((result nil) + (head nil) + (tail gnus-parameters)) + ;; A good old-fashioned non-cl loop. + (while tail + (setq head (car tail) + tail (cdr tail)) + ;; The car is regexp matching for matching the group name. + (when (string-match (car head) group) + ;; The cdr is the parameters. + (setq result (gnus-group-parameter-value (cdr head) + symbol allow-list)) + (when result + ;; Expand if necessary. + (if (and (stringp result) (string-match "\\\\" result)) + (setq result (gnus-expand-group-parameter (car head) + result group))) + ;; Exit the loop early. + (setq tail nil)))) + ;; Done. + result))) + (defun gnus-group-find-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." +If SYMBOL, return the value of that symbol in the group parameters. + +If you call this function inside a loop, consider using the faster +`gnus-group-fast-parameter' instead." (save-excursion (set-buffer gnus-group-buffer) - (let ((parameters - (nconc - (copy-sequence - (funcall gnus-group-get-parameter-function group)) - (gnus-parameters-get-parameter group)))) - (if symbol - (gnus-group-parameter-value parameters symbol allow-list) + (if symbol + (gnus-group-fast-parameter group symbol allow-list) + (let ((parameters + (nconc + (copy-sequence + (funcall gnus-group-get-parameter-function group)) + (gnus-parameters-get-parameter group)))) parameters)))) (defun gnus-group-get-parameter (group &optional symbol allow-list) @@ -3120,7 +3256,7 @@ Disallow invalid group names." (defun gnus-read-method (prompt) "Prompt the user for a method. Allow completion over sensible values." - (let* ((open-servers + (let* ((open-servers (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i)) gnus-opened-servers)) (valid-methods