Mercurial > hg > xemacs-beta
diff lisp/mh-e/mh-mime.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 131b0175ea99 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mh-e/mh-mime.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,235 @@ +;;; mh-mime --- mh-e support for composing MIME messages +;; Time-stamp: <95/08/19 16:45:17 gildea> + +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. + +;; This file is part of mh-e, part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs; 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.1.1.1 1996/12/18 03:34:37 steve 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].") + +;;;###autoload +(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. See documentation for \\[mh-edit-mhn].") + +(defun mh-mhn-compose-insertion (pathname type description) + "Add a directive to insert a MIME 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 a MIME 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 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. +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, to forward a message with MIME. +This directive tells MH to include the named messages in this one. +Arguments are DESCRIPTION, a line of text for the Content-description header, +and 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)))