# HG changeset patch # User Richard M. Stallman # Date 829937138 0 # Node ID 4dbe0f673671f510649a9a96b54da2095a784cfd # Parent 7cc3bad1b93e52c24064fe1a7dc3de8580f116e2 (metamail-mailer-name): New variable. (metamail-environment): Add MM_QUIET. (metamail-switches): Delete -m emacs. (metamail-interpret-header, metamail-interpret-body): New functions. (metamail-region, metamail-buffer): New arg VIEWMODE. diff -r 7cc3bad1b93e -r 4dbe0f673671 lisp/mail/metamail.el --- a/lisp/mail/metamail.el Fri Apr 19 09:32:55 1996 +0000 +++ b/lisp/mail/metamail.el Fri Apr 19 18:05:38 1996 +0000 @@ -1,8 +1,9 @@ ;;; metamail.el --- Metamail interface for GNU Emacs -;; Copyright (C) 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1996 Masanobu UMEDA ;; Author: Masanobu UMEDA +;; 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. @@ -24,11 +25,23 @@ ;;; 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 . @@ -38,37 +51,118 @@ (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) @@ -80,39 +174,27 @@ ;; 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