Mercurial > hg > xemacs-beta

comparison lisp/packages/metamail.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;;; metamail.el --- Metamail interface for GNU Emacs 1 ;;; metamail.el --- Metamail interface for GNU Emacs
2 ;; Keywords: mail, news, mime, multimedia 2
3 3 ;; Copyright (C) 1993, 1996 Masanobu UMEDA
4 ;; Copyright (C) 1993 Masanobu UMEDA
5 4
6 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> 5 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
7 ;; Version: Header: /cadillac-inferno-5/cvs-master/lemacs/lisp/packages/metamail.el,v 1.1 1993/12/01 08:54:51 jwz Exp 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 $
8 ;; Keywords: mail, news, mime, multimedia 7 ;; Keywords: mail, news, mime, multimedia
9 8
10 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
11 10
12 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 19 ;; General Public License for more details.
21 20
22 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 24 ;; 02111-1307, USA.
26 ;;; Synched up with: Very similar to but not quite synched with 25
27 ;;; FSF 19.30. 26 ;;; Synched up with: FSF 19.34.
28 27
29 ;;; Commentary: 28 ;;; Commentary:
30 29
31 ;; LCD Archive Entry: 30 ;; I trashed all the differences this file had from the FSF version.
32 ;; metamail|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| 31 ;; So sue me. -sb
33 ;; Metamail interface for GNU Emacs| 32
34 ;; !Date: 1993/12/01 08:54:51 !|!Revision: 1.1 !|~/misc/metamail.el.Z| 33 ;; The latest version will be at:
34 ;; ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
35 35
36 ;; Note: Metamail does not have all options which is compatible with 36 ;; Note: Metamail does not have all options which is compatible with
37 ;; the environment variables. For that reason, matamail.el have to 37 ;; the environment variables. For that reason, matamail.el have to
38 ;; hack the environment variables. In addition, there is no way to 38 ;; hack the environment variables. In addition, there is no way to
39 ;; display all header fields without extra informative body messages 39 ;; display all header fields without extra informative body messages
40 ;; which is suppressed by "-q" option. 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)))))
41 50
42 ;; The idea of using metamail to process MIME messages is from 51 ;; The idea of using metamail to process MIME messages is from
43 ;; gnus-mime.el by Spike <Spike@world.std.com>. 52 ;; gnus-mime.el by Spike <Spike@world.std.com>.
44 53
45 ;;; Code: 54 ;;; Code:
46 55
47 (defvar metamail-program-name "metamail" 56 (defvar metamail-program-name "metamail"
48 "*Metamail program name.") 57 "*Metamail program name.")
49 58
50 (defvar metamail-environment "KEYHEADS='*';export KEYHEADS;" 59 (defvar metamail-mailer-name "emacs"
51 "*Environment variables for Metamail. 60 "*Mailer name set to MM_MAILER environment variable.")
52 It must be an emtpy string or a string terminated with ';'.") 61
53 62 (defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
54 (defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z") 63 "*Environment variables passed to `metamail'.
55 "*Switches for Metamail program. 64 It must be a list of strings that have the format ENVVARNAME=VALUE.
56 -z is required to remove zap file.") 65 It is not expected to be altered globally by `set' or `setq'.
57 66 Instead, change its value temporary using `let' or `let*' form.")
58 (defun metamail-buffer (&optional buffer) 67
59 "Process current buffer through 'metamail'. 68 (defvar metamail-switches '("-x" "-d" "-z")
60 Optional argument BUFFER specifies a buffer to be filled (nil means current)." 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.")
75
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."
61 (interactive) 80 (interactive)
62 (metamail-region (point-min) (point-max) buffer)) 81 (save-excursion
63 82 (let* ((buffer-read-only nil)
64 (defun metamail-region (beg end &optional buffer) 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 )))
99
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 )))
134
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)
65 "Process current region through 'metamail'. 149 "Process current region through 'metamail'.
66 Optional argument BUFFER specifies a buffer to be filled (nil means current)." 150 Optional argument VIEWMODE specifies the value of the
67 (interactive "r") 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")
68 (let ((curbuf (current-buffer)) 157 (let ((curbuf (current-buffer))
69 (buffer-read-only nil) 158 (buffer-read-only nil)
70 (metafile (make-temp-name "/tmp/metamail"))) 159 (metafile (make-temp-name "/tmp/metamail"))
160 (option-environment
161 (list (concat "EMACS_VIEW_MODE="
162 (if (numberp viewmode) viewmode 1)))))
71 (save-excursion 163 (save-excursion
72 ;; Gee! Metamail does not ouput to stdout if input comes from 164 ;; Gee! Metamail does not ouput to stdout if input comes from
73 ;; stdin. 165 ;; stdin.
74 (write-region beg end metafile nil 'nomessage) 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))
75 (if buffer 171 (if buffer
76 (set-buffer buffer)) 172 (set-buffer buffer))
77 (setq buffer-read-only nil) 173 (setq buffer-read-only nil)
78 ;; Clear destination buffer. 174 ;; Clear destination buffer.
79 (if (eq curbuf (current-buffer)) 175 (if (eq curbuf (current-buffer))
80 (delete-region beg end) 176 (delete-region beg end)
81 (delete-region (point-min) (point-max))) 177 (delete-region (point-min) (point-max)))
82 ;; We have to pass the environment variable KEYHEADS to /bin/sh 178 ;; We have to pass the environment variable KEYHEADS to display
83 ;; to display all header fields. Metamail should have an 179 ;; all header fields. Metamail should have an optional argument
84 ;; optional argument to pass such information directly. 180 ;; to pass such information directly.
85 (apply (function call-process) 181 (let ((process-environment
86 "/bin/sh" 182 (append process-environment
87 nil 183 metamail-environment option-environment)))
88 t ;Output to current buffer 184 ;; Specify character coding system.
89 t ;Force redisplay 185 (if (boundp 'NEMACS)
90 (list "-c" 186 (define-program-kanji-code nil metamail-program-name 2)) ;JIS
91 ;; Construct environment and the command. 187 (if (featurep 'mule)
92 (concat 188 (define-program-coding-system nil metamail-program-name *junet*))
93 metamail-environment 189 (apply (function call-process)
94 metamail-program-name 190 metamail-program-name
95 " " 191 nil
96 (mapconcat (function identity) metamail-switches " ") 192 t ;Output to current buffer
97 " " 193 (not nodisplay) ;Force redisplay
98 metafile 194 (append metamail-switches
99 ))) 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))
100 ))) 201 )))
101 202
102 ;(defun metamail-region (beg end &optional buffer)
103 ; "Process current region through 'metamail'.
104 ;Optional argument BUFFER specifies a buffer to be filled (nil means current)."
105 ; (interactive "r")
106 ; (let ((curbuf (current-buffer))
107 ; (buffer-read-only nil)
108 ; (metafile (make-temp-name "/tmp/metamail")))
109 ; (save-excursion
110 ; (write-region (point-min) (point-max) metafile nil 'nomessage)
111 ; (if (eq curbuf
112 ; (if buffer (get-buffer buffer) (current-buffer)))
113 ; (delete-region (point-min) (point-max)))
114 ; (apply (function call-process)
115 ; metamail-program-name
116 ; nil
117 ; (or buffer t) ;BUFFER or current buffer
118 ; nil ;don't redisplay
119 ; (append metamail-switches (list metafile)))
120 ; )))
121
122 (provide 'metamail) 203 (provide 'metamail)
123 204
124 ;;; metamail.el ends here 205 ;;; metamail.el ends here