;;; gnus-msg.el --- mail and post interface for Semi-gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
"*Preferred method for posting USENET news.
If this variable is `current' (which is the default), Gnus will use
-the \"current\" select method when posting. If it is nil, Gnus will
-use the native select method when posting.
+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)
+ :link '(custom-manual "(gnus)Posting Server")
+ :type `(choice (const native)
(const current)
- (const native)
(sexp :tag "Methods" ,gnus-select-method)))
(defcustom gnus-outgoing-message-group nil
of names)."
:group 'gnus-message
:type '(choice (string :tag "Group")
- (function)))
+ (function)))
(defcustom gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
:group 'gnus-message
:type 'string)
-(defcustom gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
+(defcustom gnus-message-setup-hook nil
"Hook run after setting up a message buffer."
:group 'gnus-message
:type 'hook)
:type 'boolean)
(defcustom gnus-posting-styles nil
- "*Alist of styles to use when posting."
+ "*Alist of styles to use when posting.
+See Info node `(gnus)Posting Styles'."
:group 'gnus-message
:type '(repeat (cons (choice (regexp)
- (function)
(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-inews-mark-gcc-as-read nil
+(defvar gnus-named-posting-styles nil
+ "Alist mapping names to the user-defined posting styles.")
+
+(defcustom gnus-gcc-mark-as-read nil
"If non-nil, automatically mark Gcc articles as read."
+ :version "21.1"
:group 'gnus-message
:type 'boolean)
-(defcustom gnus-group-posting-charset-alist
- '(("^\\(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))
- "Alist of regexps and permitted unencoded charsets for posting.
+(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
variable to query,
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" "nntp.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 replys to signed messages.
+See also the `mml-default-sign-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+ nil
+ "Automatically encrypt replys 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."
+ :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)
;;; Internal variables.
(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
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
"Om" gnus-summary-digest-mail-forward
- "Op" gnus-summary-digest-post-forward)
+ "Op" gnus-summary-digest-post-forward
+ "P" gnus-summary-execute-command-with-posting-style)
(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.
(user-agent . Gnus))))
(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)))
(unwind-protect
(progn
,@forms)
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
+ (gnus-maybe-setup-default-charset)
(gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
+ (run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
(defun gnus-inews-insert-draft-meta-information (group article)
;; 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)))
+
+(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 ((more-than-one (cdr articles))
- (cur (current-buffer))
- refs beg article window)
+ (let (beg article yank-string
+ (more-than-one (cdr articles))
+ (cur (current-buffer))
+ refs window)
(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)
(when (setq window (get-buffer-window cur t))
(select-frame (window-frame window)))))
- (gnus-copy-article-buffer)
+ (gnus-copy-article-buffer nil yank-string)
(let ((message-reply-buffer gnus-article-copy)
(message-reply-headers
+ ;; The headers are decoded.
(with-current-buffer gnus-article-copy
- ;; The headers are decoded.
- (nnheader-parse-head t))))
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (ietf-drums-unfold-fws)
+ (nnheader-parse-head t)))))
(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)
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
(interactive)
- (let ((article (gnus-summary-article-number))
- (gnus-message-setup-hook '(gnus-maybe-setup-default-charset)))
+ (let ((article (gnus-summary-article-number)))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
(set-buffer gnus-original-article-buffer)
\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
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
+ (save-excursion
+ (set-buffer gnus-article-copy)
+ (set-buffer-multibyte t))
(let ((article-buffer (or article-buffer gnus-article-buffer))
end beg)
(if (not (and (get-buffer article-buffer)
;; Copy over the (displayed) article buffer, delete
;; hidden text and remove text properties.
(widen)
- (let ((inhibit-read-only t))
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- ;; Encode bitmap smileys to ordinary text.
- ;; Possibly, the original text might be restored.
- (static-unless (featurep 'xemacs)
- (when (featurep 'smiley-mule)
- (smiley-encode-buffer)))
- (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 'x-face-mule-bitmap-image)
- (insert
- (prog1
- (static-if (featurep 'xemacs)
- ;; Revome smiley extents for (possibly) XEmacs 21.1.
- (format "%s"
- (buffer-substring-no-properties (point-min)
- (point-max)))
- (buffer-substring-no-properties (point-min) (point-max)))
- (erase-buffer))))
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ ;; There's invisible and intangible text in T-gnus. Especially,
+ ;; if there is a boundary line (X-Boundary: ------------------),
+ ;; in the end of a header, it will cause a serious problem.
+ (add-text-properties (point-min) (point-max)
+ '(invisible nil intangible nil))
+ (when yank-string
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert yank-string))
+ ;; Encode bitmap smileys to ordinary text.
+ ;; Possibly, the original text might be restored.
+ (static-unless (featurep 'xemacs)
+ (when (featurep 'smiley-mule)
+ (smiley-encode-buffer)))
+ (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)
+ (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
+ (insert
+ (prog1
+ (static-if (featurep 'xemacs)
+ ;; Revome smiley extents for (possibly) XEmacs 21.1.
+ (format "%s"
+ (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (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 (message-goto-body) beg))
+ (setq beg (point)
+ end (or (message-goto-body) beg))
;; Delete the headers from the displayed articles.
(set-buffer gnus-article-copy)
(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)
- (article-decode-encoded-words))))
+ ;; Decode charsets.
+ (let ((gnus-article-decode-hook
+ (delq 'article-decode-charset
+ (copy-sequence gnus-article-decode-hook))))
+ ;; Needed for T-gnus.
+ (add-hook 'gnus-article-decode-hook
+ 'article-decode-encoded-words)
+ (run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
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)))
;; 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)))
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
(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 (or yank (gnus-summary-article-number)))
- (headers ""))
- (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)))
- (message-reply nil wide)
+ ;; Allow user to require confirmation before replying by mail to the
+ ;; author of a news article.
+ (when (or (not (gnus-news-group-p gnus-newsgroup-name))
+ (not 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)))
+ (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)))
+ (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 nil;;(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.
(gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
(defun gnus-summary-mail-forward (&optional full-headers post)
- "Forward the current message to another user.
-If FULL-HEADERS (the prefix), include full headers when forwarding."
+ "Forward the current message(s) to another user.
+If process marks exist, forward all marked messages;
+If FULL-HEADERS (the prefix), include full headers when forwarding.
+
+Note that this function definition for T-gnus is totally different
+from the original Gnus."
(interactive "P")
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((charset default-mime-charset))
- (set-buffer gnus-original-article-buffer)
- (make-local-variable 'default-mime-charset)
- (setq default-mime-charset charset))
- (let ((message-included-forward-headers
- (if full-headers "" message-included-forward-headers)))
- (message-forward post))))
+ (if (null (cdr (gnus-summary-work-articles nil)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((charset default-mime-charset))
+ (set-buffer gnus-original-article-buffer)
+ (make-local-variable 'default-mime-charset)
+ (setq default-mime-charset charset))
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-forward post)))
+ (gnus-summary-digest-mail-forward nil post)))
(defun gnus-summary-digest-mail-forward (&optional n post)
"Digests and forwards all articles in this series.
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
- (list (message-read-from-minibuffer "Resend message(s) to: ")
+ (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)
(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)
+
+ ;; T-gnus change: Use MIME-Edit to recompose a message.
+ ;;(mime-to-mml)
+ (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+ (fset 'mime-edit-decode-single-part-in-buffer
+ (lambda (&rest args)
+ (if (let ((content-type (car args)))
+ (and (eq 'message (mime-content-type-primary-type
+ content-type))
+ (eq 'rfc822 (mime-content-type-subtype
+ content-type))))
+ (setcar (cdr args) 'not-decode-text))
+ (apply ofn args)))
+ (unwind-protect
+ (mime-edit-again nil t)
+ (fset 'mime-edit-decode-single-part-in-buffer ofn)))
+ (message-narrow-to-head-1)
+ (insert "From: " (message-make-from) "\n")
+ (while (re-search-forward "^From:" nil t)
+ (beginning-of-line)
+ (insert "Original-"))
+ (message-remove-header "^>From[\t ]" t)
+
+ ;; 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 full-headers)
"Forward the current article to a newsgroup.
If FULL-HEADERS (the prefix), include full headers when forwarding."
(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)
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 (and (get-buffer gnus-group-buffer)
(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)))))))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
(let (mime-content-types)
- (mime-edit-insert-tag "text" "plain" "; type=emacs-lisp"))
+ (mime-edit-insert-tag
+ "application" "emacs-lisp"
+ "\nContent-Disposition: inline\nContent-Description: User settings"))
(insert (with-temp-buffer
(gnus-debug)
(buffer-string)))
"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" "nntp.el" "message.el"))
+ (let ((files gnus-debug-files)
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(ignore-errors
(and (memq (car expr) '(defvar defcustom defvoo))
(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)))))
(interactive "P")
(gnus-summary-select-article t)
(set-buffer gnus-original-article-buffer)
- (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset)))
- (gnus-setup-message 'compose-bounce
- (let* ((references (mail-fetch-field "references"))
- (parent (and references (gnus-parent-id references))))
- (message-bounce)
- ;; If there are references, we fetch the article we answered to.
- (and fetch parent
- (gnus-summary-refer-article parent)
- (gnus-summary-show-all-headers))))))
+ (gnus-setup-message 'compose-bounce
+ (let* ((references (mail-fetch-field "references"))
+ (parent (and references (gnus-parent-id references))))
+ (message-bounce)
+ ;; If there are references, we fetch the article we answered to.
+ (and fetch parent
+ (gnus-summary-refer-article parent)
+ (gnus-summary-show-all-headers)))))
;;; Gcc handling.
(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)
+ groups group method group-art
+ mml-externalize-attachments)
(when gcc
(message-remove-header "gcc")
(widen)
(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 message-encoding-buffer)
(gnus-message 1 "Couldn't store article in group %s: %s"
group (gnus-status-message method))
(sit-for 2))
- (when (and group-art gnus-inews-mark-gcc-as-read)
+ (when (and group-art
+ (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)))))))))
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
(kill-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")))))))
;;; 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)
+ ;; 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))))
;; 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)))))
+ ;; Expand all the named elements in style.
+ (setq style (apply (function nconc)
+ (mapcar
+ (lambda (attribute)
+ (if (stringp attribute)
+ (copy-sequence
+ (cdr (assoc attribute
+ gnus-named-posting-styles)))
+ (list attribute)))
+ style)))
;; 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)
(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 "\n"))))))))
+ nil 'local))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
(save-excursion
(message-remove-header "From")
(message-goto-eoh)
- (insert "From: " (message-make-from) "\n")))))))))
+ (insert "From: " (message-make-from) "\n"))))
+ nil 'local)))))
+
+(defun gnus-summary-execute-command-with-posting-style (style command)
+ "Temporarily select a posting-style named STYLE and execute COMMAND."
+ (interactive
+ (let ((style (completing-read "Posting style: "
+ gnus-named-posting-styles nil t)))
+ (list style
+ (key-binding
+ (read-key-sequence
+ (format "Command to execute with %s:" style))))))
+ (let ((gnus-posting-styles (list (list ".*" style))))
+ (call-interactively command)))
;;; @ for MIME Edit mode
projects / elisp / gnus.git- / blobdiff