X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=6bf7aaf1402fc659194f79a363eefd5ca86571c3;hb=a3dceb5435f0e48f5b39a10508e3d7d14aa9e8c2;hp=1202bdbfe000860f798921dc2cd1d8c61c3194c1;hpb=9ef3ff2439df2b5f147b53e87bc8852bd999398b;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 1202bdb..6bf7aaf 100644
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -106,7 +106,7 @@ the second with the current group name."
   :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)
@@ -216,7 +216,49 @@ use this option with care."
   "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 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.
 
@@ -303,7 +345,8 @@ 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.
 
@@ -345,6 +388,7 @@ Thank you for your help in stamping out bugs.
 	 (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)
@@ -462,6 +506,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
@@ -491,6 +537,8 @@ network.  The corresponding backend must have a 'request-post method."
   ;; 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
@@ -522,7 +570,9 @@ a news."
 		 (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)
@@ -534,6 +584,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
@@ -563,6 +615,8 @@ network.  The corresponding backend must have a 'request-post method."
   ;; 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
@@ -594,7 +648,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)))
 
 
@@ -620,7 +676,8 @@ 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."
@@ -669,7 +726,10 @@ yanked."
 	    (message-reply-headers
 	     ;; The headers are decoded.
 	     (with-current-buffer gnus-article-copy
-	       (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
@@ -705,7 +765,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)
@@ -723,8 +783,7 @@ post using the current select method."
 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)
@@ -948,7 +1007,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)
@@ -1062,37 +1121,59 @@ 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)))
-      (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-replysign signed)
+	     (mml-secure-message mml-default-sign-method 'sign))
+	    ((and gnus-message-replyencrypt encrypted)
+	     (mml-secure-message mml-default-encrypt-method
+				 (if gnus-message-replysignencrypted
+				     'signencrypt
+				   'encrypt)))))))
 
 (defun gnus-summary-reply-with-original (n &optional wide)
   "Start composing a reply mail to the current message.
@@ -1230,9 +1311,10 @@ forward those articles instead."
 (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.
@@ -1248,6 +1330,56 @@ forward those articles instead."
 	(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."
@@ -1386,7 +1518,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)))))))
 
@@ -1547,15 +1679,14 @@ this is a reply."
   (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.