Mercurial > emacs
annotate lisp/mail/mh-mime.el @ 18474:c21ad324c249
[__sony_news && _SYSTYPE_SYSV]: Include sym.h and sys/elf_mips.h.
(unexec): Add __sony_news && _SYSTYPE_SYSV conditionals.
Add a _nec_ews_svr4 conditional.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 27 Jun 1997 22:08:03 +0000 |
parents | 7417db9e3f61 |
children | 61483b4c169c |
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 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
31 ;; $Id: mh-mime.el,v 1.6 1996/01/14 07:34:30 erik Exp rms $ |
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: " |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
82 (concat "name=" |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
83 (file-name-nondirectory filename)))))) |
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
84 (mh-mhn-compose-type filename type description attributes )) |
6365 | 85 |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
86 (defun mh-mhn-compose-type (filename type |
6365 | 87 &optional description attributes comment) |
88 (beginning-of-line) | |
89 (insert "#" type) | |
90 (and attributes | |
91 (insert "; " attributes)) | |
92 (and comment | |
93 (insert " (" comment ")")) | |
94 (insert " [") | |
95 (and description | |
96 (insert description)) | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
97 (insert "] " (expand-file-name filename)) |
6365 | 98 (insert "\n")) |
99 | |
100 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
101 (defun mh-mhn-compose-anon-ftp (host filename type description) |
11506 | 102 "Add a directive for a MIME anonymous ftp external body part. |
11332 | 103 This directive tells MH to include a reference to a |
104 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
|
105 are HOST and FILENAME, which tell where to find the file, TYPE, the |
11332 | 106 MIME content type, and DESCRIPTION, a line of text for the |
107 Content-description header. See also \\[mh-edit-mhn]." | |
6365 | 108 (interactive (list |
109 (read-string "Remote host: ") | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
110 (read-string "Remote filename: ") |
6365 | 111 (completing-read "External Content-type: " |
112 mh-mime-content-types nil nil nil) | |
113 (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
|
114 (mh-mhn-compose-external-type "anon-ftp" host filename |
6365 | 115 type description)) |
116 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
117 (defun mh-mhn-compose-external-compressed-tar (host filename description) |
11506 | 118 "Add a directive to include a MIME reference to a compressed tar file. |
11332 | 119 The file should be available via anonymous ftp. This directive |
120 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
|
121 Arguments are HOST and FILENAME, which tell where to find the file, and |
11332 | 122 DESCRIPTION, a line of text for the Content-description header. |
6365 | 123 See also \\[mh-edit-mhn]." |
124 (interactive (list | |
125 (read-string "Remote host: ") | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
126 (read-string "Remote filename: ") |
6365 | 127 (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
|
128 (mh-mhn-compose-external-type "anon-ftp" host filename |
6365 | 129 "application/octet-stream" |
130 description | |
131 "type=tar; conversions=x-compress" | |
132 "mode=image")) | |
133 | |
134 | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
135 (defun mh-mhn-compose-external-type (access-type host filename type |
6365 | 136 &optional description |
137 attributes extra-params comment) | |
138 (beginning-of-line) | |
139 (insert "#@" type) | |
140 (and attributes | |
141 (insert "; " attributes)) | |
142 (and comment | |
143 (insert " (" comment ") ")) | |
144 (insert " [") | |
145 (and description | |
146 (insert description)) | |
147 (insert "] ") | |
148 (insert "access-type=" access-type "; ") | |
149 (insert "site=" host) | |
16862
7417db9e3f61
Rename args PATHNAME to FILENAME in various functions.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
150 (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
|
151 (insert "; directory=\"" (file-name-directory filename) "\"") |
6365 | 152 (and extra-params |
153 (insert "; " extra-params)) | |
154 (insert "\n")) | |
155 | |
11332 | 156 (defun mh-mhn-compose-forw (&optional description folder messages) |
11506 | 157 "Add a forw directive to this message, to forward a message with MIME. |
6365 | 158 This directive tells MH to include the named messages in this one. |
159 Arguments are DESCRIPTION, a line of text for the Content-description header, | |
11506 | 160 and FOLDER and MESSAGES, which name the message(s) to be forwarded. |
6365 | 161 See also \\[mh-edit-mhn]." |
162 (interactive (list | |
163 (read-string "Forw Content-description: ") | |
11332 | 164 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
6365 | 165 (read-string (format "Messages%s: " |
166 (if mh-sent-from-msg | |
167 (format " [%d]" mh-sent-from-msg) | |
11332 | 168 ""))))) |
6365 | 169 (beginning-of-line) |
170 (insert "#forw [") | |
171 (and description | |
172 (not (string= description "")) | |
173 (insert description)) | |
174 (insert "]") | |
175 (and folder | |
176 (not (string= folder "")) | |
177 (insert " " folder)) | |
11332 | 178 (if (and messages |
179 (not (string= messages ""))) | |
6365 | 180 (let ((start (point))) |
11332 | 181 (insert " " messages) |
6365 | 182 (subst-char-in-region start (point) ?, ? )) |
183 (if mh-sent-from-msg | |
184 (insert " " (int-to-string mh-sent-from-msg)))) | |
185 (insert "\n")) | |
186 | |
11332 | 187 (defun mh-edit-mhn (&optional extra-args) |
188 "Format the current draft for MIME, expanding any mhn directives. | |
189 Process the current draft with the mhn program, which, | |
190 using directives already inserted in the draft, fills in | |
6365 | 191 all the MIME components and header fields. |
192 This step should be done last just before sending the message. | |
193 The mhn program is part of MH version 6.8 or later. | |
194 The `\\[mh-revert-mhn-edit]' command undoes this command. | |
11332 | 195 The arguments in the list `mh-mhn-args' are passed to mhn |
196 if this function is passed an argument. | |
197 | |
198 For assistance with creating mhn directives to insert | |
6365 | 199 various types of components in a message, see |
200 \\[mh-mhn-compose-insertion] (generic insertion from a file), | |
201 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), | |
202 \\[mh-mhn-compose-external-compressed-tar] \ | |
203 \(reference to compressed tar file via anonymous ftp), and | |
204 \\[mh-mhn-compose-forw] (forward message)." | |
11332 | 205 (interactive "*P") |
6365 | 206 (save-buffer) |
207 (message "mhn editing...") | |
11332 | 208 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
209 "mhn" (if extra-args mh-mhn-args) buffer-file-name) | |
6365 | 210 (revert-buffer t t) |
11332 | 211 (message "mhn editing...done") |
212 (run-hooks 'mh-edit-mhn-hook)) | |
6365 | 213 |
214 | |
215 (defun mh-revert-mhn-edit (noconfirm) | |
216 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. | |
11332 | 217 Optional non-nil argument means don't ask for confirmation." |
6365 | 218 (interactive "*P") |
219 (if (null buffer-file-name) | |
220 (error "Buffer does not seem to be associated with any file")) | |
221 (let ((backup-strings '("," "#")) | |
222 backup-file) | |
223 (while (and backup-strings | |
224 (not (file-exists-p | |
225 (setq backup-file | |
226 (concat (file-name-directory buffer-file-name) | |
227 (car backup-strings) | |
228 (file-name-nondirectory buffer-file-name) | |
229 ".orig"))))) | |
230 (setq backup-strings (cdr backup-strings))) | |
231 (or backup-strings | |
232 (error "mhn backup file for %s no longer exists!" buffer-file-name)) | |
233 (or noconfirm | |
234 (yes-or-no-p (format "Revert buffer from file %s? " | |
235 backup-file)) | |
236 (error "mhn edit revert not confirmed.")) | |
237 (let ((buffer-read-only nil)) | |
238 (erase-buffer) | |
239 (insert-file-contents backup-file)) | |
240 (after-find-file nil))) |