Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
C
cl-site
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Vincent Dardel
cl-site
Commits
21905dbb
Commit
21905dbb
authored
Oct 28, 2018
by
Erik Huelsmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Introduce macrology to simplify definition and invocation of wrappers
parent
fc5ae7fb
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
79 additions
and
41 deletions
+79
-41
helpers.lisp
helpers.lisp
+63
-2
main.lisp
main.lisp
+3
-25
process.lisp
process.lisp
+13
-14
No files found.
helpers.lisp
View file @
21905dbb
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(
in-package
:cl-site
)
(
in-package
:cl-site
)
; Makes pathname from prefix + page object
(
defun
make-path
(
prefix
suffix
&optional
page
)
(
defun
make-path
(
prefix
suffix
&optional
page
)
"Constructs a pathname from `prefix` and `suffix`.
`suffix` can be one of
1. a context (an alist) with a ':content' element
2. a pathname
3. a string identifying a path
`prefix` can be one of
1. a pathname
2. a string identifying a path
"
(
let
((
path
(
if
page
(
cdr
(
assoc
:content
suffix
))
suffix
)))
(
let
((
path
(
if
page
(
cdr
(
assoc
:content
suffix
))
suffix
)))
(
if
(
pathnamep
prefix
)
(
if
(
pathnamep
prefix
)
(
merge-pathnames
path
prefix
)
(
merge-pathnames
path
prefix
)
(
pathname
(
concatenate
'string
(
pathname
(
concatenate
'string
prefix
path
)))))
prefix
path
)))))
; Slurps file from a string
(
defun
file-to-string
(
filepath
)
(
defun
file-to-string
(
filepath
)
"Reads the file designated by pathname `filepath` into memory,
returning the string with the sequence read from the file"
(
with-open-file
(
stream
filepath
)
(
with-open-file
(
stream
filepath
)
(
let
((
data
(
make-string
(
file-length
stream
))))
(
let
((
data
(
make-string
(
file-length
stream
))))
(
read-sequence
data
stream
)
(
read-sequence
data
stream
)
data
)))
data
)))
(
defun
header-lines
(
lines
)
"Returns a list of lines (subset of `lines`)
which form the header of the document `lines` were read from
"
(
loop
for
line
in
lines
thereis
(
when
(
string=
line
"---"
)
header-lines
)
collect
line
into
header-lines
))
(
defun
content-lines
(
lines
)
"Returns a list of lines (subset of `lines`)
which remain after the header (if any) has been discarded
"
(
loop
with
found-header-p
=
nil
for
line
in
lines
when
found-header-p
collect
line
into
post-header-lines
when
(
string=
line
"---"
)
do
(
setf
found-header-p
t
)
collect
line
into
content-lines
finally
(
return
(
if
found-header-p
post-header-lines
content-lines
))))
(
defun
populate-pages
()
(
defun
populate-pages
()
"Each page is an alist containing info to be sent to the template via the context."
"Each page is an alist containing info to be sent to the template via the context."
(
mapcar
(
lambda
(
p
)
(
mapcar
(
lambda
(
p
)
...
@@ -31,6 +63,35 @@
...
@@ -31,6 +63,35 @@
(
directory
(
merge-pathnames
#P"**/*.lisp"
*pages-dir*
)))))
(
directory
(
merge-pathnames
#P"**/*.lisp"
*pages-dir*
)))))
(
defvar
*render-hooks*
'
()
"A list of hooks wrapping the rendering of the page."
)
(
defmacro
def-render-hook
(
name
(
&rest
args
)
&rest
body
)
"Registers a hook to wrap the rendering of the page.
Provides a `call-next-hook` function which dispatches
execution to the next wrapper and ultimately to the
page renderer.
The wrapper should return the value received from
a `call-next-hook` to its caller as it is the content
of the rendered page.
"
`
(
progn
(
defun
,
name
(
,@
args
next-hooks
)
(
flet
((
call-next-hook
(
content
context
)
(
funcall
(
pop
next-hooks
)
content
context
next-hooks
)))
,@
body
))
(
push
(
function
,
name
)
*render-hooks*
)))
(
defun
render-page-with-hooks
(
content
context
)
(
let
((
hooks
(
reverse
(
cons
#'
(
lambda
(
p
c
next-processors
)
(
process-page
p
c
))
*render-hooks*
))))
(
funcall
(
pop
hooks
)
content
context
hooks
)))
(
defun
page-content
(
page
)
(
rest
(
assoc
:content
page
)))
(
defun
page-content
(
page
)
(
rest
(
assoc
:content
page
)))
...
...
main.lisp
View file @
21905dbb
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(
in-package
:cl-site
)
(
in-package
:cl-site
)
(
defun
header-lines
(
lines
)
(
loop
for
line
in
lines
thereis
(
when
(
string=
line
"---"
)
header-lines
)
collect
line
into
header-lines
))
(
defun
content-lines
(
lines
)
(
loop
with
found-header-p
=
nil
for
line
in
lines
when
found-header-p
collect
line
into
post-header-lines
when
(
string=
line
"---"
)
do
(
setf
found-header-p
t
)
collect
line
into
content-lines
finally
(
return
(
if
found-header-p
post-header-lines
content-lines
))))
(
defun
make-site
(
&optional
output-dir
)
(
defun
make-site
(
&optional
output-dir
)
(
let
((
*output-dir*
(
or
output-dir
*output-dir*
))
(
let
((
*output-dir*
(
or
output-dir
*output-dir*
))
...
@@ -52,12 +38,8 @@
...
@@ -52,12 +38,8 @@
and
do
(
format
t
"Delayed rendering ~a~%"
rel-page-path
)
and
do
(
format
t
"Delayed rendering ~a~%"
rel-page-path
)
when
satisfies-deps-p
when
satisfies-deps-p
do
(
progn
do
(
progn
(
format
t
"Rendering ~A~%"
rel-page-path
))
(
format
t
"Rendering ~A~%"
rel-page-path
)
(
preprocess-md-page
content
context
(
render-page-with-hooks
content
context
))
(
list
#'
preprocess-lisp-page
#'
generate-news
(
lambda
(
p
c
next-processors
)
(
process-page
p
c
))))
and
collect
rel-page-path
into
processed-pages
and
collect
rel-page-path
into
processed-pages
and
do
(
loop
for
resolved-deps-pages
=
and
do
(
loop
for
resolved-deps-pages
=
(
loop
for
delay
in
delayed-pages
(
loop
for
delay
in
delayed-pages
...
@@ -67,11 +49,7 @@
...
@@ -67,11 +49,7 @@
and
do
(
progn
and
do
(
progn
(
format
t
"Rendering delayed ~a~%"
(
fourth
delay
))
(
format
t
"Rendering delayed ~a~%"
(
fourth
delay
))
(
push
(
fourth
delay
)
processed-pages
)
(
push
(
fourth
delay
)
processed-pages
)
(
preprocess-md-page
(
second
delay
)
(
third
delay
)
(
render-page-with-hooks
(
second
delay
)
(
third
delay
))))
(
list
#'
preprocess-lisp-page
#'
generate-news
(
lambda
(
p
c
next-processors
)
(
process-page
p
c
))))))
while
resolved-deps-pages
while
resolved-deps-pages
do
(
setf
delayed-pages
do
(
setf
delayed-pages
(
set-difference
delayed-pages
resolved-deps-pages
:key
#'
fourth
:test
#'
string=
))))))
(
set-difference
delayed-pages
resolved-deps-pages
:key
#'
fourth
:test
#'
string=
))))))
...
...
process.lisp
View file @
21905dbb
...
@@ -47,21 +47,21 @@
...
@@ -47,21 +47,21 @@
page-context
)
page-context
)
stream
))))))
stream
))))))
(
def
un
preprocess-md-page
(
content
context
next-processors
)
(
def
-render-hook
preprocess-md-page
(
content
context
)
(
let*
((
md-file
(
enough-namestring
(
make-path
*pages-dir*
context
t
)
*pages-dir*
)))
(
let*
((
md-file
(
enough-namestring
(
make-path
*pages-dir*
context
t
)
*pages-dir*
)))
(
unless
(
string=
(
pathname-type
md-file
)
"md"
)
(
unless
(
string=
(
pathname-type
md-file
)
"md"
)
(
return-from
preprocess-md-page
(
funcall
(
pop
next-processors
)
content
context
next-processors
)))
(
return-from
preprocess-md-page
(
call-next-hook
content
context
)))
(
let
((
html-file
(
make-pathname
:defaults
md-file
:type
"html"
)))
(
let
((
html-file
(
make-pathname
:defaults
md-file
:type
"html"
)))
(
format
t
"Transforming ~A to ~A~%"
md-file
html-file
)
(
format
t
"Transforming ~A to ~A~%"
md-file
html-file
)
(
let
((
md-content
(
with-output-to-string
(
let
((
md-content
(
with-output-to-string
(
out
)
(
out
)
(
cl-markdown:markdown
content
:stream
out
))))
(
cl-markdown:markdown
content
:stream
out
))))
(
funcall
(
pop
next-processors
)
md-content
context
next-processors
)))))
(
call-next-hook
md-content
context
)))))
(
def
un
preprocess-lisp-page
(
content
context
next-processors
)
(
def
-render-hook
preprocess-lisp-page
(
content
context
)
(
let*
((
lisp-file
(
make-path
*pages-dir*
context
t
)))
(
let*
((
lisp-file
(
make-path
*pages-dir*
context
t
)))
(
unless
(
string=
(
pathname-type
lisp-file
)
"lisp"
)
(
unless
(
string=
(
pathname-type
lisp-file
)
"lisp"
)
(
return-from
preprocess-lisp-page
(
funcall
(
pop
next-processors
)
content
context
next-processors
)))
(
return-from
preprocess-lisp-page
(
call-next-hook
content
context
)))
(
let
((
html-file
(
enough-namestring
(
make-pathname
:defaults
lisp-file
:type
"html"
)
*pages-dir*
))
(
let
((
html-file
(
enough-namestring
(
make-pathname
:defaults
lisp-file
:type
"html"
)
*pages-dir*
))
*computed-page-content*
)
*computed-page-content*
)
(
format
t
"Loading ~a and creating fresh ~a...~%"
(
format
t
"Loading ~a and creating fresh ~a...~%"
...
@@ -69,13 +69,12 @@
...
@@ -69,13 +69,12 @@
;;;###TODO not happy about loading the lisp file; it defeats the preprocessor/postprocessor purpose
;;;###TODO not happy about loading the lisp file; it defeats the preprocessor/postprocessor purpose
(
load
(
merge-pathnames
lisp-file
*pages-dir*
))
(
load
(
merge-pathnames
lisp-file
*pages-dir*
))
(
let
((
headers
(
getf
*computed-page-content*
:headers
)))
(
let
((
headers
(
getf
*computed-page-content*
:headers
)))
(
funcall
(
pop
next-processors
)
(
getf
*computed-page-content*
:html-string
)
(
call-next-hook
(
getf
*computed-page-content*
:html-string
)
(
append
(
mapcan
#'
(
lambda
(
key
value
)
(
append
(
mapcan
#'
(
lambda
(
key
value
)
(
acons
key
value
nil
))
(
acons
key
value
nil
))
(
plist-keys
headers
)
(
plist-keys
headers
)
(
plist-values
headers
))
(
plist-values
headers
))
context
)
context
))))))
next-processors
)))))
(
defun
process-page
(
content
context
)
(
defun
process-page
(
content
context
)
(
let
((
template-path
(
pathname
(
merge-pathnames
*templates-dir*
*DEFAULT-PAGE-TEMPLATE*
))))
(
let
((
template-path
(
pathname
(
merge-pathnames
*templates-dir*
*DEFAULT-PAGE-TEMPLATE*
))))
...
@@ -92,9 +91,9 @@
...
@@ -92,9 +91,9 @@
;; newsbox. The news.lisp would have to include the hardcoded HTML
;; newsbox. The news.lisp would have to include the hardcoded HTML
;; which is injected below as well.
;; which is injected below as well.
;;
;;
(
def
un
generate-news
(
content
context
next-processors
)
(
def
-render-hook
generate-news
(
content
context
)
(
let
((
page-path
(
cdr
(
assoc
:content
context
)))
(
let
((
page-path
(
cdr
(
assoc
:content
context
)))
(
content
(
funcall
(
pop
next-processors
)
content
context
next-processors
)))
(
content
(
call-next-hook
content
context
)))
(
when
(
and
(
string=
(
pathname-name
page-path
)
"news"
)
(
when
(
and
(
string=
(
pathname-name
page-path
)
"news"
)
(
string=
(
pathname-type
page-path
)
"md"
))
(
string=
(
pathname-type
page-path
)
"md"
))
(
let
((
newsbox
(
generate-news-box-content
content
)))
(
let
((
newsbox
(
generate-news-box-content
content
)))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment