Mercurial > hg > xemacs-beta

comparison lisp/mu/std11.el @ 74:54cc21c15cbb r20-0b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents 131b0175ea99
children 360340f9fd5f
comparison
equal deleted inserted replaced
73:e2d7a37b7c8d 74:54cc21c15cbb
2 2
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
4 4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: mail, news, RFC 822, STD 11 6 ;; Keywords: mail, news, RFC 822, STD 11
7 ;; Version: $Id: std11.el,v 1.1.1.1 1996/12/18 22:43:39 steve Exp $ 7 ;; Version: $Id: std11.el,v 1.1.1.2 1996/12/21 20:50:52 steve Exp $
8 8
9 ;; This file is part of MU (Message Utilities). 9 ;; This file is part of MU (Message Utilities).
10 10
11 ;; This program is free software; you can redistribute it and/or 11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as 12 ;; modify it under the terms of the GNU General Public License as
111 ;;; 111 ;;;
112 112
113 (defun std11-unfold-string (string) 113 (defun std11-unfold-string (string)
114 "Unfold STRING as message header field. [std11.el]" 114 "Unfold STRING as message header field. [std11.el]"
115 (let ((dest "")) 115 (let ((dest ""))
116 (while (string-match "\n\\s +" string) 116 (while (string-match "\n\\([ \t]\\)" string)
117 (setq dest (concat dest (substring string 0 (match-beginning 0)) " ")) 117 (setq dest (concat dest
118 (substring string 0 (match-beginning 0))
119 (match-string 1 string)
120 ))
118 (setq string (substring string (match-end 0))) 121 (setq string (substring string (match-end 0)))
119 ) 122 )
120 (concat dest string) 123 (concat dest string)
121 )) 124 ))
122 125
195 198
196 199
197 ;;; @ quoted-string 200 ;;; @ quoted-string
198 ;;; 201 ;;;
199 202
203 (defun std11-wrap-as-quoted-pairs (string specials)
204 (let (dest
205 (i 0)
206 (b 0)
207 (len (length string))
208 )
209 (while (< i len)
210 (let ((chr (aref string i)))
211 (if (memq chr specials)
212 (setq dest (concat dest (substring string b i) "\\")
213 b i)
214 ))
215 (setq i (1+ i))
216 )
217 (concat dest (substring string b))
218 ))
219
200 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n)) 220 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
201 221
202 (defun std11-wrap-as-quoted-string (string) 222 (defun std11-wrap-as-quoted-string (string)
203 "Wrap STRING as RFC 822 quoted-string. [std11.el]" 223 "Wrap STRING as RFC 822 quoted-string. [std11.el]"
204 (concat "\"" 224 (concat "\""
205 (mapconcat (function 225 (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list)
206 (lambda (chr)
207 (if (memq chr std11-non-qtext-char-list)
208 (concat "\\" (char-to-string chr))
209 (char-to-string chr)
210 )
211 )) string "")
212 "\"")) 226 "\""))
213 227
214 (defun std11-strip-quoted-pair (str) 228 (defun std11-strip-quoted-pair (string)
215 (let ((dest "") 229 "Strip quoted-pairs in STRING. [std11.el]"
230 (let (dest
231 (b 0)
216 (i 0) 232 (i 0)
217 (len (length str)) 233 (len (length string))
218 chr flag) 234 )
219 (while (< i len) 235 (while (< i len)
220 (setq chr (aref str i)) 236 (let ((chr (aref string i)))
221 (if (or flag (not (eq chr ?\\))) 237 (if (eq chr ?\\)
222 (progn 238 (setq dest (concat dest (substring string b i))
223 (setq dest (concat dest (char-to-string chr))) 239 b (1+ i)
224 (setq flag nil) 240 i (+ i 2))
225 ) 241 (setq i (1+ i))
226 (setq flag t) 242 )))
227 ) 243 (concat dest (substring string b))
228 (setq i (+ i 1)) 244 ))
229 )
230 dest))
231 245
232 (defun std11-strip-quoted-string (string) 246 (defun std11-strip-quoted-string (string)
233 "Strip quoted-string STRING. [std11.el]" 247 "Strip quoted-string STRING. [std11.el]"
234 (let ((len (length string))) 248 (let ((len (length string)))
235 (or (and (>= len 2) 249 (or (and (>= len 2)
289 ((eq (car address) 'mailbox) 303 ((eq (car address) 'mailbox)
290 (let ((addr (nth 1 address)) 304 (let ((addr (nth 1 address))
291 (comment (nth 2 address)) 305 (comment (nth 2 address))
292 phrase) 306 phrase)
293 (if (eq (car addr) 'phrase-route-addr) 307 (if (eq (car addr) 'phrase-route-addr)
294 (setq phrase (mapconcat (function 308 (setq phrase
295 (lambda (token) 309 (mapconcat
296 (cdr token) 310 (function
297 )) 311 (lambda (token)
298 (nth 1 addr) "")) 312 (let ((type (car token)))
313 (cond ((eq type 'quoted-string)
314 (std11-strip-quoted-pair (cdr token))
315 )
316 ((eq type 'comment)
317 (concat
318 "("
319 (std11-strip-quoted-pair (cdr token))
320 ")")
321 )
322 (t
323 (cdr token)
324 )))))
325 (nth 1 addr) ""))
299 ) 326 )
300 (or phrase comment) 327 (cond ((> (length phrase) 0) phrase)
328 (comment (std11-strip-quoted-pair comment))
329 )
301 )))) 330 ))))
302 331
303 332
304 ;;; @ parser 333 ;;; @ parser
305 ;;; 334 ;;;