Mercurial > hg > xemacs-beta

comparison lisp/mu/std11.el @ 8:4b173ad71786 r19-15b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents b82b59fe008d
children ec9a17fef872
comparison
equal deleted inserted replaced
7:c153ca296910 8:4b173ad71786
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 03:55:31 steve Exp $ 7 ;; Version: $Id: std11.el,v 1.2 1996/12/22 00:29:20 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
198 198
199 199
200 ;;; @ quoted-string 200 ;;; @ quoted-string
201 ;;; 201 ;;;
202 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
203 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n)) 220 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
204 221
205 (defun std11-wrap-as-quoted-string (string) 222 (defun std11-wrap-as-quoted-string (string)
206 "Wrap STRING as RFC 822 quoted-string. [std11.el]" 223 "Wrap STRING as RFC 822 quoted-string. [std11.el]"
207 (concat "\"" 224 (concat "\""
208 (mapconcat (function 225 (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list)
209 (lambda (chr)
210 (if (memq chr std11-non-qtext-char-list)
211 (concat "\\" (char-to-string chr))
212 (char-to-string chr)
213 )
214 )) string "")
215 "\"")) 226 "\""))
216 227
217 (defun std11-strip-quoted-pair (str) 228 (defun std11-strip-quoted-pair (string)
218 (let ((dest "") 229 "Strip quoted-pairs in STRING. [std11.el]"
230 (let (dest
231 (b 0)
219 (i 0) 232 (i 0)
220 (len (length str)) 233 (len (length string))
221 chr flag) 234 )
222 (while (< i len) 235 (while (< i len)
223 (setq chr (aref str i)) 236 (let ((chr (aref string i)))
224 (if (or flag (not (eq chr ?\\))) 237 (if (eq chr ?\\)
225 (progn 238 (setq dest (concat dest (substring string b i))
226 (setq dest (concat dest (char-to-string chr))) 239 b (1+ i)
227 (setq flag nil) 240 i (+ i 2))
228 ) 241 (setq i (1+ i))
229 (setq flag t) 242 )))
230 ) 243 (concat dest (substring string b))
231 (setq i (+ i 1)) 244 ))
232 )
233 dest))
234 245
235 (defun std11-strip-quoted-string (string) 246 (defun std11-strip-quoted-string (string)
236 "Strip quoted-string STRING. [std11.el]" 247 "Strip quoted-string STRING. [std11.el]"
237 (let ((len (length string))) 248 (let ((len (length string)))
238 (or (and (>= len 2) 249 (or (and (>= len 2)
292 ((eq (car address) 'mailbox) 303 ((eq (car address) 'mailbox)
293 (let ((addr (nth 1 address)) 304 (let ((addr (nth 1 address))
294 (comment (nth 2 address)) 305 (comment (nth 2 address))
295 phrase) 306 phrase)
296 (if (eq (car addr) 'phrase-route-addr) 307 (if (eq (car addr) 'phrase-route-addr)
297 (setq phrase (mapconcat (function 308 (setq phrase
298 (lambda (token) 309 (mapconcat
299 (cdr token) 310 (function
300 )) 311 (lambda (token)
301 (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) ""))
302 ) 326 )
303 (or phrase comment) 327 (cond ((> (length phrase) 0) phrase)
328 (comment (std11-strip-quoted-pair comment))
329 )
304 )))) 330 ))))
305 331
306 332
307 ;;; @ parser 333 ;;; @ parser
308 ;;; 334 ;;;