blob: 4f6a1b3045f04491dfed0dc17235fddbfef98c44 (
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
;;; boudin
(import (boudin page)
(boudin page instances)
(boudin page write)
(boudin site)
(boudin util)
(chicken file)
(chicken pathname)
(chicken process-context))
(define site-posts
(make-parameter '()))
(define site-files
(make-parameter '()))
(define (copy-static file)
(copy-file file (pathname-replace-directory file (site-dest))))
(define (with-progress message thunk)
(edisplay message)
(edisplay "...")
(thunk)
(eprint "Ok."))
(define (go!)
(eprint "Building " (site-name) "...")
(when (file-exists? (site-config))
(with-progress (string-append "Config found, loading: " (site-config))
(lambda () (load (site-config)))))
(for-each (lambda (f)
(with-progress (string-append "Copying " f " to " (site-output))
(lambda () (copy-static f)))) (site-files))
(let ((posts (map make-post (site-posts))))
(for-each (lambda (pg)
(with-progress (string-append "Writing " (page-output pg))
(lambda () (write-page pg))))
(append posts
(list (make-index posts)
(make-feed posts)))))
(eprint "Done!"))
(define (main args)
(define *current #f)
(let loop ((args args))
(cond
((null? args) (go!))
((equal? (car args) "-c")
(site-config (cadr args))
(loop (cddr args)))
((not *current) ; add to posts by default
(site-posts (cons (car args) (site-posts)))
(loop (cdr args)))
((equal? (car args) "-p")
(set! *current site-posts)
(loop (cdr args)))
((equal? (car args) "-f")
(set! *current site-files)
(loop (cdr args)))
(else
(*current (cons (car args) (*current)))
(loop (cdr args))))))
(cond-expand
((or chicken-script compiling)
(import (chicken process-context))
(main (command-line-arguments)))
(else))
|
