X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=556bb40e3f86e087b01b29b4983a09a5cc456112;hp=01675ce10c1840a94091f0ec8eb9113585191cb0;hb=bbaa6736e285258f29be9409b7b75751bb847e96;hpb=58315ca8b866eeb281ab091dffdd58068813e9e2 diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 01675ce10..556bb40e3 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,5 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA @@ -33,6 +33,7 @@ (require 'gnus-ems) (require 'message) (require 'gnus-art) +(require 'gnus-util) (defcustom gnus-post-method 'current "*Preferred method for posting USENET news. @@ -66,15 +67,16 @@ current newsgroup name and then returns a suitable group name (or list 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. + "*If non-nil a 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." :group 'gnus-message - :type 'regexp) + :type '(choice (regexp) + (const nil))) (defcustom gnus-add-to-list nil "*If non-nil, add a `to-list' parameter automatically." @@ -115,6 +117,7 @@ the second with the current group name." "*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) @@ -127,6 +130,7 @@ See Info node `(gnus)Posting Styles'." (const signature-file) (const organization) (const address) + (const x-face-file) (const name) (const body) (symbol) @@ -142,28 +146,32 @@ See Info node `(gnus)Posting Styles'." :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 +(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." +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"))) -(defcustom gnus-group-posting-charset-alist +(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 @@ -176,20 +184,26 @@ nil (always encode using quoted-printable) or t (always use 8bit). 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" @@ -202,19 +216,78 @@ use this option with care." :group 'gnus-message :type '(repeat (string :tag "File"))) -(defcustom gnus-debug-exclude-variables - '(mm-mime-mule-charset-alist +(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 :tab "Variable"))) + :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 encrypted 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) ;;; 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) @@ -245,11 +318,7 @@ Thank you for your help in stamping out bugs. ") (eval-and-compile - (autoload 'gnus-uu-post-news "gnus-uu" nil t) - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'rmail-dont-reply-to "mail-utils") - (autoload 'rmail-output "rmailout")) + (autoload 'gnus-uu-post-news "gnus-uu" nil t)) ;;; @@ -285,19 +354,27 @@ Thank you for your help in stamping out bugs. (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 (articles) + `(lambda () + (gnus-inews-make-draft-meta-information + ,gnus-newsgroup-name ',articles))) + (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 gnus-article-reply) + (,yanked gnus-article-yanked-articles) (,group gnus-newsgroup-name) (message-header-setup-hook (copy-sequence message-header-setup-hook)) @@ -314,13 +391,26 @@ Thank you for your help in stamping out bugs. ;; added an optional argument to `gnus-configure-posting-styles' to ;; make sure that the correct value for the group name is used. -- drv (add-hook 'message-mode-hook - (lambda () - (gnus-configure-posting-styles ,group))) + (if (memq ,config '(reply-yank reply)) + (lambda () + (gnus-configure-posting-styles ,group)) + (lambda () + ;; There may be an old " *gnus article copy*" buffer. + (let (gnus-article-copy) + (gnus-configure-posting-styles ,group))))) + (gnus-pull ',(intern gnus-draft-meta-information-header) + message-required-headers) + (when (and ,group + (not (string= ,group ""))) + (push (cons + (intern gnus-draft-meta-information-header) + (gnus-inews-make-draft ,yanked)) + message-required-headers)) (unwind-protect (progn ,@forms) - (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config) - (gnus-inews-insert-draft-meta-information ,group ,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)) @@ -330,31 +420,32 @@ Thank you for your help in stamping out bugs. (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) + (gnus-make-local-hook 'kill-buffer-hook) + (gnus-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))) + (message-hide-headers) (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) - (save-excursion - (when (and group - (not (string= group "")) - (not (message-fetch-field gnus-draft-meta-information-header))) - (goto-char (point-min)) - (insert gnus-draft-meta-information-header ": (\"" group "\" " - (if article (number-to-string - (if (listp article) - (car article) - article)) "\"\"") - ")\n")))) +(defun gnus-inews-make-draft-meta-information (group articles) + (when (numberp articles) + (setq articles (list articles))) + (concat "(\"" group "\" " + (if articles + (mapconcat + (lambda (elem) + (number-to-string + (if (consp elem) + (car elem) + elem))) + articles " ") + "") + ")")) ;;;###autoload (defun gnus-msg-mail (&optional to subject other-headers continue @@ -411,34 +502,43 @@ Gcc: header for archiving purposes." (while (setq elem (pop alist)) (when (or (and (stringp (car elem)) (string-match (car elem) group)) - (and (gnus-functionp (car elem)) + (and (functionp (car elem)) (funcall (car elem) group)) (and (symbolp (car elem)) (symbol-value (car elem)))) (throw 'found (cons (cadr elem) (caddr elem))))))))) -(defun gnus-inews-add-send-actions (winconf buffer article &optional config) - (make-local-hook 'message-sent-hook) +(defun gnus-inews-add-send-actions (winconf buffer article + &optional config yanked) + (gnus-make-local-hook 'message-sent-hook) (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) + (gnus-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 - (if (eq config 'forward) - `(gnus-summary-mark-article-as-forwarded ',article) - `(gnus-summary-mark-article-as-replied ',article))))) - 'send)) + (set-window-configuration ,winconf)) + 'exit 'postpone 'kill) + (let ((to-be-marked (cond + (yanked + (mapcar + (lambda (x) (if (listp x) (car x) x)) 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)) @@ -453,6 +553,8 @@ If ARG is 1, prompt for a group name to find the posting style." ;; 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 @@ -477,11 +579,13 @@ 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." +network. The corresponding back end must have a 'request-post method." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -513,8 +617,11 @@ a news." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) (gnus-group-group-name)) - ""))) - (gnus-post-news 'post gnus-newsgroup-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. @@ -525,6 +632,8 @@ posting style." ;; 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 @@ -549,11 +658,13 @@ 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." +network. The corresponding back end must have a 'request-post method." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. (let ((group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) (buffer (current-buffer))) (unwind-protect (progn @@ -567,7 +678,12 @@ network. The corresponding backend must have a 'request-post method." gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv (gnus-setup-message 'message - (message-news (gnus-group-real-name gnus-newsgroup-name)))) + (progn + (message-news (gnus-group-real-name gnus-newsgroup-name)) + (set (make-local-variable 'gnus-discouraged-post-methods) + (remove + (car (gnus-find-method-for-group gnus-newsgroup-name)) + gnus-discouraged-post-methods))))) (save-excursion (set-buffer buffer) (setq gnus-newsgroup-name group))))) @@ -585,7 +701,9 @@ a news." (completing-read "Newsgroup: " gnus-active-hashtb nil (gnus-read-active-file-p)) "") - gnus-newsgroup-name))) + gnus-newsgroup-name)) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy)) (gnus-post-news 'post gnus-newsgroup-name))) @@ -594,8 +712,7 @@ a news." If prefix argument YANK is non-nil, the original article is yanked automatically. YANK is a list of elements, where the car of each element is the -article number, and the two following numbers is the region to be -yanked." +article number, and the cdr is the string to be yanked." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) @@ -611,10 +728,13 @@ yanked." ;; 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." + "Compose a followup to an article and include the original article. +The text in the region will be yanked. If the region isn't +active, the entire article will be yanked." (interactive "P") (gnus-summary-followup (gnus-summary-work-articles n) force-news)) @@ -646,7 +766,9 @@ yanked." (message-reply-headers ;; The headers are decoded. (with-current-buffer gnus-article-copy - (nnheader-parse-head t)))) + (save-restriction + (nnheader-narrow-to-headers) + (nnheader-parse-naked-head))))) (message-yank-original) (setq beg (or beg (mark t)))) (when articles @@ -663,7 +785,7 @@ post using the current select method." (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) @@ -729,6 +851,7 @@ header line with the old Message-ID." (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)) @@ -738,12 +861,16 @@ header line with the old Message-ID." (goto-char (point-min)) (while (looking-at message-unix-mail-delimiter) (forward-line 1)) - (setq beg (point) - end (or (message-goto-body) beg)) + (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) - (delete-region (goto-char (point-min)) - (or (message-goto-body) (point-max))) + (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. @@ -758,6 +885,7 @@ header line with the old Message-ID." (when article-buffer (gnus-copy-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) @@ -788,7 +916,9 @@ header line with the old Message-ID." (not to-address))) ;; This is news. (if post - (message-news (or to-group group)) + (message-news + (or to-group + (and (not (gnus-virtual-group-p pgroup)) group))) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) (message-followup (if (or newsgroup-p force-news) @@ -816,7 +946,7 @@ header line with the old Message-ID." (gnus-inews-yank-articles yank)))))) (defun gnus-msg-treat-broken-reply-to (&optional force) - "Remove the Reply-to header iff broken-reply-to." + "Remove the Reply-to header if broken-reply-to." (when (or force (gnus-group-find-parameter gnus-newsgroup-name 'broken-reply-to)) @@ -890,7 +1020,7 @@ If SILENT, don't prompt the user." method-alist)))) ;; Override normal method. ((and (eq gnus-post-method 'current) - (not (eq (car group-method) 'nndraft)) + (not (memq (car group-method) gnus-discouraged-post-methods)) (gnus-get-function group-method 'request-post t)) (assert (not arg)) group-method) @@ -903,33 +1033,21 @@ If SILENT, don't prompt the user." -;; Dummies to avoid byte-compile warning. -(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) - " (" system-configuration ")")) - ((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 ", " system-configuration ")") - ""))) - (t emacs-version)))) + (let* ((float-output-format nil) + (gnus-v + (concat "Gnus/" + (prin1-to-string (gnus-continuum-version gnus-version) t) + " (" gnus-version ")")) + (emacs-v (gnus-emacs-version))) + (if (stringp gnus-user-agent) + gnus-user-agent + (concat gnus-v + (when emacs-v + (concat " " emacs-v)))))) ;;; @@ -947,38 +1065,68 @@ If VERY-WIDE, make a very wide reply." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - (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-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) + ;; 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. @@ -1015,7 +1163,8 @@ automatically." (defun gnus-summary-wide-reply-with-original (n) "Start composing a wide reply mail to the current message. -The original article will be yanked." +The original article will be yanked. +Uses the process/prefix convention." (interactive "P") (gnus-summary-reply-with-original n t)) @@ -1048,40 +1197,49 @@ If POST, post instead of mail. For the `inline' alternatives, also see the variable `message-forward-ignored-headers'." (interactive "P") - (if (null (cdr (gnus-summary-work-articles nil))) - (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-setup-message 'forward - (gnus-summary-select-article) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) - (set-buffer gnus-original-article-buffer) - (message-forward post))))) - (gnus-uu-digest-mail-forward arg 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 - (list (message-read-from-minibuffer + (list (message-read-from-minibuffer "Resend message(s) to: " - (when (gnus-buffer-live-p gnus-original-article-buffer) + (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. @@ -1097,6 +1255,35 @@ For the `inline' alternatives, also see the variable (message-resend address)) (gnus-summary-mark-article-as-forwarded article)))) +;; From: Matthieu Moy +(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)) + (when (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. See `gnus-summary-mail-forward' for ARG." @@ -1190,7 +1377,7 @@ The current group name will be inserted at \"%s\".") ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! (when (gnus-y-or-n-p - (format "Do you want to add this as `to-list': %s " to-address)) + (format "Do you want to add this as `to-list': %s? " to-address)) (gnus-group-add-parameter group (cons 'to-list to-address)))))) (defun gnus-put-message () @@ -1203,7 +1390,7 @@ The current group name will be inserted at \"%s\".") (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) - (when (gnus-gethash group gnus-newsrc-hashtb) + (when (gnus-group-entry group) (error "No such group: %s" group)) (save-excursion (save-restriction @@ -1215,7 +1402,9 @@ The current group name will be inserted at \"%s\".") 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) @@ -1235,7 +1424,7 @@ If YANK is non-nil, include the original article." (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))))))) @@ -1288,8 +1477,7 @@ If YANK is non-nil, include the original article." (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) current-prefix-arg)) (gnus-summary-iterate n - (let ((gnus-display-mime-function nil) - (gnus-inhibit-treatment t)) + (let ((gnus-inhibit-treatment t)) (gnus-summary-select-article)) (save-excursion (set-buffer buffer) @@ -1332,17 +1520,15 @@ The source file has to be in the Emacs load path." (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 + (gnus-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)))))) (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) (insert "\n\n") @@ -1358,7 +1544,7 @@ The source file has to be in the Emacs load path." (defun gnus-summary-resend-bounced-mail (&optional fetch) "Re-mail the current message. -This only makes sense if the current message is a bounce message than +This only makes sense if the current message is a bounce message that contains some mail you have written which has been bounced back to you. If FETCH, try to fetch the article that this is a reply to, if indeed @@ -1455,14 +1641,21 @@ this is a reply." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (setq group-art - (gnus-request-accept-article group method t t)) + (when (or (not (gnus-check-backend-function + 'request-accept-article group)) + (not (setq group-art + (gnus-request-accept-article + group method t t)))) (gnus-message 1 "Couldn't store article in group %s: %s" - group (gnus-status-message method)) - (sit-for 2)) - (when (and group-art + group (gnus-status-message method))) + (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)) + (and + (boundp 'gnus-inews-mark-gcc-as-read) + (symbol-value 'gnus-inews-mark-gcc-as-read)))) (gnus-group-mark-article-read group (cdr group-art))) (kill-buffer (current-buffer))))))))) @@ -1473,14 +1666,21 @@ this is a reply." (message-narrow-to-headers) (let* ((group gnus-outgoing-message-group) (gcc (cond - ((gnus-functionp group) + ((functionp group) (funcall group)) ((or (stringp group) (list 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) @@ -1507,7 +1707,7 @@ this is a reply." ((and (listp var) (stringp (car var))) ;; A list of groups. var) - ((gnus-functionp var) + ((functionp var) ;; A function. (funcall var group)) (t @@ -1520,7 +1720,7 @@ this is a reply." ;; Regexp. (when (string-match (caar var) group) (cdar var))) - ((gnus-functionp (car var)) + ((functionp (car var)) ;; Function. (funcall (car var) group)) (t @@ -1541,23 +1741,43 @@ this is a reply." (progn (insert (if (stringp gcc-self-val) - gcc-self-val - group)) + (if (string-match " " gcc-self-val) + (concat "\"" gcc-self-val "\"") + gcc-self-val) + ;; In nndoc groups, we use the parent group name + ;; instead of the current group. + (let ((group (or (gnus-group-find-parameter + gnus-newsgroup-name 'parent-group) + group))) + (if (string-match " " group) + (concat "\"" group "\"") + group)))) (if (not (eq gcc-self-val 'none)) (insert "\n") - (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 (&optional group-name) @@ -1565,7 +1785,7 @@ this is a reply." (unless gnus-inhibit-posting-styles (let ((group (or group-name gnus-newsgroup-name "")) (styles gnus-posting-styles) - style match variable attribute value v results + style match attribute value v results filep name address element) ;; If the group has a posting-style parameter, add it at the end with a ;; regexp matching everything, to be sure it takes precedence over all @@ -1590,9 +1810,9 @@ this is a reply." (and header (string-match (pop style) header)))))) ((or (symbolp match) - (gnus-functionp match)) + (functionp match)) (cond - ((gnus-functionp match) + ((functionp match) ;; Function to be called. (funcall match)) ((boundp match) @@ -1613,7 +1833,6 @@ this is a reply." ;; We have a match, so we set the variables. (dolist (attribute style) (setq element (pop attribute) - variable nil filep nil) (setq value (cond @@ -1630,21 +1849,28 @@ this is a reply." ((stringp value) value) ((or (symbolp value) - (gnus-functionp value)) - (cond ((gnus-functionp value) + (functionp value)) + (cond ((functionp value) (funcall value)) ((boundp value) (symbol-value value)))) ((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)))) @@ -1652,8 +1878,9 @@ this is a reply." (setq name (assq 'name results) address (assq 'address results)) (setq results (delq name (delq address results))) - ;; make-local-hook is not obsolete in Emacs 20 or XEmacs. - (make-local-hook 'message-setup-hook) + (gnus-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 @@ -1685,7 +1912,9 @@ this is a reply." (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 @@ -1707,4 +1936,5 @@ this is a reply." (provide 'gnus-msg) +;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b ;;; gnus-msg.el ends here