Allow the user to specify Content-type in Message mode

* lisp/gnus/message.el (message-encode-message-body): Pass in the
content type if the user has given one.

* lisp/gnus/mml.el (mml-parse-1): Remove bogus peek at
Content-type (there are no headers here)  (bug#36527).

* lisp/gnus/mml.el (mml-generate-mime): Respect that.

2 files changed, 13 insertions, 11 deletions

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index ef6455ac5c9..ef9f8429d40 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -8061,7 +8061,10 @@ regexp VARSTR."
       (message-goto-body)
       (save-restriction
         (narrow-to-region (point) (point-max))
-        (let ((new (mml-generate-mime)))
+        (let ((new (mml-generate-mime nil
+                                      (save-restriction
+                                        (message-narrow-to-headers)
+                                        (mail-fetch-field "content-type")))))
           (when new
             (delete-region (point-min) (point-max))
             (insert new)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 4a0d40ac0ed..7fd78d7b9c1 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -295,14 +295,6 @@ part.  This is for the internal use, you should never modify the value.")
                         (t
                          (mm-find-mime-charset-region point (point)
                                                       mm-hack-charsets))))
-        ;; If the user has inserted a Content-Type header, then
-        ;; respect that instead of overwriting with "text/plain".
-        (save-restriction
-          (narrow-to-region point (point))
-          (let ((content-type (mail-fetch-field "content-type")))
-            (when (and content-type
-                       (eq (car tag) 'part))
-              (setcdr (assq 'type tag) content-type))))
         (when (and (not raw) (memq nil charsets))
           (if (or (memq 'unknown-encoding mml-confirmation-set)
                   (message-options-get 'unknown-encoding)
@@ -479,10 +471,13 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
 (declare-function libxml-parse-html-region "xml.c"
                   (start end &optional base-url discard-comments))
 
-(defun mml-generate-mime (&optional multipart-type)
+(defun mml-generate-mime (&optional multipart-type content-type)
   "Generate a MIME message based on the current MML document.
 MULTIPART-TYPE defaults to \"mixed\", but can also
-be \"related\" or \"alternate\"."
+be \"related\" or \"alternate\".
+
+If CONTENT-TYPE (and there's only one part), override the content
+type detected."
   (let ((cont (mml-parse))
         (mml-multipart-number mml-multipart-number)
         (options message-options))
@@ -490,6 +485,10 @@ be \"related\" or \"alternate\"."
         nil
       (when (and (consp (car cont))
                  (= (length cont) 1)
+                 content-type)
+        (setcdr (assq 'type (cdr (car cont))) content-type))
+      (when (and (consp (car cont))
+                 (= (length cont) 1)
                  (fboundp 'libxml-parse-html-region)
                  (equal (cdr (assq 'type (car cont))) "text/html"))
         (setq cont (mml-expand-html-into-multipart-related (car cont))))