Remove %... procedure brain-damage from RFC822 code and use optional

arguments instead.

scheme/lib/rfc822.scm

@@ -46,41 +46,13 @@
 ;;; broad-minded view of line-terminators: lines can be terminated by either
 ;;; cr/lf or just lf, and either terminating sequence is trimmed.
 ;;;
-;;; If you need stricter parsing, you can call the lower-level procedure
+;;; If you need stricter parsing, you can pass a read-line procedure
-;;; %READ-RFC-822-FIELD and %READ-RFC822-HEADERS procs. They take the
+;;; as an extra parameter. This means that you can pass in a procedure
-;;; read-line procedure as an extra parameter. This means that you can
+;;; that recognizes only cr/lf's, or only cr's (for a Mac app,
-;;; pass in a procedure that recognises only cr/lf's, or only cr's (for a
+;;; perhaps), and you can determine whether or not the terminators get
-;;; Mac app, perhaps), and you can determine whether or not the terminators 
+;;; trimmed. However, your read-line procedure must indicate the
-;;; get trimmed. However, your read-line procedure must indicate the 
+;;; header-terminating empty line by returning *either* the empty
-;;; header-terminating empty line by returning *either* the empty string or
+;;; string or the two-char string cr/lf (or the EOF object).
-;;;  the two-char string cr/lf (or the EOF object).
-
-;;; (read-rfc822-field [port])
-;;; (%read-rfc822-field read-line port)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Read one field from the port, and return two values [NAME BODY]:
-;;; - NAME	Symbol such as 'subject or 'to. The field name is converted
-;;;             to a symbol using the Scheme implementation's preferred
-;;;             case. If the implementation reads symbols in a case-sensitive
-;;;             fashion (e.g., scsh), lowercase is used. This means you can
-;;;             compare these symbols to quoted constants using EQ?. When
-;;;             printing these field names out, it looks best if you capitalise
-;;;             them with (CAPITALIZE-STRING (SYMBOL->STRING FIELD-NAME)).
-;;; - BODY	List of strings which are the field's body, e.g. 
-;;;             ("shivers@lcs.mit.edu"). Each list element is one line
-;;;             from the field's body, so if the field spreads out
-;;;             over three lines, then the body is a list of three
-;;;             strings. The terminating cr/lf's are trimmed from each
-;;;             string.  A leading space or a leading horizontal tab
-;;;             is also trimmed, but one and only one.
-;;; When there are no more fields -- EOF or a blank line has terminated the
-;;; header section -- then the procedure returns [#f #f].
-;;; 
-;;; The %READ-RFC822-FIELD variant allows you to specify your own
-;;; read-line procedure. The one used by READ-RFC822-FIELD terminates
-;;; lines with either cr/lf or just lf, and it trims the terminator
-;;; from the line. Your read-line procedure should trim the terminator
-;;; of a line so an empty line is returned just as an empty string.
 
 (define htab (ascii->char 9))
 
@@ -91,11 +63,9 @@
       (lambda (s) (string->symbol (string-map char-downcase s)))
       (lambda (s) (string->symbol (string-map char-upcase s)))))
 
-(define (read-rfc822-field . maybe-port)
+(define (read-rfc822-field . args)
-  (let-optionals maybe-port ((port (current-input-port)))
+  (let-optionals args ((port (current-input-port))
-    (%read-rfc822-field read-crlf-line port)))
+		       (read-line read-crlf-line))
-
-(define (%read-rfc822-field read-line port)
     (let ((line1 (read-line port)))
       (if (or (eof-object? line1)
 	      (zero? (string-length line1))
@@ -112,35 +82,18 @@
 						 (+ colon 1)
 						 (string-length line1)))))
 		  (let ((c (peek-char port))) ; Could return EOF.
-;;;  RFC822: continuous lines has to start with a space or a htab 
+		    ;;  RFC822: continuous lines has to start with a space or a htab 
 		    (if (or (eqv? c #\space) (eqv? c htab))
 			(lp (cons (read-line port) lines))
 			(values name (reverse lines))))))))
-	 (else (error "Illegal RFC 822 field syntax." line1)))))) ; No :
+	   (else (error "Illegal RFC 822 field syntax." line1))))))) ; No :
 
 
-;;; (read-rfc822-headers [port])
+(define (read-rfc822-headers . args)
-;;; (%read-rfc822-headers read-line port)
+  (let-optionals args ((port (current-input-port))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+		       (read-line read-crlf-line))
-;;; Read in and parse up a section of text that looks like the header portion
-;;; of an RFC 822 message. Return an alist mapping a field name (a symbol
-;;; such as 'date or 'subject) to a list of field bodies -- one for
-;;; each occurence of the field in the header. So if there are five
-;;; "Received-by:" fields in the header, the alist maps 'received-by
-;;; to a five element list. Each body is in turn represented by a list
-;;; of strings -- one for each line of the field. So a field spread across
-;;; three lines would produce a three element body.
-;;;
-;;; The %READ-RFC822-HEADERS variant allows you to specify your own read-line
-;;; procedure. See notes above for reasons why.
-
-(define (read-rfc822-headers . maybe-port)
-  (let-optionals maybe-port ((port (current-input-port)))
-    (%read-rfc822-headers read-crlf-line port)))
-
-(define (%read-rfc822-headers read-line port)
     (let lp ((alist '()))
-    (receive (field val) (%read-rfc822-field read-line port)
+      (receive (field val) (read-rfc822-field port read-line)
 	(cond (field (cond ((assq field alist) =>
 			    (lambda (entry)
 			      (set-cdr! entry (cons val (cdr entry)))
@@ -151,7 +104,7 @@
 	      (else (for-each (lambda (entry)
 				(set-cdr! entry (reverse (cdr entry))))
 			      alist)
-			 alist)))))
+		    alist))))))
 		  
 ;;; (rejoin-header-lines alist [separator])
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -171,7 +124,6 @@
 		      (cdr entry))))
 	 alist)))
 
-
 ;;; Given a set of RFC822 headers like this:
 ;;;     From: shivers
 ;;; 	To: ziggy,
@@ -211,9 +163,7 @@
 	'()
 	headers))
 
-
+;;; Other desirable functionality
-
-;;; Other desireable functionality
 ;;; - Unfolding long lines.
 ;;; - Lexing structured fields.
 ;;; - Unlexing structured fields into canonical form.

scheme/packages.scm

@@ -43,8 +43,6 @@
 (define-interface rfc822-interface
   (export read-rfc822-headers
 	  read-rfc822-field
-	  %read-rfc822-headers
-	  %read-rfc822-field
 	  rejoin-header-lines
 	  get-header-all
 	  get-header-lines