;;; gnus.el --- a newsreader for GNU Emacs
;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000 Free Software Foundation, Inc.
+;; 1997, 1998, 2000, 2001 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(eval-when-compile (require 'cl))
(eval-when-compile (require 'static))
+(require 'wid-edit)
+
(require 'gnus-vers)
(defgroup gnus nil
(require 'gnus-util)
(require 'nnheader)
+(defvar 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))
+ (\"mail\\\\.me\" (gnus-use-scoring t))
+ (\"list\\\\..*\" (total-expire . t)
+ (broken-reply-to . t)))")
+
(defvar gnus-group-parameters-more nil)
-(condition-case nil
- :symbol-for-testing-whether-colon-keyword-is-available-or-not
- (void-variable
- ;; Bind keywords.
- (dolist (keyword '(:parameter-type
- :parameter-document :function :function-document
- :variable :variable-document :variable-group
- :variable-type :variable-default))
- (set keyword keyword))))
+(defvar gnus-colon-keywords
+ (eval-when-compile
+ (when (boundp 'dgnushack-colon-keywords)
+ (symbol-value 'dgnushack-colon-keywords)))
+ "List of the colon keywords should be bound at run-time. This variable
+defaults to a proper value only if this file is byte-compiled by make.")
+
+(dolist (keyword gnus-colon-keywords)
+ (set keyword keyword))
(defmacro gnus-define-group-parameter (param &rest rest)
"Define a group parameter PARAM.
(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
+ (list
'progn
`(defcustom ,variable ,variable-default
,variable-document
,parameter-type
,parameter-document))
(if (eq type 'bool)
- `(defun ,function (group)
+ `(defun ,function (name)
,function-document
- (let ((params (gnus-group-find-parameter group))
+ (let ((params (gnus-group-find-parameter name))
val)
(cond
((memq ',param params)
t)
((setq val (assq ',param params))
(cdr val))
+ ((stringp ,variable)
+ (string-match ,variable name))
(,variable
- (string-match ,variable group)))))
+ (let ((alist ,variable)
+ elem value)
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ value (cdr elem))))
+ (if (consp value) (car value) value))))))
`(defun ,function (name)
,function-document
(and name
- (or (gnus-group-find-parameter name ',param)
+ (or (gnus-group-find-parameter name ',param ,(and type t))
(let ((alist ,variable)
elem value)
(while (setq elem (pop alist))
:type 'boolean)
(defcustom gnus-extract-address-components 'gnus-extract-address-components
- "*Function for extracting address components from a From header.
-Two pre-defined function exist: `gnus-extract-address-components',
-which is the default, quite fast, and too simplistic solution, and
+ "Function for extracting address components from a From header.
+Three pre-defined functions exist: `gnus-extract-address-components',
+which is the default, quite fast, and too simplistic solution,
`mail-extract-address-components', which works much better, but is
-slower."
+slower, and `std11-extract-address-components'."
:group 'gnus-summary-format
:type '(radio (function-item gnus-extract-address-components)
(function-item mail-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)
("nnweb" none)
("nnslashdot" post)
("nnultimate" none)
+ ("nnrss" none)
("nnwfm" none)
("nnwarchive" none)
("nnlistserv" none)
:type '(choice (const nil)
integer))
-(gnus-define-group-parameter
+;; 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 "\
+This will be used when doing followups and posts.
+
+This is primarily useful in mail groups that represent closed
+mailing lists--mailing lists where it's expected that everybody that
+writes to the mailing list is subscribed to it. Since using this
+parameter ensures that the mail only goes to the mailing list itself,
+it means that members won't receive two copies of your followups.
+
+Using `to-address' will actually work whether the group is foreign or
+not. Let's say there's a group on the server that is called
+`fa.4ad-l'. This is a real newsgroup, but the server has gotten the
+articles from a mail-to-news gateway. Posting directly to this group
+is therefore impossible--you have to send mail to the mailing list
+address instead.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
+ to-list
+ :function-document
+ "Return GROUP's to-list."
+ :variable-document
+ "*Alist of group regexps and correspondent to-lists."
+ :parameter-type '(gnus-email-address :tag "To List")
+ :parameter-document "\
+This address will be used when doing a `a' in the group.
+
+It is totally ignored when doing a followup--except that if it is
+present in a news group, you'll get mail group semantics when doing
+`f'.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
auto-expire
:type bool
:function gnus-group-auto-expirable-p
:variable-group nnmail-expire
:variable-type '(choice (const nil)
regexp)
- :parameter-type '(const :tag "Automatic Expire" t)
- :parameter-document
+ :parameter-type '(const :tag "Automatic Expire" t)
+ :parameter-document
"All articles that are read will be marked as expirable.")
-(gnus-define-group-parameter
+(gnus-define-group-parameter
total-expire
:type bool
:function gnus-group-total-expirable-p
:function-document
"Check whether GROUP is total-expirable or not."
- :variable gnus-total-expirable-newsgroups
+ :variable gnus-total-expirable-newsgroups
:variable-default nil
:variable-document
"*Groups in which to perform expiry of all read articles.
:variable-group nnmail-expire
:variable-type '(choice (const nil)
regexp)
- :parameter-type '(const :tag "Total Expire" t)
- :parameter-document
+ :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.")
+(gnus-define-group-parameter
+ charset
+ :function-document
+ "Return the default charset of GROUP."
+ :variable gnus-group-charset-alist
+ :variable-default
+ '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
+ ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
+ ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
+ ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
+ ("\\(^\\|:\\)relcom\\>" koi8-r)
+ ("\\(^\\|:\\)fido7\\>" koi8-r)
+ ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+ ("\\(^\\|:\\)israel\\>" iso-8859-1)
+ ("\\(^\\|:\\)han\\>" euc-kr)
+ ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
+ ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
+ ("\\(^\\|:\\)\\(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 "\
+The default charset to use in the 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
(bookmarks . bookmark) (dormant . dormant)
(scored . score) (saved . save)
(cached . cache) (downloadable . download)
- (unsendable . unsend)))
+ (unsendable . unsend) (forwarded . forward)))
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(const :tag "Japanese" gnus-ja)))
(defvar gnus-info-nodes
- '((gnus-group-mode "The Group Buffer")
- (gnus-summary-mode "The Summary Buffer")
- (gnus-article-mode "The Article Buffer")
- (gnus-server-mode "The Server Buffer")
+ '((gnus-group-mode "Group Buffer")
+ (gnus-summary-mode "Summary Buffer")
+ (gnus-article-mode "Article Buffer")
+ (gnus-server-mode "Server Buffer")
(gnus-browse-mode "Browse Foreign Server")
(gnus-tree-mode "Tree Display"))
"Alist of major modes and related Info nodes.")
(defvar gnus-dead-summary nil)
-(defvar gnus-article-display-hook nil
- "Controls how the article buffer will look. This is an obsolete variable;
-use the article treating faculties instead. Is is described in Info node
-`Customizing Articles'.")
-
(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
"Regexp matching invalid groups.")
gnus-summary-resend-message gnus-summary-resend-bounced-mail
gnus-summary-wide-reply gnus-summary-followup-to-mail
gnus-summary-followup-to-mail-with-original gnus-bug
- gnus-summary-wide-reply-with-original
- gnus-summary-post-forward gnus-summary-wide-reply-with-original
- gnus-summary-post-forward)
+ gnus-summary-wide-reply-with-original gnus-summary-post-forward
+ gnus-summary-digest-mail-forward gnus-summary-digest-post-forward)
("gnus-picon" :interactive t gnus-article-display-picons
gnus-group-display-picons)
("gnus-picon" gnus-picons-buffer-name)
(autoload 'smiley-toggle-buffer "gnus-bitmap")
(autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule"))))
+(unless (and (fboundp 'base64-encode-string)
+ (subrp (symbol-function 'base64-encode-string)))
+ (require 'base64))
+
+;; 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
%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)
you might not be arrested, but your summary buffer will look strange,
which is bad enough.
-The smart choice is to have these specs as for to the left as
+The smart choice is to have these specs as far to the left as
possible.
This restriction may disappear in later versions of Gnus."
(or gnus-info-filename
(get-language-info current-language-environment 'gnus-info)
"gnus")
- (cadr (assq major-mode gnus-info-nodes))))
+ (or (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))
(gnus-configure-windows 'info)))
out)
(cond
((= c ?r)
- (push (if (< (point) (mark) (point) (mark))) out)
- (push (if (> (point) (mark) (point) (mark))) out))))
+ (push (if (< (point) (mark)) (point) (mark)) out)
+ (push (if (> (point) (mark)) (point) (mark)) out))))
(setq out (delq 'gnus-prefix-nil out))
(nreverse out)))
"Say whether the group is secondary or not."
(gnus-secondary-method-p (gnus-find-method-for-group group)))
+(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))
+ params-list))
+
(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."
(save-excursion
(set-buffer gnus-group-buffer)
- (let ((parameters (funcall gnus-group-get-parameter-function group)))
+ (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)
parameters))))
(list (intern server) "")))
gnus-select-method))
+(defun gnus-server-string (server)
+ "Return a readable string that describes SERVER."
+ (let* ((server (gnus-server-to-method server))
+ (address (nth 1 server)))
+ (if (and address
+ (not (zerop (length address))))
+ (format "%s via %s" address (car server))
+ (format "%s" (car server)))))
+
(defun gnus-find-method-for-group (group &optional info)
"Find the select method that GROUP uses."
(or gnus-override-method
(let ((prefix "")
group)
(while (not group)
- (when (string-match
+ (when (string-match
gnus-invalid-group-regexp
(setq group (read-string (concat prefix prompt)
(cons (or default "") 0)
(defun gnus-read-method (prompt)
"Prompt the user for a method.
Allow completion over sensible values."
- (let* ((servers
- (append gnus-valid-select-methods
- (mapcar (lambda (i) (list (format "%s:%s" (caar i)
- (cadar i))))
- gnus-opened-servers)
+ (let* ((open-servers
+ (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
+ gnus-opened-servers))
+ (valid-methods
+ (let (methods)
+ (dolist (method gnus-valid-select-methods)
+ (if (or (memq 'prompt-address method)
+ (not (assoc (format "%s:" (car method)) open-servers)))
+ (push method methods)))
+ methods))
+ (servers
+ (append valid-methods
+ open-servers
gnus-predefined-server-alist
gnus-server-alist))
(method
(assoc method gnus-valid-select-methods))
(read-string "Address: ")
"")))
- (or (let ((opened gnus-opened-servers))
- (while (and opened
- (not (equal (format "%s:%s" method address)
- (format "%s:%s" (caaar opened)
- (cadaar opened)))))
- (pop opened))
- (caar opened))
+ (or (cadr (assoc (format "%s:%s" method address) open-servers))
(list (intern method) address))))
((assoc method servers)
method)
projects / elisp / gnus.git- / blobdiff