1 ;;; mh-mime.el --- mh-e support for composing MIME messages
3 ;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
5 ;; Author: Bill Wohler <wohler@newt.com>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ;; Internal support for mh-e package.
30 ;; Support for generating an mhn composition file.
31 ;; MIME is supported only by MH 6.8 or later.
35 ;; $Id: mh-mime.el,v 1.26 2002/04/07 19:20:56 wohler Exp $
43 ;; paragraph code should not fill # lines if MIME enabled.
44 ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
45 ;; invokes mh-edit-mhn automatically before sending.)
46 ;; actually, instead of mh-auto-edit-mhn,
47 ;; should read automhnproc from profile
48 ;; MIME option to mh-forward
49 ;; command to move to content-description insertion point
51 (defvar mh-mhn-args nil
52 "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
53 The arguments are passed to mhn if \\[mh-edit-mhn] is given a
54 prefix argument. Normally default arguments to mhn are specified in the
57 (defvar mh-edit-mhn-hook nil
58 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn].")
60 (defun mh-have-file-command ()
61 "Return t if 'file' command is on the system.
62 'file -i' is used to get MIME type of composition insertion."
63 (when (not (boundp 'mh-have-file-command
))
64 (load "executable" t t
) ; executable-find not autoloaded in emacs20
65 (setq mh-have-file-command
66 (and (fboundp 'executable-find
)
67 (executable-find "file") ; file command exists
68 ; and accepts -i and -b args.
69 (zerop (call-process "file" nil nil nil
"-i" "-b"
70 (expand-file-name "inc" mh-progs
))))))
73 (defun mh-file-mime-type (filename)
74 "Return MIME type of FILENAME from file command.
75 Returns nil if file command not on system."
77 ((not (mh-have-file-command))
78 nil
) ;No file command, exit now.
79 ((not (and (file-exists-p filename
)(file-readable-p filename
)))
83 (let ((tmp-buffer (get-buffer-create mh-temp-buffer
)))
84 (set-buffer tmp-buffer
)
87 (call-process "file" nil
'(t nil
) nil
"-b" "-i"
88 (expand-file-name filename
))
89 (goto-char (point-min))
90 (if (not (re-search-forward mh-media-type-regexp nil t
))
93 (kill-buffer tmp-buffer
)))))))
95 (defvar mh-mhn-compose-insert-p nil
96 "Buffer-local variable to know whether MIME insertion was done.
97 Triggers an automatic call to `mh-edit-mhn' in `mh-send-letter'.")
98 (make-variable-buffer-local 'mh-mhn-compose-insert-p
)
100 ;;; This is needed for Emacs20 which doesn't have mailcap-mime-types.
101 (defvar mh-mime-content-types
102 '(("application/mac-binhex40") ("application/msword")
103 ("application/octet-stream") ("application/pdf") ("application/pgp-keys")
104 ("application/pgp-signature") ("application/pkcs7-signature")
105 ("application/postscript") ("application/rtf")
106 ("application/vnd.ms-excel") ("application/vnd.ms-powerpoint")
107 ("application/vnd.ms-project") ("application/vnd.ms-tnef")
108 ("application/wordperfect5.1") ("application/wordperfect6.0")
111 ("audio/basic") ("audio/mpeg")
113 ("image/gif") ("image/jpeg") ("image/png")
115 ("message/delivery-status")
116 ("message/external-body") ("message/partial") ("message/rfc822")
118 ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
119 ("text/richtext") ("text/xml")
121 ("video/mpeg") ("video/quicktime"))
122 "Legal MIME content types.
123 See documentation for \\[mh-edit-mhn].")
125 (defvar mh-media-type-regexp
126 (concat (regexp-opt '("text" "image" "audio" "video" "application"
127 "multipart" "message") t
)
129 "Regexp matching valid media types used in MIME attachment compositions.")
131 (defun mh-mhn-compose-insertion (filename type description attributes
)
132 "Add a directive to insert a MIME message part from a file.
133 This is the typical way to insert non-text parts in a message. Arguments are
134 FILENAME, which tells where to find the file, TYPE, the MIME content type,
135 DESCRIPTION, a line of text for the Content-Description field. ATTRIBUTES is a
136 comma separated list of name=value pairs that is appended to the Content-Type
137 field of the attachment.
138 See also \\[mh-edit-mhn]."
139 (interactive (let ((filename (read-file-name "Insert contents of: ")))
142 (or (mh-file-mime-type filename
)
143 (completing-read "Content-Type: "
144 (if (and (require 'mailcap nil t
)
145 (fboundp 'mailcap-mime-types
))
146 (mapcar 'list
(mailcap-mime-types))
147 mh-mime-content-types
)))
148 (read-string "Content-Description: ")
149 (read-string "Content-Attributes: "
151 (file-name-nondirectory filename
)
153 (mh-mhn-compose-type filename type description attributes
))
155 (defun mh-mhn-compose-type (filename type
156 &optional description attributes comment
)
157 (setq mh-mhn-compose-insert-p t
)
161 (insert "; " attributes
))
163 (insert " (" comment
")"))
166 (insert description
))
167 (insert "] " (expand-file-name filename
))
171 (defun mh-mhn-compose-anon-ftp (host filename type description
)
172 "Add a directive for a MIME anonymous ftp external body part.
173 This directive tells MH to include a reference to a
174 message/external-body part retrievable by anonymous FTP. Arguments
175 are HOST and FILENAME, which tell where to find the file, TYPE, the
176 MIME content type, and DESCRIPTION, a line of text for the
177 Content-description header. See also \\[mh-edit-mhn]."
179 (read-string "Remote host: ")
180 (read-string "Remote filename: ")
181 (completing-read "External Content-Type: "
182 (if (and (require 'mailcap nil t
)
183 (fboundp 'mailcap-mime-types
))
184 (mapcar 'list
(mailcap-mime-types))
185 mh-mime-content-types
))
186 (read-string "External Content-Description: ")))
187 (mh-mhn-compose-external-type "anon-ftp" host filename
190 (defun mh-mhn-compose-external-compressed-tar (host filename description
)
191 "Add a directive to include a MIME reference to a compressed tar file.
192 The file should be available via anonymous ftp. This directive
193 tells MH to include a reference to a message/external-body part.
194 Arguments are HOST and FILENAME, which tell where to find the file, and
195 DESCRIPTION, a line of text for the Content-description header.
196 See also \\[mh-edit-mhn]."
198 (read-string "Remote host: ")
199 (read-string "Remote filename: ")
200 (read-string "Tar file Content-description: ")))
201 (mh-mhn-compose-external-type "anon-ftp" host filename
202 "application/octet-stream"
204 "type=tar; conversions=x-compress"
208 (defun mh-mhn-compose-external-type (access-type host filename type
209 &optional description
210 attributes extra-params comment
)
211 (setq mh-mhn-compose-insert-p t
)
215 (insert "; " attributes
))
217 (insert " (" comment
") "))
220 (insert description
))
222 (insert "access-type=" access-type
"; ")
223 (insert "site=" host
)
224 (insert "; name=" (file-name-nondirectory filename
))
225 (insert "; directory=\"" (file-name-directory filename
) "\"")
227 (insert "; " extra-params
))
230 (defun mh-mhn-compose-forw (&optional description folder messages
)
231 "Add a forw directive to this message, to forward a message with MIME.
232 This directive tells MH to include the named messages in this one.
233 Arguments are DESCRIPTION, a line of text for the Content-description header,
234 and FOLDER and MESSAGES, which name the message(s) to be forwarded.
235 See also \\[mh-edit-mhn]."
237 (read-string "Forw Content-description: ")
238 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil
)
239 (read-string (format "Messages%s: "
241 (format " [%d]" mh-sent-from-msg
)
243 (setq mh-mhn-compose-insert-p t
)
247 (not (string= description
""))
248 (insert description
))
251 (not (string= folder
""))
254 (not (string= messages
"")))
255 (let ((start (point)))
256 (insert " " messages
)
257 (subst-char-in-region start
(point) ?
, ?
))
259 (insert " " (int-to-string mh-sent-from-msg
))))
262 (defun mh-edit-mhn (&optional extra-args
)
263 "Format the current draft for MIME, expanding any mhn directives.
265 Process the current draft with the mhn program, which, using directives
266 already inserted in the draft, fills in all the MIME components and header
269 This step should be done last just before sending the message.
271 The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
272 list `mh-mhn-args' are passed to mhn if this function is passed an optional
273 prefix argument EXTRA-ARGS.
275 For assistance with creating mhn directives to insert various types of
276 components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
277 from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
278 anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
279 compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
280 message). If these helper functions are used, `mh-edit-mhn' is run
281 automatically when the draft is sent.
283 The mhn program is part of MH version 6.8 or later."
286 (message "mhn editing...")
289 (mh-exec-cmd-error nil
290 "mhbuild" (if extra-args mh-mhn-args
) buffer-file-name
))
292 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name
)
293 "mhn" (if extra-args mh-mhn-args
) buffer-file-name
)))
294 (setq mh-mhn-compose-insert-p nil
)
296 (message "mhn editing...done")
297 (run-hooks 'mh-edit-mhn-hook
))
300 (defun mh-revert-mhn-edit (noconfirm)
301 "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
302 Optional non-nil argument NOCONFIRM means don't ask for confirmation."
304 (if (null buffer-file-name
)
305 (error "Buffer does not seem to be associated with any file"))
306 (let ((backup-strings '("," "#"))
308 (while (and backup-strings
311 (concat (file-name-directory buffer-file-name
)
313 (file-name-nondirectory buffer-file-name
)
315 (setq backup-strings
(cdr backup-strings
)))
317 (error "Backup file for %s no longer exists!" buffer-file-name
))
319 (yes-or-no-p (format "Revert buffer from file %s? "
321 (error "Revert not confirmed"))
322 (let ((buffer-read-only nil
))
324 (insert-file-contents backup-file
))
325 (after-find-file nil
)))
327 ;;; mh-mime.el ends here