;;; 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 <umerin@flab.flab.fujitsu.junet>
(eval-when-compile (require 'cl))
(eval-when-compile (require 'static))
+(require 'wid-edit)
+
(require 'gnus-vers)
(defgroup gnus nil
: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")
"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)
(:foreground "Brown"))
(t
()))
- "Face of the splash screen.")
+ "Face for the splash screen.")
(defun gnus-splash ()
(save-excursion
t))))
(t
(insert "
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
"
)
(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)
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."
(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
: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)
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\".
(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/"
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"
(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)
("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)
: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
: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
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.")
:function-document
"Return the default charset of GROUP."
:variable gnus-group-charset-alist
- :variable-default
+ :variable-default
'(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
("\\(^\\|:\\)\\(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
(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)
(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)
(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,
%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)
(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)
;;; 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.
(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.
(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))
(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 ()
(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)))
(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)
(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
projects / elisp / gnus.git- / blobdiff