28 |
;;; Commentary: |
;;; Commentary: |
29 |
|
|
30 |
;; Internal support for MH-E package. |
;; Internal support for MH-E package. |
31 |
;; Support for generating an mhn composition file. |
;; Support for generating MH-style directives for mhn or mhbuild as well as |
32 |
;; MIME is supported only by MH 6.8 or later. |
;; MML (MIME Meta Language) tags. MH-style directives are supported by MH 6.8 |
33 |
|
;; or later. |
34 |
|
|
35 |
;;; Change Log: |
;;; Change Log: |
36 |
|
|
42 |
(require 'gnus-util) |
(require 'gnus-util) |
43 |
(require 'mh-gnus) |
(require 'mh-gnus) |
44 |
|
|
|
(autoload 'gnus-article-goto-header "gnus-art") |
|
45 |
(autoload 'article-emphasize "gnus-art") |
(autoload 'article-emphasize "gnus-art") |
46 |
(autoload 'gnus-get-buffer-create "gnus") |
(autoload 'gnus-article-goto-header "gnus-art") |
47 |
(autoload 'gnus-eval-format "gnus-spec") |
(autoload 'gnus-eval-format "gnus-spec") |
48 |
(autoload 'widget-convert-button "wid-edit") |
(autoload 'gnus-get-buffer-create "gnus") |
49 |
(autoload 'message-options-set-recipient "message") |
(autoload 'message-options-set-recipient "message") |
50 |
(autoload 'mml-unsecure-message "mml-sec") |
(autoload 'mml-attach-file "mml") |
|
(autoload 'mml-minibuffer-read-file "mml") |
|
|
(autoload 'mml-minibuffer-read-description "mml") |
|
51 |
(autoload 'mml-insert-empty-tag "mml") |
(autoload 'mml-insert-empty-tag "mml") |
52 |
|
(autoload 'mml-minibuffer-read-description "mml") |
53 |
|
(autoload 'mml-minibuffer-read-disposition "mml") |
54 |
|
(autoload 'mml-minibuffer-read-file "mml") |
55 |
(autoload 'mml-to-mime "mml") |
(autoload 'mml-to-mime "mml") |
56 |
(autoload 'mml-attach-file "mml") |
(autoload 'mml-unsecure-message "mml-sec") |
57 |
(autoload 'rfc2047-decode-region "rfc2047") |
(autoload 'rfc2047-decode-region "rfc2047") |
58 |
|
(autoload 'widget-convert-button "wid-edit") |
59 |
|
|
60 |
;;;###mh-autoload |
;;;###mh-autoload |
61 |
(defun mh-compose-insertion (&optional inline) |
(defun mh-compose-insertion (&optional inline) |
62 |
"Add a directive to insert a MIME part from a file, using mhn or gnus. |
"Add tag to include a file such as an image or sound. |
63 |
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. |
You are prompted for the filename containing the object, the media type if it |
64 |
If it is set to 'gnus, then that will be used instead. |
cannot be determined automatically, and a content description. If you're using |
65 |
|
MH-style directives, you will also be prompted for additional attributes. |
66 |
|
|
67 |
|
The option `mh-compose-insertion' controls what type of tags are inserted. |
68 |
Optional argument INLINE means make it an inline attachment." |
Optional argument INLINE means make it an inline attachment." |
69 |
(interactive "P") |
(interactive "P") |
70 |
(if (equal mh-compose-insertion 'gnus) |
(if (equal mh-compose-insertion 'mml) |
71 |
(if inline |
(if inline |
72 |
(mh-mml-attach-file "inline") |
(mh-mml-attach-file "inline") |
73 |
(mh-mml-attach-file)) |
(mh-mml-attach-file)) |
74 |
(call-interactively 'mh-mhn-compose-insertion))) |
(call-interactively 'mh-mh-attach-file))) |
75 |
|
|
76 |
;;;###mh-autoload |
;;;###mh-autoload |
77 |
(defun mh-compose-forward (&optional description folder messages) |
(defun mh-compose-forward (&optional description folder messages) |
78 |
"Add a MIME directive to forward a message, using mhn or gnus. |
"Add tag to forward a message. |
79 |
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used. |
You are prompted for a content DESCRIPTION, the name of the FOLDER in which |
80 |
If it is set to 'gnus, then that will be used instead. |
the messages to forward are located, and the MESSAGES' numbers. |
81 |
Optional argument DESCRIPTION is a description of the attachment. |
|
82 |
Optional argument FOLDER is the folder from which the forwarded message should |
The option `mh-compose-insertion' controls what type of tags are inserted." |
|
come. |
|
|
Optional argument MESSAGES is the range of messages to forward. |
|
|
If any of the optional arguments are absent, they are prompted for." |
|
83 |
(interactive (let* |
(interactive (let* |
84 |
((description (read-string "Forw Content-description: ")) |
((description (mml-minibuffer-read-description)) |
85 |
(folder (mh-prompt-for-folder "Message from" |
(folder (mh-prompt-for-folder "Message from" |
86 |
mh-sent-from-folder nil)) |
mh-sent-from-folder nil)) |
87 |
(messages (let ((default-message |
(messages (let ((default-message |
107 |
(if (null range) |
(if (null range) |
108 |
(error "No messages in specified range")) |
(error "No messages in specified range")) |
109 |
(dolist (message range) |
(dolist (message range) |
110 |
(if (equal mh-compose-insertion 'gnus) |
(if (equal mh-compose-insertion 'mml) |
111 |
(mh-mml-forward-message description folder (format "%s" message)) |
(mh-mml-forward-message description folder (format "%s" message)) |
112 |
(mh-mhn-compose-forw description folder message))))) |
(mh-mh-forward-message description folder (format "%s" message)))))) |
113 |
|
|
114 |
;; To do: |
;; To do: |
115 |
;; paragraph code should not fill # lines if MIME enabled. |
;; paragraph code should not fill # lines if MIME enabled. |
116 |
;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter] |
;; implement mh-auto-mh-to-mime (if non-nil, \\[mh-send-letter] |
117 |
;; invokes mh-edit-mhn automatically before sending.) |
;; invokes mh-mh-to-mime automatically before sending.) |
118 |
;; actually, instead of mh-auto-edit-mhn, |
;; actually, instead of mh-auto-mh-to-mime, |
119 |
;; should read automhnproc from profile |
;; should read automhnproc from profile |
120 |
;; MIME option to mh-forward |
;; MIME option to mh-forward |
121 |
;; command to move to content-description insertion point |
;; command to move to content-description insertion point |
122 |
|
|
123 |
(defvar mh-mhn-args nil |
(defvar mh-mh-to-mime-args nil |
124 |
"Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command. |
"Extra arguments for \\[mh-mh-to-mime] to pass to the \"mhbuild\" command. |
125 |
The arguments are passed to mhn if \\[mh-edit-mhn] is given a |
The arguments are passed to \"mhbuild\" if \\[mh-mh-to-mime] is given a prefix |
126 |
prefix argument. Normally default arguments to mhn are specified in the |
argument. Normally default arguments to \"mhbuild\" are specified in the MH |
127 |
MH profile.") |
profile.") |
128 |
|
|
129 |
(defvar mh-media-type-regexp |
(defvar mh-media-type-regexp |
130 |
(concat (regexp-opt '("text" "image" "audio" "video" "application" |
(concat (regexp-opt '("text" "image" "audio" "video" "application" |
198 |
(mh-file-mime-type-substitute (match-string 0) filename))) |
(mh-file-mime-type-substitute (match-string 0) filename))) |
199 |
(kill-buffer tmp-buffer))))))) |
(kill-buffer tmp-buffer))))))) |
200 |
|
|
|
;;; This is needed for Emacs20 which doesn't have mailcap-mime-types. |
|
201 |
(defvar mh-mime-content-types |
(defvar mh-mime-content-types |
202 |
'(("application/mac-binhex40") ("application/msword") |
'(("application/mac-binhex40") ("application/msword") |
203 |
("application/octet-stream") ("application/pdf") ("application/pgp-keys") |
("application/octet-stream") ("application/pdf") ("application/pgp-keys") |
219 |
("text/richtext") ("text/x-vcard") ("text/xml") |
("text/richtext") ("text/x-vcard") ("text/xml") |
220 |
|
|
221 |
("video/mpeg") ("video/quicktime")) |
("video/mpeg") ("video/quicktime")) |
222 |
"Valid MIME content types. |
"Valid MIME content types for Emacs 20. |
223 |
See documentation for \\[mh-edit-mhn].") |
Obsolete; use `mailcap-mime-types'. |
224 |
|
|
225 |
|
See also \\[mh-mh-to-mime].") |
226 |
|
|
227 |
|
;;; Delete mh-minibuffer-read-type and mh-mime-content-types and use |
228 |
|
;;; mml-minibuffer-read-type when Emacs20 is no longer supported unless we |
229 |
|
;;; think (mh-file-mime-type) is better than (mm-default-file-encoding). |
230 |
|
|
231 |
|
(defun mh-minibuffer-read-type (filename &optional default) |
232 |
|
"Return the content type associated with the given FILENAME. |
233 |
|
If the \"file\" command exists and recognizes the given file, then its value |
234 |
|
is returned\; otherwise, the user is prompted for a type (see |
235 |
|
`mailcap-mime-types' and for Emacs 20, `mh-mime-content-types'). |
236 |
|
Optional argument DEFAULT is returned if a type isn't entered." |
237 |
|
(mailcap-parse-mimetypes) |
238 |
|
(let* ((default (or default |
239 |
|
(mm-default-file-encoding filename) |
240 |
|
"application/octet-stream")) |
241 |
|
(type (or (mh-file-mime-type filename) |
242 |
|
(completing-read |
243 |
|
(format "Content type (default %s): " default) |
244 |
|
(if (fboundp 'mailcap-mime-types) |
245 |
|
(mapcar 'list (mailcap-mime-types)) |
246 |
|
mh-mime-content-types))))) |
247 |
|
(if (not (equal type "")) |
248 |
|
type |
249 |
|
default))) |
250 |
|
|
251 |
;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One: |
;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One: |
252 |
;; Format of Internet Message Bodies. |
;; Format of Internet Message Bodies. |
275 |
"Valid MIME access-type values.") |
"Valid MIME access-type values.") |
276 |
|
|
277 |
;;;###mh-autoload |
;;;###mh-autoload |
278 |
(defun mh-mhn-compose-insertion (filename type description attributes) |
(defun mh-mh-attach-file (filename type description attributes) |
279 |
"Add a directive to insert a MIME message part from a file. |
"Add a tag to insert a MIME message part from a file. |
280 |
This is the typical way to insert non-text parts in a message. |
You are prompted for the FILENAME containing the object, the media TYPE if it |
281 |
|
cannot be determined automatically, and a content DESCRIPTION. In addition, |
282 |
Arguments are FILENAME, which tells where to find the file, TYPE, the MIME |
you are also prompted for additional ATTRIBUTES. |
|
content type, DESCRIPTION, a line of text for the Content-Description field. |
|
|
ATTRIBUTES is a comma separated list of name=value pairs that is appended to |
|
|
the Content-Type field of the attachment. |
|
283 |
|
|
284 |
See also \\[mh-edit-mhn]." |
See also \\[mh-mh-to-mime]." |
285 |
(interactive (let ((filename (read-file-name "Insert contents of: "))) |
(interactive (let ((filename (mml-minibuffer-read-file "Attach file: "))) |
286 |
(list |
(list |
287 |
filename |
filename |
288 |
(or (mh-file-mime-type filename) |
(mh-minibuffer-read-type filename) |
289 |
(completing-read "Content-Type: " |
(mml-minibuffer-read-description) |
290 |
(if (fboundp 'mailcap-mime-types) |
(read-string "Attributes: " |
|
(mapcar 'list (mailcap-mime-types)) |
|
|
mh-mime-content-types))) |
|
|
(read-string "Content-Description: ") |
|
|
(read-string "Content-Attributes: " |
|
291 |
(concat "name=\"" |
(concat "name=\"" |
292 |
(file-name-nondirectory filename) |
(file-name-nondirectory filename) |
293 |
"\""))))) |
"\""))))) |
294 |
(mh-mhn-compose-type filename type description attributes )) |
(mh-mh-compose-type filename type description attributes)) |
295 |
|
|
296 |
(defun mh-mhn-compose-type (filename type |
(defun mh-mh-compose-type (filename type |
297 |
&optional description attributes comment) |
&optional description attributes comment) |
298 |
"Insert a mhn directive to insert a file. |
"Insert an MH-style directive to insert a file. |
|
|
|
299 |
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is |
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is |
300 |
used as the Content-Description field, optional set of ATTRIBUTES and an |
used as the Content-Description field, optional set of ATTRIBUTES and an |
301 |
optional COMMENT can also be included." |
optional COMMENT can also be included." |
311 |
(insert "] " (expand-file-name filename)) |
(insert "] " (expand-file-name filename)) |
312 |
(insert "\n")) |
(insert "\n")) |
313 |
|
|
|
|
|
314 |
;;;###mh-autoload |
;;;###mh-autoload |
315 |
(defun mh-mhn-compose-anon-ftp (host filename type description) |
(defun mh-mh-compose-anon-ftp (host filename type description) |
316 |
"Add a directive for a MIME anonymous ftp external body part. |
"Add tag to include anonymous ftp reference to a file. |
317 |
This directive tells MH to include a reference to a message/external-body part |
You can even have your message initiate an \"ftp\" transfer when the |
318 |
retrievable by anonymous FTP. |
recipient reads the message. You are prompted for the remote |
319 |
|
HOST and FILENAME, the media TYPE, and the content DESCRIPTION. |
|
Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the |
|
|
MIME content type, and DESCRIPTION, a line of text for the Content-description |
|
|
header. |
|
320 |
|
|
321 |
See also \\[mh-edit-mhn]." |
See also \\[mh-mh-to-mime]." |
322 |
(interactive (list |
(interactive (list |
323 |
(read-string "Remote host: ") |
(read-string "Remote host: ") |
324 |
(read-string "Remote filename: ") |
(read-string "Remote filename: ") |
325 |
(completing-read "External Content-Type: " |
(mh-minibuffer-read-type "DUMMY-FILENAME") |
326 |
(if (fboundp 'mailcap-mime-types) |
(mml-minibuffer-read-description))) |
327 |
(mapcar 'list (mailcap-mime-types)) |
(mh-mh-compose-external-type "anon-ftp" host filename |
328 |
mh-mime-content-types)) |
type description)) |
|
(read-string "External Content-Description: "))) |
|
|
(mh-mhn-compose-external-type "anon-ftp" host filename |
|
|
type description)) |
|
|
|
|
|
;;;###mh-autoload |
|
|
(defun mh-mhn-compose-external-compressed-tar (host filename description) |
|
|
"Add a directive to include a MIME reference to a compressed tar file. |
|
|
The file should be available via anonymous ftp. This directive tells MH to |
|
|
include a reference to a message/external-body part. |
|
329 |
|
|
330 |
Arguments are HOST and FILENAME, which tell where to find the file, and |
;;;###mh-autoload |
331 |
DESCRIPTION, a line of text for the Content-description header. |
(defun mh-mh-compose-external-compressed-tar (host filename description) |
332 |
|
"Add tag to include anonymous ftp reference to a compressed tar file. |
333 |
|
In addition to retrieving the file via anonymous \"ftp\" as per the |
334 |
|
\\[mh-mh-compose-anon-ftp] command, the file will also be uncompressed and |
335 |
|
untarred. You are prompted for the remote HOST and FILENAME and the content |
336 |
|
DESCRIPTION. |
337 |
|
|
338 |
See also \\[mh-edit-mhn]." |
See also \\[mh-mh-to-mime]." |
339 |
(interactive (list |
(interactive (list |
340 |
(read-string "Remote host: ") |
(read-string "Remote host: ") |
341 |
(read-string "Remote filename: ") |
(read-string "Remote filename: ") |
342 |
(read-string "Tar file Content-description: "))) |
(mml-minibuffer-read-description))) |
343 |
(mh-mhn-compose-external-type "anon-ftp" host filename |
(mh-mh-compose-external-type "anon-ftp" host filename |
344 |
"application/octet-stream" |
"application/octet-stream" |
345 |
description |
description |
346 |
"type=tar; conversions=x-compress" |
"type=tar; conversions=x-compress" |
347 |
"mode=image")) |
"mode=image")) |
348 |
|
|
349 |
;;;###mh-autoload |
;;;###mh-autoload |
350 |
(defun mh-mhn-compose-external-type (access-type host filename type |
(defun mh-mh-compose-external-type (access-type host filename type |
351 |
&optional description |
&optional description |
352 |
attributes extra-params |
attributes parameters |
353 |
comment) |
comment) |
354 |
"Add a directive to include a MIME reference to a remote file. |
"Add tag to refer to a remote file. |
355 |
The file should be available via anonymous ftp. This directive tells MH to |
This command is a general utility for referencing external files. In fact, all |
356 |
include a reference to a message/external-body part. |
of the other commands that insert directives to access external files call |
357 |
|
this command. You are prompted for the ACCESS-TYPE, remote HOST and FILENAME, |
358 |
Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the |
and content TYPE. If you provide a prefix argument, you are also prompted for |
359 |
file and TYPE which is the MIME Content-Type. Optional arguments include |
a content DESCRIPTION, ATTRIBUTES, PARAMETERS, and a COMMENT. |
|
DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES, |
|
|
EXTRA-PARAMS, and COMMENT. |
|
360 |
|
|
361 |
See also \\[mh-edit-mhn]." |
See also \\[mh-mh-to-mime]." |
362 |
(interactive (list |
(interactive (list |
363 |
(completing-read "Access Type: " mh-access-types) |
(completing-read "Access type: " mh-access-types) |
364 |
(read-string "Remote host: ") |
(read-string "Remote host: ") |
365 |
(read-string "Remote url-path: ") |
(read-string "Remote filename: ") |
366 |
(completing-read "Content-Type: " |
(mh-minibuffer-read-type "DUMMY-FILENAME") |
367 |
(if (fboundp 'mailcap-mime-types) |
(if current-prefix-arg (mml-minibuffer-read-description)) |
|
(mapcar 'list (mailcap-mime-types)) |
|
|
mh-mime-content-types)) |
|
|
(if current-prefix-arg (read-string "Content-description: ")) |
|
368 |
(if current-prefix-arg (read-string "Attributes: ")) |
(if current-prefix-arg (read-string "Attributes: ")) |
369 |
(if current-prefix-arg (read-string "Extra Parameters: ")) |
(if current-prefix-arg (read-string "Parameters: ")) |
370 |
(if current-prefix-arg (read-string "Comment: ")))) |
(if current-prefix-arg (read-string "Comment: ")))) |
371 |
(beginning-of-line) |
(beginning-of-line) |
372 |
(insert "#@" type) |
(insert "#@" type) |
384 |
(let ((directory (file-name-directory filename))) |
(let ((directory (file-name-directory filename))) |
385 |
(and directory |
(and directory |
386 |
(insert "; directory=\"" directory "\""))) |
(insert "; directory=\"" directory "\""))) |
387 |
(and extra-params |
(and parameters |
388 |
(insert "; " extra-params)) |
(insert "; " parameters)) |
389 |
(insert "\n")) |
(insert "\n")) |
390 |
|
|
391 |
;;;###mh-autoload |
;;;###mh-autoload |
392 |
(defun mh-mhn-compose-forw (&optional description folder messages) |
(defun mh-mh-forward-message (&optional description folder messages) |
393 |
"Add a forw directive to this message, to forward a message with MIME. |
"Add tag to forward a message. |
394 |
This directive tells MH to include the named messages in this one. |
You are prompted for a content DESCRIPTION, the name of the FOLDER in which |
395 |
|
the messages to forward are located, and the MESSAGES' numbers. |
396 |
|
|
397 |
Arguments are DESCRIPTION, a line of text for the Content-description header, |
See also \\[mh-mh-to-mime]." |
|
and FOLDER and MESSAGES, which name the message(s) to be forwarded. |
|
|
|
|
|
See also \\[mh-edit-mhn]." |
|
398 |
(interactive (list |
(interactive (list |
399 |
(read-string "Forw Content-description: ") |
(mml-minibuffer-read-description) |
400 |
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
401 |
(read-string (concat "Messages" |
(read-string (concat "Messages" |
402 |
(if (numberp mh-sent-from-msg) |
(if (numberp mh-sent-from-msg) |
403 |
(format " (default %d): " mh-sent-from-msg) |
(format " (default %d): " |
404 |
|
mh-sent-from-msg) |
405 |
": "))))) |
": "))))) |
406 |
(beginning-of-line) |
(beginning-of-line) |
407 |
(insert "#forw [") |
(insert "#forw [") |
422 |
(insert "\n")) |
(insert "\n")) |
423 |
|
|
424 |
;;;###mh-autoload |
;;;###mh-autoload |
425 |
(defun mh-edit-mhn (&optional extra-args) |
(defun mh-mh-to-mime (&optional extra-args) |
426 |
"Format the current draft for MIME, expanding any mhn directives. |
"Compose MIME message from MH-style directives. |
427 |
|
Typically, you send a message with attachments just like any other message. |
428 |
Process the current draft with the mhn program, which, using directives |
However, you may take a sneak preview of the MIME encoding if you wish by |
429 |
already inserted in the draft, fills in all the MIME components and header |
running this command. |
430 |
fields. |
|
431 |
|
If you wish to pass additional arguments to \"mhbuild\" (\"mhn\") to affect |
432 |
This step is performed automatically when sending the message, but this |
how it builds your message, use the `mh-mh-to-mime-args' option. For example, |
433 |
function may be called manually before sending the draft as well. |
you can build a consistency check into the message by setting |
434 |
|
`mh-mh-to-mime-args' to \"-check\". The recipient of your message can then run |
435 |
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the |
\"mhbuild -check\" on the message--\"mhbuild\" (\"mhn\") will complain if the |
436 |
list `mh-mhn-args' are passed to mhn if this function is passed an optional |
message has been corrupted on the way. This command only consults this option |
437 |
prefix argument EXTRA-ARGS. |
when given a prefix argument. |
|
|
|
|
For assistance with creating mhn directives to insert various types of |
|
|
components in a message, see \\[mh-mhn-compose-insertion] (generic insertion |
|
|
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via |
|
|
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to |
|
|
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward |
|
|
message). |
|
438 |
|
|
439 |
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no |
The value of `mh-mh-to-mime-hook' is a list of functions to be called after |
440 |
arguments, after performing the conversion. |
the message has been formatted. |
441 |
|
|
442 |
The mhn program is part of MH version 6.8 or later." |
The effects of this command can be undone by running \\[mh-mh-to-mime-undo]." |
443 |
(interactive "*P") |
(interactive "*P") |
444 |
(mh-mhn-quote-unescaped-sharp) |
(mh-mh-quote-unescaped-sharp) |
445 |
(save-buffer) |
(save-buffer) |
446 |
(message "mhn editing...") |
(message "Running %s..." (if (mh-variant-p 'nmh) "mhbuild" "mhn")) |
447 |
(cond |
(cond |
448 |
((mh-variant-p 'nmh) |
((mh-variant-p 'nmh) |
449 |
(mh-exec-cmd-error nil |
(mh-exec-cmd-error nil |
450 |
"mhbuild" (if extra-args mh-mhn-args) buffer-file-name)) |
"mhbuild" |
451 |
|
(if extra-args mh-mh-to-mime-args) |
452 |
|
buffer-file-name)) |
453 |
(t |
(t |
454 |
(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
455 |
"mhn" (if extra-args mh-mhn-args) buffer-file-name))) |
"mhn" |
456 |
|
(if extra-args mh-mh-to-mime-args) |
457 |
|
buffer-file-name))) |
458 |
(revert-buffer t t) |
(revert-buffer t t) |
459 |
(message "mhn editing...done") |
(message "Running %s...done" (if (mh-variant-p 'nmh) "mhbuild" "mhn")) |
460 |
(run-hooks 'mh-edit-mhn-hook)) |
(run-hooks 'mh-mh-to-mime-hook)) |
461 |
|
|
462 |
(defun mh-mhn-quote-unescaped-sharp () |
(defun mh-mh-quote-unescaped-sharp () |
463 |
"Quote `#' characters that haven't been quoted for `mhbuild'. |
"Quote `#' characters that haven't been quoted for \"mhbuild\". |
464 |
If the `#' character is present in the first column, but it isn't part of a |
If the `#' character is present in the first column, but it isn't part of a |
465 |
MHN directive then `mhbuild' gives an error. This function will quote all such |
MH-style directive then \"mhbuild\" gives an error. This function will quote |
466 |
characters." |
all such characters." |
467 |
(save-excursion |
(save-excursion |
468 |
(goto-char (point-min)) |
(goto-char (point-min)) |
469 |
(while (re-search-forward "^#" nil t) |
(while (re-search-forward "^#" nil t) |
470 |
(beginning-of-line) |
(beginning-of-line) |
471 |
(unless (mh-mhn-directive-present-p (point) (line-end-position)) |
(unless (mh-mh-directive-present-p (point) (line-end-position)) |
472 |
(insert "#")) |
(insert "#")) |
473 |
(goto-char (line-end-position))))) |
(goto-char (line-end-position))))) |
474 |
|
|
475 |
;;;###mh-autoload |
;;;###mh-autoload |
476 |
(defun mh-revert-mhn-edit (noconfirm) |
(defun mh-mh-to-mime-undo (noconfirm) |
477 |
"Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. |
"Undo effects of \\[mh-mh-to-mime]. |
478 |
Optional non-nil argument NOCONFIRM means don't ask for confirmation." |
Optional non-nil argument NOCONFIRM means don't ask for confirmation." |
479 |
(interactive "*P") |
(interactive "*P") |
480 |
(if (null buffer-file-name) |
(if (null buffer-file-name) |
501 |
(after-find-file nil))) |
(after-find-file nil))) |
502 |
|
|
503 |
;;;###mh-autoload |
;;;###mh-autoload |
504 |
(defun mh-mhn-directive-present-p (&optional begin end) |
(defun mh-mh-directive-present-p (&optional begin end) |
505 |
"Check if the text between BEGIN and END might be a MHN directive. |
"Check if the text between BEGIN and END might be a MH-style directive. |
506 |
The optional argument BEGIN defaults to the beginning of the buffer, while END |
The optional argument BEGIN defaults to the beginning of the buffer, while END |
507 |
defaults to the the end of the buffer." |
defaults to the the end of the buffer." |
508 |
(unless begin (setq begin (point-min))) |
(unless begin (setq begin (point-min))) |
509 |
(unless end (setq end (point-max))) |
(unless end (setq end (point-max))) |
510 |
(save-excursion |
(save-excursion |
511 |
(block 'search-for-mhn-directive |
(block 'search-for-mh-directive |
512 |
(goto-char begin) |
(goto-char begin) |
513 |
(while (re-search-forward "^#" end t) |
(while (re-search-forward "^#" end t) |
514 |
(let ((s (buffer-substring-no-properties (point) (line-end-position)))) |
(let ((s (buffer-substring-no-properties (point) (line-end-position)))) |
515 |
(cond ((equal s "")) |
(cond ((equal s "")) |
516 |
((string-match "^forw[ \t\n]+" s) |
((string-match "^forw[ \t\n]+" s) |
517 |
(return-from 'search-for-mhn-directive t)) |
(return-from 'search-for-mh-directive t)) |
518 |
(t (let ((first-token (car (split-string s "[ \t;@]")))) |
(t (let ((first-token (car (split-string s "[ \t;@]")))) |
519 |
(when (and first-token |
(when (and first-token |
520 |
(string-match mh-media-type-regexp |
(string-match mh-media-type-regexp |
521 |
first-token)) |
first-token)) |
522 |
(return-from 'search-for-mhn-directive t))))))) |
(return-from 'search-for-mh-directive t))))))) |
523 |
nil))) |
nil))) |
524 |
|
|
525 |
|
|
528 |
|
|
529 |
;;;###mh-autoload |
;;;###mh-autoload |
530 |
(defun mh-mml-to-mime () |
(defun mh-mml-to-mime () |
531 |
"Compose MIME message from mml directives. |
"Compose MIME message from MML tags. |
532 |
This step is performed automatically when sending the message, but this |
Typically, you send a message with attachments just like any other message. |
533 |
function may be called manually before sending the draft as well." |
However, you may take a sneak preview of the MIME encoding if you wish by |
534 |
|
running this command. |
535 |
|
|
536 |
|
This action can be undone by running \\[undo]." |
537 |
(interactive) |
(interactive) |
538 |
(require 'message) |
(require 'message) |
539 |
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP |
(when mh-pgp-support-flag ;; This is only needed for PGP |
540 |
(message-options-set-recipient)) |
(message-options-set-recipient)) |
541 |
(let ((saved-text (buffer-string)) |
(let ((saved-text (buffer-string)) |
542 |
(buffer (current-buffer)) |
(buffer (current-buffer)) |
578 |
(if current-prefix-arg |
(if current-prefix-arg |
579 |
(let ((def (or (car mh-mml-cryptographic-method-history) |
(let ((def (or (car mh-mml-cryptographic-method-history) |
580 |
mh-mml-method-default))) |
mh-mml-method-default))) |
581 |
(completing-read (format "Method: [%s] " def) |
(completing-read (format "Method (default %s): " def) |
582 |
'(("pgp") ("pgpmime") ("smime")) |
'(("pgp") ("pgpmime") ("smime")) |
583 |
nil t nil 'mh-mml-cryptographic-method-history def)) |
nil t nil 'mh-mml-cryptographic-method-history def)) |
584 |
mh-mml-method-default)) |
mh-mml-method-default)) |
585 |
|
|
586 |
;;;###mh-autoload |
;;;###mh-autoload |
587 |
(defun mh-mml-attach-file (&optional disposition) |
(defun mh-mml-attach-file (&optional disposition) |
588 |
"Attach a file to the outgoing MIME message. |
"Add a tag to insert a MIME message part from a file. |
589 |
The file is not inserted or encoded until you send the message with |
You are prompted for the filename containing the object, the media type if it |
590 |
`\\[mh-send-letter]'. |
cannot be determined automatically, a content description and the disposition |
591 |
Message disposition is \"inline\" or \"attachment\" and is prompted for if |
of the attachment. |
|
DISPOSITION is nil. |
|
592 |
|
|
593 |
This is basically `mml-attach-file' from gnus, modified such that a prefix |
This is basically `mml-attach-file' from Gnus, modified such that a prefix |
594 |
argument yields an `inline' disposition and Content-Type is determined |
argument yields an `inline' disposition and Content-Type is determined |
595 |
automatically." |
automatically." |
596 |
(let* ((file (mml-minibuffer-read-file "Attach file: ")) |
(let* ((file (mml-minibuffer-read-file "Attach file: ")) |
597 |
(type (or (mh-file-mime-type file) |
(type (mh-minibuffer-read-type file)) |
|
(completing-read "Content-Type: " |
|
|
(if (fboundp 'mailcap-mime-types) |
|
|
(mapcar 'list (mailcap-mime-types)) |
|
|
mh-mime-content-types)))) |
|
598 |
(description (mml-minibuffer-read-description)) |
(description (mml-minibuffer-read-description)) |
599 |
(dispos (or disposition |
(dispos (or disposition |
600 |
(completing-read "Disposition: [attachment] " |
(mml-minibuffer-read-disposition type)))) |
|
'(("attachment")("inline")) |
|
|
nil t nil nil |
|
|
"attachment")))) |
|
601 |
(mml-insert-empty-tag 'part 'type type 'filename file |
(mml-insert-empty-tag 'part 'type type 'filename file |
602 |
'disposition dispos 'description description))) |
'disposition dispos 'description description))) |
603 |
|
|
604 |
(defvar mh-identity-pgg-default-user-id) |
(defvar mh-identity-pgg-default-user-id) |
605 |
|
|
606 |
(defun mh-secure-message (method mode &optional identity) |
(defun mh-secure-message (method mode &optional identity) |
607 |
"Add directive to Encrypt/Sign an entire message. |
"Add tag to encrypt or sign message. |
608 |
METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". |
METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". |
609 |
MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\". |
MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\". |
610 |
IDENTITY is optionally the default-user-id to use." |
IDENTITY is optionally the default-user-id to use." |
611 |
(if (not mh-gnus-pgp-support-flag) |
(if (not mh-pgp-support-flag) |
612 |
(error "Sorry. Your version of gnus does not support PGP/GPG") |
(error "Your version of Gnus does not support PGP/GPG") |
613 |
;; Check the arguments |
;; Check the arguments |
614 |
(let ((valid-methods (list "pgpmime" "pgp" "smime")) |
(let ((valid-methods (list "pgpmime" "pgp" "smime")) |
615 |
(valid-modes (list "sign" "encrypt" "signencrypt" "none"))) |
(valid-modes (list "sign" "encrypt" "signencrypt" "none"))) |
616 |
(if (not (member method valid-methods)) |
(if (not (member method valid-methods)) |
617 |
(error "Sorry. METHOD \"%s\" is invalid" method)) |
(error "Method \"%s\" is invalid" method)) |
618 |
(if (not (member mode valid-modes)) |
(if (not (member mode valid-modes)) |
619 |
(error "Sorry. MODE \"%s\" is invalid" mode)) |
(error "Mode \"%s\" is invalid" mode)) |
620 |
(mml-unsecure-message) |
(mml-unsecure-message) |
621 |
(if (not (string= mode "none")) |
(if (not (string= mode "none")) |
622 |
(save-excursion |
(save-excursion |
629 |
|
|
630 |
;;;###mh-autoload |
;;;###mh-autoload |
631 |
(defun mh-mml-unsecure-message (&optional ignore) |
(defun mh-mml-unsecure-message (&optional ignore) |
632 |
"Remove any secure message directives. |
"Remove any secure message tags. |
633 |
The IGNORE argument is not used." |
The argument IGNORE is not used." |
634 |
(interactive "P") |
(interactive "P") |
635 |
(if (not mh-gnus-pgp-support-flag) |
(if (not mh-pgp-support-flag) |
636 |
(error "Sorry. Your version of gnus does not support PGP/GPG") |
(error "Your version of Gnus does not support PGP/GPG") |
637 |
(mml-unsecure-message))) |
(mml-unsecure-message))) |
638 |
|
|
639 |
;;;###mh-autoload |
;;;###mh-autoload |
640 |
(defun mh-mml-secure-message-sign (method) |
(defun mh-mml-secure-message-sign (method) |
641 |
"Add security directive to sign the entire message using METHOD." |
"Add tag to sign the message. |
642 |
|
A proper multipart message is created for you when you send the message. Use |
643 |
|
the \\[mh-mml-unsecure-message] command to remove this tag. Use a prefix |
644 |
|
argument METHOD to be prompted for one of the possible security methods |
645 |
|
(see `mh-mml-method-default')." |
646 |
(interactive (list (mh-mml-query-cryptographic-method))) |
(interactive (list (mh-mml-query-cryptographic-method))) |
647 |
(mh-secure-message method "sign" mh-identity-pgg-default-user-id)) |
(mh-secure-message method "sign" mh-identity-pgg-default-user-id)) |
648 |
|
|
649 |
;;;###mh-autoload |
;;;###mh-autoload |
650 |
(defun mh-mml-secure-message-encrypt (method) |
(defun mh-mml-secure-message-encrypt (method) |
651 |
"Add security directive to encrypt the entire message using METHOD." |
"Add tag to encrypt the message. |
652 |
|
A proper multipart message is created for you when you send the message. Use |
653 |
|
the \\[mh-mml-unsecure-message] command to remove this tag. Use a prefix |
654 |
|
argument METHOD to be prompted for one of the possible security methods |
655 |
|
(see `mh-mml-method-default')." |
656 |
(interactive (list (mh-mml-query-cryptographic-method))) |
(interactive (list (mh-mml-query-cryptographic-method))) |
657 |
(mh-secure-message method "encrypt" mh-identity-pgg-default-user-id)) |
(mh-secure-message method "encrypt" mh-identity-pgg-default-user-id)) |
658 |
|
|
659 |
;;;###mh-autoload |
;;;###mh-autoload |
660 |
(defun mh-mml-secure-message-signencrypt (method) |
(defun mh-mml-secure-message-signencrypt (method) |
661 |
"Add security directive to encrypt and sign the entire message using METHOD." |
"Add tag to encrypt and sign the message. |
662 |
|
A proper multipart message is created for you when you send the message. Use |
663 |
|
the \\[mh-mml-unsecure-message] command to remove this tag. Use a prefix |
664 |
|
argument METHOD to be prompted for one of the possible security methods |
665 |
|
(see `mh-mml-method-default')." |
666 |
(interactive (list (mh-mml-query-cryptographic-method))) |
(interactive (list (mh-mml-query-cryptographic-method))) |
667 |
(mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id)) |
(mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id)) |
668 |
|
|
669 |
;;;###mh-autoload |
;;;###mh-autoload |
670 |
(defun mh-mml-directive-present-p () |
(defun mh-mml-tag-present-p () |
671 |
"Check if the current buffer has text which may be an MML directive." |
"Check if the current buffer has text which may be a MML tag." |
672 |
(save-excursion |
(save-excursion |
673 |
(goto-char (point-min)) |
(goto-char (point-min)) |
674 |
(re-search-forward |
(re-search-forward |
691 |
|
|
692 |
;;;###mh-autoload |
;;;###mh-autoload |
693 |
(defun mh-destroy-postponed-handles () |
(defun mh-destroy-postponed-handles () |
694 |
"Free MIME data for externally displayed mime parts." |
"Free MIME data for externally displayed MIME parts." |
695 |
(let ((mime-data (mh-buffer-data))) |
(let ((mime-data (mh-buffer-data))) |
696 |
(when mime-data |
(when mime-data |
697 |
(mm-destroy-parts (mh-mime-handles mime-data))) |
(mm-destroy-parts (mh-mime-handles mime-data))) |
745 |
|
|
746 |
;;;###mh-autoload |
;;;###mh-autoload |
747 |
(defun mh-display-smileys () |
(defun mh-display-smileys () |
748 |
"Function to display smileys." |
"Display smileys." |
749 |
(when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) |
(when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) |
750 |
(mh-funcall-if-exists smiley-region (point-min) (point-max)))) |
(mh-funcall-if-exists smiley-region (point-min) (point-max)))) |
751 |
|
|
752 |
;;;###mh-autoload |
;;;###mh-autoload |
753 |
(defun mh-display-emphasis () |
(defun mh-display-emphasis () |
754 |
"Function to display graphical emphasis." |
"Display graphical emphasis." |
755 |
(when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) |
(when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) |
756 |
(flet ((article-goto-body ())) ; shadow this function to do nothing |
(flet ((article-goto-body ())) ; shadow this function to do nothing |
757 |
(save-excursion |
(save-excursion |
808 |
"Store the MIME parts of the current message. |
"Store the MIME parts of the current message. |
809 |
If ARG, prompt for directory, else use that specified by the variable |
If ARG, prompt for directory, else use that specified by the variable |
810 |
`mh-mime-save-parts-default-directory'. These directories may be superseded by |
`mh-mime-save-parts-default-directory'. These directories may be superseded by |
811 |
mh_profile directives, since this function calls on mhstore or mhn to do the |
MH profile components, since this function calls on mhstore to do the work." |
|
actual storing." |
|
812 |
(interactive "P") |
(interactive "P") |
813 |
(let ((msg (if (eq major-mode 'mh-show-mode) |
(let ((msg (if (eq major-mode 'mh-show-mode) |
814 |
(mh-show-buffer-message-number) |
(mh-show-buffer-message-number) |
948 |
(mh-mime-display-single handle)) |
(mh-mime-display-single handle)) |
949 |
((equal (car handle) "multipart/alternative") |
((equal (car handle) "multipart/alternative") |
950 |
(mh-mime-display-alternative (cdr handle))) |
(mh-mime-display-alternative (cdr handle))) |
951 |
((and mh-gnus-pgp-support-flag |
((and mh-pgp-support-flag |
952 |
(or (equal (car handle) "multipart/signed") |
(or (equal (car handle) "multipart/signed") |
953 |
(equal (car handle) "multipart/encrypted"))) |
(equal (car handle) "multipart/encrypted"))) |
954 |
(mh-mime-display-security handle)) |
(mh-mime-display-security handle)) |
1055 |
(mm-inlined-p handle))))))) |
(mm-inlined-p handle))))))) |
1056 |
(save-restriction |
(save-restriction |
1057 |
(narrow-to-region (point) (if (eobp) (point) (1+ (point)))) |
(narrow-to-region (point) (if (eobp) (point) (1+ (point)))) |
1058 |
(cond ((and mh-gnus-pgp-support-flag |
(cond ((and mh-pgp-support-flag |
1059 |
(equal type "application/pgp-signature")) |
(equal type "application/pgp-signature")) |
1060 |
nil) ; skip signatures as they are already handled... |
nil) ; skip signatures as they are already handled... |
1061 |
((not displayp) |
((not displayp) |