;;; mml.el --- A package for parsing and validating MML documents
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
(autoload 'gnus-make-local-hook "gnus-util")
(autoload 'message-fetch-field "message")
(autoload 'message-mark-active-p "message")
+ (autoload 'message-info "message")
(autoload 'fill-flowed-encode "flow-fill")
- (autoload 'message-posting-charset "message"))
-
-(eval-when-compile
+ (autoload 'message-posting-charset "message")
(autoload 'dnd-get-local-file-name "dnd"))
(defvar gnus-article-mime-handles)
(defvar message-posting-charset)
(defvar message-required-mail-headers)
(defvar message-required-news-headers)
+(defvar dnd-protocol-alist)
(defcustom mml-content-type-parameters
'(name access-type expiration size permission format)
(mm-find-buffer-file-coding-system
filename)))))
(t
- (insert (cdr (assq 'contents cont)))))
+ (let ((contents (cdr (assq 'contents cont))))
+ (if (if (featurep 'xemacs)
+ (string-match "[^\000-\377]" contents)
+ (mm-multibyte-string-p contents))
+ (progn
+ (mm-enable-multibyte)
+ (insert contents)
+ (setq charset (mm-encode-body charset)))
+ (insert contents)))))
(setq encoding (mm-encode-buffer type)
coded (mm-string-as-multibyte (buffer-string))))
(mml-insert-mime-headers cont type charset encoding nil)
;; Skip `multipart' and attributes.
(when (and (consp part) (consp (cdr part)))
(insert "\n--" mml-boundary "\n")
- (mml-generate-mime-1 part))))
+ (mml-generate-mime-1 part)
+ (goto-char (point-max)))))
(insert "\n--" mml-boundary "--\n")))))
(t
(error "Invalid element: %S" cont)))
"Can't encode a part with several charsets"))
(insert "Content-Type: " type)
(when charset
- (insert "; " (mail-header-encode-parameter
- "charset" (symbol-name charset))))
+ (mml-insert-parameter
+ (mail-header-encode-parameter "charset" (symbol-name charset))))
(when flowed
- (insert "; format=flowed"))
+ (mml-insert-parameter "format=flowed"))
(when parameters
(mml-insert-parameter-string
cont mml-content-type-parameters))
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(when (setq description (cdr (assq 'description cont)))
- (insert "Content-Description: "
- (mail-encode-encoded-word-string description) "\n"))))
+ (insert "Content-Description: ")
+ (setq description (prog1
+ (point)
+ (insert description "\n")))
+ (mail-encode-encoded-word-region description (point)))))
(defun mml-parameter-string (cont types)
(let ((string "")
(unless (setq textp (equal (mm-handle-media-supertype handle) "text"))
(save-excursion
(set-buffer (setq buffer (mml-generate-new-buffer " *mml*")))
- (mm-insert-part handle)
+ (mm-insert-part handle 'no-cache)
(if (setq mmlp (equal (mm-handle-media-type handle)
"message/rfc822"))
(mime-to-mml)))))
(defun mml-insert-parameter (&rest parameters)
"Insert PARAMETERS in a nice way."
- (dolist (param parameters)
- (insert ";")
- (let ((point (point)))
+ (let (start end)
+ (dolist (param parameters)
+ (insert ";")
+ (setq start (point))
(insert " " param)
- (when (> (current-column) 71)
- (goto-char point)
- (insert "\n")
- (end-of-line)))))
+ (setq end (point))
+ (goto-char start)
+ (end-of-line)
+ (if (> (current-column) 76)
+ (progn
+ (goto-char start)
+ (insert "\n")
+ (goto-char (1+ end)))
+ (goto-char end)))))
;;;
;;; Mode for inserting and editing MML forms
,@(if (featurep 'xemacs) nil
'(:help "Quote MML tags in region"))]
["Validate MML" mml-validate t]
- ["Preview" mml-preview t]))
+ ["Preview" mml-preview t]
+ "----"
+ ["Emacs MIME manual" (lambda () (interactive) (message-info 4))
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the Emacs MIME manual"))]
+ ["PGG manual" (lambda () (interactive) (message-info 16))
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the PGG manual"))]))
(defvar mml-mode nil
"Minor mode for editing MML.")
(easy-menu-add mml-menu mml-mode-map)
(when (boundp 'dnd-protocol-alist)
(set (make-local-variable 'dnd-protocol-alist)
- (append mml-dnd-protocol-alist
- (symbol-value 'dnd-protocol-alist))))
+ (append mml-dnd-protocol-alist dnd-protocol-alist)))
(run-hooks 'mml-mode-hook)))
;;;
;;; inserting stuff to the buffer.
;;;
+(defcustom mml-default-directory mm-default-directory
+ "The default directory where mml will find files.
+If not set, `default-directory' will be used."
+ :type '(choice directory (const :tag "Default" nil))
+ :version "23.0" ;; No Gnus
+ :group 'message)
+
(defun mml-minibuffer-read-file (prompt)
(let* ((completion-ignored-extensions nil)
- (file (read-file-name prompt nil nil t)))
+ (file (read-file-name prompt
+ (or mml-default-directory default-directory)
+ nil t)))
;; Prevent some common errors. This is inspired by similar code in
;; VM.
(when (file-directory-p file)
as in other buffers."
:type '(choice (repeat (cons (regexp) (function)))
(const :tag "Behave as in other buffers" nil))
- :version "23.0" ;; No Gnus
+ :version "22.1" ;; Gnus 5.10.9
:group 'message)
(defcustom mml-dnd-attach-options nil
(const type)
(const description)
(const disposition))))
- :version "23.0" ;; No Gnus
+ :version "22.1" ;; Gnus 5.10.9
:group 'message)
(defun mml-attach-file (file &optional type description disposition)
(lambda (event)
(interactive "@e")
(widget-button-press (widget-event-point event) event)))
+ ;; FIXME: Buffer is in article mode, but most tool bar commands won't
+ ;; work. Maybe only keep the following icons: search, print, quit
(goto-char (point-min))))
(if (and (not (mm-special-display-p (buffer-name mml-preview-buffer)))
(boundp 'gnus-buffer-configuration)
projects / gnus / blobdiff