Mercurial > hg > xemacs-beta

comparison lisp/mu/std11.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 ec9a17fef872
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; std11.el --- STD 11 functions for GNU Emacs 1 ;;; std11.el --- STD 11 functions 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: 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.3 1997/03/09 02:37:25 steve Exp $ 7 ;; Version: $Id: std11.el,v 1.1.1.1 1996/12/18 22:43:39 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\\([ \t]\\)" string) 116 (while (string-match "\n\\s +" string)
117 (setq dest (concat dest 117 (setq dest (concat dest (substring string 0 (match-beginning 0)) " "))
118 (substring string 0 (match-beginning 0))
119 (match-string 1 string)
120 ))
121 (setq string (substring string (match-end 0))) 118 (setq string (substring string (match-end 0)))
122 ) 119 )
123 (concat dest string) 120 (concat dest string)
124 )) 121 ))
125 122
198 195
199 196
200 ;;; @ quoted-string 197 ;;; @ quoted-string
201 ;;; 198 ;;;
202 199
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
220 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n)) 200 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
221 201
222 (defun std11-wrap-as-quoted-string (string) 202 (defun std11-wrap-as-quoted-string (string)
223 "Wrap STRING as RFC 822 quoted-string. [std11.el]" 203 "Wrap STRING as RFC 822 quoted-string. [std11.el]"
224 (concat "\"" 204 (concat "\""
225 (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list) 205 (mapconcat (function
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 "")
226 "\"")) 212 "\""))
227 213
228 (defun std11-strip-quoted-pair (string) 214 (defun std11-strip-quoted-pair (str)
229 "Strip quoted-pairs in STRING. [std11.el]" 215 (let ((dest "")
230 (let (dest
231 (b 0)
232 (i 0) 216 (i 0)
233 (len (length string)) 217 (len (length str))
218 chr flag)
219 (while (< i len)
220 (setq chr (aref str i))
221 (if (or flag (not (eq chr ?\\)))
222 (progn
223 (setq dest (concat dest (char-to-string chr)))
224 (setq flag nil)
225 )
226 (setq flag t)
234 ) 227 )
235 (while (< i len) 228 (setq i (+ i 1))
236 (let ((chr (aref string i))) 229 )
237 (if (eq chr ?\\) 230 dest))
238 (setq dest (concat dest (substring string b i))
239 b (1+ i)
240 i (+ i 2))
241 (setq i (1+ i))
242 )))
243 (concat dest (substring string b))
244 ))
245 231
246 (defun std11-strip-quoted-string (string) 232 (defun std11-strip-quoted-string (string)
247 "Strip quoted-string STRING. [std11.el]" 233 "Strip quoted-string STRING. [std11.el]"
248 (let ((len (length string))) 234 (let ((len (length string)))
249 (or (and (>= len 2) 235 (or (and (>= len 2)
261 (defun std11-addr-to-string (seq) 247 (defun std11-addr-to-string (seq)
262 "Return string from lexical analyzed list SEQ 248 "Return string from lexical analyzed list SEQ
263 represents addr-spec of RFC 822. [std11.el]" 249 represents addr-spec of RFC 822. [std11.el]"
264 (mapconcat (function 250 (mapconcat (function
265 (lambda (token) 251 (lambda (token)
266 (let ((name (car token))) 252 (if (let ((name (car token)))
267 (cond 253 (or (eq name 'spaces)
268 ((eq name 'spaces) "") 254 (eq name 'comment)
269 ((eq name 'comment) "") 255 ))
270 ((eq name 'quoted-string) 256 ""
271 (concat "\"" (cdr token) "\"")) 257 (cdr token)
272 (t (cdr token))) 258 )))
273 )))
274 seq "") 259 seq "")
275 ) 260 )
276 261
277 (defun std11-address-string (address) 262 (defun std11-address-string (address)
278 "Return string of address part from parsed ADDRESS of RFC 822. 263 "Return string of address part from parsed ADDRESS of RFC 822.
304 ((eq (car address) 'mailbox) 289 ((eq (car address) 'mailbox)
305 (let ((addr (nth 1 address)) 290 (let ((addr (nth 1 address))
306 (comment (nth 2 address)) 291 (comment (nth 2 address))
307 phrase) 292 phrase)
308 (if (eq (car addr) 'phrase-route-addr) 293 (if (eq (car addr) 'phrase-route-addr)
309 (setq phrase 294 (setq phrase (mapconcat (function
310 (mapconcat 295 (lambda (token)
311 (function 296 (cdr token)
312 (lambda (token) 297 ))
313 (let ((type (car token))) 298 (nth 1 addr) ""))
314 (cond ((eq type 'quoted-string)
315 (std11-strip-quoted-pair (cdr token))
316 )
317 ((eq type 'comment)
318 (concat
319 "("
320 (std11-strip-quoted-pair (cdr token))
321 ")")
322 )
323 (t
324 (cdr token)
325 )))))
326 (nth 1 addr) ""))
327 ) 299 )
328 (cond ((> (length phrase) 0) phrase) 300 (or phrase comment)
329 (comment (std11-strip-quoted-pair comment))
330 )
331 )))) 301 ))))
332 302
333 303
334 ;;; @ parser 304 ;;; @ parser
335 ;;; 305 ;;;