;;; -*-Scheme-*-
;;;
-;;; $Id: imail-umail.scm,v 1.12 2000/04/27 02:16:47 cph Exp $
+;;; $Id: imail-umail.scm,v 1.13 2000/05/02 21:09:08 cph Exp $
;;;
;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
;;;
(get-first-header-field-value
message "from" #f)))
(and from
- (rfc822-first-address from)))
+ (rfc822:first-address from)))
"unknown")
port)
(write-string " " port)
;;; -*-Scheme-*-
;;;
-;;; $Id: imail.pkg,v 1.24 2000/04/28 20:57:38 cph Exp $
+;;; $Id: imail.pkg,v 1.25 2000/05/02 21:07:54 cph Exp $
;;;
;;; Copyright (c) 2000 Massachusetts Institute of Technology
;;;
(files "rfc822")
(parent (edwin imail))
(export (edwin imail)
- rfc822-addresses->string
- rfc822-first-address
- rfc822-strip-quoted-names
- string->rfc822-addresses
- string->rfc822-tokens))
+ rfc822:addresses->string
+ rfc822:first-address
+ rfc822:header-field-name?
+ rfc822:string->addresses
+ rfc822:string->tokens
+ rfc822:strip-quoted-names))
(define-package (edwin imail imap-syntax)
(files "imap-syntax")
;;; -*-Scheme-*-
;;;
-;;; $Id: rfc822.scm,v 1.4 2000/04/14 01:45:47 cph Exp $
+;;; $Id: rfc822.scm,v 1.5 2000/05/02 21:07:59 cph Exp $
;;;
;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
;;;
(declare (usual-integrations))
\f
-(define (rfc822-first-address string)
- (let ((addresses (string->rfc822-addresses string)))
+(define rfc822:char-set:header-constituents
+ (char-set-difference (ascii-range->char-set 33 127)
+ (char-set #\:)))
+
+(define rfc822:char-set:not-header-constituents
+ (char-set-invert rfc822:char-set:header-constituents))
+
+(define (rfc822:header-field-name? string start end)
+ (and (fix:< start end)
+ (not (substring-find-next-char-in-set
+ string start end rfc822:char-set:not-header-constituents))))
+
+(define (rfc822:first-address string)
+ (let ((addresses (rfc822:string->addresses string)))
(and (pair? addresses)
(car addresses))))
-(define (rfc822-addresses->string addresses)
+(define (rfc822:addresses->string addresses)
(if (null? addresses)
""
(decorated-string-append "" ", " "" addresses)))
-(define (string->rfc822-addresses string)
+(define (rfc822:string->addresses string)
(let ((address-list
- (rfc822-strip-quoted-names
- (let loop ((tokens (string->rfc822-tokens string)))
+ (rfc822:strip-quoted-names
+ (let loop ((tokens (rfc822:string->tokens string)))
(if (pair? tokens)
(let ((rest (loop (cdr tokens))))
(if (cond ((char? (car tokens))
(car address-list)
(map string-trim (burst-string string #\, #f)))))
\f
-(define (rfc822-strip-quoted-names tokens)
+(define (rfc822:strip-quoted-names tokens)
(define (parse-list tokens separator parse-element)
(let ((first (parse-element tokens)))
(and first
\f
;;;; Parser
-(define string->rfc822-tokens
+(define rfc822:string->tokens
(let* ((special-chars
(char-set #\( #\) #\[ #\] #\< #\> #\@ #\, #\; #\: #\\ #\" #\.))
(atom-chars