Fix glaring bugs.

This commit is contained in:
Brit Butler 2012-09-12 17:25:36 -04:00
parent 8529558fb9
commit ebe80cd8bf
3 changed files with 16 additions and 16 deletions

View file

@ -12,10 +12,10 @@
(:file "util") (:file "util")
(:file "config") (:file "config")
(:file "themes") (:file "themes")
(:file "coleslaw")
(:file "feeds")
(:file "posts") (:file "posts")
(:file "indices")) (:file "indices")
(:file "feeds")
(:file "coleslaw"))
:in-order-to ((test-op (load-op coleslaw-tests))) :in-order-to ((test-op (load-op coleslaw-tests)))
:perform (test-op :after (op c) :perform (test-op :after (op c)
(funcall (intern "RUN!" :coleslaw-tests) (funcall (intern "RUN!" :coleslaw-tests)

View file

@ -7,8 +7,8 @@
"Render the given CONTENT to disk using THEME-FN if supplied. "Render the given CONTENT to disk using THEME-FN if supplied.
Additional args to render CONTENT can be passed via RENDER-ARGS." Additional args to render CONTENT can be passed via RENDER-ARGS."
(let* ((path (etypecase content (let* ((path (etypecase content
(post (format nil "posts/~a.html" (post-slug post))) (post (format nil "posts/~a.html" (post-slug content)))
(index (index-path index)))) (index (index-path content))))
(filepath (merge-pathnames path (staging *config*))) (filepath (merge-pathnames path (staging *config*)))
(page (funcall (theme-fn (or theme-fn 'base)) (page (funcall (theme-fn (or theme-fn 'base))
(list :config *config* (list :config *config*
@ -21,7 +21,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
(with-open-file (out filepath (with-open-file (out filepath
:direction :output :direction :output
:if-does-not-exist :create) :if-does-not-exist :create)
(write page :stream out)))) (write-line page out))))
(defun compile-blog (staging) (defun compile-blog (staging)
"Compile the blog to a STAGING directory as specified in .coleslawrc." "Compile the blog to a STAGING directory as specified in .coleslawrc."

View file

@ -37,34 +37,34 @@
(let ((content (remove-if-not (lambda (post) (member tag (post-tags post) (let ((content (remove-if-not (lambda (post) (member tag (post-tags post)
:test #'string=)) posts))) :test #'string=)) posts)))
(make-instance 'index :path (format nil "tag/~a.html" tag) (make-instance 'index :path (format nil "tag/~a.html" tag)
:posts (by-date content) :posts content
:title "Posts tagged ~a" tag))) :title (format nil "Posts tagged ~a" tag))))
(defun index-by-month (month posts) (defun index-by-month (month posts)
"Return an index of all POSTS matching the given MONTH." "Return an index of all POSTS matching the given MONTH."
(let ((content (remove-if-not (lambda (post) (search month (post-date post))) (let ((content (remove-if-not (lambda (post) (search month (post-date post)))
posts))) posts)))
(make-instance 'index :path (format nil "date/~a.html" month) (make-instance 'index :path (format nil "date/~a.html" month)
:posts (by-date content) :posts content
:title (format nil "Posts from ~a" month)))) :title (format nil "Posts from ~a" month))))
(defun index-by-n (i posts &optional (step 10)) (defun index-by-n (i posts &optional (step 10))
"Return the index for the Ith page of POSTS in reverse chronological order." "Return the index for the Ith page of POSTS in reverse chronological order."
(make-instance 'index :path (format nil "~d.html" i) (make-instance 'index :path (format nil "~d.html" (1+ i))
:posts (let ((index (* step (1- i)))) :posts (let ((index (* step i)))
(subseq posts index (min (length posts) (subseq posts index (min (length posts)
(+ index step)))) (+ index step))))
:title "Recent Posts")) :title "Recent Posts"))
(defun render-indices () (defun render-indices ()
"Render the indices to view posts in groups of size N, by month, and by tag." "Render the indices to view posts in groups of size N, by month, and by tag."
(let ((posts (hash-table-values *posts*))) (let ((posts (by-date (hash-table-values *posts*))))
(dolist (tag (all-tags)) (dolist (tag (all-tags))
(render-page (index-by-tag tag posts))) (render-page (index-by-tag tag posts)))
(dolist (month (all-months)) (dolist (month (all-months))
(render-page (index-by-month month posts))) (render-page (index-by-month month posts)))
(dolist (i (ceiling (length posts) 10)) (dotimes (i (ceiling (length posts) 10))
(render-page (index-by-n i (by-date posts)) nil (render-page (index-by-n i posts) nil
:prev (and (plusp (1- i)) (1- i)) :prev (and (plusp i) i)
:next (and (< (* i 10) (length posts)) (1+ i))))) :next (and (< (* i 10) (length posts)) (+ 2 i)))))
(update-symlink "index.html" "1.html")) (update-symlink "index.html" "1.html"))