Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-ew-d.el @ 86:364816949b59 r20-0b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b93
author cvs
date Mon, 13 Aug 2007 09:09:02 +0200
parents 1ce6082ce73f
children fe104dbd9147
comparison
equal deleted inserted replaced
85:c661705957e0 86:364816949b59
1 ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs 1 ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs
2 2
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996,1997 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.2 $ 12 ;; Version: $Revision: 1.3 $
13 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news 13 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
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
40 40
41 ;;; @ version 41 ;;; @ version
42 ;;; 42 ;;;
43 43
44 (defconst tm-ew-d/RCS-ID 44 (defconst tm-ew-d/RCS-ID
45 "$Id: tm-ew-d.el,v 1.2 1997/01/11 20:14:11 steve Exp $") 45 "$Id: tm-ew-d.el,v 1.3 1997/01/30 02:22:48 steve Exp $")
46 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) 46 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
47 47
48 48
49 ;;; @ MIME encoded-word definition 49 ;;; @ MIME encoded-word definition
50 ;;; 50 ;;;
121 (narrow-to-region start end) 121 (narrow-to-region start end)
122 (if unfolding 122 (if unfolding
123 (mime/unfolding) 123 (mime/unfolding)
124 ) 124 )
125 (goto-char (point-min)) 125 (goto-char (point-min))
126 (while (re-search-forward "\\?=\\(\n*\\s +\\)+=\\?" nil t) 126 (while (re-search-forward (concat "\\(" mime/encoded-word-regexp "\\)"
127 (replace-match "?==?") 127 "\\(\n?[ \t]\\)+"
128 "\\(" mime/encoded-word-regexp "\\)")
129 nil t)
130 (replace-match "\\1\\6")
131 (goto-char (point-min))
128 ) 132 )
129 (goto-char (point-min))
130 (let (charset encoding text) 133 (let (charset encoding text)
131 (while (re-search-forward mime/encoded-word-regexp nil t) 134 (while (re-search-forward mime/encoded-word-regexp nil t)
132 (insert (mime/decode-encoded-word 135 (insert (mime/decode-encoded-word
133 (prog1 136 (prog1
134 (buffer-substring (match-beginning 0) (match-end 0)) 137 (buffer-substring (match-beginning 0) (match-end 0))
193 (text 196 (text
194 (substring word (match-beginning 3) (match-end 3)) 197 (substring word (match-beginning 3) (match-end 3))
195 )) 198 ))
196 (condition-case err 199 (condition-case err
197 (mime/decode-encoded-text charset encoding text must-unfold) 200 (mime/decode-encoded-text charset encoding text must-unfold)
198 (error nil)) 201 (error
199 )) 202 (and (tl:add-text-properties 0 (length word)
203 (and tm:warning-face
204 (list 'face tm:warning-face))
205 word)
206 word)))
207 ))
200 word)) 208 word))
201 209
202 210
203 ;;; @ encoded-text decoder 211 ;;; @ encoded-text decoder
204 ;;; 212 ;;;
215 if there are in decoded encoded-text (generated by bad manner MUA such 223 if there are in decoded encoded-text (generated by bad manner MUA such
216 as a version of Net$cape). [tm-ew-d.el]" 224 as a version of Net$cape). [tm-ew-d.el]"
217 (let ((cs (mime-charset-to-coding-system charset))) 225 (let ((cs (mime-charset-to-coding-system charset)))
218 (if cs 226 (if cs
219 (let ((dest 227 (let ((dest
220 (cond ((and (string-equal "B" encoding) 228 (cond
221 (string-match mime/B-encoded-text-regexp string)) 229 ((string-equal "B" encoding)
222 (base64-decode-string string)) 230 (if (and (string-match mime/B-encoded-text-regexp string)
223 ((and (string-equal "Q" encoding) 231 (string-equal string (match-string 0 string)))
224 (string-match mime/Q-encoded-text-regexp string)) 232 (base64-decode-string string)
225 (q-encoding-decode-string string)) 233 (error "Invalid encoded-text %s" string)))
226 (t (message "Invalid encoded-word %s" encoding) 234 ((string-equal "Q" encoding)
227 nil)))) 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 )
228 (if dest 243 (if dest
229 (progn 244 (progn
230 (setq dest (decode-coding-string dest cs)) 245 (setq dest (decode-coding-string dest cs))
231 (if must-unfold 246 (if must-unfold
232 (mapconcat (function 247 (mapconcat (function
233 (lambda (chr) 248 (lambda (chr)
234 (if (eq chr ?\n) 249 (cond
235 "" 250 ((eq chr ?\n) "")
236 (char-to-string chr) 251 ((eq chr ?\t) " ")
237 ) 252 (t (char-to-string chr)))
238 )) 253 ))
239 (std11-unfold-string dest) 254 (std11-unfold-string dest)
240 "") 255 "")
241 dest) 256 dest)
242 )))))) 257 ))))))