Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-ew-d.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents
children 4b173ad71786
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
1 ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs
2
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
4
5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;; Created: 1995/10/03
9 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
10 ;; Renamed: 1993/06/03 to tiny-mime.el.
11 ;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder)
12 ;; Version: $Revision: 1.1.1.1 $
13 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
14
15 ;; This file is part of tm (Tools for MIME).
16
17 ;; This program is free software; you can redistribute it and/or
18 ;; modify it under the terms of the GNU General Public License as
19 ;; published by the Free Software Foundation; either version 2, or (at
20 ;; your option) any later version.
21
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 ;; General Public License for more details.
26
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with GNU Emacs; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
30 ;; Boston, MA 02111-1307, USA.
31
32 ;;; Code:
33
34 (require 'emu)
35 (require 'std11)
36 (require 'mel)
37 (require 'tm-def)
38
39
40 ;;; @ version
41 ;;;
42
43 (defconst tm-ew-d/RCS-ID
44 "$Id: tm-ew-d.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $")
45 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
46
47
48 ;;; @ MIME encoded-word definition
49 ;;;
50
51 (defconst mime/encoded-text-regexp "[!->@-~]+")
52 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
53 "\\("
54 mime/charset-regexp
55 "\\)"
56 (regexp-quote "?")
57 "\\(B\\|Q\\)"
58 (regexp-quote "?")
59 "\\("
60 mime/encoded-text-regexp
61 "\\)"
62 (regexp-quote "?=")))
63
64
65 ;;; @ for string
66 ;;;
67
68 (defun mime-eword/decode-string (string &optional must-unfold)
69 "Decode MIME encoded-words in STRING.
70
71 STRING is unfolded before decoding.
72
73 If an encoded-word is broken or your emacs implementation can not
74 decode the charset included in it, it is not decoded.
75
76 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
77 if there are in decoded encoded-words (generated by bad manner MUA
78 such as a version of Net$cape). [tm-ew-d.el]"
79 (setq string (std11-unfold-string string))
80 (let ((dest "")(ew nil)
81 beg end)
82 (while (and (string-match mime/encoded-word-regexp string)
83 (setq beg (match-beginning 0)
84 end (match-end 0))
85 )
86 (if (> beg 0)
87 (if (not
88 (and (eq ew t)
89 (string-match "^[ \t]+$" (substring string 0 beg))
90 ))
91 (setq dest (concat dest (substring string 0 beg)))
92 )
93 )
94 (setq dest
95 (concat dest
96 (mime/decode-encoded-word
97 (substring string beg end) must-unfold)
98 ))
99 (setq string (substring string end))
100 (setq ew t)
101 )
102 (concat dest string)
103 ))
104
105
106 ;;; @ for region
107 ;;;
108
109 (defun mime-eword/decode-region (start end &optional unfolding must-unfold)
110 "Decode MIME encoded-words in region between START and END.
111
112 If UNFOLDING is not nil, it unfolds before decoding.
113
114 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
115 if there are in decoded encoded-words (generated by bad manner MUA
116 such as a version of Net$cape). [tm-ew-d.el]"
117 (interactive "*r")
118 (save-excursion
119 (save-restriction
120 (narrow-to-region start end)
121 (if unfolding
122 (mime/unfolding)
123 )
124 (goto-char (point-min))
125 (while (re-search-forward "\\?=\\(\n*\\s +\\)+=\\?" nil t)
126 (replace-match "?==?")
127 )
128 (goto-char (point-min))
129 (let (charset encoding text)
130 (while (re-search-forward mime/encoded-word-regexp nil t)
131 (insert (mime/decode-encoded-word
132 (prog1
133 (buffer-substring (match-beginning 0) (match-end 0))
134 (delete-region (match-beginning 0) (match-end 0))
135 ) must-unfold))
136 ))
137 )))
138
139
140 ;;; @ for message header
141 ;;;
142
143 (defun mime/decode-message-header ()
144 "Decode MIME encoded-words in message header. [tm-ew-d.el]"
145 (interactive "*")
146 (save-excursion
147 (save-restriction
148 (narrow-to-region (goto-char (point-min))
149 (progn (re-search-forward "^$" nil t) (point)))
150 (mime-eword/decode-region (point-min) (point-max) t)
151 )))
152
153 (defun mime/unfolding ()
154 (goto-char (point-min))
155 (let (field beg end)
156 (while (re-search-forward std11-field-head-regexp nil t)
157 (setq beg (match-beginning 0)
158 end (std11-field-end))
159 (setq field (buffer-substring beg end))
160 (if (string-match mime/encoded-word-regexp field)
161 (save-restriction
162 (narrow-to-region (goto-char beg) end)
163 (while (re-search-forward "\n\\([ \t]\\)" nil t)
164 (replace-match
165 (match-string 1))
166 )
167 (goto-char (point-max))
168 ))
169 )))
170
171
172 ;;; @ encoded-word decoder
173 ;;;
174
175 (defun mime/decode-encoded-word (word &optional must-unfold)
176 "Decode WORD if it is an encoded-word.
177
178 If your emacs implementation can not decode the charset of WORD, it
179 returns WORD. Similarly the encoded-word is broken, it returns WORD.
180
181 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
182 if there are in decoded encoded-word (generated by bad manner MUA such
183 as a version of Net$cape). [tm-ew-d.el]"
184 (or (if (string-match mime/encoded-word-regexp word)
185 (let ((charset
186 (substring word (match-beginning 1) (match-end 1))
187 )
188 (encoding
189 (upcase
190 (substring word (match-beginning 2) (match-end 2))
191 ))
192 (text
193 (substring word (match-beginning 3) (match-end 3))
194 ))
195 (condition-case err
196 (mime/decode-encoded-text charset encoding text must-unfold)
197 (error nil))
198 ))
199 word))
200
201
202 ;;; @ encoded-text decoder
203 ;;;
204
205 (defun mime/decode-encoded-text (charset encoding string &optional must-unfold)
206 "Decode STRING as an encoded-text.
207
208 If your emacs implementation can not decode CHARSET, it returns nil.
209
210 If ENCODING is not \"B\" or \"Q\", it occurs error.
211 So you should write error-handling code if you don't want break by errors.
212
213 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
214 if there are in decoded encoded-text (generated by bad manner MUA such
215 as a version of Net$cape). [tm-ew-d.el]"
216 (let ((cs (mime-charset-to-coding-system charset)))
217 (if cs
218 (let ((dest
219 (cond ((and (string-equal "B" encoding)
220 (string-match mime/B-encoded-text-regexp string))
221 (base64-decode-string string))
222 ((and (string-equal "Q" encoding)
223 (string-match mime/Q-encoded-text-regexp string))
224 (q-encoding-decode-string string))
225 (t (message "Invalid encoded-word %s" encoding)
226 nil))))
227 (if dest
228 (progn
229 (setq dest (decode-coding-string dest cs))
230 (if must-unfold
231 (mapconcat (function
232 (lambda (chr)
233 (if (eq chr ?\n)
234 ""
235 (char-to-string chr)
236 )
237 ))
238 (std11-unfold-string dest)
239 "")
240 dest)
241 ))))))
242
243
244 ;;; @ end
245 ;;;
246
247 (provide 'tm-ew-d)
248
249 ;;; tm-ew-d.el ends here