Changeset 14848 in project


Ignore:
Timestamp:
06/01/09 05:46:35 (10 years ago)
Author:
Ivan Raikov
Message:

formular release 1.13

Location:
release/3/formular
Files:
2 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/3/formular/tags/1.13/formular.scm

    r13398 r14848  
    4545(define form-delim (string->list "------"))
    4646(define form-delim-len (length form-delim))
     47(define form-delim-end "--")
    4748
    4849(define-record-printer (section x out)
     
    6566
    6667
    67 (define $ (compose string->symbol stream->string ))
    68 
    6968;; The next two procedures follow the interface of document->stream
    7069;; from the stream-sections library to recognize the start of an RFC
     
    8483
    8584
    86 
    8785(define (read-field-value strm)
    8886  (let ((multiline?  (char=? multiline-field-start (stream-car strm))))
     
    9088      (if (or (stream-null? strm)
    9189              (and multiline? (char=? multiline-field-end (stream-car strm)))
    92               (and (not multiline?) (char=? (stream-car strm) #\newline)))
     90              (and (not multiline?) (or (char=? (stream-car strm) #\return)
     91                                        (char=? (stream-car strm) #\newline))))
    9392          (values (list->string (reverse lst)) strm)
    9493          (loop (cons (stream-car strm) lst) (stream-cdr strm))))))
     
    9796(define (read-form-fields strm)
    9897  (let ((start (form-fields-recognize-start strm)))
    99     (let loop ((fields (list)) (strm start))
    100       (if (or (stream-null? strm) (section? (stream-car strm)))
    101           (values (reverse fields) strm)
    102           (if (not (char-alphabetic? (stream-car strm)))
    103               (loop fields (stream-cdr strm))
    104               (let-values (((field-name field-rest)
    105                             (stream-break (lambda (x) (char=? x field-delim)) strm)))
    106                 (let ((field-name ($ field-name))
    107                       (field-rest (and (not (stream-null? field-rest))
    108                                        (stream-drop-while char-whitespace? (stream-cdr field-rest)))))
    109                   (if (not field-rest)
    110                       (error 'read-form-fields "premature end of field" field-name))
    111                   (let-values (((field-value rest) (read-field-value field-rest)))
    112                      (loop (cons (list field-name field-value) fields)  rest)))))))))
     98    (let loop ((fields (list)) (strm start) (last #f))
     99      (cond ((or (stream-null? strm) (section? (stream-car strm)) )
     100             (values (reverse fields) strm))
     101            ((not (char-alphabetic? (stream-car strm)))
     102             (if (and last (string-prefix? form-delim-end (list->string (list (stream-car strm) last ))))
     103                 (values (reverse fields) (stream-cdr strm))
     104                 (loop fields (stream-cdr strm) (stream-car strm))))
     105            (else
     106             (let-values (((field-name field-rest)
     107                           (stream-break (lambda (x) (char=? x field-delim)) strm)))
     108                         (let ((field-name (string->symbol (stream->string field-name)))
     109                               (field-rest (and (not (stream-null? field-rest))
     110                                                (stream-drop-while char-whitespace? (stream-cdr field-rest)))))
     111                           (if (not field-rest)
     112                               (error 'read-form-fields "premature end of field" field-name))
     113                           (let-values (((field-value rest) (read-field-value field-rest)))
     114                                       (loop (cons (list field-name field-value) fields) rest #f)))))))))
    113115
    114116;; Given an RFC 822 envelope and message streams, parses the headers
  • release/3/formular/trunk/formular.scm

    r13398 r14848  
    4545(define form-delim (string->list "------"))
    4646(define form-delim-len (length form-delim))
     47(define form-delim-end "--")
    4748
    4849(define-record-printer (section x out)
     
    6566
    6667
    67 (define $ (compose string->symbol stream->string ))
    68 
    6968;; The next two procedures follow the interface of document->stream
    7069;; from the stream-sections library to recognize the start of an RFC
     
    8483
    8584
    86 
    8785(define (read-field-value strm)
    8886  (let ((multiline?  (char=? multiline-field-start (stream-car strm))))
     
    9088      (if (or (stream-null? strm)
    9189              (and multiline? (char=? multiline-field-end (stream-car strm)))
    92               (and (not multiline?) (char=? (stream-car strm) #\newline)))
     90              (and (not multiline?) (or (char=? (stream-car strm) #\return)
     91                                        (char=? (stream-car strm) #\newline))))
    9392          (values (list->string (reverse lst)) strm)
    9493          (loop (cons (stream-car strm) lst) (stream-cdr strm))))))
     
    9796(define (read-form-fields strm)
    9897  (let ((start (form-fields-recognize-start strm)))
    99     (let loop ((fields (list)) (strm start))
    100       (if (or (stream-null? strm) (section? (stream-car strm)))
    101           (values (reverse fields) strm)
    102           (if (not (char-alphabetic? (stream-car strm)))
    103               (loop fields (stream-cdr strm))
    104               (let-values (((field-name field-rest)
    105                             (stream-break (lambda (x) (char=? x field-delim)) strm)))
    106                 (let ((field-name ($ field-name))
    107                       (field-rest (and (not (stream-null? field-rest))
    108                                        (stream-drop-while char-whitespace? (stream-cdr field-rest)))))
    109                   (if (not field-rest)
    110                       (error 'read-form-fields "premature end of field" field-name))
    111                   (let-values (((field-value rest) (read-field-value field-rest)))
    112                      (loop (cons (list field-name field-value) fields)  rest)))))))))
     98    (let loop ((fields (list)) (strm start) (last #f))
     99      (cond ((or (stream-null? strm) (section? (stream-car strm)) )
     100             (values (reverse fields) strm))
     101            ((not (char-alphabetic? (stream-car strm)))
     102             (if (and last (string-prefix? form-delim-end (list->string (list (stream-car strm) last ))))
     103                 (values (reverse fields) (stream-cdr strm))
     104                 (loop fields (stream-cdr strm) (stream-car strm))))
     105            (else
     106             (let-values (((field-name field-rest)
     107                           (stream-break (lambda (x) (char=? x field-delim)) strm)))
     108                         (let ((field-name (string->symbol (stream->string field-name)))
     109                               (field-rest (and (not (stream-null? field-rest))
     110                                                (stream-drop-while char-whitespace? (stream-cdr field-rest)))))
     111                           (if (not field-rest)
     112                               (error 'read-form-fields "premature end of field" field-name))
     113                           (let-values (((field-value rest) (read-field-value field-rest)))
     114                                       (loop (cons (list field-name field-value) fields) rest #f)))))))))
    113115
    114116;; Given an RFC 822 envelope and message streams, parses the headers
Note: See TracChangeset for help on using the changeset viewer.