Importing Pterodactyl Gnus v0.49.

[elisp/gnus.git-] / lisp / mml.el

diff --git a/lisp/mml.el b/lisp/mml.el
index c31e7fd..fab6be2 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -50,11 +50,11 @@
   "Parse the current buffer as an MML document."
   (let (struct)
     (while (and (not (eobp))
-               (not (looking-at "</multipart")))
+               (not (looking-at "</#multipart")))
       (cond
-       ((looking-at "<multipart")
+       ((looking-at "<#multipart")
        (push (nconc (mml-read-tag) (mml-parse-1)) struct))
-       ((looking-at "<part")
+       ((looking-at "<#part")
        (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
              struct))
        (t
@@ -67,7 +67,7 @@
 (defun mml-read-tag ()
   "Read a tag and return the contents."
   (let (contents name elem val)
-    (forward-char 1)
+    (forward-char 2)
     (setq name (buffer-substring (point) (progn (forward-sexp 1) (point))))
     (skip-chars-forward " \t\n")
     (while (not (looking-at ">"))
@@ -84,11 +84,16 @@
 (defun mml-read-part ()
   "Return the buffer up till the next part, multipart or closing part or multipart."
   (let ((beg (point)))
-    (if (re-search-forward "</?\\(multi\\)?part." nil t)
+    ;; If the tag ended at the end of the line, we go to the next line.
+    (when (looking-at "[ \t]*\n")
+      (forward-line 1))
+    (if (re-search-forward "<#/?\\(multi\\)?part." nil t)
        (prog1
            (buffer-substring beg (match-beginning 0))
-         (unless (equal (match-string 0) "</part>")
-           (goto-char (match-beginning 0))))
+         (if (not (equal (match-string 0) "<#/part>"))
+             (goto-char (match-beginning 0))
+           (when (looking-at "[ \t]*\n")
+             (forward-line 1))))
       (buffer-substring beg (goto-char (point-max))))))
 
 (defvar mml-boundary nil)
@@ -110,21 +115,32 @@
    ((eq (car cont) 'part)
     (let (coded encoding charset filename type)
       (setq type (or (cdr (assq 'type cont)) "text/plain"))
-      (with-temp-buffer
-       (if (setq filename (cdr (assq 'filename cont)))
-           (insert-file-contents-literally filename)
-         (insert (cdr (assq 'contents cont))))
-       (if (equal (car (split-string type "/")) "text")
+      (if (equal (car (split-string type "/")) "text")
+         (with-temp-buffer
+           (if (setq filename (cdr (assq 'filename cont)))
+               (insert-file-contents-literally filename)
+             (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\\)" nil t)
+                 (delete-region (+ (match-beginning 0) 2)
+                                (+ (match-beginning 0) 3)))))
            (setq charset (mm-encode-body)
                  encoding (mm-body-encoding))
-         (setq encoding (mm-encode-buffer type)))
-       (setq coded (buffer-string)))
+           (setq coded (buffer-string)))
+       (mm-with-unibyte-buffer
+         (if (setq filename (cdr (assq 'filename cont)))
+             (insert-file-contents-literally filename)
+           (insert (cdr (assq 'contents cont))))
+         (setq coded (buffer-string))))
       (when (or charset
                (not (equal type "text/plain")))
-       (insert "Content-Type: " type))
-      (when charset
-       (insert (format "; charset=\"%s\"" charset)))
-      (insert "\n")
+       (insert "Content-Type: " type)
+       (when charset
+         (insert (format "; charset=\"%s\"" charset)))
+       (insert "\n"))
       (unless (eq encoding '7bit)
        (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
       (insert "\n")
@@ -137,11 +153,15 @@
       (insert "\n")
       (setq cont (cddr cont))
       (while cont
+       (unless (bolp)
+         (insert "\n"))
        (insert "--" mml-boundary "\n")
        (mml-generate-mime-1 (pop cont)))
+      (unless (bolp)
+       (insert "\n"))
       (insert "--" mml-boundary "--\n")))
    (t
-    (error "%S" cont))))
+    (error "Invalid element: %S" cont))))
 
 (provide 'mml)