lisp/mail/metamail.el

   1 ;;; metamail.el --- Metamail interface for GNU Emacs
   2
   3 ;; Copyright (C) 1993 Masanobu UMEDA
   4
   5 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
   6 ;; Version: $Header: /home/gd/gnu/emacs/19.0/lisp/RCS/metamail.el,v 1.1 1993/07/20 03:02:12 rms Exp kwzh $
   7 ;; Keywords: mail, news, mime, multimedia
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; LCD Archive Entry:
  28 ;; metamail|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
  29 ;; Metamail interface for GNU Emacs|
  30 ;; $Date: 1993/07/20 03:02:12 $|$Revision: 1.1 $|~/misc/metamail.el.Z|
  31
  32 ;; Note: Metamail does not have all options which are compatible with
  33 ;; the environment variables.  For that reason, metamail.el has to
  34 ;; hack the environment variables.  In addition, there is no way to
  35 ;; display all header fields without extra informative body messages
  36 ;; which is suppressed by "-q" option.
  37
  38 ;; The idea of using metamail to process MIME messages is from
  39 ;; gnus-mime.el by Spike <Spike@world.std.com>.
  40
  41 ;;; Code:
  42
  43 (defvar metamail-program-name "metamail"
  44   "*Metamail program name.")
  45
  46 (defvar metamail-environment '("KEYHEADS=*")
  47   "*Environment variables passed to `metamail'.
  48 It must ba a list of strings that have the format ENVVARNAME=VALUE.")
  49
  50 (defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z")
  51   "*Switches for `metamail' program.
  52 -z is required to remove zap file.")
  53
  54 (defun metamail-buffer (&optional buffer nodisplay)
  55   "Process current buffer through `metamail'.
  56 Optional 1st argument BUFFER specifies a buffer to be filled (nil
  57 means current).
  58 Optional 2nd argument NODISPLAY non-nil means buffer is not
  59 redisplayed as output is inserted."
  60   (interactive)
  61   (metamail-region (point-min) (point-max) buffer nodisplay))
  62
  63 (defun metamail-region (beg end &optional buffer nodisplay)
  64   "Process current region through 'metamail'.
  65 Optional 1st argument BUFFER specifies a buffer to be filled (nil
  66 means current).
  67 Optional 2nd argument NODISPLAY non-nil means buffer is not
  68 redisplayed as output is inserted."
  69   (interactive "r")
  70   (let ((curbuf (current-buffer))
  71         (buffer-read-only nil)
  72         (metafile (make-temp-name "/tmp/metamail")))
  73     (save-excursion
  74       ;; Gee!  Metamail does not output to stdout if input comes from
  75       ;; stdin.
  76       (write-region beg end metafile nil 'nomessage)
  77       (if buffer
  78           (set-buffer buffer))
  79       (setq buffer-read-only nil)
  80       ;; Clear destination buffer.
  81       (if (eq curbuf (current-buffer))
  82           (delete-region beg end)
  83         (delete-region (point-min) (point-max)))
  84       ;; We have to pass the environment variable KEYHEADS to display
  85       ;; all header fields.  Metamail should have an optional argument
  86       ;; to pass such information directly.
  87       (let ((process-environment
  88              (append metamail-environment process-environment)))
  89         (apply (function call-process)
  90                metamail-program-name
  91                nil
  92                t                        ;Output to current buffer
  93                (not nodisplay)          ;Force redisplay
  94                (append metamail-switches (list metafile))))
  95       ;; `metamail' may not delete the temporary file!
  96       (condition-case error
  97           (delete-file metafile)
  98         (error nil))
  99       )))
 100
 101 ;(defun metamail-region (beg end &optional buffer)
 102 ;  "Process current region through 'metamail'.
 103 ;Optional argument BUFFER specifies a buffer to be filled (nil means current)."
 104 ;  (interactive "r")
 105 ;  (let ((curbuf (current-buffer))
 106 ;       (buffer-read-only nil)
 107 ;       (metafile (make-temp-name "/tmp/metamail")))
 108 ;    (save-excursion
 109 ;      (write-region (point-min) (point-max) metafile nil 'nomessage)
 110 ;      (if (eq curbuf
 111 ;             (if buffer (get-buffer buffer) (current-buffer)))
 112 ;         (delete-region (point-min) (point-max)))
 113 ;      (apply (function call-process)
 114 ;            metamail-program-name
 115 ;            nil
 116 ;            (or buffer t)              ;BUFFER or current buffer
 117 ;            nil                        ;don't redisplay
 118 ;            (append metamail-switches (list metafile)))
 119 ;      )))
 120
 121 (provide 'metamail)
 122
 123 ;;; metamail.el ends here