[bpt/emacs.git] / lisp / mail / mh-mime.el

;;; mh-mime --- mh-e support for composing MIME messages
;; Time-stamp: <94/11/18 17:48:19 gildea>

;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.

;; This file is part of mh-e.

;; mh-e is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; mh-e is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with mh-e; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;;; Internal support for mh-e package.
;;; Support for generating an mhn composition file.
;;; MIME is supported only by MH 6.8 or later.

;;; Change Log:

;; $Id: mh-mime.el,v 1.5 94/12/27 22:38:10 gildea Exp $

;;; Code:

(provide 'mh-mime)
(require 'mh-comp)


;; To do:
;; paragraph code should not fill # lines if MIME enabled.
;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
;;	invokes mh-edit-mhn automatically before sending.)
;;      actually, instead of mh-auto-edit-mhn,
;;      should read automhnproc from profile
;; MIME option to mh-forward
;; command to move to content-description insertion point

(defvar mh-mhn-args nil
  "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
The arguments are passed to mhn if \\[mh-edit-mhn] is given a
prefix argument.  Normally default arguments to mhn are specified in the
MH profile.")

(defvar mh-edit-mhn-hook nil
  "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn].")

(defvar mh-mime-content-types
  '(("text/plain") ("text/richtext")
    ("multipart/mixed") ("multipart/alternative") ("multipart/digest")
    ("multipart/parallel")
    ("message/rfc822") ("message/partial") ("message/external-body")
    ("application/octet-stream") ("application/postscript")
    ("image/jpeg") ("image/gif")
    ("audio/basic")
    ("video/mpeg"))
  "Legal MIME content types.")

(defun mh-mhn-compose-insertion (pathname type description)
  "Add a directive to insert a message part from a file.
This is the typical way to insert non-text parts in a message.
Arguments are PATHNAME, which tells where to find the file, TYPE, the
MIME content type, and DESCRIPTION, a line of text for the
Content-description header.  See also \\[mh-edit-mhn]."
  (interactive (list
		(read-file-name "Insert contents of: ")
		(completing-read "Content-type: "
				 mh-mime-content-types nil nil nil)
		(read-string "Content-description: ")))
  (mh-mhn-compose-type pathname type description))

(defun mh-mhn-compose-type (pathname type
			    &optional description attributes comment)
  (beginning-of-line)
  (insert "#" type)
  (and attributes
       (insert "; " attributes))
  (and comment
       (insert " (" comment ")"))
  (insert " [")
  (and description
       (insert description))
  (insert "] " (expand-file-name pathname))
  (insert "\n"))


(defun mh-mhn-compose-anon-ftp (host pathname type description)
  "Add a directive for an anonymous ftp external body part.
This directive tells MH to include a reference to a
message/external-body part retrievable by anonymous FTP.  Arguments
are HOST and PATHNAME, which tell where to find the file, TYPE, the
MIME content type, and DESCRIPTION, a line of text for the
Content-description header.  See also \\[mh-edit-mhn]."
  (interactive (list
		(read-string "Remote host: ")
		(read-string "Remote pathname: ")
		(completing-read "External Content-type: "
				 mh-mime-content-types nil nil nil)
		(read-string "External Content-description: ")))
  (mh-mhn-compose-external-type "anon-ftp" host pathname
				type description))

(defun mh-mhn-compose-external-compressed-tar (host pathname description)
  "Add a directive to include a 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.
Arguments are HOST and PATHNAME, which tell where to find the file, and
DESCRIPTION, a line of text for the Content-description header.
See also \\[mh-edit-mhn]."
  (interactive (list
		(read-string "Remote host: ")
		(read-string "Remote pathname: ")
		(read-string "Tar file Content-description: ")))
  (mh-mhn-compose-external-type "anon-ftp" host pathname
				"application/octet-stream"
				description
				"type=tar; conversions=x-compress"
				"mode=image"))


(defun mh-mhn-compose-external-type (access-type host pathname type
				     &optional description
				     attributes extra-params comment)
  (beginning-of-line)
  (insert "#@" type)
  (and attributes
       (insert "; " attributes))
  (and comment
       (insert " (" comment ") "))
  (insert " [")
  (and description
       (insert description))
  (insert "] ")
  (insert "access-type=" access-type "; ")
  (insert "site=" host)
  (insert "; name=" (file-name-nondirectory pathname))
  (insert "; directory=\"" (file-name-directory pathname) "\"")
  (and extra-params
       (insert "; " extra-params))
  (insert "\n"))

(defun mh-mhn-compose-forw (&optional description folder messages)
  "Add a forw directive to this message.
This directive tells MH to include the named messages in this one.
Arguments are DESCRIPTION, a line of text for the Content-description header,
FOLDER and MESSAGES, which name the message(s) to be forwarded.
See also \\[mh-edit-mhn]."
  (interactive (list
		(read-string "Forw Content-description: ")
		(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
		(read-string (format "Messages%s: "
				     (if mh-sent-from-msg
					 (format " [%d]" mh-sent-from-msg)
				       "")))))
  (beginning-of-line)
  (insert "#forw [")
  (and description
       (not (string= description ""))
       (insert description))
  (insert "]")
  (and folder
       (not (string= folder ""))
       (insert " " folder))
  (if (and messages
	   (not (string= messages "")))
      (let ((start (point)))
	(insert " " messages)
	(subst-char-in-region start (point) ?, ? ))
    (if mh-sent-from-msg
	(insert " " (int-to-string mh-sent-from-msg))))
  (insert "\n"))

(defun mh-edit-mhn (&optional extra-args)
  "Format the current draft for MIME, expanding any mhn directives.
Process the current draft with the mhn program, which,
using directives already inserted in the draft, fills in
all the MIME components and header fields.
This step should be done last just before sending the message.
The mhn program is part of MH version 6.8 or later.
The `\\[mh-revert-mhn-edit]' command undoes this command.
The arguments in the list `mh-mhn-args' are passed to mhn
if this function is passed an 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)."
  (interactive "*P")
  (save-buffer)
  (message "mhn editing...")
  (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
		     "mhn" (if extra-args mh-mhn-args) buffer-file-name)
  (revert-buffer t t)
  (message "mhn editing...done")
  (run-hooks 'mh-edit-mhn-hook))


(defun mh-revert-mhn-edit (noconfirm)
  "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
Optional non-nil argument means don't ask for confirmation."
  (interactive "*P")
  (if (null buffer-file-name)
      (error "Buffer does not seem to be associated with any file"))
  (let ((backup-strings '("," "#"))
	backup-file)
    (while (and backup-strings
		(not (file-exists-p
		      (setq backup-file
			    (concat (file-name-directory buffer-file-name)
				    (car backup-strings)
				    (file-name-nondirectory buffer-file-name)
				    ".orig")))))
      (setq backup-strings (cdr backup-strings)))
    (or backup-strings
	(error "mhn backup file for %s no longer exists!" buffer-file-name))
    (or noconfirm
	(yes-or-no-p (format "Revert buffer from file %s? "
			     backup-file))
	(error "mhn edit revert not confirmed."))
    (let ((buffer-read-only nil))
      (erase-buffer)
      (insert-file-contents backup-file))
    (after-find-file nil)))
Commit	Line	Data
c26cf6c8	1	;;; mh-mime --- mh-e support for composing MIME messages
847b8219	2	;; Time-stamp: <94/11/18 17:48:19 gildea>
c26cf6c8	3
847b8219	4	;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
c26cf6c8 RS	5
	6	;; This file is part of mh-e.
	7
	8	;; mh-e is free software; you can redistribute it and/or modify
	9	;; it under the terms of the GNU General Public License as published by
	10	;; the Free Software Foundation; either version 2, or (at your option)
	11	;; any later version.
	12
	13	;; mh-e is distributed in the hope that it will be useful,
	14	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	;; GNU General Public License for more details.
	17
	18	;; You should have received a copy of the GNU General Public License
	19	;; along with mh-e; see the file COPYING. If not, write to
	20	;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
	21
	22	;;; Commentary:
	23
	24	;;; Internal support for mh-e package.
	25	;;; Support for generating an mhn composition file.
	26	;;; MIME is supported only by MH 6.8 or later.
	27
847b8219 KH	28	;;; Change Log:
	29
	30	;; $Id: mh-mime.el,v 1.5 94/12/27 22:38:10 gildea Exp $
	31
c26cf6c8 RS	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
847b8219 KH	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
c26cf6c8 RS	56	(defvar mh-mime-content-types
	57	'(("text/plain") ("text/richtext")
	58	("multipart/mixed") ("multipart/alternative") ("multipart/digest")
	59	("multipart/parallel")
	60	("message/rfc822") ("message/partial") ("message/external-body")
	61	("application/octet-stream") ("application/postscript")
	62	("image/jpeg") ("image/gif")
	63	("audio/basic")
	64	("video/mpeg"))
	65	"Legal MIME content types.")
	66
	67	(defun mh-mhn-compose-insertion (pathname type description)
	68	"Add a directive to insert a message part from a file.
	69	This is the typical way to insert non-text parts in a message.
847b8219 KH	70	Arguments are PATHNAME, which tells where to find the file, TYPE, the
	71	MIME content type, and DESCRIPTION, a line of text for the
	72	Content-description header. See also \\[mh-edit-mhn]."
c26cf6c8 RS	73	(interactive (list
	74	(read-file-name "Insert contents of: ")
	75	(completing-read "Content-type: "
	76	mh-mime-content-types nil nil nil)
	77	(read-string "Content-description: ")))
	78	(mh-mhn-compose-type pathname type description))
	79
	80	(defun mh-mhn-compose-type (pathname type
	81	&optional description attributes comment)
	82	(beginning-of-line)
	83	(insert "#" type)
	84	(and attributes
	85	(insert "; " attributes))
	86	(and comment
	87	(insert " (" comment ")"))
	88	(insert " [")
	89	(and description
	90	(insert description))
	91	(insert "] " (expand-file-name pathname))
	92	(insert "\n"))
	93
	94
	95	(defun mh-mhn-compose-anon-ftp (host pathname type description)
	96	"Add a directive for an anonymous ftp external body part.
847b8219 KH	97	This directive tells MH to include a reference to a
	98	message/external-body part retrievable by anonymous FTP. Arguments
	99	are HOST and PATHNAME, which tell where to find the file, TYPE, the
	100	MIME content type, and DESCRIPTION, a line of text for the
	101	Content-description header. See also \\[mh-edit-mhn]."
c26cf6c8 RS	102	(interactive (list
	103	(read-string "Remote host: ")
	104	(read-string "Remote pathname: ")
	105	(completing-read "External Content-type: "
	106	mh-mime-content-types nil nil nil)
	107	(read-string "External Content-description: ")))
	108	(mh-mhn-compose-external-type "anon-ftp" host pathname
	109	type description))
	110
	111	(defun mh-mhn-compose-external-compressed-tar (host pathname description)
	112	"Add a directive to include a reference to a compressed tar file.
847b8219 KH	113	The file should be available via anonymous ftp. This directive
	114	tells MH to include a reference to a message/external-body part.
	115	Arguments are HOST and PATHNAME, which tell where to find the file, and
	116	DESCRIPTION, a line of text for the Content-description header.
c26cf6c8 RS	117	See also \\[mh-edit-mhn]."
	118	(interactive (list
	119	(read-string "Remote host: ")
	120	(read-string "Remote pathname: ")
	121	(read-string "Tar file Content-description: ")))
	122	(mh-mhn-compose-external-type "anon-ftp" host pathname
	123	"application/octet-stream"
	124	description
	125	"type=tar; conversions=x-compress"
	126	"mode=image"))
	127
	128
	129	(defun mh-mhn-compose-external-type (access-type host pathname type
	130	&optional description
	131	attributes extra-params comment)
	132	(beginning-of-line)
	133	(insert "#@" type)
	134	(and attributes
	135	(insert "; " attributes))
	136	(and comment
	137	(insert " (" comment ") "))
	138	(insert " [")
	139	(and description
	140	(insert description))
	141	(insert "] ")
	142	(insert "access-type=" access-type "; ")
	143	(insert "site=" host)
	144	(insert "; name=" (file-name-nondirectory pathname))
	145	(insert "; directory=\"" (file-name-directory pathname) "\"")
	146	(and extra-params
	147	(insert "; " extra-params))
	148	(insert "\n"))
	149
847b8219	150	(defun mh-mhn-compose-forw (&optional description folder messages)
c26cf6c8 RS	151	"Add a forw directive to this message.
	152	This directive tells MH to include the named messages in this one.
	153	Arguments are DESCRIPTION, a line of text for the Content-description header,
847b8219	154	FOLDER and MESSAGES, which name the message(s) to be forwarded.
c26cf6c8 RS	155	See also \\[mh-edit-mhn]."
	156	(interactive (list
	157	(read-string "Forw Content-description: ")
847b8219	158	(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
c26cf6c8 RS	159	(read-string (format "Messages%s: "
	160	(if mh-sent-from-msg
	161	(format " [%d]" mh-sent-from-msg)
847b8219	162	"")))))
c26cf6c8 RS	163	(beginning-of-line)
	164	(insert "#forw [")
	165	(and description
	166	(not (string= description ""))
	167	(insert description))
	168	(insert "]")
	169	(and folder
	170	(not (string= folder ""))
	171	(insert " " folder))
847b8219 KH	172	(if (and messages
847b8219 KH	173	(not (string= messages "")))
c26cf6c8	174	(let ((start (point)))
847b8219	175	(insert " " messages)
c26cf6c8 RS	176	(subst-char-in-region start (point) ?, ? ))
	177	(if mh-sent-from-msg
	178	(insert " " (int-to-string mh-sent-from-msg))))
	179	(insert "\n"))
	180
847b8219 KH	181	(defun mh-edit-mhn (&optional extra-args)
	182	"Format the current draft for MIME, expanding any mhn directives.
	183	Process the current draft with the mhn program, which,
	184	using directives already inserted in the draft, fills in
c26cf6c8 RS	185	all the MIME components and header fields.
	186	This step should be done last just before sending the message.
	187	The mhn program is part of MH version 6.8 or later.
	188	The `\\[mh-revert-mhn-edit]' command undoes this command.
847b8219 KH	189	The arguments in the list `mh-mhn-args' are passed to mhn
	190	if this function is passed an argument.
	191
	192	For assistance with creating mhn directives to insert
c26cf6c8 RS	193	various types of components in a message, see
	194	\\[mh-mhn-compose-insertion] (generic insertion from a file),
	195	\\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
	196	\\[mh-mhn-compose-external-compressed-tar] \
	197	\(reference to compressed tar file via anonymous ftp), and
	198	\\[mh-mhn-compose-forw] (forward message)."
847b8219	199	(interactive "*P")
c26cf6c8 RS	200	(save-buffer)
c26cf6c8 RS	201	(message "mhn editing...")
847b8219 KH	202	(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
847b8219 KH	203	"mhn" (if extra-args mh-mhn-args) buffer-file-name)
c26cf6c8	204	(revert-buffer t t)
847b8219 KH	205	(message "mhn editing...done")
847b8219 KH	206	(run-hooks 'mh-edit-mhn-hook))
c26cf6c8 RS	207
	208
	209	(defun mh-revert-mhn-edit (noconfirm)
	210	"Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
847b8219	211	Optional non-nil argument means don't ask for confirmation."
c26cf6c8 RS	212	(interactive "*P")
	213	(if (null buffer-file-name)
	214	(error "Buffer does not seem to be associated with any file"))
	215	(let ((backup-strings '("," "#"))
	216	backup-file)
	217	(while (and backup-strings
	218	(not (file-exists-p
	219	(setq backup-file
	220	(concat (file-name-directory buffer-file-name)
	221	(car backup-strings)
	222	(file-name-nondirectory buffer-file-name)
	223	".orig")))))
	224	(setq backup-strings (cdr backup-strings)))
	225	(or backup-strings
	226	(error "mhn backup file for %s no longer exists!" buffer-file-name))
	227	(or noconfirm
	228	(yes-or-no-p (format "Revert buffer from file %s? "
	229	backup-file))
	230	(error "mhn edit revert not confirmed."))
	231	(let ((buffer-read-only nil))
	232	(erase-buffer)
	233	(insert-file-contents backup-file))
	234	(after-find-file nil)))