Mercurial > emacs
comparison lisp/mail/mh-mime.el @ 6365:a1b8926f7ece
entered into RCS
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 15 Mar 1994 06:16:30 +0000 |
parents | |
children | c9c652970786 |
comparison
equal
deleted
inserted
replaced
6364:59663885e8c7 | 6365:a1b8926f7ece |
---|---|
1 ;;; mh-mime --- mh-e support for composing MIME messages | |
2 ;; Time-stamp: <94/03/08 08:41:27 gildea> | |
3 | |
4 ;; Copyright 1993 Free Software Foundation, Inc. | |
5 | |
6 ;; This file is part of mh-e. | |
7 | |
8 ;; mh-e is free software; you can redistribute it and/or modify | |
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 | |
13 ;; mh-e is distributed in the hope that it will be useful, | |
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 | |
19 ;; along with mh-e; see the file COPYING. If not, write to | |
20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
21 | |
22 ;;; Commentary: | |
23 | |
24 ;;; Internal support for mh-e package. | |
25 ;;; Support for generating an mhn composition file. | |
26 ;;; MIME is supported only by MH 6.8 or later. | |
27 | |
28 ;;; Code: | |
29 | |
30 (provide 'mh-mime) | |
31 (require 'mh-comp) | |
32 | |
33 | |
34 ;; To do: | |
35 ;; paragraph code should not fill # lines if MIME enabled. | |
36 ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] | |
37 ;; invokes mh-edit-mhn automatically before sending.) | |
38 ;; actually, instead of mh-auto-edit-mhn, | |
39 ;; should read automhnproc from profile | |
40 ;; MIME option to mh-forward | |
41 ;; command to move to content-description insertion point | |
42 | |
43 (defvar mh-mime-content-types | |
44 '(("text/plain") ("text/richtext") | |
45 ("multipart/mixed") ("multipart/alternative") ("multipart/digest") | |
46 ("multipart/parallel") | |
47 ("message/rfc822") ("message/partial") ("message/external-body") | |
48 ("application/octet-stream") ("application/postscript") | |
49 ("image/jpeg") ("image/gif") | |
50 ("audio/basic") | |
51 ("video/mpeg")) | |
52 "Legal MIME content types.") | |
53 | |
54 (defun mh-mhn-compose-insertion (pathname type description) | |
55 "Add a directive to insert a message part from a file. | |
56 This is the typical way to insert non-text parts in a message. | |
57 See also \\[mh-edit-mhn]." | |
58 (interactive (list | |
59 (read-file-name "Insert contents of: ") | |
60 (completing-read "Content-type: " | |
61 mh-mime-content-types nil nil nil) | |
62 (read-string "Content-description: "))) | |
63 (mh-mhn-compose-type pathname type description)) | |
64 | |
65 (defun mh-mhn-compose-type (pathname type | |
66 &optional description attributes comment) | |
67 (beginning-of-line) | |
68 (insert "#" type) | |
69 (and attributes | |
70 (insert "; " attributes)) | |
71 (and comment | |
72 (insert " (" comment ")")) | |
73 (insert " [") | |
74 (and description | |
75 (insert description)) | |
76 (insert "] " (expand-file-name pathname)) | |
77 (insert "\n")) | |
78 | |
79 | |
80 (defun mh-mhn-compose-anon-ftp (host pathname type description) | |
81 "Add a directive for an anonymous ftp external body part. | |
82 This directive tells MH to include a reference to a message/external-body part | |
83 retrievable by anonymous FTP. See also \\[mh-edit-mhn]." | |
84 (interactive (list | |
85 (read-string "Remote host: ") | |
86 (read-string "Remote pathname: ") | |
87 (completing-read "External Content-type: " | |
88 mh-mime-content-types nil nil nil) | |
89 (read-string "External Content-description: "))) | |
90 (mh-mhn-compose-external-type "anon-ftp" host pathname | |
91 type description)) | |
92 | |
93 (defun mh-mhn-compose-external-compressed-tar (host pathname description) | |
94 "Add a directive to include a reference to a compressed tar file. | |
95 The file should be available via anonymous ftp. | |
96 This directive tells MH to include a reference to a message/external-body part. | |
97 See also \\[mh-edit-mhn]." | |
98 (interactive (list | |
99 (read-string "Remote host: ") | |
100 (read-string "Remote pathname: ") | |
101 (read-string "Tar file Content-description: "))) | |
102 (mh-mhn-compose-external-type "anon-ftp" host pathname | |
103 "application/octet-stream" | |
104 description | |
105 "type=tar; conversions=x-compress" | |
106 "mode=image")) | |
107 | |
108 | |
109 (defun mh-mhn-compose-external-type (access-type host pathname type | |
110 &optional description | |
111 attributes extra-params comment) | |
112 (beginning-of-line) | |
113 (insert "#@" type) | |
114 (and attributes | |
115 (insert "; " attributes)) | |
116 (and comment | |
117 (insert " (" comment ") ")) | |
118 (insert " [") | |
119 (and description | |
120 (insert description)) | |
121 (insert "] ") | |
122 (insert "access-type=" access-type "; ") | |
123 (insert "site=" host) | |
124 (insert "; name=" (file-name-nondirectory pathname)) | |
125 (insert "; directory=\"" (file-name-directory pathname) "\"") | |
126 (and extra-params | |
127 (insert "; " extra-params)) | |
128 (insert "\n")) | |
129 | |
130 (defun mh-mhn-compose-forw (&optional description msgs folder) | |
131 "Add a forw directive to this message. | |
132 This directive tells MH to include the named messages in this one. | |
133 Arguments are DESCRIPTION, a line of text for the Content-description header, | |
134 MESSAGES and FOLDER, which name the message(s) to be forwarded. | |
135 See also \\[mh-edit-mhn]." | |
136 (interactive (list | |
137 (read-string "Forw Content-description: ") | |
138 (read-string (format "Messages%s: " | |
139 (if mh-sent-from-msg | |
140 (format " [%d]" mh-sent-from-msg) | |
141 ""))) | |
142 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil))) | |
143 (beginning-of-line) | |
144 (insert "#forw [") | |
145 (and description | |
146 (not (string= description "")) | |
147 (insert description)) | |
148 (insert "]") | |
149 (and folder | |
150 (not (string= folder "")) | |
151 (insert " " folder)) | |
152 (if (and msgs | |
153 (not (string= msgs ""))) | |
154 (let ((start (point))) | |
155 (insert " " msgs) | |
156 (subst-char-in-region start (point) ?, ? )) | |
157 (if mh-sent-from-msg | |
158 (insert " " (int-to-string mh-sent-from-msg)))) | |
159 (insert "\n")) | |
160 | |
161 (defun mh-edit-mhn () | |
162 "Filter the current draft through the mhn program for MIME formatting. | |
163 Using directives already inserted in the draft, fills in | |
164 all the MIME components and header fields. | |
165 This step should be done last just before sending the message. | |
166 The mhn program is part of MH version 6.8 or later. | |
167 The `\\[mh-revert-mhn-edit]' command undoes this command. | |
168 For assistance with creating MIME directives to insert | |
169 various types of components in a message, see | |
170 \\[mh-mhn-compose-insertion] (generic insertion from a file), | |
171 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp), | |
172 \\[mh-mhn-compose-external-compressed-tar] \ | |
173 \(reference to compressed tar file via anonymous ftp), and | |
174 \\[mh-mhn-compose-forw] (forward message)." | |
175 (interactive "*") | |
176 (save-buffer) | |
177 (message "mhn editing...") | |
178 (mh-exec-cmd-error (format "mhdraft=%s" (buffer-file-name)) | |
179 "mhn" (buffer-file-name)) | |
180 (revert-buffer t t) | |
181 (message "mhn editing...done")) | |
182 | |
183 | |
184 (defun mh-revert-mhn-edit (noconfirm) | |
185 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file. | |
186 Argument (optional) non-nil means don't ask for confirmation." | |
187 (interactive "*P") | |
188 (if (null buffer-file-name) | |
189 (error "Buffer does not seem to be associated with any file")) | |
190 (let ((backup-strings '("," "#")) | |
191 backup-file) | |
192 (while (and backup-strings | |
193 (not (file-exists-p | |
194 (setq backup-file | |
195 (concat (file-name-directory buffer-file-name) | |
196 (car backup-strings) | |
197 (file-name-nondirectory buffer-file-name) | |
198 ".orig"))))) | |
199 (setq backup-strings (cdr backup-strings))) | |
200 (or backup-strings | |
201 (error "mhn backup file for %s no longer exists!" buffer-file-name)) | |
202 (or noconfirm | |
203 (yes-or-no-p (format "Revert buffer from file %s? " | |
204 backup-file)) | |
205 (error "mhn edit revert not confirmed.")) | |
206 (let ((buffer-read-only nil)) | |
207 (erase-buffer) | |
208 (insert-file-contents backup-file)) | |
209 (after-find-file nil))) |