Change names of RFC-822 procedures, and move header-field name
authorChris Hanson <org/chris-hanson/cph>
Tue, 2 May 2000 21:09:08 +0000 (21:09 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 2 May 2000 21:09:08 +0000 (21:09 +0000)
predicate to "rfc822.scm".

v7/src/imail/imail-umail.scm
v7/src/imail/imail.pkg
v7/src/imail/rfc822.scm

index 82aac484098856f809b02c91e4f5b8556043f01d..c16bb6bebfb0f2db342708204ef6e52a979d6924 100644 (file)
@@ -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
 ;;;
                                   (get-first-header-field-value
                                    message "from" #f)))
                              (and from
-                                  (rfc822-first-address from)))
+                                  (rfc822:first-address from)))
                            "unknown")
                        port)
          (write-string " " port)
index fb97538b5433209024d86d7f45fc988edc1db02b..9d30e3523576c4311fa040182ac7ac6de63d62b0 100644 (file)
@@ -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
 ;;;
   (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")
index c1aa6377acbadb68e23cb6b4e62a26a66a45d09d..554969318cde6e496232708b082c2a559c29bf1e 100644 (file)
@@ -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
 ;;;
 
 (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))
@@ -50,7 +62,7 @@
        (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