Mercurial > emacs
annotate lisp/mail/mh-mime.el @ 35759:952c61f346ff
(gnus-article-x-face-command)
(gnus-treat-display-xface, gnus-treat-display-smileys): Add
:version.
author | Dave Love <fx@gnu.org> |
---|---|
date | Wed, 31 Jan 2001 11:56:26 +0000 |
parents | 61483b4c169c |
children | 67b464da13ec |
rev | line source |
---|---|
6365 | 1 ;;; mh-mime --- mh-e support for composing MIME messages |
13387 | 2 ;; Time-stamp: <95/08/19 16:45:17 gildea> |
6365 | 3 |
11332 | 4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. |
6365 | 5 |
13387 | 6 ;; This file is part of mh-e, part of GNU Emacs. |
6365 | 7 |
11333 | 8 ;; GNU Emacs is free software; you can redistribute it and/or modify |
6365 | 9 ;; it under the terms of the GNU General Public License as published by |
10 ;; the Free Software Foundation; either version 2, or (at your option) | |
11 ;; any later version. | |
12 | |
11333 | 13 ;; GNU Emacs is distributed in the hope that it will be useful, |
6365 | 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 ;; GNU General Public License for more details. | |
17 | |
18 ;; You should have received a copy of the GNU General Public License | |
14169 | 19 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 ;; Boston, MA 02111-1307, USA. | |
6365 | 22 |
23 ;;; Commentary: | |
24 | |
14169 | 25 ;; Internal support for mh-e package. |
26 ;; Support for generating an mhn composition file. | |
27 ;; MIME is supported only by MH 6.8 or later. | |
6365 | 28 |
11332 | 29 ;;; Change Log: |
30 | |
23305
61483b4c169c
(mh-mhn-compose-insertion): Use quotes.
Karl Heuer <kwzh@gnu.org>
parents:
16862
diff
changeset
|
31 ;; $Id: mh-mime.el,v 1.7 1997/01/13 03:25:05 rms Exp kwzh $ |
11332 | 32 |
6365 | 33 ;;; Code: |
34 | |
35 (provide 'mh-mime) | |
36 (require 'mh-comp) | |
37 | |
38 | |
39 ;; To do: | |
40 ;; paragraph code should not fill # lines if MIME enabled. | |
41 ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] | |
42 ;; invokes mh-edit-mhn automatically before sending.) | |
43 ;; actually, instead of mh-auto-edit-mhn, | |
44 ;; should read automhnproc from profile | |
45 ;; MIME option to mh-forward | |
46 ;; command to move to content-description insertion point | |
47 | |
11332 | 48 (defvar mh-mhn-args nil |
49 "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command. | |
50 The arguments are passed to mhn if \\[mh-edit-mhn] is given a | |
51 prefix argument. Normally default arguments to mhn are specified in the | |
52 MH profile.") | |
53 | |
54 (defvar mh-edit-mhn-hook nil | |
55 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn].") | |
56 | |
11506 | 57 ;;;###autoload |
6365 | 58 (defvar mh-mime-content-types |
59 '(("text/plain") ("text/richtext") | |
60 ("multipart/mixed") ("multipart/alternative") ("multipart/digest") | |
61 ("multipart/parallel") | |
62 ("message/rfc822") ("message/partial") ("message/external-body") | |
63 ("application/octet-stream") ("application/postscript") | |
64 ("image/jpeg") ("image/gif") | |
65 ("audio/basic") | |
66 ("video/mpeg")) | |
11506 | 67 "Legal MIME content types. See documentation for \\[mh-edit-mhn].") |
6365 | 68 |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
69 (defun mh-mhn-compose-insertion (filename type description attributes) |
11506 | 70 "Add a directive to insert a MIME message part from a file. |
6365 | 71 This is the typical way to insert non-text parts in a message. |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
72 Arguments are FILENAME, which tells where to find the file, TYPE, the |
11332 | 73 MIME content type, and DESCRIPTION, a line of text for the |
74 Content-description header. See also \\[mh-edit-mhn]." | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
75 (interactive (let ((filename (read-file-name "Insert contents of: "))) |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
76 (list |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
77 filename |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
78 (completing-read "Content-type: " |
6365 | 79 mh-mime-content-types nil nil nil) |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
80 (read-string "Content-description: ") |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
81 (read-string "Content-Attributes: " |
23305
61483b4c169c
(mh-mhn-compose-insertion): Use quotes.
Karl Heuer <kwzh@gnu.org>
parents:
16862
diff
changeset
|
82 (concat "name=\"" |
61483b4c169c
(mh-mhn-compose-insertion): Use quotes.
Karl Heuer <kwzh@gnu.org>
parents:
16862
diff
changeset
|
83 (file-name-nondirectory filename) |
61483b4c169c
(mh-mhn-compose-insertion): Use quotes.
Karl Heuer <kwzh@gnu.org>
parents:
16862
diff
changeset
|
84 "\""))))) |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
85 (mh-mhn-compose-type filename type description attributes )) |
6365 | 86 |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
87 (defun mh-mhn-compose-type (filename type |
6365 | 88 &optional description attributes comment) |
89 (beginning-of-line) | |
90 (insert "#" type) | |
91 (and attributes | |
92 (insert "; " attributes)) | |
93 (and comment | |
94 (insert " (" comment ")")) | |
95 (insert " [") | |
96 (and description | |
97 (insert description)) | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
98 (insert "] " (expand-file-name filename)) |
6365 | 99 (insert "\n")) |
100 | |
101 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
102 (defun mh-mhn-compose-anon-ftp (host filename type description) |
11506 | 103 "Add a directive for a MIME anonymous ftp external body part. |
11332 | 104 This directive tells MH to include a reference to a |
105 message/external-body part retrievable by anonymous FTP. Arguments | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
106 are HOST and FILENAME, which tell where to find the file, TYPE, the |
11332 | 107 MIME content type, and DESCRIPTION, a line of text for the |
108 Content-description header. See also \\[mh-edit-mhn]." | |
6365 | 109 (interactive (list |
110 (read-string "Remote host: ") | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
111 (read-string "Remote filename: ") |
6365 | 112 (completing-read "External Content-type: " |
113 mh-mime-content-types nil nil nil) | |
114 (read-string "External Content-description: "))) | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
115 (mh-mhn-compose-external-type "anon-ftp" host filename |
6365 | 116 type description)) |
117 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
118 (defun mh-mhn-compose-external-compressed-tar (host filename description) |
11506 | 119 "Add a directive to include a MIME reference to a compressed tar file. |
11332 | 120 The file should be available via anonymous ftp. This directive |
121 tells MH to include a reference to a message/external-body part. | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
122 Arguments are HOST and FILENAME, which tell where to find the file, and |
11332 | 123 DESCRIPTION, a line of text for the Content-description header. |
6365 | 124 See also \\[mh-edit-mhn]." |
125 (interactive (list | |
126 (read-string "Remote host: ") | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
127 (read-string "Remote filename: ") |
6365 | 128 (read-string "Tar file Content-description: "))) |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
129 (mh-mhn-compose-external-type "anon-ftp" host filename |
6365 | 130 "application/octet-stream" |
131 description | |
132 "type=tar; conversions=x-compress" | |
133 "mode=image")) | |
134 | |
135 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
136 (defun mh-mhn-compose-external-type (access-type host filename type |
6365 | 137 &optional description |
138 attributes extra-params comment) | |
139 (beginning-of-line) | |
140 (insert "#@" type) | |
141 (and attributes | |
142 (insert "; " attributes)) | |
143 (and comment | |
144 (insert " (" comment ") ")) | |
145 (insert " [") | |
146 (and description | |
147 (insert description)) | |
148 (insert "] ") | |
149 (insert "access-type=" access-type "; ") | |
150 (insert "site=" host) | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
151 (insert "; name=" (file-name-nondirectory filename)) |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
152 (insert "; directory=\"" (file-name-directory filename) "\"") |
6365 | 153 (and extra-params |
154 (insert "; " extra-params)) | |
155 (insert "\n")) | |
156 | |
11332 | 157 (defun mh-mhn-compose-forw (&optional description folder messages) |
11506 | 158 "Add a forw directive to this message, to forward a message with MIME. |
6365 | 159 This directive tells MH to include the named messages in this one. |
160 Arguments are DESCRIPTION, a line of text for the Content-description header, | |
11506 | 161 and FOLDER and MESSAGES, which name the message(s) to be forwarded. |
6365 | 162 See also \\[mh-edit-mhn]." |
163 (interactive (list | |
164 (read-string "Forw Content-description: ") | |
11332 | 165 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
6365 | 166 (read-string (format "Messages%s: " |
167 (if mh-sent-from-msg | |
168 (format " [%d]" mh-sent-from-msg) | |
11332 | 169 ""))))) |
6365 | 170 (beginning-of-line) |
171 (insert "#forw [") | |
172 (and description | |
173 (not (string= description "")) | |
174 (insert description)) | |
175 (insert "]") | |
176 (and folder | |
177 (not (string= folder "")) | |
178 (insert " " folder)) | |
11332 | 179 (if (and messages |
180 (not (string= messages ""))) | |
6365 | 181 (let ((start (point))) |
11332 | 182 (insert " " messages) |
6365 | 183 (subst-char-in-region start (point) ?, ? )) |
184 (if mh-sent-from-msg | |
185 (insert " " (int-to-string mh-sent-from-msg)))) | |
186 (insert "\n")) | |
187 | |
11332 | 188 (defun mh-edit-mhn (&optional extra-args) |
189 "Format the current draft for MIME, expanding any mhn directives. | |
190 Process the current draft with the mhn program, which, | |
191 using directives already inserted in the draft, fills in | |
6365 | 192 all the MIME components and header fields. |
193 This step should be done last just before sending the message. | |
194 The mhn program is part of MH version 6.8 or later. | |
195 The `\\[mh-revert-mhn-edit]' command undoes this command. | |
11332 | 196 The arguments in the list `mh-mhn-args' are passed to mhn |
197 if this function is passed an argument. | |
198 | |
199 For assistance with creating mhn directives to insert | |
6365 | 200 various types of components in a message, see |
201 \\[mh-mhn-compose-insertion] (generic insertion from a file), | |
202 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), | |
203 \\[mh-mhn-compose-external-compressed-tar] \ | |
204 \(reference to compressed tar file via anonymous ftp), and | |
205 \\[mh-mhn-compose-forw] (forward message)." | |
11332 | 206 (interactive "*P") |
6365 | 207 (save-buffer) |
208 (message "mhn editing...") | |
11332 | 209 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
210 "mhn" (if extra-args mh-mhn-args) buffer-file-name) | |
6365 | 211 (revert-buffer t t) |
11332 | 212 (message "mhn editing...done") |
213 (run-hooks 'mh-edit-mhn-hook)) | |
6365 | 214 |
215 | |
216 (defun mh-revert-mhn-edit (noconfirm) | |
217 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. | |
11332 | 218 Optional non-nil argument means don't ask for confirmation." |
6365 | 219 (interactive "*P") |
220 (if (null buffer-file-name) | |
221 (error "Buffer does not seem to be associated with any file")) | |
222 (let ((backup-strings '("," "#")) | |
223 backup-file) | |
224 (while (and backup-strings | |
225 (not (file-exists-p | |
226 (setq backup-file | |
227 (concat (file-name-directory buffer-file-name) | |
228 (car backup-strings) | |
229 (file-name-nondirectory buffer-file-name) | |
230 ".orig"))))) | |
231 (setq backup-strings (cdr backup-strings))) | |
232 (or backup-strings | |
233 (error "mhn backup file for %s no longer exists!" buffer-file-name)) | |
234 (or noconfirm | |
235 (yes-or-no-p (format "Revert buffer from file %s? " | |
236 backup-file)) | |
237 (error "mhn edit revert not confirmed.")) | |
238 (let ((buffer-read-only nil)) | |
239 (erase-buffer) | |
240 (insert-file-contents backup-file)) | |
241 (after-find-file nil))) |