Synch with Gnus.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d800645..0d46836 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)