;;; 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>
(defgroup gnus-charset nil
"Group character set issues."
:link '(custom-manual "(gnus)Charsets")
+ :version "21.1"
:group 'gnus)
(defgroup gnus-cache nil
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.8.8"
+(defconst gnus-version-number "0.01"
"Version number for this version of Gnus.")
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Oort Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
(defcustom gnus-inhibit-startup-message nil
:group 'gnus-start
:type 'boolean)
+(unless (fboundp 'gnus-group-remove-excess-properties)
+ (defalias 'gnus-group-remove-excess-properties 'ignore))
+
+(unless (fboundp 'gnus-set-text-properties)
+ (defalias 'gnus-set-text-properties 'set-text-properties))
+
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
(defalias 'gnus-overlay-end 'overlay-end)
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
- (defalias 'gnus-set-text-properties 'set-text-properties)
- (defalias 'gnus-group-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'identity)
(setq gnus-mode-line-image-cache
(find-image
'((:type xpm :file "gnus-pointer.xpm"
- :ascent 80)
+ :ascent center)
(:type xbm :file "gnus-pointer.xbm"
- :ascent 80))))
+ :ascent center))))
gnus-mode-line-image-cache)
'help-echo "This is Gnus")
str)
(defalias 'gnus-deactivate-mark 'deactivate-mark)
(defalias 'gnus-window-edges 'window-edges)
(defalias 'gnus-key-press-event-p 'numberp)
- (defalias 'gnus-decode-rfc1522 'ignore))
+ ;;(defalias 'gnus-decode-rfc1522 'ignore)
+ )
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
(display-graphic-p)
(let ((image (find-image
`((:type xpm :file "gnus.xpm")
+ (:type pbm :file "gnus.pbm"
+ ;; Account for the pbm's blackground.
+ :background ,(face-foreground 'gnus-splash-face)
+ :foreground ,(face-background 'default))
(:type xbm :file "gnus.xbm"
;; Account for the xbm's blackground.
:background ,(face-foreground 'gnus-splash-face)
(require 'gnus-util)
(require 'nnheader)
+(defvar gnus-group-parameters-more nil)
+
+(defmacro gnus-define-group-parameter (param &rest rest)
+ "Define a group parameter PARAM.
+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.
+:parameter-type The type for customizing the parameter.
+:parameter-document The document for the parameter.
+:variable The name of the variable.
+:variable-document The document 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."
+ (let* ((type (plist-get rest :type))
+ (parameter-type (plist-get rest :parameter-type))
+ (parameter-document (plist-get rest :parameter-document))
+ (function (or (plist-get rest :function)
+ (intern (format "gnus-parameter-%s" param))))
+ (function-document (or (plist-get rest :function-document) ""))
+ (variable (or (plist-get rest :variable)
+ (intern (format "gnus-parameter-%s-alist" 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)))))
+ (variable-default (plist-get rest :variable-default)))
+ (list
+ 'progn
+ `(defcustom ,variable ,variable-default
+ ,variable-document
+ :group 'gnus-group-parameter
+ :group ',variable-group
+ :type ,variable-type)
+ `(setq gnus-group-parameters-more
+ (delq (assq ',param gnus-group-parameters-more)
+ gnus-group-parameters-more))
+ `(add-to-list 'gnus-group-parameters-more
+ (list ',param
+ ,parameter-type
+ ,parameter-document))
+ (if (eq type 'bool)
+ `(defun ,function (name)
+ ,function-document
+ (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
+ (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 ,(and type t))
+ (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 type
+ 'value
+ '(if (consp value) (car value) value))))))))))
+
(defcustom gnus-home-directory "~/"
"Directory variable that specifies the \"home\" directory.
All other Gnus path variables are initialized from this variable."
("nnweb" none)
("nnslashdot" post)
("nnultimate" none)
+ ("nnwfm" none)
("nnwarchive" none)
("nnlistserv" none)
("nnagent" post-mail)
:inline t
(list :format "%v"
variable
- (sexp :tag "Value"))))
- ))
+ (sexp :tag "Value"))))))
(gnus-redefine-select-method-widget)
:type '(choice (const nil)
integer))
-(defcustom gnus-auto-expirable-newsgroups nil
+(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
+ :function-document
+ "Check whether GROUP is auto-expirable or not."
+ :variable gnus-auto-expirable-newsgroups
+ :variable-default nil
+ :variable-document
"*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."
- :group 'nnmail-expire
- :type '(choice (const nil)
- regexp))
-
-(defcustom gnus-total-expirable-newsgroups nil
- "*Groups in which to perform expiry of all read articles.
+ :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
+ :type bool
+ :function gnus-group-total-expirable-p
+ :function-document
+ "Check whether GROUP is total-expirable or not."
+ :variable gnus-total-expirable-newsgroups
+ :variable-default nil
+ :variable-document
+ "*Groups in which to perform expiry of all read articles.
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.)"
- :group 'nnmail-expire
- :type '(choice (const nil)
- regexp))
+ :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.")
(defcustom gnus-group-uncollapsed-levels 1
"Number of group name elements to leave alone when making a short group name."
:type 'symbol
:group 'gnus-charset)
-(defcustom gnus-default-posting-charset nil
- "Default charset assumed to be used when posting non-ASCII characters.
-This variable is overridden on a group-to-group basis by the
-gnus-group-posting-charset-alist variable and is only used on groups not
-covered by that variable.
-If nil, no default charset is assumed when posting."
- :type 'symbol
- :group 'gnus-charset)
-
\f
;;; Internal variables
(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+(defvar gnus-draft-meta-information-header "X-Draft-From")
(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
(defvar gnus-agent nil
"Whether we want to use the Gnus agent or not.")
+(defvar gnus-agent-fetching nil
+ "Whether Gnus agent is in fetching mode.")
+
(defvar gnus-command-method nil
"Dynamically bound variable that says what the current backend is.")
(nthcdr 3 package)
(cdr package)))))
'(("info" :interactive t Info-goto-node)
- ("pp" pp pp-to-string pp-eval-expression)
+ ("pp" pp-to-string)
("qp" quoted-printable-decode-region quoted-printable-decode-string)
("ps-print" ps-print-preprint)
- ("browse-url" :interactive t browse-url)
("message" :interactive t
message-send-and-exit message-yank-original)
("babel" babel-as-string)
(let ((group (or group gnus-newsgroup-name)))
(not (gnus-check-backend-function 'request-replace-article group))))
-(defun gnus-group-total-expirable-p (group)
- "Check whether GROUP is total-expirable or not."
- (let ((params (gnus-group-find-parameter group))
- val)
- (cond
- ((memq 'total-expire params)
- t)
- ((setq val (assq 'total-expire params)) ; (auto-expire . t)
- (cdr val))
- (gnus-total-expirable-newsgroups ; Check var.
- (string-match gnus-total-expirable-newsgroups group)))))
-
-(defun gnus-group-auto-expirable-p (group)
- "Check whether GROUP is auto-expirable or not."
- (let ((params (gnus-group-find-parameter group))
- val)
- (cond
- ((memq 'auto-expire params)
- t)
- ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
- (cdr val))
- (gnus-auto-expirable-newsgroups ; Check var.
- (string-match gnus-auto-expirable-newsgroups group)))))
-
(defun gnus-virtual-group-p (group)
"Say whether GROUP is virtual or not."
(memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
(and active
(file-exists-p active))))))
+(defsubst gnus-method-to-server-name (method)
+ (concat
+ (format "%s" (car method))
+ (when (and
+ (or (assoc (format "%s" (car method))
+ (gnus-methods-using 'address))
+ (gnus-server-equal method gnus-message-archive-method))
+ (nth 1 method)
+ (not (string= (nth 1 method) "")))
+ (concat "+" (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)))
(if (or (not method)
(gnus-server-equal method "native"))
group
- (concat (format "%s" (car method))
- (when (and
- (or (assoc (format "%s" (car method))
- (gnus-methods-using 'address))
- (gnus-server-equal method gnus-message-archive-method))
- (nth 1 method)
- (not (string= (nth 1 method) "")))
- (concat "+" (nth 1 method)))
- ":" group)))
+ (concat (gnus-method-to-server-name method) ":" group)))
(defun gnus-group-real-prefix (group)
"Return the prefix of the current group name."
(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)
projects / gnus / blobdiff