blob: b56b93b6d72ad7bc0f3b00e92047b3d8ec69d86a (
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
;;; boudin
(import (boudin page)
(boudin page post)
(boudin page index)
(boudin page style)
(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 (apply make-style (site-style))
(make-index posts)
(make-feed posts)))))
(eprint "Done!"))
(define (main args)
(define *current #f)
(define glob? #t)
(when (null? args)
(exit 1))
(let loop ((args args))
(cond
((null? args)
(for-each print (site-posts))
(go!))
;; Configuration file: -c FILE
((equal? (car args) "-c")
(site-config (cadr args))
(loop (cddr args)))
;; Change directory: -C DIRECTORY
((equal? (car args) "-C")
(change-directory (cadr args))
(loop (cddr args)))
;; Don't glob filenames: -r (raw)
((equal? (car args) "-r")
(set! glob? #f)
(loop (cdr args)))
;; Posts follow -p
((equal? (car args) "-p")
(set! *current site-posts)
(loop (cdr args)))
;; Files follow -f
((equal? (car args) "-f")
(set! *current site-files)
(loop (cdr args)))
;; Append current path to *current
(else
(let ((*current (or *current site-posts))) ; posts by default
(*current (append ((if glob? glob list) (car args))
(*current))))
(loop (cdr args))))))
(cond-expand
((or chicken-script compiling)
(import (chicken process-context))
(main (command-line-arguments)))
(else))
|
