;;; gnus-msg.el --- mail and post interface for Semi-gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
(defcustom gnus-message-replysignencrypted
t
- "Setting this causes automatically encryped messages to also be signed."
+ "Setting this causes automatically encrypted messages to also be signed."
:group 'gnus-message
:type 'boolean)
:group 'gnus-message
:type 'boolean)
-(defcustom gnus-user-agent 'emacs-gnus-type
- "Which information should be exposed in the User-Agent header.
-
-It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
-\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
-`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
-`emacs-gnus' plus system type\) or a custom string. If you set it to a
-string, be sure to use a valid format, see RFC 2616."
- :group 'gnus-message
- :type '(choice
- (item :tag "Show Gnus and Emacs versions and system type"
- emacs-gnus-type)
- (item :tag "Show Gnus and Emacs versions and system configuration"
- emacs-gnus-config)
- (item :tag "Show Gnus and Emacs versions" emacs-gnus)
- (item :tag "Show only Gnus version" gnus)
- (string :tag "Other")))
-
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
", a modified version of Semi-gnus")))
(eval-and-compile
- (autoload 'gnus-uu-post-news "gnus-uu" nil t)
- (autoload 'news-setup "rnewspost")
- (autoload 'news-reply-mode "rnewspost")
- (autoload 'rmail-dont-reply-to "mail-utils")
- (autoload 'rmail-output "rmailout"))
+ (autoload 'gnus-uu-post-news "gnus-uu" nil t))
\f
;;;
;;; Internal functions.
-(defun gnus-inews-make-draft ()
+(defun gnus-inews-make-draft (articles)
`(lambda ()
(gnus-inews-make-draft-meta-information
- ,gnus-newsgroup-name ',gnus-article-reply)))
+ ,gnus-newsgroup-name ',articles)))
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
;; added an optional argument to `gnus-configure-posting-styles' to
;; make sure that the correct value for the group name is used. -- drv
(add-hook 'message-mode-hook
- (lambda ()
- (gnus-configure-posting-styles ,group)))
+ (if (memq ,config '(reply-yank reply))
+ (lambda ()
+ (gnus-configure-posting-styles ,group))
+ (lambda ()
+ ;; There may be an old " *gnus article copy*" buffer.
+ (let (gnus-article-copy)
+ (gnus-configure-posting-styles ,group)))))
(gnus-pull ',(intern gnus-draft-meta-information-header)
message-required-headers)
(when (and ,group
(not (string= ,group "")))
(push (cons
(intern gnus-draft-meta-information-header)
- (gnus-inews-make-draft))
+ (gnus-inews-make-draft ,yanked))
message-required-headers))
(unwind-protect
(progn
(run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
-(defun gnus-inews-make-draft-meta-information (group article)
+(defun gnus-inews-make-draft-meta-information (group articles)
+ (when (numberp articles)
+ (setq articles (list articles)))
(concat "(\"" group "\" "
- (if article (number-to-string
- (if (listp article)
- (car article)
- article)) "\"\"")
+ (if articles
+ (mapconcat
+ (lambda (elem)
+ (number-to-string
+ (if (consp elem)
+ (car elem)
+ elem)))
+ articles " ")
+ "")
")"))
;;;###autoload
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
- (setq message-user-agent (gnus-extended-version))
+ (setq message-user-agent (gnus-message-make-user-agent))
(unless message-use-multi-frames
(message-add-action
`(if (gnus-buffer-exists-p ,buffer)
(set-window-configuration ,winconf))
'exit 'postpone 'kill))
(let ((to-be-marked (cond
- (yanked yanked)
+ (yanked
+ (mapcar
+ (lambda (x) (if (listp x) (car x) x)) yanked))
(article (if (listp article) article (list article)))
(t nil))))
(message-add-action
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
-network. The corresponding backend must have a 'request-post method."
+network. The corresponding back end must have a 'request-post method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
-network. The corresponding backend must have a 'request-post method."
+network. The corresponding back end must have a 'request-post method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(progn
(message-news (gnus-group-real-name gnus-newsgroup-name))
(set (make-local-variable 'gnus-discouraged-post-methods)
- (delq
+ (remove
(car (gnus-find-method-for-group gnus-newsgroup-name))
- (copy-sequence gnus-discouraged-post-methods))))))
+ gnus-discouraged-post-methods)))))
(save-excursion
(set-buffer buffer)
(setq gnus-newsgroup-name group)))))
If prefix argument YANK is non-nil, the original article is yanked
automatically.
YANK is a list of elements, where the car of each element is the
-article number, and the two following numbers is the region to be
-yanked."
+article number, and the cdr is the string to be yanked."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(gnus-summary-handle-replysign)))
(defun gnus-summary-followup-with-original (n &optional force-news)
- "Compose a followup to an article and include the original article."
+ "Compose a followup to an article and include the original article.
+The text in the region will be yanked. If the region isn't
+active, the entire article will be yanked."
(interactive "P")
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
(not to-address)))
;; This is news.
(if post
- (message-news (or to-group group))
+ (message-news
+ (or to-group
+ (and (not (gnus-virtual-group-p pgroup)) group)))
(set-buffer gnus-article-copy)
(gnus-msg-treat-broken-reply-to)
(message-followup (if (or newsgroup-p force-news)
(t gnus-select-method))))
\f
+;; Dummies to avoid byte-compile warning.
+(eval-when-compile
+ (defvar xemacs-codename))
+
(defun gnus-message-make-user-agent (&optional include-mime-info max-column
newline-product)
"Return a user-agent info. If INCLUDE-MIME-INFO is non-nil and the
variable `mime-edit-user-agent-value' is bound, the value will be
-included in the return value. If MAX-COLUMN is specified, the return
-value will be folded up as it were filled. NEWLINE-PRODUCT specifies
-whether a newline should be inserted in front of each product-token.
-If the value is t or `hard', it works strictly. Otherwise, if it is
-non-nil (e.g. `soft'), it works semi-strictly.
+included in the return value, and `gnus-user-agent' is ignored. If
+MAX-COLUMN is specified, the return value will be folded up as it were
+filled. NEWLINE-PRODUCT specifies whether a newline should be
+inserted in front of each product-token. If the value is t or `hard',
+it works strictly. Otherwise, if it is non-nil (e.g. `soft'), it
+works semi-strictly.
-Here is an example of how to use this function:
+Here is an odd example, which inserts a User-Agent: header when you
+begin to compose a message:
\(add-hook 'gnus-message-setup-hook
(lambda nil
(gnus-message-make-user-agent t 76 'soft)
\"\\n\")))))
"
- (let ((user-agent (if (and include-mime-info
- (boundp 'mime-edit-user-agent-value))
- (concat (gnus-extended-version)
- " "
- mime-edit-user-agent-value)
- (gnus-extended-version))))
+ (let ((gnus-v (gnus-extended-version))
+ user-agent)
+ (cond ((and include-mime-info
+ (boundp 'mime-edit-user-agent-value))
+ (setq user-agent (concat gnus-v " " mime-edit-user-agent-value)))
+ ((eq gnus-user-agent 'gnus-mime-edit)
+ (setq user-agent
+ (if (boundp 'mime-edit-user-agent-value)
+ (concat gnus-v " " mime-edit-user-agent-value)
+ gnus-v)))
+ (t
+ (setq user-agent (if (stringp gnus-user-agent)
+ gnus-user-agent
+ (concat gnus-v
+ (let ((emacs-v (gnus-emacs-version)))
+ (when emacs-v
+ (concat " " emacs-v))))))))
(when max-column
(unless (natnump max-column)
(setq max-column 76))
(gnus-summary-work-articles 1))))
;; Allow user to require confirmation before replying by mail to the
;; author of a news article (or mail message).
- (when (or
+ (when (or
(not (or (gnus-news-group-p gnus-newsgroup-name)
gnus-confirm-treat-mail-like-news))
(not (cond ((stringp gnus-confirm-mail-reply-to-news)
(goto-char (point-max))
(insert mail-header-separator)
(goto-char (point-min))
- (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
- (forward-char 1)
+ (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+ (forward-char 1))
(widen)))))
(defun gnus-summary-post-forward (&optional full-headers)
;; This mail group doesn't have a `to-list', so we add one
;; here. Magic!
(when (gnus-y-or-n-p
- (format "Do you want to add this as `to-list': %s " to-address))
+ (format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
(defun gnus-put-message ()
(not (gnus-group-read-only-p group)))
(setq group (read-string "Put in group: " nil (gnus-writable-groups))))
- (when (gnus-gethash group gnus-newsrc-hashtb)
+ (when (gnus-group-entry group)
(error "No such group: %s" group))
(save-excursion
(save-restriction
(defun gnus-summary-resend-bounced-mail (&optional fetch)
"Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
(coding-system-for-write 'raw-text)
- (output-coding-system 'raw-text)
groups group method group-art
mml-externalize-attachments)
(when gcc
(concat "^" (regexp-quote mail-header-separator) "$")
nil t)
(replace-match "" t t ))
- (unless (setq group-art
- (gnus-request-accept-article group method t t))
+ (when (or (not (gnus-check-backend-function
+ 'request-accept-article group))
+ (not (setq group-art
+ (gnus-request-accept-article
+ group method t t))))
(gnus-message 1 "Couldn't store article in group %s: %s"
- group (gnus-status-message method))
- (sit-for 2))
+ group (gnus-status-message method)))
(when (and group-art
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
(if (string-match " " gcc-self-val)
(concat "\"" gcc-self-val "\"")
gcc-self-val)
- (if (string-match " " group)
- (concat "\"" group "\"")
- group)))
+ ;; In nndoc groups, we use the parent group name
+ ;; instead of the current group.
+ (let ((group (or (gnus-group-find-parameter
+ gnus-newsgroup-name 'parent-group)
+ group)))
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))))
(if (not (eq gcc-self-val 'none))
(insert "\n")
(gnus-delete-line)))
projects / elisp / gnus.git- / blobdiff