Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-ew-d.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents e04119814345
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs 1 ;;; tm-ew-d.el --- RFC 1522 based MIME encoded-word decoder for GNU Emacs
2 2
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
4 4
5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp> 5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> 7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;; Created: 1995/10/03 8 ;; Created: 1995/10/03
9 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. 9 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
10 ;; Renamed: 1993/06/03 to tiny-mime.el. 10 ;; Renamed: 1993/06/03 to tiny-mime.el.
11 ;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder) 11 ;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder)
12 ;; Version: $Revision: 1.5 $ 12 ;; Version: $Revision: 1.1.1.1 $
13 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news 13 ;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
14 14
15 ;; This file is part of tm (Tools for MIME). 15 ;; This file is part of tm (Tools for MIME).
16 16
17 ;; This program is free software; you can redistribute it and/or 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 18 ;; modify it under the terms of the GNU General Public License as
33 33
34 (require 'emu) 34 (require 'emu)
35 (require 'std11) 35 (require 'std11)
36 (require 'mel) 36 (require 'mel)
37 (require 'tm-def) 37 (require 'tm-def)
38 (require 'tl-str)
39 38
40 39
41 ;;; @ version 40 ;;; @ version
42 ;;; 41 ;;;
43 42
44 (defconst tm-ew-d/RCS-ID 43 (defconst tm-ew-d/RCS-ID
45 "$Id: tm-ew-d.el,v 1.5 1997/03/16 05:55:41 steve Exp $") 44 "$Id: tm-ew-d.el,v 1.1.1.1 1996/12/18 22:43:37 steve Exp $")
46 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) 45 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
47 46
48 47
49 ;;; @ MIME encoded-word definition 48 ;;; @ MIME encoded-word definition
50 ;;; 49 ;;;
121 (narrow-to-region start end) 120 (narrow-to-region start end)
122 (if unfolding 121 (if unfolding
123 (mime/unfolding) 122 (mime/unfolding)
124 ) 123 )
125 (goto-char (point-min)) 124 (goto-char (point-min))
126 (while (re-search-forward (concat "\\(" mime/encoded-word-regexp "\\)" 125 (while (re-search-forward
127 "\\(\n?[ \t]\\)+" 126 (concat (regexp-quote "?=") "\\s +" (regexp-quote "=?"))
128 "\\(" mime/encoded-word-regexp "\\)") 127 nil t)
129 nil t) 128 (replace-match "?==?")
130 (replace-match "\\1\\6")
131 (goto-char (point-min))
132 ) 129 )
130 (goto-char (point-min))
133 (let (charset encoding text) 131 (let (charset encoding text)
134 (while (re-search-forward mime/encoded-word-regexp nil t) 132 (while (re-search-forward mime/encoded-word-regexp nil t)
135 (insert (mime/decode-encoded-word 133 (insert (mime/decode-encoded-word
136 (prog1 134 (prog1
137 (buffer-substring (match-beginning 0) (match-end 0)) 135 (buffer-substring (match-beginning 0) (match-end 0))
157 (defun mime/unfolding () 155 (defun mime/unfolding ()
158 (goto-char (point-min)) 156 (goto-char (point-min))
159 (let (field beg end) 157 (let (field beg end)
160 (while (re-search-forward std11-field-head-regexp nil t) 158 (while (re-search-forward std11-field-head-regexp nil t)
161 (setq beg (match-beginning 0) 159 (setq beg (match-beginning 0)
162 end (std11-field-end)) 160 end (std11-field-end))
163 (setq field (buffer-substring beg end)) 161 (setq field (buffer-substring beg end))
164 (if (string-match mime/encoded-word-regexp field) 162 (if (string-match mime/encoded-word-regexp field)
165 (save-restriction 163 (save-restriction
166 (narrow-to-region (goto-char beg) end) 164 (narrow-to-region (goto-char beg) end)
167 (while (re-search-forward "\n\\([ \t]\\)" nil t) 165 (while (re-search-forward "\n[ \t]+" nil t)
168 (replace-match 166 (replace-match " ")
169 (match-string 1)) 167 )
170 )
171 (goto-char (point-max)) 168 (goto-char (point-max))
172 )) 169 ))
173 ))) 170 )))
174 171
175 172
194 (substring word (match-beginning 2) (match-end 2)) 191 (substring word (match-beginning 2) (match-end 2))
195 )) 192 ))
196 (text 193 (text
197 (substring word (match-beginning 3) (match-end 3)) 194 (substring word (match-beginning 3) (match-end 3))
198 )) 195 ))
199 (condition-case err 196 (mime/decode-encoded-text charset encoding text must-unfold)
200 (mime/decode-encoded-text charset encoding text must-unfold) 197 ))
201 (error
202 (and (add-text-properties 0 (length word)
203 (and tm:warning-face
204 (list 'face tm:warning-face))
205 word)
206 word)))
207 ))
208 word)) 198 word))
209 199
210 200
211 ;;; @ encoded-text decoder 201 ;;; @ encoded-text decoder
212 ;;; 202 ;;;
223 if there are in decoded encoded-text (generated by bad manner MUA such 213 if there are in decoded encoded-text (generated by bad manner MUA such
224 as a version of Net$cape). [tm-ew-d.el]" 214 as a version of Net$cape). [tm-ew-d.el]"
225 (let ((cs (mime-charset-to-coding-system charset))) 215 (let ((cs (mime-charset-to-coding-system charset)))
226 (if cs 216 (if cs
227 (let ((dest 217 (let ((dest
228 (cond 218 (cond ((string-equal "B" encoding)
229 ((string-equal "B" encoding) 219 (base64-decode-string string))
230 (if (and (string-match mime/B-encoded-text-regexp string) 220 ((string-equal "Q" encoding)
231 (string-equal string (match-string 0 string))) 221 (q-encoding-decode-string string))
232 (base64-decode-string string) 222 (t (message "unknown encoding %s" encoding)
233 (error "Invalid encoded-text %s" string))) 223 nil))))
234 ((string-equal "Q" encoding)
235 (if (and (string-match mime/Q-encoded-text-regexp string)
236 (string-equal string (match-string 0 string)))
237 (q-encoding-decode-string string)
238 (error "Invalid encoded-text %s" string)))
239 (t
240 (error "Invalid encoding %s" encoding)
241 )))
242 )
243 (if dest 224 (if dest
244 (progn 225 (progn
245 (setq dest (decode-coding-string dest cs)) 226 (setq dest (decode-coding-string dest cs))
246 (if must-unfold 227 (if must-unfold
247 (mapconcat (function 228 (mapconcat (function
248 (lambda (chr) 229 (lambda (chr)
249 (cond 230 (if (eq chr ?\n)
250 ((eq chr ?\n) "") 231 ""
251 ((eq chr ?\t) " ") 232 (char-to-string chr)
252 (t (char-to-string chr))) 233 )
253 )) 234 ))
254 (std11-unfold-string dest) 235 (std11-unfold-string dest)
255 "") 236 "")
256 dest) 237 dest)
257 )))))) 238 ))))))