From: yamaoka <yamaoka>
Date: Tue, 31 Oct 2000 04:53:17 +0000 (+0000)
Subject: Synch with Gnus.
X-Git-Tag: t-gnus-6_14-quimby-before-installer-changed-~33
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9ef92bef33ada3844eb20f5e2d1a9db9355ead21;p=elisp%2Fgnus.git-

Synch with Gnus.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d800645..0d46836 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2000-10-30 23:37:07  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+	* qp.el (quoted-printable-encode-region): Replace leading - when
+	ultra safe.
+	* mml.el (mml-generate-mime-postprocess-function): Removed.
+	(mml-postprocess-alist): Removed.
+	(mml-generate-mime-1): Use ultra-safe when sign.
+	* mml2015.el (mml2015-fix-micalg): Uppercase.
+	(mml2015-verify): Insert LF.
+	(mml2015-mailcrypt-sign): Downcase; search backward.
+
 2000-10-16 11:36:52  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* nnultimate.el (nnultimate-forum-table-p): Be a bit more
diff --git a/lisp/mml.el b/lisp/mml.el
index ed8753d..3950474 100644
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -73,27 +73,6 @@ unknown encoding; `use-ascii': always use ASCII for those characters
 with unknown encoding; `multipart': always send messages with more than
 one charsets.")
 
-(defvar mml-generate-mime-preprocess-function nil
-  "A function called before generating a mime part.
-The function is called with one parameter, which is the part to be 
-generated.")
-
-(defvar mml-generate-mime-postprocess-function 'mml-postprocess
-  "A function called after generating a mime part.
-The function is called with one parameter, which is the generated part.")
-
-(autoload 'mml2015-sign "mml2015")
-(autoload 'mml2015-encrypt "mml2015")
-(autoload 'mml-smime-encrypt "mml-smime")
-(autoload 'mml-smime-sign "mml-smime")
-
-(defvar mml-postprocess-alist
-  '(("pgp-sign" . mml2015-sign)
-    ("pgp-encrypt" . mml2015-encrypt)
-    ("smime-sign" . mml-smime-sign)
-    ("smime-encrypt" . mml-smime-encrypt))
-  "Alist of postprocess functions.")
-
 (defvar mml-generate-default-type "text/plain")
 
 (defvar mml-buffer-list nil)
@@ -300,130 +279,128 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 	(buffer-string)))))
 
 (defun mml-generate-mime-1 (cont)
-  (save-restriction
-    (narrow-to-region (point) (point))
-    (if mml-generate-mime-preprocess-function
-	(funcall mml-generate-mime-preprocess-function cont))
-    (cond
-     ((or (eq (car cont) 'part) (eq (car cont) 'mml))
-      (let ((raw (cdr (assq 'raw cont)))
-	    coded encoding charset filename type)
-	(setq type (or (cdr (assq 'type cont)) "text/plain"))
-	(if (and (not raw)
-		 (member (car (split-string type "/")) '("text" "message")))
-	    (with-temp-buffer
+  (let ((mm-use-ultra-safe-encoding 
+	 (or mm-use-ultra-safe-encoding (assq 'sign cont))))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (cond
+       ((or (eq (car cont) 'part) (eq (car cont) 'mml))
+	(let ((raw (cdr (assq 'raw cont)))
+	      coded encoding charset filename type)
+	  (setq type (or (cdr (assq 'type cont)) "text/plain"))
+	  (if (and (not raw)
+		   (member (car (split-string type "/")) '("text" "message")))
+	      (with-temp-buffer
+		(cond
+		 ((cdr (assq 'buffer cont))
+		  (insert-buffer-substring (cdr (assq 'buffer cont))))
+		 ((and (setq filename (cdr (assq 'filename cont)))
+		       (not (equal (cdr (assq 'nofile cont)) "yes")))
+		  (mm-insert-file-contents filename))
+		 ((eq 'mml (car cont))
+		  (insert (cdr (assq 'contents cont))))
+		 (t
+		  (save-restriction
+		    (narrow-to-region (point) (point))
+		    (insert (cdr (assq 'contents cont)))
+		    ;; Remove quotes from quoted tags.
+		    (goto-char (point-min))
+		    (while (re-search-forward
+			    "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)
+		      (delete-region (+ (match-beginning 0) 2)
+				     (+ (match-beginning 0) 3))))))
+		(cond 
+		 ((eq (car cont) 'mml)
+		  (let ((mml-boundary (funcall mml-boundary-function
+					       (incf mml-multipart-number)))
+			(mml-generate-default-type "text/plain"))
+		    (mml-to-mime))
+		  (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
+		    ;; ignore 0x1b, it is part of iso-2022-jp
+		    (setq encoding (mm-body-7-or-8))))
+		 ((string= (car (split-string type "/")) "message")
+		  (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
+		    ;; ignore 0x1b, it is part of iso-2022-jp
+		    (setq encoding (mm-body-7-or-8))))
+		 (t 
+		  (setq charset (mm-encode-body))
+		  (setq encoding (mm-body-encoding
+				  charset (cdr (assq 'encoding cont))))))
+		(setq coded (buffer-string)))
+	    (mm-with-unibyte-buffer
 	      (cond
 	       ((cdr (assq 'buffer cont))
 		(insert-buffer-substring (cdr (assq 'buffer cont))))
 	       ((and (setq filename (cdr (assq 'filename cont)))
 		     (not (equal (cdr (assq 'nofile cont)) "yes")))
-		(mm-insert-file-contents filename))
-	       ((eq 'mml (car cont))
-		(insert (cdr (assq 'contents cont))))
+		(let ((coding-system-for-read mm-binary-coding-system))
+		  (mm-insert-file-contents filename nil nil nil nil t)))
 	       (t
-		(save-restriction
-		  (narrow-to-region (point) (point))
-		  (insert (cdr (assq 'contents cont)))
-		  ;; Remove quotes from quoted tags.
-		  (goto-char (point-min))
-		  (while (re-search-forward
-			  "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)
-		    (delete-region (+ (match-beginning 0) 2)
-				   (+ (match-beginning 0) 3))))))
-	      (cond 
-	       ((eq (car cont) 'mml)
-		(let ((mml-boundary (funcall mml-boundary-function
-					     (incf mml-multipart-number)))
-		      (mml-generate-default-type "text/plain"))
-		  (mml-to-mime))
-		(let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
-		  ;; ignore 0x1b, it is part of iso-2022-jp
-		  (setq encoding (mm-body-7-or-8))))
-	       ((string= (car (split-string type "/")) "message")
-		(let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
-		  ;; ignore 0x1b, it is part of iso-2022-jp
-		  (setq encoding (mm-body-7-or-8))))
-	       (t 
-		(setq charset (mm-encode-body))
-		(setq encoding (mm-body-encoding
-				charset (cdr (assq 'encoding cont))))))
-	      (setq coded (buffer-string)))
-	  (mm-with-unibyte-buffer
-	    (cond
-	     ((cdr (assq 'buffer cont))
-	      (insert-buffer-substring (cdr (assq 'buffer cont))))
-	     ((and (setq filename (cdr (assq 'filename cont)))
-		   (not (equal (cdr (assq 'nofile cont)) "yes")))
-	      (let ((coding-system-for-read mm-binary-coding-system))
-		(mm-insert-file-contents filename nil nil nil nil t)))
-	     (t
-	      (insert (cdr (assq 'contents cont)))))
-	    (setq encoding (mm-encode-buffer type)
-		  coded (buffer-string))))
-	(mml-insert-mime-headers cont type charset encoding)
-	(insert "\n")
-	(insert coded)))
-     ((eq (car cont) 'external)
-      (insert "Content-Type: message/external-body")
-      (let ((parameters (mml-parameter-string
-			 cont '(expiration size permission)))
-	    (name (cdr (assq 'name cont))))
-	(when name
-	  (setq name (mml-parse-file-name name))
-	  (if (stringp name)
+		(insert (cdr (assq 'contents cont)))))
+	      (setq encoding (mm-encode-buffer type)
+		    coded (buffer-string))))
+	  (mml-insert-mime-headers cont type charset encoding)
+	  (insert "\n")
+	  (insert coded)))
+       ((eq (car cont) 'external)
+	(insert "Content-Type: message/external-body")
+	(let ((parameters (mml-parameter-string
+			   cont '(expiration size permission)))
+	      (name (cdr (assq 'name cont))))
+	  (when name
+	    (setq name (mml-parse-file-name name))
+	    (if (stringp name)
+		(mml-insert-parameter
+		 (mail-header-encode-parameter "name" name)
+		 "access-type=local-file")
 	      (mml-insert-parameter
-	       (mail-header-encode-parameter "name" name)
-	       "access-type=local-file")
-	    (mml-insert-parameter
-	     (mail-header-encode-parameter
-	      "name" (file-name-nondirectory (nth 2 name)))
-	     (mail-header-encode-parameter "site" (nth 1 name))
-	     (mail-header-encode-parameter
-	      "directory" (file-name-directory (nth 2 name))))
-	    (mml-insert-parameter
-	     (concat "access-type="
-		     (if (member (nth 0 name) '("ftp@" "anonymous@"))
-			 "anon-ftp"
-		       "ftp")))))      
-	(when parameters
-	  (mml-insert-parameter-string
-	   cont '(expiration size permission))))
-      (insert "\n\n")
-      (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
-      (insert "Content-ID: " (message-make-message-id) "\n")
-      (insert "Content-Transfer-Encoding: "
-	      (or (cdr (assq 'encoding cont)) "binary"))
-      (insert "\n\n")
-      (insert (or (cdr (assq 'contents cont))))
-      (insert "\n"))
-     ((eq (car cont) 'multipart)
-      (let* ((type (or (cdr (assq 'type cont)) "mixed"))
-	     (mml-generate-default-type (if (equal type "digest")
-					    "message/rfc822"
-					  "text/plain"))
-	     (handler (assoc type mml-generate-multipart-alist)))
-	(if handler
-	    (funcall (cdr handler) cont)
-	  ;; No specific handler.  Use default one.
-	  (let ((mml-boundary (mml-compute-boundary cont)))
-	    (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
-			    type mml-boundary))
-	    ;; Skip `multipart' and `type' elements.
-	    (setq cont (cddr cont))
-	    (while cont
-	      (insert "\n--" mml-boundary "\n")
-	      (mml-generate-mime-1 (pop cont)))
-	    (insert "\n--" mml-boundary "--\n")))))
-     (t
-      (error "Invalid element: %S" cont)))
-    (if mml-generate-mime-postprocess-function
-	(funcall mml-generate-mime-postprocess-function cont))
-    (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist)))
-      (when item
-	(funcall (nth 1 item) cont)))
-    (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)))
-      (when item
-	(funcall (nth 1 item) cont)))))
+	       (mail-header-encode-parameter
+		"name" (file-name-nondirectory (nth 2 name)))
+	       (mail-header-encode-parameter "site" (nth 1 name))
+	       (mail-header-encode-parameter
+		"directory" (file-name-directory (nth 2 name))))
+	      (mml-insert-parameter
+	       (concat "access-type="
+		       (if (member (nth 0 name) '("ftp@" "anonymous@"))
+			   "anon-ftp"
+			 "ftp")))))      
+	  (when parameters
+	    (mml-insert-parameter-string
+	     cont '(expiration size permission))))
+	(insert "\n\n")
+	(insert "Content-Type: " (cdr (assq 'type cont)) "\n")
+	(insert "Content-ID: " (message-make-message-id) "\n")
+	(insert "Content-Transfer-Encoding: "
+		(or (cdr (assq 'encoding cont)) "binary"))
+	(insert "\n\n")
+	(insert (or (cdr (assq 'contents cont))))
+	(insert "\n"))
+       ((eq (car cont) 'multipart)
+	(let* ((type (or (cdr (assq 'type cont)) "mixed"))
+	       (mml-generate-default-type (if (equal type "digest")
+					      "message/rfc822"
+					    "text/plain"))
+	       (handler (assoc type mml-generate-multipart-alist)))
+	  (if handler
+	      (funcall (cdr handler) cont)
+	    ;; No specific handler.  Use default one.
+	    (let ((mml-boundary (mml-compute-boundary cont)))
+	      (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
+			      type mml-boundary))
+	      ;; Skip `multipart' and `type' elements.
+	      (setq cont (cddr cont))
+	      (while cont
+		(insert "\n--" mml-boundary "\n")
+		(mml-generate-mime-1 (pop cont)))
+	      (insert "\n--" mml-boundary "--\n")))))
+       (t
+	(error "Invalid element: %S" cont)))
+      (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist)))
+	(when item
+	  (funcall (nth 1 item) cont)))
+      (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist)))
+	(when item
+	  (funcall (nth 1 item) cont))))))
 
 (defun mml-compute-boundary (cont)
   "Return a unique boundary that does not exist in CONT."
@@ -880,13 +857,6 @@ If RAW, don't highlight the article."
   (interactive)
   (mml-parse))
 
-(defun mml-postprocess (cont)
-  (let ((pp (cdr (or (assq 'postprocess cont)
-		     (assq 'pp cont))))
-	item)
-    (if (and pp (setq item (assoc pp mml-postprocess-alist)))
-	(funcall (cdr item) cont))))
-
 (provide 'mml)
 
 ;;; mml.el ends here
diff --git a/lisp/mml2015.el b/lisp/mml2015.el
index 9651553..4153f5e 100644
--- a/lisp/mml2015.el
+++ b/lisp/mml2015.el
@@ -61,9 +61,10 @@
       (list handles))))
 
 (defun mml2015-fix-micalg (alg)
-  (if (and alg (string-match "^pgp-" alg))
-      (substring alg (match-end 0))
-    alg))
+  (upcase
+   (if (and alg (string-match "^pgp-" alg))
+       (substring alg (match-end 0))
+     alg)))
 
 ;;;###autoload
 (defun mml2015-verify (handle ctl)
@@ -77,10 +78,8 @@
 		      (or (mml2015-fix-micalg
 			   (mail-content-type-get ctl 'micalg))
 			  "SHA1")))
-      (insert part)
+      (insert part "\n")
       (goto-char (point-max))
-      (unless (bolp)
-	(insert "\n"))
       (unless (setq part (mm-find-part-by-type 
 			   (cdr handle) "application/pgp-signature"))
 	(error "Corrupted pgp-signature part."))
@@ -120,10 +119,10 @@
     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
 		    boundary))
     (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
-		    hash))
-    (insert "\n")
-    (insert (format "--%s\n" boundary))
-    (unless (re-search-forward (cdr (assq 'signed-end-line scheme-alist)))
+		    (downcase hash)))
+    (insert (format "\n--%s\n" boundary))
+    (goto-char (point-max))
+    (unless (re-search-backward (cdr (assq 'signed-end-line scheme-alist)))
       (error "Cannot find signature part." ))
     (goto-char (match-beginning 0))
     (unless (re-search-backward "^-+BEGIN" nil t)
@@ -135,7 +134,6 @@
     (insert (format "--%s--\n" boundary))
     (goto-char (point-max))))
 
-
 (defun mml2015-mailcrypt-encrypt (cont)
   (mc-encrypt-generic 
    (or (message-options-get 'message-recipients)
diff --git a/lisp/qp.el b/lisp/qp.el
index 79e4362..4dccdcf 100644
--- a/lisp/qp.el
+++ b/lisp/qp.el
@@ -125,8 +125,10 @@ encode lines starting with \"From\"."
 	      ;; line.
 	      (when mm-use-ultra-safe-encoding
 		(beginning-of-line)
-		(when (looking-at "From ")
-		  (replace-match "From=20" nil t)))
+		(if (looking-at "From ")
+		    (replace-match "From=20" nil t)
+		  (if (looking-at "-")
+		      (replace-match "=2D" nil t))))
 	      (end-of-line)
 	      (while (> (current-column) 76);; tab-width must be 1.
 		(beginning-of-line)