Mercurial > hg > xemacs-beta

comparison lisp/mh-e/mh-mime.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 131b0175ea99
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; mh-mime --- mh-e support for composing MIME messages
2 ;; Time-stamp: <95/08/19 16:45:17 gildea>
3
4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
5
6 ;; This file is part of mh-e, part of GNU Emacs.
7
8 ;; GNU Emacs 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 ;; GNU Emacs 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 GNU Emacs; 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 ;;; Change Log:
29
30 ;; $Id: mh-mime.el,v 1.1.1.1 1996/12/18 03:34:37 steve Exp $
31
32 ;;; Code:
33
34 (provide 'mh-mime)
35 (require 'mh-comp)
36
37
38 ;; To do:
39 ;; paragraph code should not fill # lines if MIME enabled.
40 ;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
41 ;; invokes mh-edit-mhn automatically before sending.)
42 ;; actually, instead of mh-auto-edit-mhn,
43 ;; should read automhnproc from profile
44 ;; MIME option to mh-forward
45 ;; command to move to content-description insertion point
46
47 (defvar mh-mhn-args nil
48 "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
49 The arguments are passed to mhn if \\[mh-edit-mhn] is given a
50 prefix argument. Normally default arguments to mhn are specified in the
51 MH profile.")
52
53 (defvar mh-edit-mhn-hook nil
54 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn].")
55
56 ;;;###autoload
57 (defvar mh-mime-content-types
58 '(("text/plain") ("text/richtext")
59 ("multipart/mixed") ("multipart/alternative") ("multipart/digest")
60 ("multipart/parallel")
61 ("message/rfc822") ("message/partial") ("message/external-body")
62 ("application/octet-stream") ("application/postscript")
63 ("image/jpeg") ("image/gif")
64 ("audio/basic")
65 ("video/mpeg"))
66 "Legal MIME content types. See documentation for \\[mh-edit-mhn].")
67
68 (defun mh-mhn-compose-insertion (pathname type description)
69 "Add a directive to insert a MIME message part from a file.
70 This is the typical way to insert non-text parts in a message.
71 Arguments are PATHNAME, which tells where to find the file, TYPE, the
72 MIME content type, and DESCRIPTION, a line of text for the
73 Content-description header. See also \\[mh-edit-mhn]."
74 (interactive (list
75 (read-file-name "Insert contents of: ")
76 (completing-read "Content-type: "
77 mh-mime-content-types nil nil nil)
78 (read-string "Content-description: ")))
79 (mh-mhn-compose-type pathname type description))
80
81 (defun mh-mhn-compose-type (pathname type
82 &optional description attributes comment)
83 (beginning-of-line)
84 (insert "#" type)
85 (and attributes
86 (insert "; " attributes))
87 (and comment
88 (insert " (" comment ")"))
89 (insert " [")
90 (and description
91 (insert description))
92 (insert "] " (expand-file-name pathname))
93 (insert "\n"))
94
95
96 (defun mh-mhn-compose-anon-ftp (host pathname type description)
97 "Add a directive for a MIME anonymous ftp external body part.
98 This directive tells MH to include a reference to a
99 message/external-body part retrievable by anonymous FTP. Arguments
100 are HOST and PATHNAME, which tell where to find the file, TYPE, the
101 MIME content type, and DESCRIPTION, a line of text for the
102 Content-description header. See also \\[mh-edit-mhn]."
103 (interactive (list
104 (read-string "Remote host: ")
105 (read-string "Remote pathname: ")
106 (completing-read "External Content-type: "
107 mh-mime-content-types nil nil nil)
108 (read-string "External Content-description: ")))
109 (mh-mhn-compose-external-type "anon-ftp" host pathname
110 type description))
111
112 (defun mh-mhn-compose-external-compressed-tar (host pathname description)
113 "Add a directive to include a MIME reference to a compressed tar file.
114 The file should be available via anonymous ftp. This directive
115 tells MH to include a reference to a message/external-body part.
116 Arguments are HOST and PATHNAME, which tell where to find the file, and
117 DESCRIPTION, a line of text for the Content-description header.
118 See also \\[mh-edit-mhn]."
119 (interactive (list
120 (read-string "Remote host: ")
121 (read-string "Remote pathname: ")
122 (read-string "Tar file Content-description: ")))
123 (mh-mhn-compose-external-type "anon-ftp" host pathname
124 "application/octet-stream"
125 description
126 "type=tar; conversions=x-compress"
127 "mode=image"))
128
129
130 (defun mh-mhn-compose-external-type (access-type host pathname type
131 &optional description
132 attributes extra-params comment)
133 (beginning-of-line)
134 (insert "#@" type)
135 (and attributes
136 (insert "; " attributes))
137 (and comment
138 (insert " (" comment ") "))
139 (insert " [")
140 (and description
141 (insert description))
142 (insert "] ")
143 (insert "access-type=" access-type "; ")
144 (insert "site=" host)
145 (insert "; name=" (file-name-nondirectory pathname))
146 (insert "; directory=\"" (file-name-directory pathname) "\"")
147 (and extra-params
148 (insert "; " extra-params))
149 (insert "\n"))
150
151 (defun mh-mhn-compose-forw (&optional description folder messages)
152 "Add a forw directive to this message, to forward a message with MIME.
153 This directive tells MH to include the named messages in this one.
154 Arguments are DESCRIPTION, a line of text for the Content-description header,
155 and FOLDER and MESSAGES, which name the message(s) to be forwarded.
156 See also \\[mh-edit-mhn]."
157 (interactive (list
158 (read-string "Forw Content-description: ")
159 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
160 (read-string (format "Messages%s: "
161 (if mh-sent-from-msg
162 (format " [%d]" mh-sent-from-msg)
163 "")))))
164 (beginning-of-line)
165 (insert "#forw [")
166 (and description
167 (not (string= description ""))
168 (insert description))
169 (insert "]")
170 (and folder
171 (not (string= folder ""))
172 (insert " " folder))
173 (if (and messages
174 (not (string= messages "")))
175 (let ((start (point)))
176 (insert " " messages)
177 (subst-char-in-region start (point) ?, ? ))
178 (if mh-sent-from-msg
179 (insert " " (int-to-string mh-sent-from-msg))))
180 (insert "\n"))
181
182 (defun mh-edit-mhn (&optional extra-args)
183 "Format the current draft for MIME, expanding any mhn directives.
184 Process the current draft with the mhn program, which,
185 using directives already inserted in the draft, fills in
186 all the MIME components and header fields.
187 This step should be done last just before sending the message.
188 The mhn program is part of MH version 6.8 or later.
189 The `\\[mh-revert-mhn-edit]' command undoes this command.
190 The arguments in the list `mh-mhn-args' are passed to mhn
191 if this function is passed an argument.
192
193 For assistance with creating mhn directives to insert
194 various types of components in a message, see
195 \\[mh-mhn-compose-insertion] (generic insertion from a file),
196 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
197 \\[mh-mhn-compose-external-compressed-tar] \
198 \(reference to compressed tar file via anonymous ftp), and
199 \\[mh-mhn-compose-forw] (forward message)."
200 (interactive "*P")
201 (save-buffer)
202 (message "mhn editing...")
203 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
204 "mhn" (if extra-args mh-mhn-args) buffer-file-name)
205 (revert-buffer t t)
206 (message "mhn editing...done")
207 (run-hooks 'mh-edit-mhn-hook))
208
209
210 (defun mh-revert-mhn-edit (noconfirm)
211 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
212 Optional non-nil argument means don't ask for confirmation."
213 (interactive "*P")
214 (if (null buffer-file-name)
215 (error "Buffer does not seem to be associated with any file"))
216 (let ((backup-strings '("," "#"))
217 backup-file)
218 (while (and backup-strings
219 (not (file-exists-p
220 (setq backup-file
221 (concat (file-name-directory buffer-file-name)
222 (car backup-strings)
223 (file-name-nondirectory buffer-file-name)
224 ".orig")))))
225 (setq backup-strings (cdr backup-strings)))
226 (or backup-strings
227 (error "mhn backup file for %s no longer exists!" buffer-file-name))
228 (or noconfirm
229 (yes-or-no-p (format "Revert buffer from file %s? "
230 backup-file))
231 (error "mhn edit revert not confirmed."))
232 (let ((buffer-read-only nil))
233 (erase-buffer)
234 (insert-file-contents backup-file))
235 (after-find-file nil)))