From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 2 May 2000 21:09:08 +0000 (+0000)
Subject: Change names of RFC-822 procedures, and move header-field name
X-Git-Tag: 20090517-FFI~3949
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=01993e171c0a8c576420f9c5e19ea136b8e556be;p=mit-scheme.git

Change names of RFC-822 procedures, and move header-field name
predicate to "rfc822.scm".
---

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 82aac4840..c16bb6beb 100644
--- a/v7/src/imail/imail-umail.scm
+++ b/v7/src/imail/imail-umail.scm
@@ -1,6 +1,6 @@
 ;;; -*-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
 ;;;
@@ -146,7 +146,7 @@
 				   (get-first-header-field-value
 				    message "from" #f)))
 			      (and from
-				   (rfc822-first-address from)))
+				   (rfc822:first-address from)))
 			    "unknown")
 			port)
 	  (write-string " " port)
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index fb97538b5..9d30e3523 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-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
 ;;;
@@ -111,11 +111,12 @@
   (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")
diff --git a/v7/src/imail/rfc822.scm b/v7/src/imail/rfc822.scm
index c1aa6377a..554969318 100644
--- a/v7/src/imail/rfc822.scm
+++ b/v7/src/imail/rfc822.scm
@@ -1,6 +1,6 @@
 ;;; -*-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
 ;;;
@@ -22,20 +22,32 @@
 
 (declare (usual-integrations))
 
-(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))
@@ -50,7 +62,7 @@
 	(car address-list)
 	(map string-trim (burst-string string #\, #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
@@ -127,7 +139,7 @@
 
 ;;;; Parser
 
-(define string->rfc822-tokens
+(define rfc822:string->tokens
   (let* ((special-chars
 	  (char-set #\( #\) #\[ #\] #\< #\> #\@ #\, #\; #\: #\\ #\" #\.))
 	 (atom-chars