;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
+(require 'gnus-util)
(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
-If this variable is `current', Gnus will use the \"current\" select
-method when posting. If it is nil (which is the default), Gnus will
-use the native select method when posting.
+If this variable is `current' (which is the default), Gnus will use
+the \"current\" select method when posting. If it is `native', Gnus
+will use the native select method when posting.
This method will not be used in mail groups and the like, only in
\"real\" newsgroups.
-If not nil nor `native', the value must be a valid method as discussed
+If not `native' nor `current', the value must be a valid method as discussed
in the documentation of `gnus-select-method'. It can also be a list of
methods. If that is the case, the user will be queried for what select
method to use when posting."
:group 'gnus-group-foreign
- :type `(choice (const nil)
- (const current)
- (const native)
+ :link '(custom-manual "(gnus)Posting Server")
+ :type `(choice (const native)
+ (const current)
(sexp :tag "Methods" ,gnus-select-method)))
-(defvar gnus-outgoing-message-group nil
+(defcustom gnus-outgoing-message-group nil
"*All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value. This variable
If you want to have greater control over what group to put each
message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
-of names).")
+of names)."
+ :group 'gnus-message
+ :type '(choice (string :tag "Group")
+ (function)))
-(defvar gnus-mailing-list-groups nil
+(defcustom gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
gatewayed to a newsgroup, and you want to followup to an article in
-the group.")
+the group."
+ :group 'gnus-message
+ :type 'regexp)
-(defvar gnus-add-to-list nil
- "*If non-nil, add a `to-list' parameter automatically.")
+(defcustom gnus-add-to-list nil
+ "*If non-nil, add a `to-list' parameter automatically."
+ :group 'gnus-message
+ :type 'boolean)
-(defvar gnus-crosspost-complaint
+(defcustom gnus-crosspost-complaint
"Hi,
You posted the article below with the following Newsgroups header:
"
"Format string to be inserted when complaining about crossposts.
The first %s will be replaced by the Newsgroups header;
-the second with the current group name.")
-
-(defvar gnus-message-setup-hook nil
- "Hook run after setting up a message buffer.")
-
-(defvar gnus-bug-create-help-buffer t
- "*Should we create the *Gnus Help Bug* buffer?")
-
-(defvar gnus-posting-styles nil
- "*Alist of styles to use when posting.")
-
-(defcustom gnus-group-posting-charset-alist
- '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+the second with the current group name."
+ :group 'gnus-message
+ :type 'string)
+
+(defcustom gnus-message-setup-hook nil
+ "Hook run after setting up a message buffer."
+ :group 'gnus-message
+ :type 'hook)
+
+(defcustom gnus-bug-create-help-buffer t
+ "*Should we create the *Gnus Help Bug* buffer?"
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-posting-styles nil
+ "*Alist of styles to use when posting.
+See Info node `(gnus)Posting Styles'."
+ :group 'gnus-message
+ :link '(custom-manual "(gnus)Posting Styles")
+ :type '(repeat (cons (choice (regexp)
+ (variable)
+ (list (const header)
+ (string :tag "Header")
+ (regexp :tag "Regexp"))
+ (function)
+ (sexp))
+ (repeat (list
+ (choice (const signature)
+ (const signature-file)
+ (const organization)
+ (const address)
+ (const x-face-file)
+ (const name)
+ (const body)
+ (symbol)
+ (string :tag "Header"))
+ (choice (string)
+ (function)
+ (variable)
+ (sexp)))))))
+
+(defcustom gnus-gcc-mark-as-read nil
+ "If non-nil, automatically mark Gcc articles as read."
+ :version "21.1"
+ :group 'gnus-message
+ :type 'boolean)
+
+(defvar gnus-inews-mark-gcc-as-read nil
+ "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
+
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
+ 'gnus-gcc-mark-as-read)
+
+(defcustom gnus-gcc-externalize-attachments nil
+ "Should local-file attachments be included as external parts in Gcc copies?
+If it is `all', attach files as external parts;
+if a regexp and matches the Gcc group name, attach files as external parts;
+if nil, attach files as normal parts."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(choice (const nil :tag "None")
+ (const all :tag "Any")
+ (string :tag "Regexp")))
+
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
+ '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
+ :variable-document
"Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
- :type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
- :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+ :value nil
+ (repeat (symbol)))
+ :parameter-document "\
+List of charsets that are permitted to be unencoded.")
+
+(defcustom gnus-debug-files
+ '("gnus.el" "gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el" "gnus-async.el"
+ "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
+ "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
+ "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
+ "Files whose variables will be reported in `gnus-bug'."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(repeat (string :tag "File")))
+
+(defcustom gnus-debug-exclude-variables
+ '(mm-mime-mule-charset-alist
+ nnmail-split-fancy message-minibuffer-local-map)
+ "Variables that should not be reported in `gnus-bug'."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(repeat (symbol :tag "Variable")))
+
+(defcustom gnus-discouraged-post-methods
+ '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
+ "A list of back ends that are not used in \"real\" newsgroups.
+This variable is used only when `gnus-post-method' is `current'."
+ :version "21.3"
+ :group 'gnus-group-foreign
+ :type '(repeat (symbol :tag "Back end")))
+
+(defcustom gnus-message-replysign
+ nil
+ "Automatically sign replies to signed messages.
+See also the `mml-default-sign-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+ nil
+ "Automatically encrypt replies to encrypted messages.
+See also the `mml-default-encrypt-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replysignencrypted
+ t
+ "Setting this causes automatically encryped messages to also be signed."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-confirm-mail-reply-to-news nil
+ "If non-nil, Gnus requests confirmation when replying to news.
+This is done because new users often reply by mistake when reading
+news.
+This can also be a function receiving the group name as the only
+parameter which should return non-nil iff a confirmation is needed, or
+a regexp, in which case a confirmation is asked for iff the group name
+matches the regexp."
+ :group 'gnus-message
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (regexp :tag "Iff group matches regexp")
+ (function :tag "Iff function evaluates to non-nil")))
+
+(defcustom gnus-confirm-treat-mail-like-news
+ nil
+ "If non-nil, Gnus will treat mail like news with regard to confirmation
+when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
+for fine-tuning this.
+If nil, Gnus will never ask for confirmation if replying to mail."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-summary-resend-default-address t
+ "If non-nil, Gnus tries to suggest a default address to resend to.
+If nil, the address field will always be empty after invoking
+`gnus-summary-resend-message'."
+ :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
"Inhibit the use of posting styles.")
+(defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
+(defvar gnus-check-before-posting nil)
(defvar gnus-last-posting-server nil)
(defvar gnus-message-group-art nil)
+(defvar gnus-msg-force-broken-reply-to nil)
+
(defconst gnus-bug-message
"Sending a bug report to the Gnus Towers.
========================================
(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
"p" gnus-summary-post-news
+ "i" gnus-summary-news-other-window
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
"c" gnus-summary-cancel-article
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
+ "v" gnus-summary-very-wide-reply
+ "V" gnus-summary-very-wide-reply-with-original
"n" gnus-summary-followup-to-mail
"N" gnus-summary-followup-to-mail-with-original
"m" gnus-summary-mail-other-window
"u" gnus-uu-post-news
"\M-c" gnus-summary-mail-crosspost-complaint
+ "Br" gnus-summary-reply-broken-reply-to
+ "BR" gnus-summary-reply-broken-reply-to-with-original
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
"Om" gnus-uu-digest-mail-forward
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
+ "r" gnus-summary-resend-message
+ "e" gnus-summary-resend-message-edit)
;;; Internal functions.
+(defun gnus-inews-make-draft ()
+ `(lambda ()
+ (gnus-inews-make-draft-meta-information
+ ,gnus-newsgroup-name ',gnus-article-reply)))
+
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
- (,article (and gnus-article-reply (gnus-summary-article-number)))
+ (,article gnus-article-reply)
+ (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(setq mml-buffer-list nil)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
- (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
+ ;; #### FIXME: for a reason that I did not manage to identify yet,
+ ;; the variable `gnus-newsgroup-name' does not honor a dynamically
+ ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
+ ;; After evaluation of @forms below, it gets the value we actually want
+ ;; to override, and the posting styles are used. For that reason, I've
+ ;; 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)))
+ (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))
+ message-required-headers))
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ ,yanked)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
(gnus-run-hooks 'gnus-message-setup-hook)
(if (eq major-mode 'message-mode)
- ;; Make mml-buffer-list local.
- ;; Restore global mml-buffer-list value as mbl.
- ;; What a hack! -- Shenghuo
- (let ((mml-buffer-list mml-buffer-list))
- (setq mml-buffer-list mbl)
- (make-local-variable 'mml-buffer-list)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl) ;; Global value
+ (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ ;; LOCAL argument of add-hook differs between GNU Emacs
+ ;; and XEmacs. make-local-hook makes sure they are local.
+ (make-local-hook 'kill-buffer-hook)
+ (make-local-hook 'change-major-mode-hook)
+ (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
(mml-destroy-buffers)
(setq mml-buffer-list mbl)))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
+ (run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
+(defun gnus-inews-make-draft-meta-information (group article)
+ (concat "(\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")"))
+
+;;;###autoload
+(defun gnus-msg-mail (&optional to subject other-headers continue
+ switch-action yank-action send-actions)
+ "Start editing a mail message to be sent.
+Like `message-mail', but with Gnus paraphernalia, particularly the
+Gcc: header for archiving purposes."
+ (interactive)
+ (let ((buf (current-buffer))
+ mail-buf)
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions))
+ (when switch-action
+ (setq mail-buf (current-buffer))
+ (switch-to-buffer buf)
+ (apply switch-action mail-buf nil)))
+ ;; COMPOSEFUNC should return t if succeed. Undocumented ???
+ t)
+
+(defvar save-selected-window-window)
+
+;;;###autoload
+(defun gnus-button-mailto (address)
+ "Mail to ADDRESS."
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-setup-message 'message
+ (message-reply address))
+ (and (boundp 'save-selected-window-window)
+ (not (window-live-p save-selected-window-window))
+ (setq save-selected-window-window (selected-window))))
+
+;;;###autoload
+(defun gnus-button-reply (&optional to-address wide)
+ "Like `message-reply'."
+ (interactive)
+ (gnus-setup-message 'message
+ (message-reply to-address wide))
+ (and (boundp 'save-selected-window-window)
+ (not (window-live-p save-selected-window-window))
+ (setq save-selected-window-window (selected-window))))
+
+;;;###autoload
+(define-mail-user-agent 'gnus-user-agent
+ 'gnus-msg-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
+
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
(group (or group ""))
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article)
+(defun gnus-inews-add-send-actions (winconf buffer article
+ &optional config yanked)
(make-local-hook 'message-sent-hook)
- (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
+ (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
+ 'gnus-inews-do-gcc) nil t)
+ (when gnus-agent
+ (make-local-hook 'message-header-hook)
+ (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(setq message-newsreader (setq message-mailer (gnus-extended-version)))
(message-add-action
- `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
- (message-add-action
`(when (gnus-buffer-exists-p ,buffer)
- (save-excursion
- (set-buffer ,buffer)
- ,(when article
- `(gnus-summary-mark-article-as-replied ,article))))
- 'send))
+ (set-window-configuration ,winconf))
+ 'exit 'postpone 'kill)
+ (let ((to-be-marked (cond
+ (yanked yanked)
+ (article (if (listp article) article (list article)))
+ (t nil))))
+ (message-add-action
+ `(when (gnus-buffer-exists-p ,buffer)
+ (save-excursion
+ (set-buffer ,buffer)
+ ,(when to-be-marked
+ (if (eq config 'forward)
+ `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
+ `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
+ 'send)))
(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
(gnus-read-active-file-p))
(gnus-group-group-name))
""))
+ ;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message (message-mail)))
(save-excursion
(set-buffer buffer)
(setq gnus-newsgroup-name group)))))
+(defun gnus-group-news (&optional arg)
+ "Start composing a news.
+If ARG, post to group under point.
+If ARG is 1, prompt for group name to post to.
+
+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."
+ (interactive "P")
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ ""))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message
+ (message-news (gnus-group-real-name gnus-newsgroup-name))))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
(defun gnus-group-post-news (&optional arg)
- "Start composing a news message.
-If ARG, post to the group under point.
-If ARG is 1, prompt for a group name."
+ "Start composing a message (a news by default).
+If ARG, post to group under point. If ARG is 1, prompt for group name.
+Depending on the selected group, the message might be either a mail or
+a news."
(interactive "P")
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
(completing-read "Newsgroup: " gnus-active-hashtb nil
(gnus-read-active-file-p))
(gnus-group-group-name))
- "")))
+ ""))
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy))
+ (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
+ (string= gnus-newsgroup-name ""))))
+
+(defun gnus-summary-mail-other-window (&optional arg)
+ "Start composing a mail in another window.
+Use the posting of the current group by default.
+If ARG, don't do that. If ARG is 1, prompt for group name to find the
+posting style."
+ (interactive "P")
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message (message-mail)))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-news-other-window (&optional arg)
+ "Start composing a news in another window.
+Post to the current group by default.
+If ARG, don't do that. If ARG is 1, prompt for group name to post to.
+
+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."
+ (interactive "P")
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message
+ (message-news (gnus-group-real-name gnus-newsgroup-name))))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-post-news (&optional arg)
+ "Start composing a message. Post to the current group by default.
+If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
+Depending on the selected group, the message might be either a mail or
+a news."
+ (interactive "P")
+ ;; Bind this variable here to make message mode hooks work ok.
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Newsgroup: " gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name))
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy))
(gnus-post-news 'post gnus-newsgroup-name)))
-(defun gnus-summary-post-news ()
- "Start composing a news message."
- (interactive)
- (gnus-post-news 'post gnus-newsgroup-name))
(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
-If prefix argument YANK is non-nil, original article is yanked automatically."
+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."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(when yank
- (gnus-summary-goto-subject (car yank)))
+ (gnus-summary-goto-subject
+ (if (listp (car yank))
+ (caar yank)
+ (car yank))))
(save-window-excursion
(gnus-summary-select-article))
(let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- yank nil force-news)))
+ yank nil force-news)
+ (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."
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
- (let (beg article)
+ (let (beg article yank-string)
(message-goto-body)
(while (setq article (pop articles))
+ (when (listp article)
+ (setq yank-string (nth 1 article)
+ article (nth 0 article)))
(save-window-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-select-article nil nil nil article)
(gnus-summary-remove-process-mark article))
- (gnus-copy-article-buffer)
+ (gnus-copy-article-buffer nil yank-string)
(let ((message-reply-buffer gnus-article-copy)
- (message-reply-headers gnus-current-headers))
+ (message-reply-headers
+ ;; The headers are decoded.
+ (with-current-buffer gnus-article-copy
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (nnheader-parse-naked-head)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
- (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
\f
-(defun gnus-copy-article-buffer (&optional article-buffer)
+(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
;; make a copy of the article buffer with all text properties removed
;; this copy is in the buffer gnus-article-copy.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
(error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
- (save-restriction
- ;; Copy over the (displayed) article buffer, delete
- ;; hidden text and remove text properties.
- (widen)
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (insert
- (prog1
- (buffer-substring-no-properties (point-min) (point-max))
- (erase-buffer)))
- ;; Find the original headers.
- (set-buffer gnus-original-article-buffer)
- (goto-char (point-min))
- (while (looking-at message-unix-mail-delimiter)
- (forward-line 1))
- (setq beg (point))
- (setq end (or (search-forward "\n\n" nil t) (point)))
- ;; Delete the headers from the displayed articles.
- (set-buffer gnus-article-copy)
- (delete-region (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
- ;; Insert the original article headers.
- (insert-buffer-substring gnus-original-article-buffer beg end)
- (article-decode-encoded-words)))
+ (let ((gnus-newsgroup-charset (or gnus-article-charset
+ gnus-newsgroup-charset))
+ (gnus-newsgroup-ignored-charsets
+ (or gnus-article-ignored-charsets
+ gnus-newsgroup-ignored-charsets)))
+ (save-restriction
+ ;; Copy over the (displayed) article buffer, delete
+ ;; hidden text and remove text properties.
+ (widen)
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ (when yank-string
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert yank-string))
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (gnus-remove-text-with-property 'gnus-decoration)
+ (insert
+ (prog1
+ (buffer-substring-no-properties (point-min) (point-max))
+ (erase-buffer)))
+ ;; Find the original headers.
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (let ((mail-header-separator ""))
+ (setq beg (point)
+ end (or (message-goto-body)
+ ;; There may be just a header.
+ (point-max))))
+ ;; Delete the headers from the displayed articles.
+ (set-buffer gnus-article-copy)
+ (let ((mail-header-separator ""))
+ (delete-region (goto-char (point-min))
+ (or (message-goto-body) (point-max))))
+ ;; Insert the original article headers.
+ (insert-buffer-substring gnus-original-article-buffer beg end)
+ ;; Decode charsets.
+ (let ((gnus-article-decode-hook
+ (delq 'article-decode-charset
+ (copy-sequence gnus-article-decode-hook))))
+ (run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
(when article-buffer
(gnus-copy-article-buffer))
- (let ((gnus-article-reply article-buffer)
+ (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
to-address to-group mailing-list to-list
newsgroup-p)
(when group
- (setq to-address (gnus-group-find-parameter group 'to-address)
+ (setq to-address (gnus-parameter-to-address group)
to-group (gnus-group-find-parameter group 'to-group)
- to-list (gnus-group-find-parameter group 'to-list)
+ to-list (gnus-parameter-to-list group)
newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
force-news
(and (gnus-news-group-p
(or pgroup gnus-newsgroup-name)
- (if header (mail-header-number header)
- gnus-current-article))
+ (or header gnus-current-article))
(not mailing-list)
(not to-list)
(not to-address)))
(message-news (or to-group group))
(set-buffer gnus-article-copy)
(gnus-msg-treat-broken-reply-to)
- (message-followup (if (or newsgroup-p force-news) nil to-group)))
+ (message-followup (if (or newsgroup-p force-news)
+ (if (save-restriction
+ (article-narrow-to-head)
+ (message-fetch-field "newsgroups"))
+ nil
+ "")
+ to-group)))
;; The is mail.
(if post
(progn
(when yank
(gnus-inews-yank-articles yank))))))
-(defun gnus-msg-treat-broken-reply-to ()
- "Remove the Reply-to header iff broken-reply-to."
- (when (gnus-group-find-parameter
- gnus-newsgroup-name 'broken-reply-to)
+(defun gnus-msg-treat-broken-reply-to (&optional force)
+ "Remove the Reply-to header if broken-reply-to."
+ (when (or force
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))
(save-restriction
(message-narrow-to-head)
(message-remove-header "reply-to"))))
(defun gnus-post-method (arg group &optional silent)
"Return the posting method based on GROUP and ARG.
If SILENT, don't prompt the user."
- (let ((group-method (gnus-find-method-for-group group)))
+ (let ((gnus-post-method (or (gnus-parameter-post-method group)
+ gnus-post-method))
+ (group-method (gnus-find-method-for-group group)))
(cond
;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
((null group-method)
- (or (and (null (eq gnus-post-method 'active)) gnus-post-method)
- gnus-select-method message-post-method))
+ (or (and (listp gnus-post-method) ;If not current/native/nil
+ (not (listp (car gnus-post-method))) ; and not a list of methods
+ gnus-post-method) ;then use it.
+ gnus-select-method
+ message-post-method))
;; We want the inverse of the default
((and arg (not (eq arg 0)))
- (if (eq gnus-post-method 'active)
+ (if (eq gnus-post-method 'current)
gnus-select-method
group-method))
;; We query the user for a post method.
((or arg
- (and gnus-post-method
- (not (eq gnus-post-method 'current))
+ (and (listp gnus-post-method)
(listp (car gnus-post-method))))
(let* ((methods
;; Collect all methods we know about.
(append
- (when (and gnus-post-method
- (not (eq gnus-post-method 'current)))
+ (when (listp gnus-post-method)
(if (listp (car gnus-post-method))
gnus-post-method
(list gnus-post-method)))
(setq method-alist
(mapcar
(lambda (m)
- (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+ (if (equal (cadr m) "")
+ (list (symbol-name (car m)) m)
+ (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
post-methods))
;; Query the user.
(cadr
method-alist))))
;; Override normal method.
((and (eq gnus-post-method 'current)
- (not (eq (car group-method) 'nndraft))
- (gnus-get-function group-method 'request-post t)
- (not arg))
+ (not (memq (car group-method) gnus-discouraged-post-methods))
+ (gnus-get-function group-method 'request-post t))
+ (assert (not arg))
group-method)
- ((and gnus-post-method
- (not (eq gnus-post-method 'current)))
+ ;; Use gnus-post-method.
+ ((listp gnus-post-method) ;A method...
+ (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
gnus-post-method)
- ;; Use the normal select method.
+ ;; Use the normal select method (nil or native).
(t gnus-select-method))))
\f
;; Dummies to avoid byte-compile warning.
-(defvar nnspool-rejected-article-hook)
-(defvar xemacs-codename)
+(eval-when-compile
+ (defvar nnspool-rejected-article-hook)
+ (defvar xemacs-codename))
(defun gnus-extended-version ()
- "Stringified Gnus version and Emacs version."
+ "Stringified Gnus version and Emacs version.
+See the variable `gnus-user-agent'."
(interactive)
- (concat
- "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
- " (" gnus-version ")"
- " "
- (cond
- ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- (concat "Emacs/" (match-string 1 emacs-version)))
- ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat (match-string 1 emacs-version)
+ (let* ((gnus-v
+ (concat "Gnus/"
+ (prin1-to-string (gnus-continuum-version gnus-version) t)
+ " (" gnus-version ")"))
+ (system-v
+ (cond
+ ((eq gnus-user-agent 'emacs-gnus-config)
+ system-configuration)
+ ((eq gnus-user-agent 'emacs-gnus-type)
+ (symbol-name system-type))
+ (t nil)))
+ (emacs-v
+ (cond
+ ((eq gnus-user-agent 'gnus)
+ nil)
+ ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
+ (concat "Emacs/" (match-string 1 emacs-version)
+ (if system-v
+ (concat " (" system-v ")")
+ "")))
+ ((string-match
+ "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
+ emacs-version)
+ (concat
+ (match-string 1 emacs-version)
(format "/%d.%d" emacs-major-version emacs-minor-version)
(if (match-beginning 3)
(match-string 3 emacs-version)
"")
(if (boundp 'xemacs-codename)
- (concat " (" xemacs-codename ")")
+ (concat
+ " (" xemacs-codename
+ (if system-v
+ (concat ", " system-v ")")
+ ")"))
"")))
- (t emacs-version))))
+ (t emacs-version))))
+ (if (stringp gnus-user-agent)
+ gnus-user-agent
+ (concat gnus-v
+ (when emacs-v
+ (concat " " emacs-v))))))
\f
;;;
;;; Mail reply commands of Gnus summary mode
-(defun gnus-summary-reply (&optional yank wide)
- "Start composing a reply mail to the current message.
+(defun gnus-summary-reply (&optional yank wide very-wide)
+ "Start composing a mail reply to the current message.
If prefix argument YANK is non-nil, the original article is yanked
-automatically."
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
- ;; Stripping headers should be specified with mail-yank-ignored-headers.
- (when yank
- (gnus-summary-goto-subject (car yank)))
- (let ((gnus-article-reply t))
- (gnus-setup-message (if yank 'reply-yank 'reply)
- (gnus-summary-select-article)
- (set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to)
- (save-restriction
- (message-narrow-to-head)
- (goto-char (point-max)))
- (mml-quote-region (point) (point-max))
- (message-reply nil wide)
+ ;; Allow user to require confirmation before replying by mail to the
+ ;; author of a news article (or mail message).
+ (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)
+ (string-match gnus-confirm-mail-reply-to-news
+ gnus-newsgroup-name))
+ ((functionp gnus-confirm-mail-reply-to-news)
+ (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
+ (t gnus-confirm-mail-reply-to-news)))
+ (y-or-n-p "Really reply by mail to article author? "))
+ (let* ((article
+ (if (listp (car yank))
+ (caar yank)
+ (car yank)))
+ (gnus-article-reply (or article (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
+ (headers ""))
+ ;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
- (gnus-inews-yank-articles yank)))))
+ (gnus-summary-goto-subject article))
+ (gnus-setup-message (if yank 'reply-yank 'reply)
+ (if (not very-wide)
+ (gnus-summary-select-article)
+ (dolist (article very-wide)
+ (gnus-summary-select-article nil nil nil article)
+ (save-excursion
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq headers (concat headers (buffer-string)))))))
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (when very-wide
+ (erase-buffer)
+ (insert headers))
+ (goto-char (point-max)))
+ (mml-quote-region (point) (point-max))
+ (message-reply nil wide)
+ (when yank
+ (gnus-inews-yank-articles yank))
+ (gnus-summary-handle-replysign)))))
+
+(defun gnus-summary-handle-replysign ()
+ "Check the various replysign variables and take action accordingly."
+ (when (or gnus-message-replysign gnus-message-replyencrypt)
+ (let (signed encrypted)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (setq signed (memq 'signed gnus-article-wash-types))
+ (setq encrypted (memq 'encrypted gnus-article-wash-types)))
+ (cond ((and gnus-message-replyencrypt encrypted)
+ (mml-secure-message mml-default-encrypt-method
+ (if gnus-message-replysignencrypted
+ 'signencrypt
+ 'encrypt)))
+ ((and gnus-message-replysign signed)
+ (mml-secure-message mml-default-sign-method 'sign))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n) wide))
+(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+ "Like `gnus-summary-reply' except removing reply-to field.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (let ((gnus-msg-force-broken-reply-to t))
+ (gnus-summary-reply yank wide very-wide)))
+
+(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+ "Like `gnus-summary-reply-with-original' except removing reply-to field.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
(interactive "P")
(gnus-summary-reply-with-original n t))
+(defun gnus-summary-very-wide-reply (&optional yank)
+ "Start composing a very wide reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
+
+(defun gnus-summary-very-wide-reply-with-original (n)
+ "Start composing a very wide reply mail to the current message.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply
+ (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
+
(defun gnus-summary-mail-forward (&optional arg post)
- "Forward the current message to another user.
-If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
+ "Forward the current message(s) to another user.
+If process marks exist, forward all marked messages;
+if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
if ARG is 1, decode the message and forward directly inline;
-if ARG is 2, foward message as an rfc822 MIME section;
+if ARG is 2, forward message as an rfc822 MIME section;
if ARG is 3, decode message and forward as an rfc822 MIME section;
-if ARG is 4, foward message directly inline;
+if ARG is 4, forward message directly inline;
otherwise, use flipped `message-forward-as-mime'.
-If POST, post instead of mail."
+If POST, post instead of mail.
+For the `inline' alternatives, also see the variable
+`message-forward-ignored-headers'."
(interactive "P")
- (let ((message-forward-as-mime message-forward-as-mime)
- (message-forward-show-mml message-forward-show-mml))
- (cond
- ((null arg))
- ((eq arg 1) (setq message-forward-as-mime nil
- message-forward-show-mml t))
- ((eq arg 2) (setq message-forward-as-mime t
- message-forward-show-mml nil))
- ((eq arg 3) (setq message-forward-as-mime t
- message-forward-show-mml t))
- ((eq arg 4) (setq message-forward-as-mime nil
- message-forward-show-mml nil))
- (t (setq message-forward-as-mime (not message-forward-as-mime))))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
- text)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (mm-with-unibyte-current-buffer
- (setq text (buffer-string))))
- (set-buffer
- (gnus-get-buffer-create
- (generate-new-buffer-name " *Gnus forward*")))
- (erase-buffer)
- (mm-disable-multibyte)
- (insert text)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: ") )
- (when message-forward-show-mml
- (mm-enable-multibyte)
- (mime-to-mml))
- (message-forward post)))))
+ (if (cdr (gnus-summary-work-articles nil))
+ ;; Process marks are given.
+ (gnus-uu-digest-mail-forward arg post)
+ ;; No process marks.
+ (let ((message-forward-as-mime message-forward-as-mime)
+ (message-forward-show-mml message-forward-show-mml))
+ (cond
+ ((null arg))
+ ((eq arg 1)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml t))
+ ((eq arg 2)
+ (setq message-forward-as-mime t
+ message-forward-show-mml nil))
+ ((eq arg 3)
+ (setq message-forward-as-mime t
+ message-forward-show-mml t))
+ ((eq arg 4)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml nil))
+ (t
+ (setq message-forward-as-mime (not message-forward-as-mime))))
+ (let* ((gnus-article-reply (gnus-summary-article-number))
+ (gnus-article-yanked-articles (list gnus-article-reply)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((mail-parse-charset
+ (or (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ gnus-article-charset))
+ gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ gnus-newsgroup-ignored-charsets))
+ (set-buffer gnus-original-article-buffer)
+ (message-forward post)))))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
- (interactive "sResend message(s) to: \nP")
+ (interactive
+ (list (message-read-from-minibuffer
+ "Resend message(s) to: "
+ (when (and gnus-summary-resend-default-address
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ ;; If some other article is currently selected, the
+ ;; initial-contents is wrong. Whatever, it is just the
+ ;; initial-contents.
+ (with-current-buffer gnus-original-article-buffer
+ (nnmail-fetch-field "to"))))
+ current-prefix-arg))
(let ((articles (gnus-summary-work-articles n))
article)
(while (setq article (pop articles))
(gnus-summary-select-article nil nil nil article)
(save-excursion
(set-buffer gnus-original-article-buffer)
- (message-resend address)))))
+ (message-resend address))
+ (gnus-summary-mark-article-as-forwarded article))))
+
+;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
+(defun gnus-summary-resend-message-edit ()
+ "Resend an article that has already been sent.
+A new buffer will be created to allow the user to modify body and
+contents of the message, and then, everything will happen as when
+composing a new message."
+ (interactive)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (let ((cur (current-buffer))
+ (to (message-fetch-field "to")))
+ ;; Get a normal message buffer.
+ (message-pop-to-buffer (message-buffer-name "Resend" to))
+ (insert-buffer-substring cur)
+ (mime-to-mml)
+ (message-narrow-to-head-1)
+ ;; Gnus will generate a new one when sending.
+ (message-remove-header "Message-ID")
+ (message-remove-header message-ignored-resent-headers t)
+ ;; Remove unwanted headers.
+ (goto-char (point-max))
+ (insert mail-header-separator)
+ (goto-char (point-min))
+ (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+ (forward-char 1)
+ (widen)))))
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit)))))))
-(defun gnus-summary-mail-other-window ()
- "Compose mail in other window."
- (interactive)
- (gnus-setup-message 'message
- (message-mail)))
-
(defun gnus-mail-parse-comma-list ()
(let (accumulated
beg)
(let ((reply gnus-article-reply)
(winconf gnus-prev-winconf)
(group gnus-newsgroup-name))
+ (unless (and group
+ (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
- (or (and group (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)
(error "No such group: %s" group))
-
(save-excursion
(save-restriction
(widen)
(message-narrow-to-headers)
- (let (gnus-deletable-headers)
- (if (message-news-p)
- (message-generate-headers message-required-news-headers)
- (message-generate-headers message-required-mail-headers)))
+ (let ((gnus-deletable-headers nil))
+ (message-generate-headers
+ (if (message-news-p)
+ message-required-news-headers
+ message-required-mail-headers)))
(goto-char (point-max))
- (insert "Gcc: " group "\n")
+ (if (string-match " " group)
+ (insert "Gcc: \"" group "\"\n")
+ (insert "Gcc: " group "\n"))
(widen)))
-
(gnus-inews-do-gcc)
-
- (when (get-buffer gnus-group-buffer)
- (when (gnus-buffer-exists-p (car-safe reply))
- (set-buffer (car reply))
- (and (cdr reply)
- (gnus-summary-mark-article-as-replied
- (cdr reply))))
- (when winconf
- (set-window-configuration winconf)))))
+ (when (and (get-buffer gnus-group-buffer)
+ (gnus-buffer-exists-p (car-safe reply))
+ (cdr reply))
+ (set-buffer (car reply))
+ (gnus-summary-mark-article-as-replied (cdr reply)))
+ (when winconf
+ (set-window-configuration winconf))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
- (message-reply address)
+ (gnus-msg-mail address)
(when yank
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(interactive)
(unless (gnus-alive-p)
(error "Gnus has been shut down"))
- (gnus-setup-message 'bug
- (delete-other-windows)
- (when gnus-bug-create-help-buffer
- (switch-to-buffer "*Gnus Help Bug*")
- (erase-buffer)
- (insert gnus-bug-message)
- (goto-char (point-min)))
- (message-pop-to-buffer "*Gnus Bug*")
- (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+ (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
+ (unless (message-mail-user-agent)
+ (delete-other-windows)
+ (when gnus-bug-create-help-buffer
+ (switch-to-buffer "*Gnus Help Bug*")
+ (erase-buffer)
+ (insert gnus-bug-message)
+ (goto-char (point-min)))
+ (message-pop-to-buffer "*Gnus Bug*"))
+ (let ((message-this-is-mail t))
+ (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
(let (text)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus environment info*"))
+ (erase-buffer)
(gnus-debug)
(setq text (buffer-string)))
- (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
+ (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
- (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
- "gnus-art.el" "gnus-start.el" "gnus-async.el"
- "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
- "nnmail.el" "message.el"))
+ (let ((files gnus-debug-files)
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(and (or (eq (car expr) 'defvar)
(eq (car expr) 'defcustom))
(stringp (nth 3 expr))
+ (not (memq (nth 1 expr) gnus-debug-exclude-variables))
(or (not (boundp (nth 1 expr)))
(not (equal (eval (nth 2 expr))
(symbol-value (nth 1 expr)))))
(insert "------------------ Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
- (condition-case ()
- (pp `(setq ,(car olist)
- ,(if (or (consp (setq sym (symbol-value (car olist))))
- (and (symbolp sym)
- (not (or (eq sym nil)
- (eq sym t)))))
- (list 'quote (symbol-value (car olist)))
- (symbol-value (car olist))))
- (current-buffer))
- (error
- (format "(setq %s 'whatever)\n" (car olist))))
+ (ignore-errors
+ (pp `(setq ,(car olist)
+ ,(if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ (list 'quote (symbol-value (car olist)))
+ (symbol-value (car olist))))
+ (current-buffer)))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
;;; Gcc handling.
+(defun gnus-inews-group-method (group)
+ (cond
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ ((and (null (gnus-get-info group))
+ (eq (car (gnus-server-to-method gnus-message-archive-method))
+ (car (gnus-server-to-method (gnus-group-method group)))))
+ gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
+ (t (gnus-server-to-method (gnus-group-method group)))))
+
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
(interactive)
- (when (gnus-alive-p)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
- groups group method)
- (when gcc
- (message-remove-header "gcc")
- (widen)
- (setq groups (message-unquote-tokens
- (message-tokenize-header gcc " ,")))
- ;; Copy the article over to some group(s).
- (while (setq group (pop groups))
- (gnus-check-server
- (setq method
- (cond ((and (null (gnus-get-info group))
- (eq (car gnus-message-archive-method)
- (car
- (gnus-server-to-method
- (gnus-group-method group)))))
- ;; If the group doesn't exist, we assume
- ;; it's an archive group...
- gnus-message-archive-method)
- ;; Use the method.
- ((gnus-info-method (gnus-get-info group))
- (gnus-info-method (gnus-get-info group)))
- ;; Find the method.
- (t (gnus-group-method group)))))
- (gnus-check-server method)
- (unless (gnus-request-group group t method)
- (gnus-request-create-group group method))
- (save-excursion
- (nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (let ((mail-parse-charset message-default-charset)
- (rfc2047-header-encoding-alist
- (cons '("Newsgroups" . default)
- rfc2047-header-encoding-alist)))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (replace-match "" t t ))
- (unless (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))
- (kill-buffer (current-buffer))))))))))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (cur (current-buffer))
+ groups group method group-art
+ mml-externalize-attachments)
+ (when gcc
+ (message-remove-header "gcc")
+ (widen)
+ (setq groups (message-unquote-tokens
+ (message-tokenize-header gcc " ,")))
+ ;; Copy the article over to some group(s).
+ (while (setq group (pop groups))
+ (unless (gnus-check-server
+ (setq method (gnus-inews-group-method group)))
+ (error "Can't open server %s" (if (stringp method) method
+ (car method))))
+ (unless (gnus-request-group group nil method)
+ (gnus-request-create-group group method))
+ (setq mml-externalize-attachments
+ (if (stringp gnus-gcc-externalize-attachments)
+ (string-match gnus-gcc-externalize-attachments group)
+ gnus-gcc-externalize-attachments))
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (let* ((mail-parse-charset message-default-charset)
+ (newsgroups-field (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Newsgroups")))
+ (followup-field (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Followup-To")))
+ ;; BUG: We really need to get the charset for
+ ;; each name in the Newsgroups and Followup-To
+ ;; lines to allow crossposting between group
+ ;; namess with incompatible character sets.
+ ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
+ (group-field-charset
+ (gnus-group-name-charset
+ method (or newsgroups-field "")))
+ (followup-field-charset
+ (gnus-group-name-charset
+ method (or followup-field "")))
+ (rfc2047-header-encoding-alist
+ (append
+ (when group-field-charset
+ (list (cons "Newsgroups" group-field-charset)))
+ (when followup-field-charset
+ (list (cons "Followup-To" followup-field-charset)))
+ rfc2047-header-encoding-alist)))
+ (mail-encode-encoded-word-buffer)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
+ (unless (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))
+ (when (and group-art
+ ;; FIXME: Should gcc-mark-as-read work when
+ ;; Gnus is not running?
+ (gnus-alive-p)
+ (or gnus-gcc-mark-as-read
+ gnus-inews-mark-gcc-as-read))
+ (gnus-group-mark-article-read group (cdr group-art)))
+ (kill-buffer (current-buffer)))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
group))))
(when gcc
(insert "Gcc: "
- (if (stringp gcc) gcc
- (mapconcat 'identity gcc " "))
+ (if (stringp gcc)
+ (if (string-match " " gcc)
+ (concat "\"" gcc "\"")
+ gcc)
+ (mapconcat (lambda (group)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))
+ gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
(progn
(insert
(if (stringp gcc-self-val)
- gcc-self-val
- group))
+ (if (string-match " " gcc-self-val)
+ (concat "\"" gcc-self-val "\"")
+ gcc-self-val)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group)))
(if (not (eq gcc-self-val 'none))
(insert "\n")
- (progn
- (beginning-of-line)
- (kill-line))))
+ (gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
+ (let ((str (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method))))
+ (insert (if (string-match " " str)
+ (concat "\"" str "\"")
+ str)))
(when groups
(insert " ")))
(insert "\n")))))))
+(defun gnus-mailing-list-followup-to ()
+ "Look at the headers in the current buffer and return a Mail-Followup-To address."
+ (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
+ (list-post (gnus-fetch-original-field "list-post")))
+ (when (and list-post
+ (string-match "mailto:\\([^>]+\\)" list-post))
+ (setq list-post (match-string 1 list-post)))
+ (or list-post
+ x-been-there)))
+
;;; Posting styles.
-(defun gnus-configure-posting-styles ()
+(defun gnus-configure-posting-styles (&optional group-name)
"Configure posting styles according to `gnus-posting-styles'."
(unless gnus-inhibit-posting-styles
- (let ((group (or gnus-newsgroup-name ""))
+ (let ((group (or group-name gnus-newsgroup-name ""))
(styles gnus-posting-styles)
style match variable attribute value v results
filep name address element)
;; Regexp string match on the group name.
(string-match match group))
((eq match 'header)
- (let ((header (message-fetch-field (pop style))))
- (and header
- (string-match (pop style) header))))
+ ;; Obsolete format of header match.
+ (and (gnus-buffer-live-p gnus-article-copy)
+ (with-current-buffer gnus-article-copy
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header))))))
((or (symbolp match)
(gnus-functionp match))
(cond
;; Variable to be checked.
(symbol-value match))))
((listp match)
- ;; This is a form to be evaled.
- (eval match)))
+ (cond
+ ((eq (car match) 'header)
+ ;; New format of header match.
+ (and (gnus-buffer-live-p gnus-article-copy)
+ (with-current-buffer gnus-article-copy
+ (let ((header (message-fetch-field (nth 1 match))))
+ (and header
+ (string-match (nth 2 match) header))))))
+ (t
+ ;; This is a form to be evaled.
+ (eval match)))))
;; We have a match, so we set the variables.
(dolist (attribute style)
(setq element (pop attribute)
((listp value)
(eval value))))
;; Translate obsolescent value.
- (when (eq element 'signature-file)
+ (cond
+ ((eq element 'signature-file)
(setq element 'signature
filep t))
+ ((eq element 'x-face-file)
+ (setq element 'x-face
+ filep t)))
;; Get the contents of file elems.
(when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
+ (goto-char (point-max))
+ (while (bolp)
+ (delete-char -1))
(buffer-string))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))
(setq name (assq 'name results)
address (assq 'address results))
(setq results (delq name (delq address results)))
- (make-local-variable 'message-setup-hook)
+ ;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
+ (make-local-hook 'message-setup-hook)
+ (setq results (sort results (lambda (x y)
+ (string-lessp (car x) (car y)))))
(dolist (result results)
(add-hook 'message-setup-hook
(cond
(let ((value ,(cdr result)))
(when value
(message-goto-eoh)
- (insert ,header ": " value "\n"))))))))))
+ (insert ,header ": " value)
+ (unless (bolp)
+ (insert "\n")))))))))
+ nil 'local))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
+ (set (make-local-variable 'user-mail-address)
+ ,(or (cdr address) user-mail-address))
(let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
(save-excursion
(message-remove-header "From")
(message-goto-eoh)
- (insert "From: " (message-make-from) "\n")))))))))
+ (insert "From: " (message-make-from) "\n"))))
+ nil 'local)))))
;;; Allow redefinition of functions.
projects / elisp / gnus.git- / blobdiff