浏览代码

Miscellaneous fixes.

Brit Butler 11 年之前
父节点
当前提交
d0059ed69e
共有 3 个文件被更改,包括 10 次插入8 次删除
  1. 2 3
      src/indexes.lisp
  2. 1 1
      src/posts.lisp
  3. 7 4
      src/util.lisp

+ 2 - 3
src/indexes.lisp

105
   (dolist (feed (find-all 'feed))
105
   (dolist (feed (find-all 'feed))
106
     (render-feed feed)))
106
     (render-feed feed)))
107
 
107
 
108
-;; TODO: tag-feed isn't reached by do-subclasses!
109
 (defclass tag-feed (feed) ())
108
 (defclass tag-feed (feed) ())
110
 
109
 
111
 (defmethod page-url ((object tag-feed))
110
 (defmethod page-url ((object tag-feed))
130
 (defun all-months ()
129
 (defun all-months ()
131
   "Retrieve a list of all months with published content."
130
   "Retrieve a list of all months with published content."
132
   (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
131
   (let ((months (mapcar (lambda (x) (subseq (content-date x) 0 7))
133
-                        (hash-table-values *content*))))
132
+                        (find-all 'post))))
134
     (sort (remove-duplicates months :test #'string=) #'string>)))
133
     (sort (remove-duplicates months :test #'string=) #'string>)))
135
 
134
 
136
 (defun all-tags ()
135
 (defun all-tags ()
137
   "Retrieve a list of all tags used in content."
136
   "Retrieve a list of all tags used in content."
138
-  (let* ((dupes (mappend #'content-tags (hash-table-values *content*)))
137
+  (let* ((dupes (mappend #'content-tags (find-all 'post)))
139
          (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
138
          (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
140
     (sort tags #'string< :key #'tag-name)))
139
     (sort tags #'string< :key #'tag-name)))
141
 
140
 

+ 1 - 1
src/posts.lisp

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

+ 7 - 4
src/util.lisp

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