home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / vrac_os2 / e31el3.zip / EMACS / 19.31 / LISP / METAMAIL.EL < prev    next >
Lisp/Scheme  |  1996-05-23  |  8KB  |  201 lines
  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: /home/fsf/rms/e19/lisp/RCS/metamail.el,v 1.5 1996/04/19 18:05:38 rms Exp $
  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 the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; The latest version will be at:
  29. ;;    ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
  30.  
  31. ;; Note: Metamail does not have all options which is compatible with
  32. ;; the environment variables.  For that reason, matamail.el have to
  33. ;; hack the environment variables.  In addition, there is no way to
  34. ;; display all header fields without extra informative body messages
  35. ;; which are suppressed by "-q" option.
  36.  
  37. ;; The following definition is what I'm using with GNUS 4:
  38. ;;(setq gnus-show-mime-method
  39. ;;      (function
  40. ;;       (lambda ()
  41. ;;       (metamail-interpret-header)
  42. ;;       (let ((metamail-switches    ;Suppress header fields in a body.
  43. ;;          (append metamail-switches '("-q"))))
  44. ;;         (metamail-interpret-body)))))
  45.  
  46. ;; The idea of using metamail to process MIME messages is from
  47. ;; gnus-mime.el by Spike <Spike@world.std.com>.
  48.  
  49. ;;; Code:
  50.  
  51. (defvar metamail-program-name "metamail"
  52.   "*Metamail program name.")
  53.  
  54. (defvar metamail-mailer-name "emacs"
  55.   "*Mailer name set to MM_MAILER environment variable.")
  56.  
  57. (defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
  58.   "*Environment variables passed to `metamail'.
  59. It must be a list of strings that have the format ENVVARNAME=VALUE.
  60. It is not expected to be altered globally by `set' or `setq'.
  61. Instead, change its value temporary using `let' or `let*' form.")
  62.  
  63. (defvar metamail-switches '("-x" "-d" "-z")
  64.   "*Switches for `metamail' program.
  65. `-z' is required to remove zap file.
  66. It is not expected to be altered globally by `set' or `setq'.
  67. Instead, change its value temporary using `let' or `let*' form.
  68. `-m MAILER' argument is automatically generated from the
  69. `metamail-mailer-name' variable.")
  70.  
  71. ;;;###autoload
  72. (defun metamail-interpret-header ()
  73.   "Interpret a header part of a MIME message in current buffer.
  74. Its body part is not interpreted at all."
  75.   (interactive)
  76.   (save-excursion
  77.     (let* ((buffer-read-only nil)
  78.        (metamail-switches        ;Inhibit processing an empty body.
  79.         (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
  80.        (end (progn
  81.           (goto-char (point-min))
  82.           (search-forward "\n\n" nil 'move)
  83.           ;; An extra newline is inserted by metamail if there
  84.           ;; is no body part.  So, insert a dummy body by
  85.           ;; itself.
  86.           (insert "\n")
  87.           (point))))
  88.       (metamail-region (point-min) end nil nil 'nodisplay)
  89.       ;; Remove an extra newline inserted by myself.
  90.       (goto-char (point-min))
  91.       (if (search-forward "\n\n\n" nil t)
  92.       (delete-char -1))
  93.       )))
  94.  
  95. ;;;###autoload
  96. (defun metamail-interpret-body (&optional viewmode nodisplay)
  97.   "Interpret a body part of a MIME message in current buffer.
  98. Optional argument VIEWMODE specifies the value of the
  99. EMACS_VIEW_MODE environment variable (defaulted to 1).
  100. Optional argument NODISPLAY non-nil means buffer is not
  101. redisplayed as output is inserted.
  102. Its header part is not interpreted at all."
  103.   (interactive "p")
  104.   (save-excursion
  105.     (let ((contype nil)
  106.       (encoding nil)
  107.       (end (progn
  108.          (goto-char (point-min))
  109.          (search-forward "\n\n" nil t)
  110.          (point))))
  111.       ;; Find Content-Type and Content-Transfer-Encoding from the header.
  112.       (save-restriction
  113.     (narrow-to-region (point-min) end)
  114.     (setq contype 
  115.           (or (mail-fetch-field "Content-Type") "text/plain"))
  116.     (setq encoding 
  117.           (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
  118.       ;; Interpret the body part only.
  119.       (let ((metamail-switches        ;Process body part only.
  120.          (append metamail-switches
  121.              (list "-b" "-c" contype "-E" encoding))))
  122.     (metamail-region end (point-max) viewmode nil nodisplay))
  123.       ;; Mode specific hack.
  124.       (cond ((eq major-mode 'rmail-mode)
  125.          ;; Adjust the marker of this message if in Rmail mode buffer.
  126.          (set-marker (aref rmail-message-vector (1+ rmail-current-message))
  127.              (point-max))))
  128.       )))
  129.  
  130. ;;;###autoload
  131. (defun metamail-buffer (&optional viewmode buffer nodisplay)
  132.   "Process current buffer through `metamail'.
  133. Optional argument VIEWMODE specifies the value of the
  134. EMACS_VIEW_MODE environment variable (defaulted to 1).
  135. Optional argument BUFFER specifies a buffer to be filled (nil
  136. means current).
  137. Optional argument NODISPLAY non-nil means buffer is not
  138. redisplayed as output is inserted."
  139.   (interactive "p")
  140.   (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
  141.  
  142. ;;;###autoload
  143. (defun metamail-region (beg end &optional viewmode buffer nodisplay)
  144.   "Process current region through 'metamail'.
  145. Optional argument VIEWMODE specifies the value of the
  146. EMACS_VIEW_MODE environment variable (defaulted to 1).
  147. Optional argument BUFFER specifies a buffer to be filled (nil
  148. means current).
  149. Optional argument NODISPLAY non-nil means buffer is not
  150. redisplayed as output is inserted."
  151.   (interactive "r\np")
  152.   (let ((curbuf (current-buffer))
  153.     (buffer-read-only nil)
  154.     (metafile (make-temp-name "/tmp/metamail"))
  155.     (option-environment
  156.      (list (concat "EMACS_VIEW_MODE=" 
  157.                (if (numberp viewmode) viewmode 1)))))
  158.     (save-excursion
  159.       ;; Gee!  Metamail does not ouput to stdout if input comes from
  160.       ;; stdin.
  161.       (let ((selective-display nil)    ;Disable ^M to nl translation.
  162.         (kanji-fileio-code 2)    ;Write in JIS code when nemacs.
  163.         (file-coding-system        ;Write in JUNET style when mule.
  164.          (if (featurep 'mule) *junet*)))
  165.     (write-region beg end metafile nil 'nomessage))
  166.       (if buffer
  167.       (set-buffer buffer))
  168.       (setq buffer-read-only nil)
  169.       ;; Clear destination buffer.
  170.       (if (eq curbuf (current-buffer))
  171.       (delete-region beg end)
  172.     (delete-region (point-min) (point-max)))
  173.       ;; We have to pass the environment variable KEYHEADS to display
  174.       ;; all header fields.  Metamail should have an optional argument
  175.       ;; to pass such information directly.
  176.       (let ((process-environment
  177.          (append process-environment
  178.              metamail-environment option-environment)))
  179.     ;; Specify character coding system.
  180.     (if (boundp 'NEMACS)
  181.         (define-program-kanji-code nil metamail-program-name 2)) ;JIS
  182.     (if (featurep 'mule)
  183.         (define-program-coding-system nil metamail-program-name *junet*))
  184.     (apply (function call-process)
  185.            metamail-program-name
  186.            nil
  187.            t            ;Output to current buffer
  188.            (not nodisplay)        ;Force redisplay
  189.            (append metamail-switches
  190.                (list "-m" (or metamail-mailer-name "emacs"))
  191.                (list metafile))))
  192.       ;; `metamail' may not delete the temporary file!
  193.       (condition-case error
  194.       (delete-file metafile)
  195.     (error nil))
  196.       )))
  197.  
  198. (provide 'metamail)
  199.  
  200. ;;; metamail.el ends here
  201.