|
0
|
1 ;;; metamail.el --- Metamail interface for GNU Emacs
|
|
|
2
|
|
2
|
3 ;; Copyright (C) 1993, 1996 Masanobu UMEDA
|
|
0
|
4
|
|
|
5 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
|
|
2
|
6 ;; Version: $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs-19/lisp/packages/metamail.el,v 1.1.1.2 1996/12/18 03:45:03 steve Exp $
|
|
0
|
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
|
|
2
|
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
24 ;; 02111-1307, USA.
|
|
0
|
25
|
|
2
|
26 ;;; Synched up with: FSF 19.34.
|
|
0
|
27
|
|
|
28 ;;; Commentary:
|
|
|
29
|
|
2
|
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
|
|
0
|
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
|
|
2
|
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)))))
|
|
0
|
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 (defvar metamail-program-name "metamail"
|
|
|
57 "*Metamail program name.")
|
|
|
58
|
|
2
|
59 (defvar metamail-mailer-name "emacs"
|
|
|
60 "*Mailer name set to MM_MAILER environment variable.")
|
|
|
61
|
|
|
62 (defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
|
|
|
63 "*Environment variables passed to `metamail'.
|
|
|
64 It must be a list of strings that have the format ENVVARNAME=VALUE.
|
|
|
65 It is not expected to be altered globally by `set' or `setq'.
|
|
|
66 Instead, change its value temporary using `let' or `let*' form.")
|
|
|
67
|
|
|
68 (defvar metamail-switches '("-x" "-d" "-z")
|
|
|
69 "*Switches for `metamail' program.
|
|
|
70 `-z' is required to remove zap file.
|
|
|
71 It is not expected to be altered globally by `set' or `setq'.
|
|
|
72 Instead, change its value temporary using `let' or `let*' form.
|
|
|
73 `-m MAILER' argument is automatically generated from the
|
|
|
74 `metamail-mailer-name' variable.")
|
|
0
|
75
|
|
2
|
76 ;;;###autoload
|
|
|
77 (defun metamail-interpret-header ()
|
|
|
78 "Interpret a header part of a MIME message in current buffer.
|
|
|
79 Its body part is not interpreted at all."
|
|
|
80 (interactive)
|
|
|
81 (save-excursion
|
|
|
82 (let* ((buffer-read-only nil)
|
|
|
83 (metamail-switches ;Inhibit processing an empty body.
|
|
|
84 (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
|
|
|
85 (end (progn
|
|
|
86 (goto-char (point-min))
|
|
|
87 (search-forward "\n\n" nil 'move)
|
|
|
88 ;; An extra newline is inserted by metamail if there
|
|
|
89 ;; is no body part. So, insert a dummy body by
|
|
|
90 ;; itself.
|
|
|
91 (insert "\n")
|
|
|
92 (point))))
|
|
|
93 (metamail-region (point-min) end nil nil 'nodisplay)
|
|
|
94 ;; Remove an extra newline inserted by myself.
|
|
|
95 (goto-char (point-min))
|
|
|
96 (if (search-forward "\n\n\n" nil t)
|
|
|
97 (delete-char -1))
|
|
|
98 )))
|
|
0
|
99
|
|
2
|
100 ;;;###autoload
|
|
|
101 (defun metamail-interpret-body (&optional viewmode nodisplay)
|
|
|
102 "Interpret a body part of a MIME message in current buffer.
|
|
|
103 Optional argument VIEWMODE specifies the value of the
|
|
|
104 EMACS_VIEW_MODE environment variable (defaulted to 1).
|
|
|
105 Optional argument NODISPLAY non-nil means buffer is not
|
|
|
106 redisplayed as output is inserted.
|
|
|
107 Its header part is not interpreted at all."
|
|
|
108 (interactive "p")
|
|
|
109 (save-excursion
|
|
|
110 (let ((contype nil)
|
|
|
111 (encoding nil)
|
|
|
112 (end (progn
|
|
|
113 (goto-char (point-min))
|
|
|
114 (search-forward "\n\n" nil t)
|
|
|
115 (point))))
|
|
|
116 ;; Find Content-Type and Content-Transfer-Encoding from the header.
|
|
|
117 (save-restriction
|
|
|
118 (narrow-to-region (point-min) end)
|
|
|
119 (setq contype
|
|
|
120 (or (mail-fetch-field "Content-Type") "text/plain"))
|
|
|
121 (setq encoding
|
|
|
122 (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
|
|
|
123 ;; Interpret the body part only.
|
|
|
124 (let ((metamail-switches ;Process body part only.
|
|
|
125 (append metamail-switches
|
|
|
126 (list "-b" "-c" contype "-E" encoding))))
|
|
|
127 (metamail-region end (point-max) viewmode nil nodisplay))
|
|
|
128 ;; Mode specific hack.
|
|
|
129 (cond ((eq major-mode 'rmail-mode)
|
|
|
130 ;; Adjust the marker of this message if in Rmail mode buffer.
|
|
|
131 (set-marker (aref rmail-message-vector (1+ rmail-current-message))
|
|
|
132 (point-max))))
|
|
|
133 )))
|
|
0
|
134
|
|
2
|
135 ;;;###autoload
|
|
|
136 (defun metamail-buffer (&optional viewmode buffer nodisplay)
|
|
|
137 "Process current buffer through `metamail'.
|
|
|
138 Optional argument VIEWMODE specifies the value of the
|
|
|
139 EMACS_VIEW_MODE environment variable (defaulted to 1).
|
|
|
140 Optional argument BUFFER specifies a buffer to be filled (nil
|
|
|
141 means current).
|
|
|
142 Optional argument NODISPLAY non-nil means buffer is not
|
|
|
143 redisplayed as output is inserted."
|
|
|
144 (interactive "p")
|
|
|
145 (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
|
|
|
146
|
|
|
147 ;;;###autoload
|
|
|
148 (defun metamail-region (beg end &optional viewmode buffer nodisplay)
|
|
0
|
149 "Process current region through 'metamail'.
|
|
2
|
150 Optional argument VIEWMODE specifies the value of the
|
|
|
151 EMACS_VIEW_MODE environment variable (defaulted to 1).
|
|
|
152 Optional argument BUFFER specifies a buffer to be filled (nil
|
|
|
153 means current).
|
|
|
154 Optional argument NODISPLAY non-nil means buffer is not
|
|
|
155 redisplayed as output is inserted."
|
|
|
156 (interactive "r\np")
|
|
0
|
157 (let ((curbuf (current-buffer))
|
|
|
158 (buffer-read-only nil)
|
|
2
|
159 (metafile (make-temp-name "/tmp/metamail"))
|
|
|
160 (option-environment
|
|
|
161 (list (concat "EMACS_VIEW_MODE="
|
|
|
162 (if (numberp viewmode) viewmode 1)))))
|
|
0
|
163 (save-excursion
|
|
|
164 ;; Gee! Metamail does not ouput to stdout if input comes from
|
|
|
165 ;; stdin.
|
|
2
|
166 (let ((selective-display nil) ;Disable ^M to nl translation.
|
|
|
167 (kanji-fileio-code 2) ;Write in JIS code when nemacs.
|
|
|
168 (file-coding-system ;Write in JUNET style when mule.
|
|
|
169 (if (featurep 'mule) *junet*)))
|
|
|
170 (write-region beg end metafile nil 'nomessage))
|
|
0
|
171 (if buffer
|
|
|
172 (set-buffer buffer))
|
|
|
173 (setq buffer-read-only nil)
|
|
|
174 ;; Clear destination buffer.
|
|
|
175 (if (eq curbuf (current-buffer))
|
|
|
176 (delete-region beg end)
|
|
|
177 (delete-region (point-min) (point-max)))
|
|
2
|
178 ;; We have to pass the environment variable KEYHEADS to display
|
|
|
179 ;; all header fields. Metamail should have an optional argument
|
|
|
180 ;; to pass such information directly.
|
|
|
181 (let ((process-environment
|
|
|
182 (append process-environment
|
|
|
183 metamail-environment option-environment)))
|
|
|
184 ;; Specify character coding system.
|
|
|
185 (if (boundp 'NEMACS)
|
|
|
186 (define-program-kanji-code nil metamail-program-name 2)) ;JIS
|
|
|
187 (if (featurep 'mule)
|
|
|
188 (define-program-coding-system nil metamail-program-name *junet*))
|
|
|
189 (apply (function call-process)
|
|
|
190 metamail-program-name
|
|
|
191 nil
|
|
|
192 t ;Output to current buffer
|
|
|
193 (not nodisplay) ;Force redisplay
|
|
|
194 (append metamail-switches
|
|
|
195 (list "-m" (or metamail-mailer-name "emacs"))
|
|
|
196 (list metafile))))
|
|
|
197 ;; `metamail' may not delete the temporary file!
|
|
|
198 (condition-case error
|
|
|
199 (delete-file metafile)
|
|
|
200 (error nil))
|
|
0
|
201 )))
|
|
|
202
|
|
|
203 (provide 'metamail)
|
|
|
204
|
|
|
205 ;;; metamail.el ends here
|
