瀏覽代碼

Minor comments and doc cleanups. Rearrange util.

Brit Butler 11 年之前
父節點
當前提交
3029c7e774
共有 4 個文件被更改,包括 46 次插入44 次删除
  1. 4 0
      src/coleslaw.lisp
  2. 1 1
      src/documents.lisp
  3. 2 0
      src/indexes.lisp
  4. 39 43
      src/util.lisp

+ 4 - 0
src/coleslaw.lisp

67
       (with-output-to-string (str)
67
       (with-output-to-string (str)
68
         (3bmd:parse-string-and-print-to-stream text str)))))
68
         (3bmd:parse-string-and-print-to-stream text str)))))
69
 
69
 
70
+(defun make-pubdate ()
71
+  "Make a RFC1123 pubdate representing the current time."
72
+  (local-time:format-rfc1123-timestring nil (local-time:now)))
73
+
70
 (defun page-path (object)
74
 (defun page-path (object)
71
   "The path to store OBJECT at once rendered."
75
   "The path to store OBJECT at once rendered."
72
   (rel-path (staging-dir *config*) (namestring (page-url object))))
76
   (rel-path (staging-dir *config*) (namestring (page-url object))))

+ 1 - 1
src/documents.lisp

44
 ;; Instance Methods
44
 ;; Instance Methods
45
 
45
 
46
 (defgeneric page-url (document)
46
 (defgeneric page-url (document)
47
-  (:documentation "The url to the document, without the domain."))
47
+  (:documentation "The url to the DOCUMENT without the domain."))
48
 
48
 
49
 (defmethod page-url :around ((document t))
49
 (defmethod page-url :around ((document t))
50
   (let ((result (call-next-method)))
50
   (let ((result (call-next-method)))

+ 2 - 0
src/indexes.lisp

102
   (dolist (feed (find-all 'feed))
102
   (dolist (feed (find-all 'feed))
103
     (render-feed feed)))
103
     (render-feed feed)))
104
 
104
 
105
+;;; Tag Feeds
106
+
105
 (defclass tag-feed (feed) ())
107
 (defclass tag-feed (feed) ())
106
 
108
 
107
 (defmethod page-url ((object tag-feed))
109
 (defmethod page-url ((object tag-feed))

+ 39 - 43
src/util.lisp

15
        (let ((,klasses (,all-subclasses (find-class ',class))))
15
        (let ((,klasses (,all-subclasses (find-class ',class))))
16
          (loop for ,var in ,klasses do ,@body)))))
16
          (loop for ,var in ,klasses do ,@body)))))
17
 
17
 
18
-(defun fmt (fmt-str args)
19
-  "A convenient FORMAT interface for string building."
20
-  (apply 'format nil fmt-str args))
21
-
22
-(defun rel-path (base path &rest args)
23
-  "Take a relative PATH and return the corresponding pathname beneath BASE.
24
-If ARGS is provided, use (fmt path args) as the value of PATH."
25
-  (merge-pathnames (fmt path args) base))
26
-
27
-(defun app-path (path &rest args)
28
-  "Return a relative path beneath coleslaw."
29
-  (apply 'rel-path coleslaw-conf:*basedir* path args))
30
-
31
-(defun run-program (program &rest args)
32
-  "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,
33
-use (fmt program args) as the value of PROGRAM."
34
-  (inferior-shell:run (fmt program args) :show t))
35
-
36
-(defun update-symlink (path target)
37
-  "Update the symlink at PATH to point to TARGET."
38
-  (run-program "ln -sfn ~a ~a" target path))
39
-
40
 (defmacro do-files ((var path &optional extension) &body body)
18
 (defmacro do-files ((var path &optional extension) &body body)
41
   "For each file on PATH, run BODY. If EXTENSION is provided, only run BODY
19
   "For each file on PATH, run BODY. If EXTENSION is provided, only run BODY
42
 on files that match the given extension."
20
 on files that match the given extension."
48
                    ,@body)))
26
                    ,@body)))
49
              `,body))))
27
              `,body))))
50
 
28
 
51
-(defun exit ()
52
-  "Exit the lisp system returning a 0 status code."
53
-  #+sbcl (sb-ext:quit)
54
-  #+ccl (ccl:quit)
55
-  #+ecl (si:quit)
56
-  #+cmucl (ext:quit)
57
-  #+clisp (ext:quit)
58
-  #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
29
+(defmacro with-current-directory (path &body body)
30
+  "Change the current OS directory to PATH and execute BODY in
31
+an UNWIND-PROTECT, then change back to the current directory."
32
+  (alexandria:with-gensyms (old)
33
+    `(let ((,old (current-directory)))
34
+       (unwind-protect (progn
35
+                         (setf (current-directory) ,path)
36
+                         ,@body)
37
+         (setf (current-directory) ,old)))))
59
 
38
 
60
 (defun current-directory ()
39
 (defun current-directory ()
61
   "Return the operating system's current directory."
40
   "Return the operating system's current directory."
75
   #+clisp (ext:cd path)
54
   #+clisp (ext:cd path)
76
   #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
55
   #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
77
 
56
 
78
-(defmacro with-current-directory (path &body body)
79
-  "Change the current OS directory to PATH and execute BODY in
80
-an UNWIND-PROTECT, then change back to the current directory."
81
-  (alexandria:with-gensyms (old)
82
-    `(let ((,old (current-directory)))
83
-       (unwind-protect (progn
84
-                         (setf (current-directory) ,path)
85
-                         ,@body)
86
-         (setf (current-directory) ,old)))))
57
+(defun exit ()
58
+  "Exit the lisp system returning a 0 status code."
59
+  #+sbcl (sb-ext:quit)
60
+  #+ccl (ccl:quit)
61
+  #+ecl (si:quit)
62
+  #+cmucl (ext:quit)
63
+  #+clisp (ext:quit)
64
+  #-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
65
+
66
+(defun fmt (fmt-str args)
67
+  "A convenient FORMAT interface for string building."
68
+  (apply 'format nil fmt-str args))
69
+
70
+(defun rel-path (base path &rest args)
71
+  "Take a relative PATH and return the corresponding pathname beneath BASE.
72
+If ARGS is provided, use (fmt path args) as the value of PATH."
73
+  (merge-pathnames (fmt path args) base))
74
+
75
+(defun app-path (path &rest args)
76
+  "Return a relative path beneath coleslaw."
77
+  (apply 'rel-path coleslaw-conf:*basedir* path args))
78
+
79
+(defun run-program (program &rest args)
80
+  "Take a PROGRAM and execute the corresponding shell command. If ARGS is provided,
81
+use (fmt program args) as the value of PROGRAM."
82
+  (inferior-shell:run (fmt program args) :show t))
83
+
84
+(defun update-symlink (path target)
85
+  "Update the symlink at PATH to point to TARGET."
86
+  (run-program "ln -sfn ~a ~a" target path))
87
 
87
 
88
 (defun take-up-to (n seq)
88
 (defun take-up-to (n seq)
89
   "Take elements from SEQ until all elements or N have been taken."
89
   "Take elements from SEQ until all elements or N have been taken."
90
   (subseq seq 0 (min (length seq) n)))
90
   (subseq seq 0 (min (length seq) n)))
91
-
92
-(defun make-pubdate ()
93
-  "Make a RFC1123 pubdate representing the current time."
94
-  (local-time:format-rfc1123-timestring nil (local-time:now)))