Repaginate.
authorChris Hanson <org/chris-hanson/cph>
Tue, 20 Jun 2000 19:45:37 +0000 (19:45 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 20 Jun 2000 19:45:37 +0000 (19:45 +0000)
v7/src/imail/imail-core.scm

index 3d2aab34fd99430f88bec0b0fc6c62316af0cf6e..36fb31763b69de94bed7a338ce555cc88af4240f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.106 2000/06/20 19:44:53 cph Exp $
+;;; $Id: imail-core.scm,v 1.107 2000/06/20 19:45:37 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
        ((string? object) (string->header-fields object))
        (else (error:wrong-type-argument object "header fields" #f))))
 
+(define (header-field-name? object)
+  (and (string? object)
+       (rfc822:header-field-name? object 0 (string-length object))))
+
+(define (header-field-value? object)
+  (and (string? object)
+       (let ((end (string-length object)))
+        (let loop ((index 0))
+          (let ((nl (substring-find-next-char object index end #\newline)))
+            (or (not nl)
+                (and (fix:< (fix:+ nl 1) end)
+                     (char-lwsp? (string-ref object (fix:+ nl 1)))
+                     (loop (fix:+ nl 2)))))))))
+
+(define (guarantee-header-field-name object procedure)
+  (if (not (header-field-name? object))
+      (error:wrong-type-argument object "header-field name" procedure)))
+
+(define (guarantee-header-field-value object procedure)
+  (if (not (header-field-value? object))
+      (error:wrong-type-argument object "header-field value" procedure)))
+\f
 (define (get-first-header-field headers name error?)
   (let loop ((headers (->header-fields headers)))
     (cond ((pair? headers)
         (string-trim (header-field-value header)))
        (get-all-header-fields headers name)))
 \f
-(define (header-field-name? object)
-  (and (string? object)
-       (rfc822:header-field-name? object 0 (string-length object))))
-
-(define (header-field-value? object)
-  (and (string? object)
-       (let ((end (string-length object)))
-        (let loop ((index 0))
-          (let ((nl (substring-find-next-char object index end #\newline)))
-            (or (not nl)
-                (and (fix:< (fix:+ nl 1) end)
-                     (char-lwsp? (string-ref object (fix:+ nl 1)))
-                     (loop (fix:+ nl 2)))))))))
-
-(define (guarantee-header-field-name object procedure)
-  (if (not (header-field-name? object))
-      (error:wrong-type-argument object "header-field name" procedure)))
-
-(define (guarantee-header-field-value object procedure)
-  (if (not (header-field-value? object))
-      (error:wrong-type-argument object "header-field value" procedure)))
-
 (define (header-field->lines header)
   (let ((lines (string->lines (header-field-value header))))
     (cons (string-append (header-field-name header) ":" (car lines))