;;; metamail.el --- Metamail interface for GNU Emacs
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996 Masanobu UMEDA
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
+;; Version: $Header: metamail.el,v 1.10 96/04/18 11:27:08 umerin Exp $
;; Keywords: mail, news, mime, multimedia
;; This file is part of GNU Emacs.
;;; Commentary:
-;; Note: Metamail does not have all options which are compatible with
-;; the environment variables. For that reason, metamail.el has to
+;; The latest version will be at:
+;; ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
+
+;; Note: Metamail does not have all options which is compatible with
+;; the environment variables. For that reason, matamail.el have to
;; hack the environment variables. In addition, there is no way to
;; display all header fields without extra informative body messages
-;; which is suppressed by "-q" option.
+;; which are suppressed by "-q" option.
+
+;; The following definition is what I'm using with GNUS 4:
+;;(setq gnus-show-mime-method
+;; (function
+;; (lambda ()
+;; (metamail-interpret-header)
+;; (let ((metamail-switches ;Suppress header fields in a body.
+;; (append metamail-switches '("-q"))))
+;; (metamail-interpret-body)))))
;; The idea of using metamail to process MIME messages is from
;; gnus-mime.el by Spike <Spike@world.std.com>.
(defvar metamail-program-name "metamail"
"*Metamail program name.")
-(defvar metamail-environment '("KEYHEADS=*")
+(defvar metamail-mailer-name "emacs"
+ "*Mailer name set to MM_MAILER environment variable.")
+
+(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
"*Environment variables passed to `metamail'.
-It must ba a list of strings that have the format ENVVARNAME=VALUE.")
+It must be a list of strings that have the format ENVVARNAME=VALUE.
+It is not expected to be altered globally by `set' or `setq'.
+Instead, change its value temporary using `let' or `let*' form.")
-(defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z")
+(defvar metamail-switches '("-x" "-d" "-z")
"*Switches for `metamail' program.
--z is required to remove zap file.")
+`-z' is required to remove zap file.
+It is not expected to be altered globally by `set' or `setq'.
+Instead, change its value temporary using `let' or `let*' form.
+`-m MAILER' argument is automatically generated from the
+`metamail-mailer-name' variable.")
+
+;;;###autoload
+(defun metamail-interpret-header ()
+ "Interpret a header part of a MIME message in current buffer.
+Its body part is not interpreted at all."
+ (interactive)
+ (save-excursion
+ (let* ((buffer-read-only nil)
+ (metamail-switches ;Inhibit processing an empty body.
+ (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
+ (end (progn
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ ;; An extra newline is inserted by metamail if there
+ ;; is no body part. So, insert a dummy body by
+ ;; itself.
+ (insert "\n")
+ (point))))
+ (metamail-region (point-min) end nil nil 'nodisplay)
+ ;; Remove an extra newline inserted by myself.
+ (goto-char (point-min))
+ (if (search-forward "\n\n\n" nil t)
+ (delete-char -1))
+ )))
-(defun metamail-buffer (&optional buffer nodisplay)
+;;;###autoload
+(defun metamail-interpret-body (&optional viewmode nodisplay)
+ "Interpret a body part of a MIME message in current buffer.
+Optional argument VIEWMODE specifies the value of the
+EMACS_VIEW_MODE environment variable (defaulted to 1).
+Optional argument NODISPLAY non-nil means buffer is not
+redisplayed as output is inserted.
+Its header part is not interpreted at all."
+ (interactive "p")
+ (save-excursion
+ (let ((contype nil)
+ (encoding nil)
+ (end (progn
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (point))))
+ ;; Find Content-Type and Content-Transfer-Encoding from the header.
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (setq contype
+ (or (mail-fetch-field "Content-Type") "text/plain"))
+ (setq encoding
+ (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
+ ;; Interpret the body part only.
+ (let ((metamail-switches ;Process body part only.
+ (append metamail-switches
+ (list "-b" "-c" contype "-E" encoding))))
+ (metamail-region end (point-max) viewmode nil nodisplay))
+ ;; Mode specific hack.
+ (cond ((eq major-mode 'rmail-mode)
+ ;; Adjust the marker of this message if in Rmail mode buffer.
+ (set-marker (aref rmail-message-vector (1+ rmail-current-message))
+ (point-max))))
+ )))
+
+;;;###autoload
+(defun metamail-buffer (&optional viewmode buffer nodisplay)
"Process current buffer through `metamail'.
-Optional 1st argument BUFFER specifies a buffer to be filled (nil
+Optional argument VIEWMODE specifies the value of the
+EMACS_VIEW_MODE environment variable (defaulted to 1).
+Optional argument BUFFER specifies a buffer to be filled (nil
means current).
-Optional 2nd argument NODISPLAY non-nil means buffer is not
+Optional argument NODISPLAY non-nil means buffer is not
redisplayed as output is inserted."
- (interactive)
- (metamail-region (point-min) (point-max) buffer nodisplay))
+ (interactive "p")
+ (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
-(defun metamail-region (beg end &optional buffer nodisplay)
+;;;###autoload
+(defun metamail-region (beg end &optional viewmode buffer nodisplay)
"Process current region through 'metamail'.
-Optional 1st argument BUFFER specifies a buffer to be filled (nil
+Optional argument VIEWMODE specifies the value of the
+EMACS_VIEW_MODE environment variable (defaulted to 1).
+Optional argument BUFFER specifies a buffer to be filled (nil
means current).
-Optional 2nd argument NODISPLAY non-nil means buffer is not
+Optional argument NODISPLAY non-nil means buffer is not
redisplayed as output is inserted."
- (interactive "r")
+ (interactive "r\np")
(let ((curbuf (current-buffer))
(buffer-read-only nil)
- (metafile (make-temp-name "/tmp/metamail")))
+ (metafile (make-temp-name "/tmp/metamail"))
+ (option-environment
+ (list (concat "EMACS_VIEW_MODE="
+ (if (numberp viewmode) viewmode 1)))))
(save-excursion
- ;; Gee! Metamail does not output to stdout if input comes from
+ ;; Gee! Metamail does not ouput to stdout if input comes from
;; stdin.
- (write-region beg end metafile nil 'nomessage)
+ (let ((selective-display nil) ;Disable ^M to nl translation.
+ (kanji-fileio-code 2) ;Write in JIS code when nemacs.
+ (file-coding-system ;Write in JUNET style when mule.
+ (if (featurep 'mule) *junet*)))
+ (write-region beg end metafile nil 'nomessage))
(if buffer
(set-buffer buffer))
(setq buffer-read-only nil)
;; all header fields. Metamail should have an optional argument
;; to pass such information directly.
(let ((process-environment
- (append metamail-environment process-environment)))
+ (append process-environment
+ metamail-environment option-environment)))
+ ;; Specify character coding system.
+ (if (boundp 'NEMACS)
+ (define-program-kanji-code nil metamail-program-name 2)) ;JIS
+ (if (featurep 'mule)
+ (define-program-coding-system nil metamail-program-name *junet*))
(apply (function call-process)
metamail-program-name
nil
t ;Output to current buffer
(not nodisplay) ;Force redisplay
- (append metamail-switches (list metafile))))
+ (append metamail-switches
+ (list "-m" (or metamail-mailer-name "emacs"))
+ (list metafile))))
;; `metamail' may not delete the temporary file!
(condition-case error
(delete-file metafile)
(error nil))
)))
-;(defun metamail-region (beg end &optional buffer)
-; "Process current region through 'metamail'.
-;Optional argument BUFFER specifies a buffer to be filled (nil means current)."
-; (interactive "r")
-; (let ((curbuf (current-buffer))
-; (buffer-read-only nil)
-; (metafile (make-temp-name "/tmp/metamail")))
-; (save-excursion
-; (write-region (point-min) (point-max) metafile nil 'nomessage)
-; (if (eq curbuf
-; (if buffer (get-buffer buffer) (current-buffer)))
-; (delete-region (point-min) (point-max)))
-; (apply (function call-process)
-; metamail-program-name
-; nil
-; (or buffer t) ;BUFFER or current buffer
-; nil ;don't redisplay
-; (append metamail-switches (list metafile)))
-; )))
-
(provide 'metamail)
;;; metamail.el ends here
projects / emacs.git / commitdiff