X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=1952a4fae68a606465c7589361a2fcde67555712;hb=789f295cf95c5affbfab4c9b81b38199809a3593;hp=630388004c46ff83bf9641f684cd3dc05834596d;hpb=542b408bd421ccbecca1e37bca351c475a14ad1e;p=gnus

diff --git a/lisp/message.el b/lisp/message.el
index 630388004..1952a4fae 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,7 +1,7 @@
 ;;; message.el --- composing mail and news messages
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
@@ -583,7 +583,13 @@ Done before generating the new subject of a forward."
   :version "22.1"
   :group 'message-insertion
   :link '(custom-manual "(message)Insertion Variables")
-  :type 'regexp)
+  :type 'regexp
+  :set (lambda (symbol value)
+	 (prog1
+	     (custom-set-default symbol value)
+	   (if (boundp 'gnus-message-cite-prefix-regexp)
+	       (setq gnus-message-cite-prefix-regexp
+		     (concat "^\\(?:" value "\\)"))))))
 
 (defcustom message-cancel-message "I am canceling my own article.\n"
   "Message to be inserted in the cancel message."
@@ -761,6 +767,14 @@ If this is nil, use `user-mail-address'.  If it is the symbol
   :link '(custom-manual "(message)Mail Variables")
   :group 'message-sending)
 
+(defcustom message-sendmail-extra-arguments nil
+  "Additional arguments to `sendmail-program'."
+  ;; E.g. '("-a" "account") for msmtp
+  :version "23.0" ;; No Gnus
+  :type '(repeat string)
+  ;; :link '(custom-manual "(message)Mail Variables")
+  :group 'message-sending)
+
 ;; qmail-related stuff
 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
   "Location of the qmail-inject program."
@@ -1571,10 +1585,16 @@ functionality to work."
 
 (defcustom message-generate-hashcash (if (executable-find "hashcash") t)
   "*Whether to generate X-Hashcash: headers.
+If `t', always generate hashcash headers.  If `opportunistic',
+only generate hashcash headers if it can be done without the user
+waiting (i.e., only asynchronously).
+
 You must have the \"hashcash\" binary installed, see `hashcash-path'."
   :group 'message-headers
   :link '(custom-manual "(message)Mail Headers")
-  :type 'boolean)
+  :type '(choice (const :tag "Always" t)
+		 (const :tag "Never" nil)
+		 (const :tag "Opportunistic" opportunistic)))
 
 ;;; Internal variables.
 
@@ -1689,7 +1709,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (defvar message-send-mail-real-function nil
   "Internal send mail function.")
 
-(defvar message-bogus-system-names "^localhost\\."
+(defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
   "The regexp of bogus system names.")
 
 (defcustom message-valid-fqdn-regexp
@@ -1898,72 +1918,93 @@ see `message-narrow-to-headers-or-head'."
       (substring subject (match-end 0))
     subject))
 
+(defcustom message-replacement-char "."
+  "Replacement character used instead of unprintable or not decodable chars."
+  :group 'message-various
+  :version "22.1" ;; Gnus 5.10.9
+  :type '(choice string
+		 (const ".")
+		 (const "?")))
+
+;; FIXME: We also should call `message-strip-subject-encoded-words'
+;; when forwarding.  Probably in `message-make-forward-subject' and
+;; `message-forward-make-body'.
+
 (defun message-strip-subject-encoded-words (subject)
   "Fix non-decodable words in SUBJECT."
   ;; Cf. `gnus-simplify-subject-fully'.
-  (let ((case-fold-search t)
-	(replacement-chars (format "[%s%s%s]"
-				   message-replacement-char
-				   message-replacement-char
-				   message-replacement-char))
-	(have-marker
-	 (with-temp-buffer
-	   (insert subject)
-	   (goto-char (point-min))
-	   (search-forward "=?" nil t)))
-	;; (subj-encoded (rfc2047-encode-string subject))
-	;; (encodable (rfc2047-encodable-p))
-	cs-string cs-coding q-or-b ;; word rest
-	word-beg word-end)
-    (if (not have-marker)
+  (let* ((case-fold-search t)
+	 (replacement-chars (format "[%s%s%s]"
+				    message-replacement-char
+				    message-replacement-char
+				    message-replacement-char))
+	 (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)")
+	 cs-string
+	 (have-marker
+	  (with-temp-buffer
+	    (insert subject)
+	    (goto-char (point-min))
+	    (when (re-search-forward enc-word-re nil t)
+	      (setq cs-string (match-string 1)))))
+	 cs-coding q-or-b word-beg word-end)
+    (if (or (not have-marker) ;; No encoded word found...
+	    ;; ... or double encoding was correct:
+	    (and (stringp cs-string)
+		 (setq cs-string (downcase cs-string))
+		 (mm-coding-system-p (intern cs-string))
+		 (not (prog1
+			  (y-or-n-p
+			   (format "\
+Decoded Subject \"%s\"
+contains a valid encoded word.  Decode again? "
+				   subject))
+			(setq cs-coding (intern cs-string))))))
 	subject
       (with-temp-buffer
 	(insert subject)
 	(goto-char (point-min))
-	(while (re-search-forward
-		"=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)" nil t)
+	(while (re-search-forward enc-word-re nil t)
 	  (setq cs-string (downcase (match-string 1))
 		q-or-b    (match-string 2)
-		;; text      (match-string 3)
-		;; rest      (match-string 4)
 		word-beg (match-beginning 0)
 		word-end (match-end 0))
-	  (if (and (mm-coding-system-p (intern cs-string))
-		   (y-or-n-p
-		    (format
-		     "Double encoded subject?  Decode using charset %s? "
-		     cs-string)))
-	      (setq cs-coding (intern cs-string))
+	  (setq cs-coding
+		(if (mm-coding-system-p (intern cs-string))
+		    (setq cs-coding (intern cs-string))
+		  nil))
+	  ;; No double encoded subject? => bogus charset.
+	  (unless cs-coding
 	    (setq cs-coding
 		  (mm-read-coding-system
-		   ;; Would DEFAULT-CODING-SYSTEM make sense?
 		   (format "\
-Given charset `%s' in Subject is bogus.  Hit RET to replace
-non-decodable characters with \"%s\" or enter replacement charset: "
-			   cs-string message-replacement-char))))
-	  (if cs-coding
-	      (replace-match (concat "=?" (symbol-name cs-coding)
-				     "?\\2?\\3\\4\\5"))
-	    (save-excursion
-	      (goto-char word-beg)
-	      (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
-	      (replace-match "")
-	      ;; QP or base64
-	      (if (string-match "\\`Q\\'" q-or-b)
-		  ;; QP
-		  (progn
-		    (message "Replacing non-decodable characters with \"%s\"."
-			     message-replacement-char)
-		    (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+"
-					      word-end t)
-		      (replace-match message-replacement-char)))
-		;; base64
-		(message "Replacing non-decodable characters with \"%s\"."
-			 replacement-chars)
-		(re-search-forward "[^?]+" word-end t)
-		(replace-match replacement-chars))
-	      (re-search-forward "\\?=")
-	      (replace-match ""))))
+Decoded Subject \"%s\"
+contains an encoded word.  The charset `%s' is unknown or invalid.
+Hit RET to replace non-decodable characters with \"%s\" or enter replacement
+charset: "
+			   subject cs-string message-replacement-char)))
+	    (if cs-coding
+		(replace-match (concat "=?" (symbol-name cs-coding)
+				       "?\\2?\\3\\4\\5"))
+	      (save-excursion
+		(goto-char word-beg)
+		(re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
+		(replace-match "")
+		;; QP or base64
+		(if (string-match "\\`Q\\'" q-or-b)
+		    ;; QP
+		    (progn
+		      (message "Replacing non-decodable characters with \"%s\"."
+			       message-replacement-char)
+		      (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+"
+						word-end t)
+			(replace-match message-replacement-char)))
+		  ;; base64
+		  (message "Replacing non-decodable characters with \"%s\"."
+			   replacement-chars)
+		  (re-search-forward "[^?]+" word-end t)
+		  (replace-match replacement-chars))
+		(re-search-forward "\\?=")
+		(replace-match "")))))
 	(rfc2047-decode-region (point-min) (point-max))
 	(buffer-string)))))
 
@@ -3911,14 +3952,6 @@ not have PROP."
 	(setq start next)))
     (nreverse regions)))
 
-(defcustom message-replacement-char "."
-  "Replacement character used instead of unprintable or not decodable chars."
-  :group 'message-various
-  :version "23.0" ;; No Gnus
-  :type '(choice string
-		 (const ".")
-		 (const "?")))
-
 (defun message-fix-before-sending ()
   "Do various things to make the message nice before sending it."
   ;; Make sure there's a newline at the end of the message.
@@ -4107,7 +4140,8 @@ not have PROP."
 	      (gnus-setup-posting-charset nil)
 	    message-posting-charset))
 	 (headers message-required-mail-headers))
-    (when message-generate-hashcash
+    (when (and message-generate-hashcash
+	       (not (eq message-generate-hashcash 'opportunistic)))
       (message "Generating hashcash...")
       ;; Wait for calculations already started to finish...
       (hashcash-wait-async)
@@ -4269,6 +4303,7 @@ If you always want Gnus to send messages in one piece, set
 				     "/usr/ucblib/sendmail")
 				    (t "fakemail"))
 			      nil errbuf nil "-oi")
+			message-sendmail-extra-arguments
 			;; Always specify who from,
 			;; since some systems have broken sendmails.
 			;; But some systems are more broken with -f, so
@@ -5166,14 +5201,14 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 	   (concat message-user-path "!" login-name))
 	  (t login-name))))
 
-(defun message-make-from ()
+(defun message-make-from (&optional name address )
   "Make a From header."
   (let* ((style message-from-style)
-	 (login (message-make-address))
-	 (fullname
-	  (or (and (boundp 'user-full-name)
-		   user-full-name)
-	      (user-full-name))))
+	 (login (or address (message-make-address)))
+	 (fullname (or name
+		       (and (boundp 'user-full-name)
+			    user-full-name)
+		       (user-full-name))))
     (when (string= fullname "&")
       (setq fullname (user-login-name)))
     (with-temp-buffer
@@ -5268,8 +5303,8 @@ give as trustworthy answer as possible."
 	   (stringp message-user-fqdn)
 	   (string-match message-valid-fqdn-regexp message-user-fqdn)
 	   (not (string-match message-bogus-system-names message-user-fqdn)))
+      ;; `message-user-fqdn' seems to be valid
       message-user-fqdn)
-     ;; `message-user-fqdn' seems to be valid
      ((and (string-match message-valid-fqdn-regexp system-name)
 	   (not (string-match message-bogus-system-names system-name)))
       ;; `system-name' returned the right result.
@@ -6065,7 +6100,7 @@ OTHER-HEADERS is an alist of header/value pairs."
 
 (defun message-get-reply-headers (wide &optional to-address address-headers)
   (let (follow-to mct never-mct to cc author mft recipients extra)
-    ;; Find all relevant headers we need.
+  ;; Find all relevant headers we need.
     (save-restriction
       (message-narrow-to-headers-or-head)
       ;; Gmane renames "To".  Look at "Original-To", too, if it is present in
@@ -6773,6 +6808,62 @@ Optional DIGEST will use digest to forward."
       (message-forward-make-body-digest-mime forward-buffer)
     (message-forward-make-body-digest-plain forward-buffer)))
 
+(eval-and-compile
+  (autoload 'mm-uu-dissect-text-parts "mm-uu")
+  (autoload 'mm-uu-dissect "mm-uu"))
+
+(defun message-signed-or-encrypted-p (&optional dont-emulate-mime handles)
+  "Say whether the current buffer contains signed or encrypted message.
+If DONT-EMULATE-MIME is nil, this function does the MIME emulation on
+messages that don't conform to PGP/MIME described in RFC2015.  HANDLES
+is for the internal use."
+  (unless handles
+    (let ((mm-decrypt-option 'never)
+	  (mm-verify-option 'never))
+      (if (setq handles (mm-dissect-buffer nil t))
+	  (unless dont-emulate-mime
+	    (mm-uu-dissect-text-parts handles))
+	(unless dont-emulate-mime
+	  (setq handles (mm-uu-dissect))))))
+  ;; Check text/plain message in which there is a signed or encrypted
+  ;; body that has been encoded by B or Q.
+  (unless (or handles dont-emulate-mime)
+    (let ((cur (current-buffer))
+	  (mm-decrypt-option 'never)
+	  (mm-verify-option 'never))
+      (with-temp-buffer
+	(insert-buffer-substring cur)
+	(when (setq handles (mm-dissect-buffer t t))
+	  (if (and (prog1
+		       (bufferp (car handles))
+		     (mm-destroy-parts handles))
+		   (equal (mm-handle-media-type handles) "text/plain"))
+	      (progn
+		(mm-decode-content-transfer-encoding
+		 (mm-handle-encoding handles))
+		(setq handles (mm-uu-dissect)))
+	    (setq handles nil))))))
+  (when handles
+    (prog1
+	(catch 'found
+	  (dolist (handle (if (stringp (car handles))
+			      (if (member (car handles)
+					  '("multipart/signed"
+					    "multipart/encrypted"))
+				  (throw 'found t)
+				(cdr handles))
+			    (list handles)))
+	    (if (stringp (car handle))
+		(when (message-signed-or-encrypted-p dont-emulate-mime handle)
+		  (throw 'found t))
+	      (when (and (bufferp (car handle))
+			 (equal (mm-handle-media-type handle)
+				"message/rfc822"))
+		(with-current-buffer (mm-handle-buffer handle)
+		  (when (message-signed-or-encrypted-p dont-emulate-mime)
+		    (throw 'found t)))))))
+      (mm-destroy-parts handles))))
+
 ;;;###autoload
 (defun message-forward-make-body (forward-buffer &optional digest)
   ;; Put point where we want it before inserting the forwarded
@@ -6785,11 +6876,13 @@ Optional DIGEST will use digest to forward."
     (if message-forward-as-mime
 	(if (and message-forward-show-mml
 		 (not (and (eq message-forward-show-mml 'best)
+			   ;; Use the raw form in the body if it contains
+			   ;; signed or encrypted message so as not to be
+			   ;; destroyed by re-encoding.
 			   (with-current-buffer forward-buffer
-			     (goto-char (point-min))
-			     (re-search-forward
-			      "Content-Type: *multipart/\\(signed\\|encrypted\\)"
-			      nil t)))))
+			     (condition-case nil
+				 (message-signed-or-encrypted-p)
+			       (error t))))))
 	    (message-forward-make-body-mml forward-buffer)
 	  (message-forward-make-body-mime forward-buffer))
       (message-forward-make-body-plain forward-buffer)))