marcuskammer/coleslaw
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Miscellaneous fixes.

Browse source
This commit is contained in:
Brit Butler 2014-04-15 16:46:04 -04:00
parent 7af3462d99
commit d0059ed69e
3 changed files with 10 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/indexes.lisp
View file

@ -105,7 +105,6 @@
(dolist (feed (find-all 'feed)) (dolist (feed (find-all 'feed))
(render-feed feed))) (render-feed feed)))
;; TODO: tag-feed isn't reached by do-subclasses!
(defclass tag-feed (feed) ()) (defclass tag-feed (feed) ())
(defmethod page-url ((object tag-feed)) (defmethod page-url ((object tag-feed))
@ -130,12 +129,12 @@
(defun all-months () (defun all-months ()
"Retrieve a list of all months with published content." "Retrieve a list of all months with published content."
(let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7)) (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
(hash-table-values *content*)))) (find-all 'post))))
(sort (remove-duplicates months :test #'string=) #'string>))) (sort (remove-duplicates months :test #'string=) #'string>)))
(defun all-tags () (defun all-tags ()
"Retrieve a list of all tags used in content." "Retrieve a list of all tags used in content."
(let* ((dupes (mappend #'content-tags (hash-table-values *content*))) (let* ((dupes (mappend #'content-tags (find-all 'post)))
(tags (remove-duplicates dupes :test #'string= :key #'tag-slug))) (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
(sort tags #'string< :key #'tag-name))) (sort tags #'string< :key #'tag-name)))

2
src/posts.lisp
View file

@ -22,7 +22,7 @@
:next next))) :next next)))
(defmethod page-url ((object post)) (defmethod page-url ((object post))
(format nil "~a/~a" (posts-dir *config*) (content-slug object))) (format nil "posts/~a" (content-slug object)))
(defmethod publish ((doc-type (eql (find-class 'post)))) (defmethod publish ((doc-type (eql (find-class 'post))))
(loop for (next post prev) on (append '(nil) (by-date (find-all 'post))) (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))

11
src/util.lisp
View file

@ -7,10 +7,13 @@
(defmacro do-subclasses ((var class) &body body) (defmacro do-subclasses ((var class) &body body)
"Iterate over the subclasses of CLASS performing BODY with VAR "Iterate over the subclasses of CLASS performing BODY with VAR
lexically bound to the current subclass' class-name." lexically bound to the current subclass' class-name."
(alexandria:with-gensyms (klass klasses) (alexandria:with-gensyms (klasses all-subclasses)
`(let* ((,klass (if (typep ,class 'class) ,class (find-class ',class))) `(labels ((,all-subclasses (class)
(,klasses (closer-mop:class-direct-subclasses ,klass))) (let ((subclasses (closer-mop:class-direct-subclasses class)))
(loop for ,var in ,klasses do ,@body)))) (append subclasses (loop for subclass in subclasses
nconc (,all-subclasses subclass))))))
(let ((,klasses (,all-subclasses (find-class ',class))))
(loop for ,var in ,klasses do ,@body)))))
(defun fmt (fmt-str args) (defun fmt (fmt-str args)
"A convenient FORMAT interface for string building." "A convenient FORMAT interface for string building."