cgit.sxemacs.org Git - packages/blob - xemacs-packages/net-utils/metamail.el

   1 ;;; metamail.el --- Metamail interface for GNU Emacs
   2
   3 ;; Copyright (C) 1993, 1996  Masanobu UMEDA
   4
   5 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
   6 ;; Version: $Header: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/net-utils/metamail.el,v 1.4 2007-03-06 14:02:59 viteno Exp $
   7 ;; Keywords: mail, news, mime, multimedia
   8
   9 ;; This file is part of XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with: FSF 19.34.
  27
  28 ;;; Commentary:
  29
  30 ;; I trashed all the differences this file had from the FSF version.
  31 ;;  So sue me.  -sb
  32
  33 ;; The latest version will be at:
  34 ;;      ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
  35
  36 ;; Note: Metamail does not have all options which is compatible with
  37 ;; the environment variables.  For that reason, matamail.el have to
  38 ;; hack the environment variables.  In addition, there is no way to
  39 ;; display all header fields without extra informative body messages
  40 ;; which are suppressed by "-q" option.
  41
  42 ;; The following definition is what I'm using with GNUS 4:
  43 ;;(setq gnus-show-mime-method
  44 ;;      (function
  45 ;;       (lambda ()
  46 ;;        (metamail-interpret-header)
  47 ;;        (let ((metamail-switches     ;Suppress header fields in a body.
  48 ;;               (append metamail-switches '("-q"))))
  49 ;;          (metamail-interpret-body)))))
  50
  51 ;; The idea of using metamail to process MIME messages is from
  52 ;; gnus-mime.el by Spike <Spike@world.std.com>.
  53
  54 ;;; Code:
  55
  56 (defgroup metamail nil
  57   "Metamail interface for Emacs."
  58   :group 'mail
  59   :group 'hypermedia
  60   :group 'processes)
  61
  62 (defcustom metamail-program-name "metamail"
  63   "*Metamail program name."
  64   :type 'string
  65   :group 'metamail)
  66
  67 (defcustom metamail-mailer-name "emacs"
  68   "*Mailer name set to MM_MAILER environment variable."
  69   :type 'string
  70   :group 'metamail)
  71
  72 (defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
  73   "*Environment variables passed to `metamail'.
  74 It must be a list of strings that have the format ENVVARNAME=VALUE.
  75 It is not expected to be altered globally by `set' or `setq'.
  76 Instead, change its value temporary using `let' or `let*' form.")
  77
  78 (defcustom metamail-switches '("-x" "-d" "-z")
  79   "*Switches for `metamail' program.
  80 `-z' is required to remove zap file.
  81 It is not expected to be altered globally by `set' or `setq'.
  82 Instead, change its value temporary using `let' or `let*' form.
  83 `-m MAILER' argument is automatically generated from the
  84 `metamail-mailer-name' variable."
  85   :type '(repeat (string :tag "Switch"))
  86   :group 'metamail)
  87
  88 ;;;###autoload
  89 (defun metamail-interpret-header ()
  90   "Interpret a header part of a MIME message in current buffer.
  91 Its body part is not interpreted at all."
  92   (interactive)
  93   (save-excursion
  94     (let* ((buffer-read-only nil)
  95            (metamail-switches           ;Inhibit processing an empty body.
  96             (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
  97            (end (progn
  98                   (goto-char (point-min))
  99                   (search-forward "\n\n" nil 'move)
 100                   ;; An extra newline is inserted by metamail if there
 101                   ;; is no body part.  So, insert a dummy body by
 102                   ;; itself.
 103                   (insert "\n")
 104                   (point))))
 105       (metamail-region (point-min) end nil nil 'nodisplay)
 106       ;; Remove an extra newline inserted by myself.
 107       (goto-char (point-min))
 108       (if (search-forward "\n\n\n" nil t)
 109           (delete-char -1))
 110       )))
 111
 112 (eval-when-compile
 113   (defvar rmail-message-vector)
 114   (defvar rmail-current-message))
 115
 116 ;;;###autoload
 117 (defun metamail-interpret-body (&optional viewmode nodisplay)
 118   "Interpret a body part of a MIME message in current buffer.
 119 Optional argument VIEWMODE specifies the value of the
 120 EMACS_VIEW_MODE environment variable (defaulted to 1).
 121 Optional argument NODISPLAY non-nil means buffer is not
 122 redisplayed as output is inserted.
 123 Its header part is not interpreted at all."
 124   (interactive "p")
 125   (save-excursion
 126     (let ((contype nil)
 127           (encoding nil)
 128          (end (progn
 129                 (goto-char (point-min))
 130                 (search-forward "\n\n" nil t)
 131                 (point))))
 132       ;; Find Content-Type and Content-Transfer-Encoding from the header.
 133       (save-restriction
 134         (narrow-to-region (point-min) end)
 135         (setq contype
 136               (or (mail-fetch-field "Content-Type") "text/plain"))
 137         (setq encoding
 138               (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
 139       ;; Interpret the body part only.
 140       (let ((metamail-switches         ;Process body part only.
 141              (append metamail-switches
 142                      (list "-b" "-c" contype "-E" encoding))))
 143         (metamail-region end (point-max) viewmode nil nodisplay))
 144       ;; Mode specific hack.
 145       (cond ((eq major-mode 'rmail-mode)
 146              ;; Adjust the marker of this message if in Rmail mode buffer.
 147              (set-marker (aref rmail-message-vector (1+ rmail-current-message))
 148                          (point-max))))
 149       )))
 150
 151 ;;;###autoload
 152 (defun metamail-buffer (&optional viewmode buffer nodisplay)
 153   "Process current buffer through `metamail'.
 154 Optional argument VIEWMODE specifies the value of the
 155 EMACS_VIEW_MODE environment variable (defaulted to 1).
 156 Optional argument BUFFER specifies a buffer to be filled (nil
 157 means current).
 158 Optional argument NODISPLAY non-nil means buffer is not
 159 redisplayed as output is inserted."
 160   (interactive "p")
 161   (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
 162
 163 (eval-when-compile
 164   (when (featurep 'xemacs)
 165     (defalias 'define-program-coding-system 'ignore)))
 166
 167 ;;;###autoload
 168 (defun metamail-region (beg end &optional viewmode buffer nodisplay)
 169   "Process current region through 'metamail'.
 170 Optional argument VIEWMODE specifies the value of the
 171 EMACS_VIEW_MODE environment variable (defaulted to 1).
 172 Optional argument BUFFER specifies a buffer to be filled (nil
 173 means current).
 174 Optional argument NODISPLAY non-nil means buffer is not
 175 redisplayed as output is inserted."
 176   (interactive "r\np")
 177   (let ((curbuf (current-buffer))
 178         (buffer-read-only nil)
 179         (metafile (make-temp-name "/tmp/metamail"))
 180         (option-environment
 181          (list (format "EMACS_VIEW_MODE=%s"
 182                        (if (numberp viewmode) viewmode 1)))))
 183     (save-excursion
 184       ;; Gee!  Metamail does not output to stdout if input comes from
 185       ;; stdin.
 186       (let ((selective-display nil)         ;Disable ^M to nl translation.
 187             (buffer-file-coding-system      ;Write in JUNET style when mule.
 188              (if (featurep 'mule)
 189                  (get-coding-system 'junet)))
 190             (coding-system-for-write ;Write in iso-2022-jp style
 191              'iso-2022-jp)           ;  when XEmacs/mule
 192             )
 193         (write-region beg end metafile nil 'nomessage))
 194       (if buffer
 195           (set-buffer buffer))
 196       (setq buffer-read-only nil)
 197       ;; Clear destination buffer.
 198       (if (eq curbuf (current-buffer))
 199           (delete-region beg end)
 200         (delete-region (point-min) (point-max)))
 201       ;; We have to pass the environment variable KEYHEADS to display
 202       ;; all header fields.  Metamail should have an optional argument
 203       ;; to pass such information directly.
 204       (let ((process-environment
 205              (append process-environment
 206                      metamail-environment option-environment)))
 207         ;; Specify character coding system.
 208         (if (featurep 'mule)
 209             (if (fboundp 'define-program-coding-system)
 210                 (define-program-coding-system
 211                   nil
 212                   metamail-program-name
 213                   'junet)
 214               ;; XEmacs with MULE
 215               (setq buffer-file-coding-system 'junet)))
 216         (apply (function call-process)
 217                metamail-program-name
 218                nil
 219                t                        ;Output to current buffer
 220                (not nodisplay)          ;Force redisplay
 221                (append metamail-switches
 222                        (list "-m" (or metamail-mailer-name "emacs"))
 223                        (list metafile))))
 224       ;; `metamail' may not delete the temporary file!
 225       (condition-case nil
 226           (delete-file metafile)
 227         (error nil))
 228       )))
 229
 230 (provide 'metamail)
 231
 232 ;;; metamail.el ends here