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
|
pollen/setup
pollen/file
net/uri-codec
file/sha1
gregor
txexpr
racket/list
racket/system
racket/string)
;; Provides common helper functions used throughout the project
(provide maybe-meta ; Select from (current-metas) or default value ("") if not available
maybe-attr ; Return an attribute’s value or a default ("") if not available
here-output-path
here-id
listing-context
series-metas-noun ; Retrieve noun-singular from current 'series meta, or ""
series-metas-title ; Retrieve title of series in current 'series meta, or ""
metas-series-pagenode
invalidate-series
make-tag-predicate
tx-strs
ymd->english
ymd->dateformat
default-authorname
default-title
web-root
|
>
>
>
>
|
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
|
pollen/setup
pollen/file
net/uri-codec
file/sha1
gregor
txexpr
racket/list
racket/match
racket/port
racket/system
racket/string)
;; Provides common helper functions used throughout the project
(provide maybe-meta ; Select from (current-metas) or default value ("") if not available
maybe-attr ; Return an attribute’s value or a default ("") if not available
here-output-path
here-source-path
here-id
listing-context
series-metas-noun ; Retrieve noun-singular from current 'series meta, or ""
series-metas-title ; Retrieve title of series in current 'series meta, or ""
metas-series-pagenode
invalidate-series
checked-in?
make-tag-predicate
tx-strs
ymd->english
ymd->dateformat
default-authorname
default-title
web-root
|
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
(define (default-title body-txprs)
(format "“~a…”" (first-words body-txprs 5)))
(define (maybe-meta m [missing ""])
(cond [(current-metas) (or (select-from-metas m (current-metas)) missing)]
[else missing]))
;; Return the current output path, relative to (current-project-root)
;; Similar to the variable 'here' which is only accessible in Pollen templates,
;; except this is an actual path, not a string.
(define (here-output-path)
(cond [(current-metas)
(define-values (_ rel-path-parts)
(drop-common-prefix (explode-path (current-project-root))
(explode-path (string->path (select-from-metas 'here-path (current-metas))))))
(->output-path (apply build-path rel-path-parts))]
[else (string->path ".")]))
(define listing-context (make-parameter ""))
;; Checks current-metas for a 'series meta and returns the pagenode of that series,
;; or '|| if no series is specified.
(define (metas-series-pagenode)
(define maybe-series (or (select-from-metas 'series (current-metas)) ""))
|
>
>
>
>
>
>
>
>
>
>
<
<
<
<
|
<
|
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
|
(define (default-title body-txprs)
(format "“~a…”" (first-words body-txprs 5)))
(define (maybe-meta m [missing ""])
(cond [(current-metas) (or (select-from-metas m (current-metas)) missing)]
[else missing]))
;; Return the current source path, relative to (current-project-root)
(define (here-source-path)
(match (current-metas)
[(? hash? m)
(define-values (_ rel-path-parts)
(drop-common-prefix (explode-path (current-project-root))
(explode-path (string->path (hash-ref m 'here-path)))))
(apply build-path rel-path-parts)]
[_ (string->path ".")]))
;; Return the current output path, relative to (current-project-root)
;; Similar to the variable 'here' which is only accessible in Pollen templates,
;; except this is an actual path, not a string.
(define (here-output-path)
(->output-path (here-source-path)))
(define listing-context (make-parameter ""))
;; Checks current-metas for a 'series meta and returns the pagenode of that series,
;; or '|| if no series is specified.
(define (metas-series-pagenode)
(define maybe-series (or (select-from-metas 'series (current-metas)) ""))
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(define series-file (build-path (current-project-root)
series-folder
(format "~a.poly.pm" series-name)))
(when (file-exists? series-file)
(case (system-type 'os)
[(windows) (system (format "type nul >> ~a" series-file))]
[else (system (format "touch ~a" series-file))]))))
;; ~~~ Project-wide Pagetrees ~~~
(define (include-in-pagetree folder extension)
(define (matching-file? f)
(string-suffix? f extension))
(define (file->output-pagenode f)
|
>
>
>
>
>
>
>
>
>
>
|
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
(define series-file (build-path (current-project-root)
series-folder
(format "~a.poly.pm" series-name)))
(when (file-exists? series-file)
(case (system-type 'os)
[(windows) (system (format "type nul >> ~a" series-file))]
[else (system (format "touch ~a" series-file))]))))
;; Determine if the current article has been checked into Fossil repo
(define (checked-in?)
(cond [(current-metas)
(define articles-path (build-path (current-project-root) articles-folder))
(define checked-in
(with-output-to-string
(lambda () (system (format "/usr/local/bin/fossil ls ~a" articles-path)))))
(string-contains? checked-in (path->string (here-source-path)))]
[else #f]))
;; ~~~ Project-wide Pagetrees ~~~
(define (include-in-pagetree folder extension)
(define (matching-file? f)
(string-suffix? f extension))
(define (file->output-pagenode f)
|