suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/net/head-sig.ss
View File

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

25
collects/net/head-unit.ss
View File

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