/[emacs]/emacs/lisp/mh-e/mh-mime.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-mime.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20 by wohler, Fri Oct 14 17:15:40 2005 UTC revision 1.21 by wohler, Sun Oct 23 21:26:17 2005 UTC
# Line 28  Line 28 
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    
# Line 41  Line 42 
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
# Line 105  If any of the optional arguments are abs Line 107  If any of the optional arguments are abs
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"
# Line 196  Returns nil if file command not on syste Line 198  Returns nil if file command not on syste
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")
# Line 218  Returns nil if file command not on syste Line 219  Returns nil if file command not on syste
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.
# Line 248  See documentation for \\[mh-edit-mhn].") Line 275  See documentation for \\[mh-edit-mhn].")
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."
# Line 292  optional COMMENT can also be included." Line 311  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)
# Line 378  See also \\[mh-edit-mhn]." Line 384  See also \\[mh-edit-mhn]."
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 [")
# Line 417  See also \\[mh-edit-mhn]." Line 422  See also \\[mh-edit-mhn]."
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)
# Line 499  Optional non-nil argument NOCONFIRM mean Line 501  Optional non-nil argument NOCONFIRM mean
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    
# Line 526  defaults to the the end of the buffer." Line 528  defaults to the the end of the buffer."
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))
# Line 573  number." Line 578  number."
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
# Line 632  IDENTITY is optionally the default-user- Line 629  IDENTITY is optionally the default-user-
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
# Line 682  The IGNORE argument is not used." Line 691  The IGNORE argument is not used."
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)))
# Line 736  This is used to decide if smileys and gr Line 745  This is used to decide if smileys and gr
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
# Line 799  Set from last use.") Line 808  Set from last use.")
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)
# Line 940  displayed." Line 948  displayed."
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))
# Line 1047  This is only useful if a Content-Disposi Line 1055  This is only useful if a Content-Disposi
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)

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26