* gnus-art.el (gnus-mime-inline-part): Decode parts according to the coding

[gnus] / lisp / mml.el

diff --git a/lisp/mml.el b/lisp/mml.el
index a05c2da..c131407 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -1,5 +1,5 @@
 ;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -45,6 +45,7 @@
   '(name access-type expiration size permission format)
   "*A list of acceptable parameters in MML tag.
 These parameters are generated in Content-Type header if exists."
+  :version "21.4"
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
@@ -52,12 +53,14 @@ These parameters are generated in Content-Type header if exists."
   '(filename creation-date modification-date read-date)
   "*A list of acceptable parameters in MML tag.
 These parameters are generated in Content-Disposition header if exists."
+  :version "21.4"
   :type '(repeat (symbol :tag "Parameter"))
   :group 'message)
 
 (defcustom mml-insert-mime-headers-always nil
   "If non-nil, always put Content-Type: text/plain at top of empty parts.
 It is necessary to work against a bug in certain clients."
+  :version "21.4"
   :type 'boolean
   :group 'message)
 
@@ -394,22 +397,25 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
       (cond
        ((or (eq (car cont) 'part) (eq (car cont) 'mml))
        (let ((raw (cdr (assq 'raw cont)))
-             coded encoding charset filename type flowed)
-         (setq type (or (cdr (assq 'type cont)) "text/plain"))
+             type charset coding filename encoding flowed coded)
+         (setq type (or (cdr (assq 'type cont)) "text/plain")
+               charset (cdr (assq 'charset cont))
+               coding (mm-charset-to-coding-system charset))
+         (cond ((eq coding 'ascii)
+                (setq charset nil
+                      coding nil))
+               (charset
+                (setq charset (intern (downcase charset)))))
          (if (and (not raw)
                   (member (car (split-string type "/")) '("text" "message")))
              (progn
                (with-temp-buffer
-                 (setq charset (mm-charset-to-coding-system
-                                (cdr (assq 'charset cont))))
-                 (when (eq charset 'ascii)
-                   (setq charset nil))
                  (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 charset))
+                   (let ((coding-system-for-read coding))
                      (mm-insert-file-contents filename)))
                   ((eq 'mml (car cont))
                    (insert (cdr (assq 'contents cont))))
@@ -465,11 +471,17 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
            (mm-with-unibyte-buffer
              (cond
               ((cdr (assq 'buffer cont))
-               (insert-buffer-substring (cdr (assq 'buffer cont))))
+               (insert (with-current-buffer (cdr (assq 'buffer cont))
+                         (mm-with-unibyte-current-buffer
+                           (buffer-string)))))
               ((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)))
+                 (mm-insert-file-contents filename nil nil nil nil t))
+               (unless charset
+                 (setq charset (mm-coding-system-to-mime-charset
+                                (mm-find-buffer-file-coding-system
+                                 filename)))))
               (t
                (insert (cdr (assq 'contents cont)))))
              (setq encoding (mm-encode-buffer type)
@@ -803,7 +815,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
       (insert " " param)
       (when (> (current-column) 71)
        (goto-char point)
-       (insert "\n ")
+       (insert "\n")
        (end-of-line)))))
 
 ;;;
@@ -946,11 +958,9 @@ See Info node `(emacs-mime)Composing'.
                      (if (string-match "^text/.*" type)
                          "inline"
                        "attachment")))
-        (disposition (completing-read 
-                      (format "Disposition: (default %s): " default)
-                      '(("attachment") ("inline") (""))
-                      nil
-                      nil)))
+        (disposition (completing-read "Disposition: "
+                                      '(("attachment") ("inline") (""))
+                                      nil t)))
     (if (not (equal disposition ""))
        disposition
       default)))
@@ -1075,10 +1085,15 @@ Should be adopted if code in `message-send-mail' is changed."
     (message-position-on-field "Mail-Followup-To" "X-Draft-From")
     (insert (message-make-mail-followup-to))))
 
+(defvar mml-preview-buffer nil)
+
 (defun mml-preview (&optional raw)
   "Display current buffer with Gnus, in a new buffer.
 If RAW, don't highlight the article."
   (interactive "P")
+  (setq mml-preview-buffer (generate-new-buffer
+                           (concat (if raw "*Raw MIME preview of "
+                                     "*MIME preview of ") (buffer-name))))
   (save-excursion
     (let* ((buf (current-buffer))
           (message-options message-options)
@@ -1090,13 +1105,13 @@ If RAW, don't highlight the article."
                                           (message-fetch-field "Newsgroups")))
                                        message-posting-charset)))
       (message-options-set-recipient)
-      (switch-to-buffer (generate-new-buffer
-                        (concat (if raw "*Raw MIME preview of "
-                                  "*MIME preview of ") (buffer-name))))
       (when (boundp 'gnus-buffers)
-       (push (current-buffer) gnus-buffers))
-      (erase-buffer)
-      (insert-buffer-substring buf)
+       (push mml-preview-buffer gnus-buffers))
+      (save-restriction
+       (widen)
+       (set-buffer mml-preview-buffer)
+       (erase-buffer)
+       (insert-buffer-substring buf))
       (mml-preview-insert-mail-followup-to)
       (let ((message-deletable-headers (if (message-news-p)
                                           nil
@@ -1109,6 +1124,7 @@ If RAW, don't highlight the article."
           (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
          (replace-match "\n"))
       (let ((mail-header-separator ""));; mail-header-separator is removed.
+       (message-sort-headers)
        (mml-to-mime))
       (if raw
          (when (fboundp 'set-buffer-multibyte)
@@ -1141,7 +1157,11 @@ If RAW, don't highlight the article."
                     (lambda (event)
                       (interactive "@e")
                       (widget-button-press (widget-event-point event) event)))
-      (goto-char (point-min)))))
+      (goto-char (point-min))))
+  (if (and (boundp 'gnus-buffer-configuration)
+          (assq 'mml-preview gnus-buffer-configuration))
+      (gnus-configure-windows 'mml-preview)
+    (pop-to-buffer mml-preview-buffer)))
 
 (defun mml-validate ()
   "Validate the current MML document."