original commit: 632c67cb6f80d468839ad49600a7f5fbcd30d6e3
This commit is contained in:
Matthew Flatt 2004-04-15 16:29:05 +00:00
parent 12e10c977e
commit 6f933fb41a
2 changed files with 20 additions and 6 deletions

View File

@ -9,6 +9,7 @@
extract-field
remove-field
insert-field
replace-field
extract-all-fields
append-headers
standard-message-header

View File

@ -17,7 +17,7 @@
(define re:continue (regexp "^[ \t\v]"))
(define (validate-header s)
(let ([m (regexp-match #rx"[^\0-\277]" s)])
(let ([m (regexp-match #rx"[^\000-\377]" s)])
(when m
(error 'validate-header "non-Latin-1 character in string: ~a" (car m))))
(let ([len (string-length s)])
@ -55,7 +55,7 @@
s
"")))))))
(define (remove-field field header)
(define (replace-field field data header)
(let ([m (regexp-match-positions
(make-field-start-regexp field)
header)])
@ -68,10 +68,23 @@
(string-length header))])
(let ([m (regexp-match-positions #rx"[\r][\n][^: \r\n\"]*:" s)])
(if m
(string-append pre (substring s (+ 2 (caar m))
(string-length s)))
pre)))
header)))
(string-append pre
(let ([rest
(substring s (+ 2 (caar m))
(string-length s))])
(if data
(insert-field field data rest)
rest)))
(if data
(insert-field field data pre)
pre))))
(if data
(insert-field field data header)
header))))
(define (remove-field field header)
(replace-field field #f header))
(define (insert-field field data header)
(let ([field (format "~a: ~a\r\n"