X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmml.el;h=4770d120291af7abbafb17d371c3a26ec1d42d43;hb=1728d285312ef05192815148f093dd4656fb4d94;hp=9203465ee4636f8188c1b206456d772b98e80333;hpb=7ab0d92af27fe27abf4c10a26e7d3a1c3c9c9e18;p=elisp%2Fgnus.git- diff --git a/lisp/mml.el b/lisp/mml.el index 9203465..4770d12 100644 --- 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,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -27,19 +27,20 @@ (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) +(eval-when-compile 'cl) (eval-and-compile - (autoload 'message-make-message-id "message")) + (autoload 'message-make-message-id "message") + (autoload 'gnus-setup-posting-charset "gnus-msg") + (autoload 'message-fetch-field "message") + (autoload 'message-posting-charset "message")) -(defvar mml-generate-multipart-alist - '(("signed" . rfc2015-generate-signed-multipart) - ("encrypted" . rfc2015-generate-encrypted-multipart)) +(defvar mml-generate-multipart-alist nil "*Alist of multipart generation functions. - Each entry has the form (NAME . FUNCTION), where -NAME: is a string containing the name of the part (without the +NAME is a string containing the name of the part (without the leading \"/multipart/\"), -FUNCTION: is a Lisp function which is called to generate the part. +FUNCTION is a Lisp function which is called to generate the part. The Lisp function has to supply the appropriate MIME headers and the contents of this part.") @@ -64,6 +65,36 @@ suggestion each time. The function is called with one parameter, which is a number that says how many times the function has been called for this message.") +(defvar mml-confirmation-set nil + "A list of symbols, each of which disables some warning. +`unknown-encoding': always send messages contain characters with +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 nil + "A function called after generating a mime part. +The function is called with one parameter, which is the generated part.") + +(defvar mml-generate-default-type "text/plain") + +(defvar mml-buffer-list nil) + +(defun mml-generate-new-buffer (name) + (let ((buf (generate-new-buffer name))) + (push buf mml-buffer-list) + buf)) + +(defun mml-destroy-buffers () + (let (kill-buffer-hook) + (mapcar 'kill-buffer mml-buffer-list) + (setq mml-buffer-list nil))) + (defun mml-parse () "Parse the current buffer as an MML document." (goto-char (point-min)) @@ -76,7 +107,7 @@ called for this message.") (defun mml-parse-1 () "Parse the current buffer as an MML document." - (let (struct tag point contents charsets warn) + (let (struct tag point contents charsets warn use-ascii no-markup-p raw) (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond @@ -86,23 +117,47 @@ called for this message.") (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) struct)) (t - (if (looking-at "<#part") - (setq tag (mml-read-tag)) + (if (or (looking-at "<#part") (looking-at "<#mml")) + (setq tag (mml-read-tag) + no-markup-p nil + warn nil) (setq tag (list 'part '(type . "text/plain")) + no-markup-p t warn t)) - (setq point (point) - contents (mml-read-part) - charsets (mm-find-mime-charset-region point (point))) - (if (< (length charsets) 2) - (push (nconc tag (list (cons 'contents contents))) - struct) + (setq raw (cdr (assq 'raw tag)) + point (point) + contents (if raw + (mm-with-unibyte-current-buffer + (mml-read-part (eq 'mml (car tag)))) + (mml-read-part (eq 'mml (car tag)))) + charsets (if raw nil + (mm-find-mime-charset-region point (point)))) + (when (and (not raw) (memq nil charsets)) + (if (or (memq 'unknown-encoding mml-confirmation-set) + (y-or-n-p + "Warning: You message contains characters with unknown encoding. Really send?")) + (if (setq use-ascii + (or (memq 'use-ascii mml-confirmation-set) + (y-or-n-p "Use ASCII as charset?"))) + (setq charsets (delq nil charsets)) + (setq warn nil)) + (error "Edit your message to remove those characters"))) + (if (or raw + (eq 'mml (car tag)) + (< (length charsets) 2)) + (if (or (not no-markup-p) + (string-match "[^ \t\r\n]" contents)) + ;; Don't create blank parts. + (push (nconc tag (list (cons 'contents contents))) + struct)) (let ((nstruct (mml-parse-singlepart-with-multiple-charsets - tag point (point)))) + tag point (point) use-ascii))) (when (and warn + (not (memq 'multipart mml-confirmation-set)) (not (y-or-n-p (format - "Warning: Your message contains %d parts. Really send? " + "Warning: Your message contains more than %d parts. Really send? " (length nstruct))))) (error "Edit your message to use only one charset")) (setq struct (nconc nstruct struct))))))) @@ -110,56 +165,63 @@ called for this message.") (forward-line 1)) (nreverse struct))) -(defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end) +(defun mml-parse-singlepart-with-multiple-charsets + (orig-tag beg end &optional use-ascii) (save-excursion - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((current (mm-mime-charset (char-charset (following-char)))) - charset struct space newline paragraph) - (while (not (eobp)) - (cond - ;; The charset remains the same. - ((or (eq (setq charset (mm-mime-charset - (char-charset (following-char)))) 'us-ascii) - (eq charset current))) - ;; The initial charset was ascii. - ((eq current 'us-ascii) - (setq current charset - space nil - newline nil - paragraph nil)) - ;; We have a change in charsets. - (t - (push (append - orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (or paragraph newline space (point)))))) - struct) - (setq beg (or paragraph newline space (point)) - current charset - space nil - newline nil - paragraph nil))) - ;; Compute places where it might be nice to break the part. - (cond - ((memq (following-char) '(? ?\t)) - (setq space (1+ (point)))) - ((eq (following-char) ?\n) - (setq newline (1+ (point)))) - ((and (eq (following-char) ?\n) - (not (bobp)) - (eq (char-after (1- (point))) ?\n)) - (setq paragraph (point)))) - (forward-char 1)) - ;; Do the final part. - (unless (= beg (point)) - (push (append orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (point))))) - struct)) - struct))) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((current (or (mm-mime-charset (mm-charset-after)) + (and use-ascii 'us-ascii))) + charset struct space newline paragraph) + (while (not (eobp)) + (setq charset (mm-mime-charset (mm-charset-after))) + (cond + ;; The charset remains the same. + ((eq charset 'us-ascii)) + ((or (and use-ascii (not charset)) + (eq charset current)) + (setq space nil + newline nil + paragraph nil)) + ;; The initial charset was ascii. + ((eq current 'us-ascii) + (setq current charset + space nil + newline nil + paragraph nil)) + ;; We have a change in charsets. + (t + (push (append + orig-tag + (list (cons 'contents + (buffer-substring-no-properties + beg (or paragraph newline space (point)))))) + struct) + (setq beg (or paragraph newline space (point)) + current charset + space nil + newline nil + paragraph nil))) + ;; Compute places where it might be nice to break the part. + (cond + ((memq (following-char) '(? ?\t)) + (setq space (1+ (point)))) + ((and (eq (following-char) ?\n) + (not (bobp)) + (eq (char-after (1- (point))) ?\n)) + (setq paragraph (point))) + ((eq (following-char) ?\n) + (setq newline (1+ (point))))) + (forward-char 1)) + ;; Do the final part. + (unless (= beg (point)) + (push (append orig-tag + (list (cons 'contents + (buffer-substring-no-properties + beg (point))))) + struct)) + struct)))) (defun mml-read-tag () "Read a tag and return the contents." @@ -182,22 +244,32 @@ called for this message.") (skip-chars-forward " \t\n") (cons (intern name) (nreverse contents)))) -(defun mml-read-part () - "Return the buffer up till the next part, multipart or closing part or multipart." - (let ((beg (point))) +(defun mml-read-part (&optional mml) + "Return the buffer up till the next part, multipart or closing part or multipart. +If MML is non-nil, return the buffer up till the correspondent mml tag." + (let ((beg (point)) (count 1)) ;; 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 - "<#\\(/\\)?\\(multipart\\|part\\|external\\)." nil t) - (prog1 - (buffer-substring-no-properties beg (match-beginning 0)) - (if (or (not (match-beginning 1)) - (equal (match-string 2) "multipart")) - (goto-char (match-beginning 0)) - (when (looking-at "[ \t]*\n") - (forward-line 1)))) - (buffer-substring-no-properties beg (goto-char (point-max)))))) + (if mml + (progn + (while (and (> count 0) (not (eobp))) + (if (re-search-forward "<#\\(/\\)?mml." nil t) + (setq count (+ count (if (match-beginning 1) -1 1))) + (goto-char (point-max)))) + (buffer-substring-no-properties beg (if (> count 0) + (point) + (match-beginning 0)))) + (if (re-search-forward + "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) + (prog1 + (buffer-substring-no-properties beg (match-beginning 0)) + (if (or (not (match-beginning 1)) + (equal (match-string 2) "multipart")) + (goto-char (match-beginning 0)) + (when (looking-at "[ \t]*\n") + (forward-line 1)))) + (buffer-substring-no-properties beg (goto-char (point-max))))))) (defvar mml-boundary nil) (defvar mml-base-boundary "-=-=") @@ -206,7 +278,7 @@ called for this message.") (defun mml-generate-mime () "Generate a MIME message based on the current MML document." (let ((cont (mml-parse)) - (mml-multipart-number 0)) + (mml-multipart-number mml-multipart-number)) (if (not cont) nil (with-temp-buffer @@ -218,96 +290,125 @@ called for this message.") (buffer-string))))) (defun mml-generate-mime-1 (cont) - (cond - ((eq (car cont) 'part) - (let (coded encoding charset filename type) - (setq type (or (cdr (assq 'type cont)) "text/plain")) - (if (member (car (split-string type "/")) '("text" "message")) - (with-temp-buffer + (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 + (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)) + (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\\)" nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3)))))) - (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") + (mm-with-unibyte-current-buffer + (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")) - (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)) - (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)))) + (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)))) (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." @@ -362,7 +463,7 @@ called for this message.") cont '(name access-type expiration size permission))) (when (or charset parameters - (not (equal type "text/plain"))) + (not (equal type mml-generate-default-type))) (when (consp charset) (error "Can't encode a part with several charsets.")) @@ -415,13 +516,13 @@ called for this message.") (mail-header-encode-parameter (symbol-name type) value)))))) -(defvar ange-ftp-path-format) +(defvar ange-ftp-name-format) (defvar efs-path-regexp) (defun mml-parse-file-name (path) (if (if (boundp 'efs-path-regexp) (string-match efs-path-regexp path) - (if (boundp 'ange-ftp-path-format) - (string-match (car ange-ftp-path-format)))) + (if (boundp 'ange-ftp-name-format) + (string-match (car ange-ftp-name-format) path))) (list (match-string 1 path) (match-string 2 path) (substring path (1+ (match-end 2)))) path)) @@ -451,27 +552,43 @@ called for this message.") (if (stringp (car handles)) (mml-insert-mime handles) (mml-insert-mime handles t)) - (mm-destroy-parts handles))) + (mm-destroy-parts handles)) + (save-restriction + (message-narrow-to-head) + ;; Remove them, they are confusing. + (message-remove-header "Content-Type") + (message-remove-header "MIME-Version") + (message-remove-header "Content-Transfer-Encoding"))) (defun mml-to-mime () "Translate the current buffer from MML to MIME." (message-encode-message-body) (save-restriction (message-narrow-to-headers-or-head) - (mail-encode-encoded-word-buffer))) + (let ((mail-parse-charset message-default-charset)) + (mail-encode-encoded-word-buffer)))) (defun mml-insert-mime (handle &optional no-markup) - (let (textp buffer) + (let (textp buffer mmlp) ;; Determine type and stuff. (unless (stringp (car handle)) - (unless (setq textp (equal (mm-handle-media-supertype handle) - "text")) + (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) (save-excursion - (set-buffer (setq buffer (generate-new-buffer " *mml*"))) - (mm-insert-part handle)))) - (unless no-markup - (mml-insert-mml-markup handle buffer textp)) + (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) + (mm-insert-part handle) + (if (setq mmlp (equal (mm-handle-media-type handle) + "message/rfc822")) + (mime-to-mml))))) + (if mmlp + (mml-insert-mml-markup handle nil t t) + (unless (and no-markup + (equal (mm-handle-media-type handle) "text/plain")) + (mml-insert-mml-markup handle buffer textp))) (cond + (mmlp + (insert-buffer buffer) + (goto-char (point-max)) + (insert "<#/mml>\n")) ((stringp (car handle)) (mapcar 'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) @@ -484,12 +601,14 @@ called for this message.") (t (insert "<#/part>\n"))))) -(defun mml-insert-mml-markup (handle &optional buffer nofile) +(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) (insert "<#multipart type=" (mm-handle-media-subtype handle) ">\n") - (insert "<#part type=" (mm-handle-media-type handle)) + (if mmlp + (insert "<#mml type=" (mm-handle-media-type handle)) + (insert "<#part type=" (mm-handle-media-type handle))) (dolist (elem (append (cdr (mm-handle-type handle)) (cdr (mm-handle-disposition handle)))) (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")) @@ -529,7 +648,7 @@ called for this message.") (define-key map "p" 'mml-insert-part) (define-key map "v" 'mml-validate) (define-key map "P" 'mml-preview) - (define-key map "n" 'mml-narrow-to-part) + ;;(define-key map "n" 'mml-narrow-to-part) (define-key main "\M-m" map) main)) @@ -543,7 +662,7 @@ called for this message.") ("Insert" ["Multipart" mml-insert-multipart t] ["Part" mml-insert-part t]) - ["Narrow" mml-narrow-to-part t] + ;;["Narrow" mml-narrow-to-part t] ["Quote" mml-quote-region t] ["Validate" mml-validate t] ["Preview" mml-preview t])) @@ -586,6 +705,7 @@ called for this message.") file)) (defun mml-minibuffer-read-type (name &optional default) + (mailcap-parse-mimetypes) (let* ((default (or default (mm-default-file-encoding name) ;; Perhaps here we should check what the file @@ -596,10 +716,9 @@ called for this message.") (format "Content type (default %s): " default) (mapcar 'list - (delete-duplicates + (mm-delete-duplicates (nconc - (mapcar (lambda (m) (cdr m)) - mailcap-mime-extensions) + (mapcar 'cdr mailcap-mime-extensions) (apply 'nconc (mapcar @@ -613,8 +732,7 @@ called for this message.") nil type))) (cdr l)))) - mailcap-mime-data))) - :test 'equal))))) + mailcap-mime-data)))))))) (if (not (equal string "")) string default))) @@ -636,7 +754,7 @@ called for this message.") (goto-char (point-min)) ;; Quote parts. (while (re-search-forward - "<#/?!*\\(multipart\\|part\\|external\\)" nil t) + "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t) ;; Insert ! after the #. (goto-char (+ (match-beginning 0) 2)) (insert "!"))))) @@ -651,7 +769,7 @@ called for this message.") (value (pop plist))) (when value ;; Quote VALUE if it contains suspicious characters. - (when (string-match "[\"\\~/* \t\n]" value) + (when (string-match "[\"'\\~/*;() \t\n]" value) (setq value (prin1-to-string value))) (insert (format " %s=%s" key value))))) (insert ">\n")) @@ -706,35 +824,48 @@ TYPE is the MIME type to use." (defun mml-insert-multipart (&optional type) (interactive (list (completing-read "Multipart type (default mixed): " - '(("mixed") ("alternative") ("digest") ("parallel") - ("signed") ("encrypted")) - nil nil "mixed"))) + '(("mixed") ("alternative") ("digest") ("parallel") + ("signed") ("encrypted")) + nil nil "mixed"))) (or type (setq type "mixed")) (mml-insert-empty-tag "multipart" 'type type) (forward-line -1)) +(defun mml-insert-part (&optional type) + (interactive + (list (mml-minibuffer-read-type ""))) + (mml-insert-tag 'part 'type type 'disposition "inline") + (forward-line -1)) + (defun mml-preview (&optional raw) - "Display current buffer with Gnus, in a new buffer. + "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." - (interactive "P") - (let ((buf (current-buffer))) - (switch-to-buffer (get-buffer-create - (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) - (erase-buffer) - (insert-buffer buf) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (replace-match "\n")) - (mml-to-mime) - (unless raw - (run-hooks 'gnus-article-decode-hook) - (let ((gnus-newsgroup-name "dummy")) - (gnus-article-prepare-display))) - (fundamental-mode) - (setq buffer-read-only t) - (goto-char (point-min)))) + (interactive "P") + (let ((buf (current-buffer)) + (message-posting-charset (or (gnus-setup-posting-charset + (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field "Newsgroups"))) + message-posting-charset))) + (switch-to-buffer (get-buffer-create + (concat (if raw "*Raw MIME preview of " + "*MIME preview of ") (buffer-name)))) + (erase-buffer) + (insert-buffer buf) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (replace-match "\n")) + (mml-to-mime) + (if raw + (mm-disable-multibyte) + (let ((gnus-newsgroup-charset (car message-posting-charset))) + (run-hooks 'gnus-article-decode-hook) + (let ((gnus-newsgroup-name "dummy")) + (gnus-article-prepare-display)))) + (fundamental-mode) + (setq buffer-read-only t) + (goto-char (point-min)))) (defun mml-validate () "Validate the current MML document."