Revision: [email protected]/emacs--devo--0--patch-62

Merge from gnus--rel--5.10

Patches applied:

 * gnus--rel--5.10  (patch 22-26)

   - Update from CVS
   - Merge from emacs--devo--0

8 files changed, 112 insertions, 62 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 168280e8e2..f7c9732565 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,37 @@
+2006-02-09  Daiki Ueno  <[email protected]>
+
+	* pgg-gpg.el (pgg-gpg-encrypt-region): Don't convert line-endings
+	in elisp.
+	(pgg-gpg-encrypt-symmetric-region): Ditto.
+	(pgg-gpg-sign-region): Ditto.
+
+	* pgg-def.el (pgg-text-mode): New variable.
+
+	* mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode.
+	(mml2015-pgg-encrypt): Ditto.
+
+	* mml1991.el (mml1991-pgg-sign): Enable pgg-text-mode.
+	(mml1991-pgg-encrypt): Ditto.
+
+2006-02-08  Katsumi Yamaoka  <[email protected]>
+
+	* nnfolder.el (nnfolder-insert-newsgroup-line): Use
+	message-make-date instead of current-time-string.
+
+	* mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset
+	to gnus-decoded which mm-uu might set.
+
+2006-02-08  Katsumi Yamaoka  <[email protected]>
+
+	* rfc2231.el (rfc2231-parse-string): Sort segmented parameters;
+	don't decode quoted parameters; remove misimported Emacs code.
+	Suggested by ARISAWA Akihiro <[email protected]>.
+	(rfc2231-decode-encoded-string): Don't use split-string which
+	behaves differently according to Emacs version; use
+	mm-decode-coding-region to convert charset to coding-system.
+	Suggested by ARISAWA Akihiro <[email protected]>.
+	(rfc2231-encode-string): Remove misimported Emacs code.
+
 2006-02-07  Katsumi Yamaoka  <[email protected]>
 
 	* gnus-art.el (article-decode-charset): Don't use ignore-errors
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 73cab0a567..43d6bddf19 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -486,7 +486,8 @@
 	      ;; disable prepare hook
 	      gnus-article-prepare-hook
 	      (gnus-newsgroup-charset
-	       (or charset gnus-newsgroup-charset)))
+	       (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
+		 (or charset gnus-newsgroup-charset))))
 	  (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
 	    (run-hooks 'gnus-article-decode-hook))
 	  (gnus-article-prepare-display)
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 761ce4f0af..0c6bb67538 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -229,7 +229,8 @@
   (defvar pgg-output-buffer))
 
 (defun mml1991-pgg-sign (cont)
-  (let (headers cte)
+  (let ((pgg-text-mode t)
+	headers cte)
     ;; Don't sign headers.
     (goto-char (point-min))
     (while (not (looking-at "^$"))
@@ -261,7 +262,8 @@
     t))
 
 (defun mml1991-pgg-encrypt (cont &optional sign)
-  (let (cte)
+  (let ((pgg-text-mode t)
+	cte)
     ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
     (goto-char (point-min))
     (while (looking-at "^Content[^ ]+:")
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index cb9e77983d..80dd5b2659 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -814,6 +814,7 @@
 	(boundary (mml-compute-boundary cont))
 	(pgg-default-user-id (or (message-options-get 'mml-sender)
 				 pgg-default-user-id))
+	(pgg-text-mode t)
 	entry)
     (unless (pgg-sign-region (point-min) (point-max))
       (pop-to-buffer mml2015-result-buffer)
@@ -841,6 +842,7 @@
 
 (defun mml2015-pgg-encrypt (cont &optional sign)
   (let ((pgg-errors-buffer mml2015-result-buffer)
+	(pgg-text-mode t)
 	(boundary (mml-compute-boundary cont)))
     (unless (pgg-encrypt-region (point-min) (point-max)
 				(split-string
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index c7043011fa..bd9957283f 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -826,7 +826,7 @@ deleted.  Point is left where the deleted region was."
       (insert "\n"))
     (forward-char -1)
     (insert (format (concat nnfolder-article-marker "%d   %s\n")
-		    (cdr group-art) (current-time-string)))))
+		    (cdr group-art) (message-make-date)))))
 
 (defun nnfolder-active-number (group)
   ;; Find the next article number in GROUP.
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index 31c9f1ade9..7b4cf2447f 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -52,14 +52,8 @@ function fails in parsing of parameters."
     (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
 	  (stoken (ietf-drums-token-to-list ietf-drums-tspecials))
 	  (ntoken (ietf-drums-token-to-list "0-9"))
-	  (prev-value "")
-	  display-name mailbox c display-string parameters
-	  attribute value type subtype number encoded
-	  prev-attribute prev-encoded)
-      ;; Some mailer (e.g. Thunderbird 1.5) doesn't terminate each
-      ;; line with semicolon when folding a long parameter value.
-      (while (string-match "\\([^\t\n\r ;]\\)[\t ]*\r?\n[\t ]+" string)
-	(setq string (replace-match "\\1;\n " nil nil string)))
+	  c type attribute encoded number prev-attribute vals
+	  prev-encoded parameters value)
       (ietf-drums-init (mail-header-remove-whitespace
 			(mail-header-remove-comments string)))
       (let ((table (copy-syntax-table ietf-drums-syntax-table)))
@@ -97,31 +91,36 @@ function fails in parsing of parameters."
 			       (point) (progn (forward-sexp 1) (point))))))
 		    (error "Invalid header: %s" string))
 		  (setq c (char-after))
-		  (when (eq c ?*)
-		    (forward-char 1)
-		    (setq c (char-after))
-		    (if (not (memq c ntoken))
-			(setq encoded t
-			      number nil)
-		      (setq number
-			    (string-to-number
-			     (buffer-substring
-			      (point) (progn (forward-sexp 1) (point)))))
-		      (setq c (char-after))
-		      (when (eq c ?*)
-			(setq encoded t)
+		  (if (eq c ?*)
+		      (progn
 			(forward-char 1)
-			(setq c (char-after)))))
+			(setq c (char-after))
+			(if (not (memq c ntoken))
+			    (setq encoded t
+				  number nil)
+			  (setq number
+				(string-to-number
+				 (buffer-substring
+				  (point) (progn (forward-sexp 1) (point)))))
+			  (setq c (char-after))
+			  (when (eq c ?*)
+			    (setq encoded t)
+			    (forward-char 1)
+			    (setq c (char-after)))))
+		    (setq number nil
+			  encoded nil))
 		  ;; See if we have any previous continuations.
 		  (when (and prev-attribute
 			     (not (eq prev-attribute attribute)))
+		    (setq vals
+			  (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
 		    (push (cons prev-attribute
 				(if prev-encoded
-				    (rfc2231-decode-encoded-string prev-value)
-				  prev-value))
+				    (rfc2231-decode-encoded-string vals)
+				  vals))
 			  parameters)
 		    (setq prev-attribute nil
-			  prev-value ""
+			  vals nil
 			  prev-encoded nil))
 		  (unless (eq c ?=)
 		    (error "Invalid header: %s" string))
@@ -132,7 +131,10 @@ function fails in parsing of parameters."
 		    (setq value (buffer-substring (1+ (point))
 						  (progn
 						    (forward-sexp 1)
-						    (1- (point))))))
+						    (1- (point)))))
+		    (when encoded
+		      (setq value (mapconcat (lambda (c) (format "%%%02x" c))
+					     value ""))))
 		   ((and (or (memq c ttoken)
 			     ;; EXTENSION: Support non-ascii chars.
 			     (> c ?\177))
@@ -153,9 +155,10 @@ function fails in parsing of parameters."
 		   (t
 		    (error "Invalid header: %s" string)))
 		  (if number
-		      (setq prev-attribute attribute
-			    prev-value (concat prev-value value)
-			    prev-encoded encoded)
+		      (progn
+			(push (cons number value) vals)
+			(setq prev-attribute attribute
+			      prev-encoded encoded))
 		    (push (cons attribute
 				(if encoded
 				    (rfc2231-decode-encoded-string value)
@@ -164,10 +167,11 @@ function fails in parsing of parameters."
 
 	      ;; Take care of any final continuations.
 	      (when prev-attribute
+		(setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
 		(push (cons prev-attribute
 			    (if prev-encoded
-				(rfc2231-decode-encoded-string prev-value)
-			      prev-value))
+				(rfc2231-decode-encoded-string vals)
+			      vals))
 		      parameters)))
 	  (error
 	   (setq parameters nil)
@@ -181,25 +185,27 @@ function fails in parsing of parameters."
 
 (defun rfc2231-decode-encoded-string (string)
   "Decode an RFC2231-encoded string.
-These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
-  (with-temp-buffer
-    (let ((elems (split-string string "'")))
-      ;; The encoded string may contain zero to two single-quote
-      ;; marks.  This should give us the encoded word stripped
-      ;; of any preceding values.
-      (insert (car (last elems)))
+These look like:
+ \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
+ \"This is ***fun***\"."
+  (string-match "\\`\\(\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string)
+  (let ((coding-system (mm-charset-to-coding-system (match-string 2 string)))
+	;;(language (match-string 3 string))
+	(value (match-string 4 string)))
+    (mm-with-multibyte-buffer
+      (insert value)
       (goto-char (point-min))
       (while (search-forward "%" nil t)
 	(insert
 	 (prog1
 	     (string-to-number (buffer-substring (point) (+ (point) 2)) 16)
 	   (delete-region (1- (point)) (+ (point) 2)))))
-      ;; Encode using the charset, if any.
-      (when (and (mm-multibyte-p)
-		 (> (length elems) 1)
-		 (not (equal (intern (downcase (car elems))) 'us-ascii)))
-	(mm-decode-coding-region (point-min) (point-max)
-				 (intern (downcase (car elems)))))
+      ;; Decode using the charset, if any.
+      (unless (memq coding-system '(nil ascii))
+	(mm-decode-coding-region (point-min) (point-max) coding-system))
       (buffer-string))))
 
 (defun rfc2231-encode-string (param value)
@@ -263,12 +269,12 @@ the result of this function."
 	    (forward-line 1))))
        (spacep
 	(goto-char (point-min))
-	(insert "\n " param "=\"")
+	(insert param "=\"")
 	(goto-char (point-max))
 	(insert "\""))
        (t
 	(goto-char (point-min))
-	(insert "\n " param "=")))
+	(insert param "=")))
       (buffer-string))))
 
 (provide 'rfc2231)
diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el
index 0b356461d6..058dca4fa8 100644
--- a/lisp/pgg-def.el
+++ b/lisp/pgg-def.el
@@ -83,6 +83,9 @@ Whether the passphrase is cached at all is controlled by
 (defvar pgg-scheme nil
   "Current scheme of PGP implementation.")
 
+(defvar pgg-text-mode nil
+  "If t, inform the recipient that the input is text.")
+
 (defmacro pgg-truncate-key-identifier (key)
   `(if (> (length ,key) 8) (substring ,key 8) ,key))
 
diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el
index be9b8bf9e7..0c9f45ab5b 100644
--- a/lisp/pgg-gpg.el
+++ b/lisp/pgg-gpg.el
@@ -87,7 +87,9 @@
 	    (buffer-disable-undo)
 	    (erase-buffer)
 	    (if (file-exists-p output-file-name)
-		(let ((coding-system-for-read 'raw-text-dos))
+		(let ((coding-system-for-read (if pgg-text-mode
+						  'raw-text
+						'binary)))
 		  (insert-file-contents output-file-name)))
 	    (set-buffer errors-buffer)
 	    (if (not (equal exit-status 0))
@@ -187,7 +189,8 @@ passphrase cache or user."
                             pgg-gpg-user-id))))
 	 (args
 	  (append
-	   (list "--batch" "--textmode" "--armor" "--always-trust" "--encrypt")
+	   (list "--batch" "--armor" "--always-trust" "--encrypt")
+	   (if pgg-text-mode (list "--textmode"))
 	   (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
 	   (if recipients
 	       (apply #'nconc
@@ -196,8 +199,7 @@ passphrase cache or user."
 			      (append recipients
 				      (if pgg-encrypt-for-me
 					  (list pgg-gpg-user-id)))))))))
-    (pgg-as-lbt start end 'CRLF
-      (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
     (when sign
       (with-current-buffer pgg-errors-buffer
 	;; Possibly cache passphrase under, e.g. "jas", for future sign.
@@ -215,9 +217,9 @@ passphrase cache or user."
                          (pgg-read-passphrase
                           "GnuPG passphrase for symmetric encryption: ")))
 	 (args
-	  (append (list "--batch" "--textmode" "--armor" "--symmetric" ))))
-    (pgg-as-lbt start end 'CRLF
-      (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+	  (append (list "--batch" "--armor" "--symmetric" )
+		  (if pgg-text-mode (list "--textmode")))))
+    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
     (pgg-process-when-success)))
 
 (defun pgg-gpg-decrypt-region (start end &optional passphrase)
@@ -279,13 +281,13 @@ passphrase cache or user."
                           (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
                           pgg-gpg-user-id)))
 	 (args
-	  (list (if cleartext "--clearsign" "--detach-sign")
-		"--armor" "--batch" "--verbose"
-		"--local-user" pgg-gpg-user-id))
+	  (append (list (if cleartext "--clearsign" "--detach-sign")
+			"--armor" "--batch" "--verbose"
+			"--local-user" pgg-gpg-user-id)
+		  (if pgg-text-mode (list "--textmode"))))
 	 (inhibit-read-only t)
 	 buffer-read-only)
-    (pgg-as-lbt start end 'CRLF
-      (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
     (with-current-buffer pgg-errors-buffer
       ;; Possibly cache passphrase under, e.g. "jas", for future sign.
       (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)