[Emacs-diffs] master 7828001: Allow the user to specify Content-type in Message mode

[Lars Ingebrigtsen]

branch: master
commit 7828001aef134bf3a062edcea92cd0ce0dac407e
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    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.
---
 lisp/gnus/message.el |  5 ++++-
 lisp/gnus/mml.el     | 19 +++++++++----------
 2 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index ef6455a..ef9f842 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 4a0d40a..7fd78d7 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))))