;;; mml.el --- A package for parsing and validating MML documents
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(require 'mm-util)
(require 'mm-bodies)
(require 'mm-encode)
(autoload 'message-posting-charset "message")
(autoload 'dnd-get-local-file-name "dnd"))
+(autoload 'message-options-set "message")
+(autoload 'message-narrow-to-head "message")
+(autoload 'message-in-body-p "message")
+(autoload 'message-mail-p "message")
+
(defvar gnus-article-mime-handles)
(defvar gnus-mouse-2)
(defvar gnus-newsrc-hashtb)
(defvar message-required-mail-headers)
(defvar message-required-news-headers)
(defvar dnd-protocol-alist)
+(defvar mml-dnd-protocol-alist)
(defcustom mml-content-type-parameters
'(name access-type expiration size permission format)
the string \"attachment\" or the string \"inline\". The value t for
SUPERTYPE, SUBTYPE or TYPE matches any of those types. The first
match found will be used."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:type (let ((dispositions '(radio :format "DISPOSITION: %v"
:value "attachment"
(const :format "%v " "attachment")
(mml-multipart-number mml-multipart-number))
(if (not cont)
nil
- (with-temp-buffer
+ (mm-with-multibyte-buffer
(if (and (consp (car cont))
(= (length cont) 1))
(mml-generate-mime-1 (car cont))
;; insert a "; format=flowed" string unless the
;; user has already specified it.
(setq flowed (null (assq 'format cont)))))
- (setq charset (mm-encode-body charset))
+ ;; Prefer `utf-8' for text/calendar parts.
+ (if (or charset
+ (not (string= type "text/calendar")))
+ (setq charset (mm-encode-body charset))
+ (let ((mm-coding-system-priorities
+ (cons 'utf-8 mm-coding-system-priorities)))
+ (setq charset (mm-encode-body))))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
(setq coded (buffer-string)))
(progn
(mm-enable-multibyte)
(insert contents)
- (setq charset (mm-encode-body charset)))
+ (unless raw
+ (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)
- (insert "\n")
- (mm-with-unibyte-current-buffer
- (insert coded)))))
+ (insert "\n" coded))))
((eq (car cont) 'external)
(insert "Content-Type: message/external-body")
(let ((parameters (mml-parameter-string
(mail-header-encode-parameter
(symbol-name type) value))))))
-(eval-when-compile
- (defvar ange-ftp-name-format)
- (defvar efs-path-regexp))
+(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)
;;; Transforming MIME to MML
;;;
+;; message-narrow-to-head autoloads message.
+(declare-function message-remove-header "message"
+ (header &optional is-regexp first reverse))
+
(defun mime-to-mml (&optional handles)
"Translate the current buffer (which should be a message) into MML.
If HANDLES is non-nil, use it instead reparsing the buffer."
(message-remove-header "Content-Disposition")
(message-remove-header "Content-Transfer-Encoding")))
+(autoload 'message-encode-message-body "message")
+(declare-function message-narrow-to-headers-or-head "message" ())
+
(defun mml-to-mime ()
"Translate the current buffer from MML to MIME."
- (message-encode-message-body)
+ ;; `message-encode-message-body' will insert an encoded Content-Description
+ ;; header in the message header if the body contains a single part
+ ;; that is specified by a user with a MML tag containing a description
+ ;; token. So, we encode the message header first to prevent the encoded
+ ;; Content-Description header from being encoded again.
(save-restriction
(message-narrow-to-headers-or-head)
;; Skip past any From_ headers.
(while (looking-at "From ")
(forward-line 1))
(let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer))))
+ (mail-encode-encoded-word-buffer)))
+ (message-encode-message-body))
(defun mml-insert-mime (handle &optional no-markup)
(let (textp buffer mmlp)
(goto-char (point-max))
(insert "<#/mml>\n"))
((stringp (car handle))
- (mapcar 'mml-insert-mime (cdr handle))
+ (mapc 'mml-insert-mime (cdr handle))
(insert "<#/multipart>\n"))
(textp
(let ((charset (mail-content-type-get
(define-key main "\C-c\C-m" map)
main))
+(defun mml-toggle-gcc-externalize-attachments ()
+ (interactive)
+ (prog1
+ (setq gnus-gcc-externalize-attachments
+ (not gnus-gcc-externalize-attachments))
+ (message "gnus-gcc-externalize-attachments is `%s'."
+ gnus-gcc-externalize-attachments)))
+
(easy-menu-define
mml-menu mml-mode-map ""
`("Attachments"
'(:help "Attach a file at point"))]
["Attach Buffer..." mml-attach-buffer
,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a buffer to the outgoing MIME message"))]
+ '(:help "Attach a buffer to the outgoing message"))]
["Attach External..." mml-attach-external
,@(if (featurep 'xemacs) '(t)
- '(:help "Attach reference to file"))]
+ '(:help "Attach reference to an external file"))]
+ ;; ["Externalize Attachments"
+ ;; (lambda () (interactive) (mml-toggle-gcc-externalize-attachments))
+ ;; ,@(if (featurep 'xemacs) nil
+ ;; '(:help "Save attachments as external parts in Gcc copies"))
+ ;; :visible (booleanp gnus-gcc-externalize-attachments)
+ ;; :style radio
+ ;; :selected (equal gnus-gcc-externalize-attachments t) ]
+ "----"
;;
("Change Security Method"
["PGP/MIME"
["Encrypt/Sign off" mml-unsecure-message
,@(if (featurep 'xemacs) '(t)
'(:help "Don't Encrypt/Sign Message"))]
+ ;; Do we have separate encrypt and encrypt/sign commands for parts?
+ ["Sign Part" mml-secure-sign t]
+ ["Encrypt Part" mml-secure-encrypt t]
+ "----"
;; Maybe we could remove these, because people who write MML most probably
;; don't use the menu:
["Insert Part..." mml-insert-part
["Insert Multipart..." mml-insert-multipart
:active (message-in-body-p)]
;;
- ;; Do we have separate encrypt and encrypt/sign commands for parts?
- ["Sign Part" mml-secure-sign t]
- ["Encrypt Part" mml-secure-encrypt t]
;;["Narrow" mml-narrow-to-part t]
["Quote MML in region" mml-quote-region
:active (message-mark-active-p)
["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))
+ ["PGG manual" (lambda () (interactive) (message-info mml2015-use))
+ :visible (equal mml2015-use 'pgg)
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the PGG manual"))]
+ ["EasyPG manual" (lambda () (interactive) (message-info mml2015-use))
+ :visible (equal mml2015-use 'epg)
,@(if (featurep 'xemacs) '(t)
- '(:help "Display the PGG manual"))]))
+ '(:help "Display the EasyPG manual"))]))
(defvar mml-mode nil
"Minor mode for editing MML.")
"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
+ :version "23.1" ;; No Gnus
:group 'message)
(defun mml-minibuffer-read-file (prompt)
don't ask for options. If it is t, ask the user whether or not
to specify options."
:type '(choice
- (const :tag "Non" nil)
+ (const :tag "None" nil)
(const :tag "Query" t)
(list :value (type description disposition)
(set :inline t
(mml-insert-tag 'part 'type type 'disposition "inline")
(forward-line -1))
+(declare-function message-subscribed-p "message" ())
+(declare-function message-make-mail-followup-to "message"
+ (&optional only-show-subscribed))
+(declare-function message-position-on-field "message" (header &rest afters))
+
(defun mml-preview-insert-mail-followup-to ()
"Insert a Mail-Followup-To header before previewing an article.
Should be adopted if code in `message-send-mail' is changed."
(defvar mml-preview-buffer nil)
+(autoload 'gnus-make-hashtable "gnus-util")
+(autoload 'widget-button-press "wid-edit" nil t)
+(declare-function widget-event-point "wid-edit" (event))
+;; If gnus-buffer-configuration is bound this is loaded.
+(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
+;; Called after message-mail-p, which autoloads message.
+(declare-function message-news-p "message" ())
+(declare-function message-options-set-recipient "message" ())
+(declare-function message-generate-headers "message" (headers))
+(declare-function message-sort-headers "message" ())
+
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
If RAW, display a raw encoded MIME message.
projects / gnus / blobdiff