blob: 57d4549fb95c13d7a4621e80acaebc8e4318eb6c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
(define-module (ldp content)
#:use-module (oop goops)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs bytevectors)
#:use-module (rnrs))
(define-class <content> ()
(port #:init-keyword #:port #:getter content-port)
(additional #:init-keyword #:additional #:getter content-additional))
(define (the-boolean x)
(unless (boolean? x)
(scm-error 'wrong-type-arg
"the-boolean"
"Expected a boolean."
'()
(list x)))
x)
(define (the-binary-port x)
(unless (binary-port? x)
(scm-error 'wrong-type-arg
"the-binary-port"
"Expected a binary port."
'()
(list x)))
x)
(define (the-bytevector x)
(unless (bytevector? x)
(scm-error 'wrong-type-arg
"the-bytevector"
"Expected a bytevector."
'()
(list x)))
x)
(define-public (make-content port additional)
(when (string? additional)
(set! additional (string->utf8 additional)))
(make <content>
#:port (the-binary-port port)
#:additional additional))
(define-public (load-content content binary?)
(let ((left (get-bytevector-all (content-port content)))
(right (content-additional content)))
(let ((nl (bytevector-length left))
(nr (bytevector-length right)))
(let ((total (make-bytevector (+ nl nr))))
(bytevector-copy! left 0 total 0 nl)
(bytevector-copy! right 0 total nl nr)
(if binary?
total
(utf8->string total))))))
|
