Switcher argument order in LET-METADATA macro
The new order which places the bindings is more consistent with the order of other forms in the standard which created local bindings.
This commit is contained in:
parent
aefa02fe1a
commit
4aa3958c99
12 changed files with 46 additions and 90 deletions
|
@ -68,7 +68,7 @@
|
||||||
(last (pathname-directory file-path) 3)))
|
(last (pathname-directory file-path) 3)))
|
||||||
(post (funcall (gethash (pathname-type file-path) hssg.blog:*BLOG-POST-READERS*)
|
(post (funcall (gethash (pathname-type file-path) hssg.blog:*BLOG-POST-READERS*)
|
||||||
file-path)))
|
file-path)))
|
||||||
(hssg:let-metadata post
|
(hssg:let-metadata
|
||||||
((category :category hssg.blog.i18n:*default-category*)
|
((category :category hssg.blog.i18n:*default-category*)
|
||||||
(slug :slug (pathname-name file-path))
|
(slug :slug (pathname-name file-path))
|
||||||
(title :title)
|
(title :title)
|
||||||
|
@ -77,6 +77,7 @@
|
||||||
(published :published (apply #'hssg.blog.util:date-from-numbers date-components))
|
(published :published (apply #'hssg.blog.util:date-from-numbers date-components))
|
||||||
(modified :modified)
|
(modified :modified)
|
||||||
(content :content))
|
(content :content))
|
||||||
|
post
|
||||||
(make-instance 'hssg.blog.artifacts:post-artifact :blog blog :slug slug :title title :content content
|
(make-instance 'hssg.blog.artifacts:post-artifact :blog blog :slug slug :title title :content content
|
||||||
:category category :tags tags :author author
|
:category category :tags tags :author author
|
||||||
:published published
|
:published published
|
||||||
|
|
|
@ -22,8 +22,9 @@
|
||||||
(defun breadcrumb->sxml (item)
|
(defun breadcrumb->sxml (item)
|
||||||
"Convert a breadcrumb entry from the items to an SXML tree"
|
"Convert a breadcrumb entry from the items to an SXML tree"
|
||||||
(declare (type list item))
|
(declare (type list item))
|
||||||
(hssg:let-metadata item ((title :title)
|
(hssg:let-metadata ((title :title)
|
||||||
(url :url))
|
(url :url))
|
||||||
|
item
|
||||||
`((:li :class ,(if url "" "active"))
|
`((:li :class ,(if url "" "active"))
|
||||||
,(if url
|
,(if url
|
||||||
`((:a :href ,url) ,title)
|
`((:a :href ,url) ,title)
|
||||||
|
|
|
@ -172,16 +172,16 @@
|
||||||
- next Next post"
|
- next Next post"
|
||||||
|
|
||||||
(:css
|
(:css
|
||||||
(hssg:let-metadata post ((css :css))
|
(hssg:let-metadata ((css :css)) post
|
||||||
css))
|
css))
|
||||||
(:periods
|
(:periods
|
||||||
(with-slots ((periods hssg.blog.artifacts:periods ))
|
(with-slots ((periods hssg.blog.artifacts:periods ))
|
||||||
blog
|
blog
|
||||||
periods))
|
periods))
|
||||||
(:breadcrumbs
|
(:breadcrumbs
|
||||||
(hssg:let-metadata post ((title :title)
|
(hssg:let-metadata ((date :published)
|
||||||
(date :published)
|
|
||||||
(slug :slug))
|
(slug :slug))
|
||||||
|
post
|
||||||
`(((:title . ,(slot-value blog 'hssg.blog.artifacts:top))
|
`(((:title . ,(slot-value blog 'hssg.blog.artifacts:top))
|
||||||
(:url . "../../../../"))
|
(:url . "../../../../"))
|
||||||
((:title . ,(hssg.blog.util:date->year date))
|
((:title . ,(hssg.blog.util:date->year date))
|
||||||
|
@ -191,7 +191,7 @@
|
||||||
((:title . ,(hssg.blog.util:date->day date)))
|
((:title . ,(hssg.blog.util:date->day date)))
|
||||||
((:title . ,slug)))))
|
((:title . ,slug)))))
|
||||||
(:content
|
(:content
|
||||||
(hssg:let-metadata post ((status :status :published)
|
(hssg:let-metadata ((status :status :published)
|
||||||
(title :title)
|
(title :title)
|
||||||
(date :published)
|
(date :published)
|
||||||
(modified :modified)
|
(modified :modified)
|
||||||
|
@ -199,6 +199,7 @@
|
||||||
(tags :tags '())
|
(tags :tags '())
|
||||||
(author :author)
|
(author :author)
|
||||||
(content :content))
|
(content :content))
|
||||||
|
post
|
||||||
`(((:main :class "blogpost")
|
`(((:main :class "blogpost")
|
||||||
(:article
|
(:article
|
||||||
(:h1
|
(:h1
|
||||||
|
|
|
@ -19,10 +19,6 @@
|
||||||
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
||||||
(in-package #:hssg.artifact)
|
(in-package #:hssg.artifact)
|
||||||
|
|
||||||
(defgeneric write-artifact (artifact)
|
|
||||||
(:documentation "Write the given ARTIFACT to disc. The artifact's state
|
|
||||||
determines where and how the artifact will be written."))
|
|
||||||
|
|
||||||
(defgeneric derive-artifact (artifact)
|
(defgeneric derive-artifact (artifact)
|
||||||
(:documentation "Derives the GIVEN artifact to produce a file system instruction."))
|
(:documentation "Derives the GIVEN artifact to produce a file system instruction."))
|
||||||
|
|
||||||
|
|
|
@ -19,11 +19,6 @@
|
||||||
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.(in-package #:hssg.artifact)
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.(in-package #:hssg.artifact)
|
||||||
(in-package #:hssg.artifact._compound)
|
(in-package #:hssg.artifact._compound)
|
||||||
|
|
||||||
(defmethod hssg.artifact:write-artifact ((wrapper hssg.artifact:compound-artifact))
|
|
||||||
"Writes each of the artifacts inside the WRAPPER individually."
|
|
||||||
(dolist (artifact (slot-value wrapper 'hssg.artifact:artifacts))
|
|
||||||
(hssg.artifact:write-artifact artifact)))
|
|
||||||
|
|
||||||
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:compound-artifact))
|
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:compound-artifact))
|
||||||
(with-slots ((artifacts hssg.artifact:artifacts)) artifact
|
(with-slots ((artifacts hssg.artifact:artifacts)) artifact
|
||||||
(make-instance 'hssg.filesystem:compound-instruction
|
(make-instance 'hssg.filesystem:compound-instruction
|
||||||
|
|
|
@ -19,23 +19,6 @@
|
||||||
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
||||||
(in-package #:hssg.artifact.directory)
|
(in-package #:hssg.artifact.directory)
|
||||||
|
|
||||||
(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:directory-artifact))
|
|
||||||
(with-slots ((input hssg.artifact::input)
|
|
||||||
(output hssg.artifact::output))
|
|
||||||
artifact
|
|
||||||
;; The INPUT contains the directory to copy, but we need its parent to
|
|
||||||
;; construct file paths
|
|
||||||
(let ((content-dir (merge-pathnames (fad:pathname-parent-directory input)))
|
|
||||||
(output-dir (merge-pathnames (fad:pathname-parent-directory output))))
|
|
||||||
(fad:walk-directory
|
|
||||||
input
|
|
||||||
(lambda (pathname)
|
|
||||||
(let* ((relative (enough-namestring pathname content-dir))
|
|
||||||
(target (merge-pathnames relative output-dir)))
|
|
||||||
(ensure-directories-exist target)
|
|
||||||
(fad:copy-file pathname target :overwrite t))))))
|
|
||||||
nil)
|
|
||||||
|
|
||||||
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:directory-artifact))
|
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:directory-artifact))
|
||||||
(with-slots ((path hssg.artifact::directory)
|
(with-slots ((path hssg.artifact::directory)
|
||||||
(base-path hssg.artifact::base))
|
(base-path hssg.artifact::base))
|
||||||
|
|
|
@ -19,18 +19,6 @@
|
||||||
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
||||||
(in-package #:hssg.artifact.html)
|
(in-package #:hssg.artifact.html)
|
||||||
|
|
||||||
(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:html-artifact))
|
|
||||||
(with-slots ((data hssg.artifact::data)
|
|
||||||
(template hssg.artifact::template)
|
|
||||||
(output hssg.artifact::output))
|
|
||||||
artifact
|
|
||||||
(ensure-directories-exist output)
|
|
||||||
(with-open-file (*STANDARD-OUTPUT* output :direction :output :if-exists :supersede :if-does-not-exist :create)
|
|
||||||
(let ((plump:*tag-dispatchers* plump:*xml-tags*))
|
|
||||||
(format t "<!DOCTYPE html>~%")
|
|
||||||
(plump:serialize (sexp->plump-tree
|
|
||||||
(cdr (assoc :content (funcall template data)))))))))
|
|
||||||
|
|
||||||
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:html-artifact))
|
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:html-artifact))
|
||||||
(with-slots ((data hssg.artifact::data)
|
(with-slots ((data hssg.artifact::data)
|
||||||
(template hssg.artifact::template)
|
(template hssg.artifact::template)
|
||||||
|
|
|
@ -25,14 +25,6 @@
|
||||||
"Buffer size to use when copying a file. The file will be copied in chunks of
|
"Buffer size to use when copying a file. The file will be copied in chunks of
|
||||||
this size.")
|
this size.")
|
||||||
|
|
||||||
(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:verbatim-artifact))
|
|
||||||
(with-slots ((input hssg.artifact::input)
|
|
||||||
(output hssg.artifact::output))
|
|
||||||
artifact
|
|
||||||
(ensure-directories-exist output)
|
|
||||||
(fad:copy-file input output :overwrite t)
|
|
||||||
nil))
|
|
||||||
|
|
||||||
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:verbatim-artifact))
|
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:verbatim-artifact))
|
||||||
(with-slots ((file-name hssg.artifact::file-name)
|
(with-slots ((file-name hssg.artifact::file-name)
|
||||||
(directory hssg.artifact::directory))
|
(directory hssg.artifact::directory))
|
||||||
|
|
|
@ -19,13 +19,6 @@
|
||||||
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
||||||
(in-package #:hssg.artifact.xml)
|
(in-package #:hssg.artifact.xml)
|
||||||
|
|
||||||
(defmethod hssg.artifact:write-artifact ((artifact hssg.artifact:xml-artifact))
|
|
||||||
(with-slots ((data hssg.artifact::data)
|
|
||||||
(output hssg.artifact::output))
|
|
||||||
artifact
|
|
||||||
(with-open-file (*STANDARD-OUTPUT* output :direction :output :if-exists :supersede :if-does-not-exist :create)
|
|
||||||
(plump:serialize (sexp->xml-tree data)))))
|
|
||||||
|
|
||||||
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:xml-artifact))
|
(defmethod hssg.artifact:derive-artifact ((artifact hssg.artifact:xml-artifact))
|
||||||
(with-slots ((data hssg.artifact::data)
|
(with-slots ((data hssg.artifact::data)
|
||||||
(output hssg.artifact::output))
|
(output hssg.artifact::output))
|
||||||
|
|
|
@ -58,7 +58,7 @@
|
||||||
(setf (documentation ',name 'function) ,docstring)
|
(setf (documentation ',name 'function) ,docstring)
|
||||||
',name)))
|
',name)))
|
||||||
|
|
||||||
(defmacro let-metadata (data-expr (&rest bindings) &body body)
|
(defmacro let-metadata ((&rest bindings) data-expr &body body)
|
||||||
"Binds the metadata from the DATA-EXPRession to the BINDINGS for the
|
"Binds the metadata from the DATA-EXPRession to the BINDINGS for the
|
||||||
evaluation of the BODY expressions. Each bindings is a tuple of the form
|
evaluation of the BODY expressions. Each bindings is a tuple of the form
|
||||||
(KEYWORD SYMBOL &OPTIONAL DEFAULT). The DEFAULT expression will only be
|
(KEYWORD SYMBOL &OPTIONAL DEFAULT). The DEFAULT expression will only be
|
||||||
|
@ -68,10 +68,11 @@
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
(let ((data '((:a . \"a\") (:b . \"b\"))))
|
(let ((data '((:a . \"a\") (:b . \"b\"))))
|
||||||
(let-metadata data ((a :a)
|
(let-metadata ((a :a)
|
||||||
(b :b)
|
(b :b)
|
||||||
(c :c \"c\") ; Explicit default
|
(c :c \"c\") ; Explicit default
|
||||||
(d :d)) ; Implicit default
|
(d :d)) ; Implicit default
|
||||||
|
data
|
||||||
(list a b c d)))
|
(list a b c d)))
|
||||||
--
|
--
|
||||||
(\"a\" \"b\" \"c\" NIL)"
|
(\"a\" \"b\" \"c\" NIL)"
|
||||||
|
|
|
@ -35,9 +35,10 @@
|
||||||
(clunit:deftest lisp-reader-can-read-files (hssg.reader.lisp)
|
(clunit:deftest lisp-reader-can-read-files (hssg.reader.lisp)
|
||||||
"The Lisp reader can read the contents of a Lisp file"
|
"The Lisp reader can read the contents of a Lisp file"
|
||||||
(let ((data (funcall reader "test/hssg/sample-files/metadata.lisp")))
|
(let ((data (funcall reader "test/hssg/sample-files/metadata.lisp")))
|
||||||
(hssg:let-metadata data ((foo :foo)
|
(hssg:let-metadata ((foo :foo)
|
||||||
(bar :bar)
|
(bar :bar)
|
||||||
(baz :baz))
|
(baz :baz))
|
||||||
|
data
|
||||||
(let ((clunit:*clunit-equality-test* #'string-equal))
|
(let ((clunit:*clunit-equality-test* #'string-equal))
|
||||||
(clunit:assert-equality* "foo" foo foo)
|
(clunit:assert-equality* "foo" foo foo)
|
||||||
(clunit:assert-equality* "bar" bar bar)
|
(clunit:assert-equality* "bar" bar bar)
|
||||||
|
|
|
@ -34,10 +34,11 @@
|
||||||
|
|
||||||
(clunit:deftest let-metadata-form (hssg.template)
|
(clunit:deftest let-metadata-form (hssg.template)
|
||||||
"The LET-METADATA form can bind data from an association list"
|
"The LET-METADATA form can bind data from an association list"
|
||||||
(hssg:let-metadata foo-bar-data ((foo :foo)
|
(hssg:let-metadata ((foo :foo)
|
||||||
(bar :bar)
|
(bar :bar)
|
||||||
(baz :baz)
|
(baz :baz)
|
||||||
(qux :qux "qux"))
|
(qux :qux "qux"))
|
||||||
|
foo-bar-data
|
||||||
(clunit:assert-equal "foo" foo foo)
|
(clunit:assert-equal "foo" foo foo)
|
||||||
(clunit:assert-equal "bar" bar bar)
|
(clunit:assert-equal "bar" bar bar)
|
||||||
(clunit:assert-equal nil baz baz)
|
(clunit:assert-equal nil baz baz)
|
||||||
|
@ -59,9 +60,10 @@
|
||||||
(:foo (string-upcase foo))
|
(:foo (string-upcase foo))
|
||||||
(:baz "baz")))
|
(:baz "baz")))
|
||||||
(out (hssg:apply-template template foo-bar-data)))
|
(out (hssg:apply-template template foo-bar-data)))
|
||||||
(hssg:let-metadata out ((foo :foo)
|
(hssg:let-metadata ((foo :foo)
|
||||||
(bar :bar)
|
(bar :bar)
|
||||||
(baz :baz))
|
(baz :baz))
|
||||||
|
out
|
||||||
(let ((clunit:*clunit-equality-test* #'string-equal))
|
(let ((clunit:*clunit-equality-test* #'string-equal))
|
||||||
(clunit:assert-equality* "FOO" foo foo)
|
(clunit:assert-equality* "FOO" foo foo)
|
||||||
(clunit:assert-equality* "bar" bar bar)
|
(clunit:assert-equality* "bar" bar bar)
|
||||||
|
@ -78,9 +80,10 @@
|
||||||
(:bar (string-upcase bar))))
|
(:bar (string-upcase bar))))
|
||||||
(template (hssg:chain-templates t1 t2 t3))
|
(template (hssg:chain-templates t1 t2 t3))
|
||||||
(out (hssg:apply-template template foo-data)))
|
(out (hssg:apply-template template foo-data)))
|
||||||
(hssg:let-metadata out ((foo :foo)
|
(hssg:let-metadata ((foo :foo)
|
||||||
(bar :bar)
|
(bar :bar)
|
||||||
(baz :baz))
|
(baz :baz))
|
||||||
|
out
|
||||||
(let ((clunit:*clunit-equality-test* #'string-equal))
|
(let ((clunit:*clunit-equality-test* #'string-equal))
|
||||||
(clunit:assert-equality* "FOO" foo foo)
|
(clunit:assert-equality* "FOO" foo foo)
|
||||||
(clunit:assert-equality* "bar" bar bar)
|
(clunit:assert-equality* "bar" bar bar)
|
||||||
|
@ -91,9 +94,10 @@
|
||||||
(let* ((template (hssg:template-with-data (hssg:template () (:baz "baz"))
|
(let* ((template (hssg:template-with-data (hssg:template () (:baz "baz"))
|
||||||
'((:bar . "bar"))))
|
'((:bar . "bar"))))
|
||||||
(out (hssg:apply-template template foo-data)))
|
(out (hssg:apply-template template foo-data)))
|
||||||
(hssg:let-metadata out ((foo :foo)
|
(hssg:let-metadata ((foo :foo)
|
||||||
(bar :bar)
|
(bar :bar)
|
||||||
(baz :baz))
|
(baz :baz))
|
||||||
|
out
|
||||||
(let ((clunit:*clunit-equality-test* #'string-equal))
|
(let ((clunit:*clunit-equality-test* #'string-equal))
|
||||||
(clunit:assert-equality* "foo" foo foo)
|
(clunit:assert-equality* "foo" foo foo)
|
||||||
(clunit:assert-equality* "bar" bar bar)
|
(clunit:assert-equality* "bar" bar bar)
|
||||||
|
|
Loading…
Add table
Reference in a new issue