|
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>
|
|
149
|
6 ;; Version: $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/metamail.el,v 1.4 1997/05/18 03:40:08 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
|
|
149
|
56 (defgroup metamail nil
|
|
|
57 "Metamail interface for Emacs."
|
|
|
58 :group 'mail
|
|
|
59 :group 'hypermedia
|
|
|
60 :group 'processes)
|
|
0
|
61
|
|
149
|
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)
|
|
2
|
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
|
|
149
|
78 (defcustom metamail-switches '("-x" "-d" "-z")
|
|
2
|
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
|
|
149
|
84 `metamail-mailer-name' variable."
|
|
|
85 :type '(repeat (string :tag "Switch"))
|
|
|
86 :group 'metamail)
|
|
0
|
87
|
|
2
|
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 )))
|
|
0
|
111
|
|
2
|
112 ;;;###autoload
|
|
|
113 (defun metamail-interpret-body (&optional viewmode nodisplay)
|
|
|
114 "Interpret a body part of a MIME message in current buffer.
|
|
|
115 Optional argument VIEWMODE specifies the value of the
|
|
|
116 EMACS_VIEW_MODE environment variable (defaulted to 1).
|
|
|
117 Optional argument NODISPLAY non-nil means buffer is not
|
|
|
118 redisplayed as output is inserted.
|
|
|
119 Its header part is not interpreted at all."
|
|
|
120 (interactive "p")
|
|
|
121 (save-excursion
|
|
|
122 (let ((contype nil)
|
|
|
123 (encoding nil)
|
|
|
124 (end (progn
|
|
|
125 (goto-char (point-min))
|
|
|
126 (search-forward "\n\n" nil t)
|
|
|
127 (point))))
|
|
|
128 ;; Find Content-Type and Content-Transfer-Encoding from the header.
|
|
|
129 (save-restriction
|
|
|
130 (narrow-to-region (point-min) end)
|
|
|
131 (setq contype
|
|
|
132 (or (mail-fetch-field "Content-Type") "text/plain"))
|
|
|
133 (setq encoding
|
|
|
134 (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
|
|
|
135 ;; Interpret the body part only.
|
|
|
136 (let ((metamail-switches ;Process body part only.
|
|
|
137 (append metamail-switches
|
|
|
138 (list "-b" "-c" contype "-E" encoding))))
|
|
|
139 (metamail-region end (point-max) viewmode nil nodisplay))
|
|
|
140 ;; Mode specific hack.
|
|
|
141 (cond ((eq major-mode 'rmail-mode)
|
|
|
142 ;; Adjust the marker of this message if in Rmail mode buffer.
|
|
|
143 (set-marker (aref rmail-message-vector (1+ rmail-current-message))
|
|
|
144 (point-max))))
|
|
|
145 )))
|
|
0
|
146
|
|
2
|
147 ;;;###autoload
|
|
|
148 (defun metamail-buffer (&optional viewmode buffer nodisplay)
|
|
|
149 "Process current buffer through `metamail'.
|
|
|
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 "p")
|
|
|
157 (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
|
|
|
158
|
|
|
159 ;;;###autoload
|
|
|
160 (defun metamail-region (beg end &optional viewmode buffer nodisplay)
|
|
0
|
161 "Process current region through 'metamail'.
|
|
2
|
162 Optional argument VIEWMODE specifies the value of the
|
|
|
163 EMACS_VIEW_MODE environment variable (defaulted to 1).
|
|
|
164 Optional argument BUFFER specifies a buffer to be filled (nil
|
|
|
165 means current).
|
|
|
166 Optional argument NODISPLAY non-nil means buffer is not
|
|
|
167 redisplayed as output is inserted."
|
|
|
168 (interactive "r\np")
|
|
0
|
169 (let ((curbuf (current-buffer))
|
|
|
170 (buffer-read-only nil)
|
|
2
|
171 (metafile (make-temp-name "/tmp/metamail"))
|
|
|
172 (option-environment
|
|
|
173 (list (concat "EMACS_VIEW_MODE="
|
|
|
174 (if (numberp viewmode) viewmode 1)))))
|
|
0
|
175 (save-excursion
|
|
|
176 ;; Gee! Metamail does not ouput to stdout if input comes from
|
|
|
177 ;; stdin.
|
|
110
|
178 (let ((selective-display nil) ;Disable ^M to nl translation.
|
|
|
179 (kanji-fileio-code 2) ;Write in JIS code when nemacs.
|
|
|
180 (file-coding-system ;Write in JUNET style when mule.
|
|
|
181 (if (featurep 'mule) '*junet*))
|
|
|
182 (coding-system-for-write ;Write in iso-2022-jp style
|
|
|
183 'iso-2022-jp) ; when XEmacs/mule
|
|
|
184 )
|
|
2
|
185 (write-region beg end metafile nil 'nomessage))
|
|
0
|
186 (if buffer
|
|
|
187 (set-buffer buffer))
|
|
|
188 (setq buffer-read-only nil)
|
|
|
189 ;; Clear destination buffer.
|
|
|
190 (if (eq curbuf (current-buffer))
|
|
|
191 (delete-region beg end)
|
|
|
192 (delete-region (point-min) (point-max)))
|
|
2
|
193 ;; We have to pass the environment variable KEYHEADS to display
|
|
|
194 ;; all header fields. Metamail should have an optional argument
|
|
|
195 ;; to pass such information directly.
|
|
|
196 (let ((process-environment
|
|
|
197 (append process-environment
|
|
|
198 metamail-environment option-environment)))
|
|
|
199 ;; Specify character coding system.
|
|
|
200 (if (boundp 'NEMACS)
|
|
|
201 (define-program-kanji-code nil metamail-program-name 2)) ;JIS
|
|
|
202 (if (featurep 'mule)
|
|
94
|
203 (if (fboundp 'define-program-coding-system)
|
|
|
204 (define-program-coding-system
|
|
|
205 nil
|
|
|
206 metamail-program-name
|
|
|
207 'junet)
|
|
|
208 ;; XEmacs with MULE
|
|
110
|
209 (setq buffer-file-coding-system 'junet)))
|
|
2
|
210 (apply (function call-process)
|
|
|
211 metamail-program-name
|
|
|
212 nil
|
|
|
213 t ;Output to current buffer
|
|
|
214 (not nodisplay) ;Force redisplay
|
|
|
215 (append metamail-switches
|
|
|
216 (list "-m" (or metamail-mailer-name "emacs"))
|
|
|
217 (list metafile))))
|
|
|
218 ;; `metamail' may not delete the temporary file!
|
|
|
219 (condition-case error
|
|
|
220 (delete-file metafile)
|
|
|
221 (error nil))
|
|
0
|
222 )))
|
|
|
223
|
|
|
224 (provide 'metamail)
|
|
|
225
|
|
|
226 ;;; metamail.el ends here
|
