Browse Source

Merge pull request #44 from tychoish/more-data

adding additional configurable options
Brit Butler 11 years ago
parent
commit
5a32bb19cf
5 changed files with 56 additions and 35 deletions
  1. 14 11
      src/coleslaw.lisp
  2. 25 13
      src/config.lisp
  3. 2 2
      src/content.lisp
  4. 1 0
      src/packages.lisp
  5. 14 9
      src/posts.lisp

+ 14 - 11
src/coleslaw.lisp

16
   (:documentation "The url to the object, without the domain."))
16
   (:documentation "The url to the object, without the domain."))
17
 
17
 
18
 (defmethod page-url :around ((object t))
18
 (defmethod page-url :around ((object t))
19
-  (let ((result (call-next-method)))
19
+  (let ((result (call-next-method))
20
+        (extension (if (string= (page-ext *config*) "/")
21
+                       "html"
22
+                       (page-ext *config*))))
20
     (if (pathname-type result)
23
     (if (pathname-type result)
21
         result
24
         result
22
-        (make-pathname :type "html" :defaults result))))
25
+        (make-pathname :type extension :defaults result)
26
+        )))
23
 
27
 
24
 (defun page-path (object)
28
 (defun page-path (object)
25
   "The path to store OBJECT at once rendered."
29
   "The path to store OBJECT at once rendered."
46
 
50
 
47
 (defun compile-blog (staging)
51
 (defun compile-blog (staging)
48
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
52
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
49
-  (when (probe-file staging)
50
-    (run-program "rm -R ~a" staging))
51
   (ensure-directories-exist staging)
53
   (ensure-directories-exist staging)
52
   (with-current-directory staging
54
   (with-current-directory staging
53
     (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
55
     (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
55
                        (app-path "themes/~a/js" (theme *config*))
57
                        (app-path "themes/~a/js" (theme *config*))
56
                        (merge-pathnames "static" (repo *config*))))
58
                        (merge-pathnames "static" (repo *config*))))
57
       (when (probe-file dir)
59
       (when (probe-file dir)
58
-        (run-program "cp -R ~a ." dir)))
60
+        (run-program "rsync --delete -raz ~a ." dir)))
59
     (do-ctypes (publish (make-keyword ctype)))
61
     (do-ctypes (publish (make-keyword ctype)))
60
     (render-indices)
62
     (render-indices)
61
     (update-symlink "index.html" "1.html")
63
     (update-symlink "index.html" "1.html")
88
 (defun preview (path &optional (content-type 'post))
90
 (defun preview (path &optional (content-type 'post))
89
   "Render the content at PATH under user's configured repo and save it to
91
   "Render the content at PATH under user's configured repo and save it to
90
 ~/tmp.html. Load the user's config and theme if necessary."
92
 ~/tmp.html. Load the user's config and theme if necessary."
91
-  (unless *config*
92
-    (load-config nil)
93
-    (compile-theme (theme *config*)))
94
-  (let* ((file (rel-path (repo *config*) path))
95
-         (content (construct content-type (read-content file))))
96
-    (write-page "~/tmp.html" (render-page content))))
93
+  (let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
94
+    (unless *config*
95
+      (load-config (namestring current-working-directory))
96
+      (compile-theme (theme *config*)))
97
+    (let* ((file (rel-path (repo *config*) path))
98
+           (content (construct content-type (read-content file))))
99
+      (write-page "tmp.html" (render-page content)))))

+ 25 - 13
src/config.lisp

1
 (in-package :coleslaw)
1
 (in-package :coleslaw)
2
 
2
 
3
 (defclass blog ()
3
 (defclass blog ()
4
-  ((author      :initarg :author      :accessor author)
5
-   (deploy-dir  :initarg :deploy-dir  :accessor deploy-dir)
6
-   (domain      :initarg :domain      :accessor domain)
7
-   (feeds       :initarg :feeds       :accessor feeds)
8
-   (license     :initarg :license     :accessor license)
9
-   (plugins     :initarg :plugins     :accessor plugins)
10
-   (repo        :initarg :repo        :accessor repo)
11
-   (sitenav     :initarg :sitenav     :accessor sitenav)
12
-   (staging-dir :initarg :staging-dir :accessor staging-dir)
13
-   (title       :initarg :title       :accessor title)
14
-   (theme       :initarg :theme       :accessor theme)))
4
+  ((author          :initarg :author         :accessor author)
5
+   (deploy-dir      :initarg :deploy-dir     :accessor deploy-dir)
6
+   (domain          :initarg :domain         :accessor domain)
7
+   (feeds           :initarg :feeds          :accessor feeds)
8
+   (license         :initarg :license        :accessor license)
9
+   (plugins         :initarg :plugins        :accessor plugins)
10
+   (repo            :initarg :repo           :accessor repo)
11
+   (sitenav         :initarg :sitenav        :accessor sitenav)
12
+   (staging-dir     :initarg :staging-dir    :accessor staging-dir)
13
+   (posts-dir       :initarg :posts-dir      :accessor posts-dir      :initform "posts")
14
+   (separator       :initarg :separator      :accessor separator      :initform ";;;;;")
15
+   (page-ext        :initarg :page-ext       :accessor page-ext       :initform "html")
16
+   (title           :initarg :title          :accessor title)
17
+   (theme           :initarg :theme          :accessor theme)))
15
 
18
 
16
 (define-condition unknown-config-section-error (error)
19
 (define-condition unknown-config-section-error (error)
17
   ((text :initarg :text :reader text)))
20
   ((text :initarg :text :reader text)))
37
       (destructuring-bind (name &rest args) plugin
40
       (destructuring-bind (name &rest args) plugin
38
         (apply 'enable-plugin (plugin-path name) args)))))
41
         (apply 'enable-plugin (plugin-path name) args)))))
39
 
42
 
40
-(defun load-config (&optional config-key (dir (user-homedir-pathname)))
43
+(defun discover-config-path (&optional (path ""))
44
+  "Checks the project directory for a coleslawrc and if one
45
+doesn't exist, uses the coleslawrc in the home directory."
46
+  (let ((rel-path (make-pathname :directory path :name ".coleslawrc")))
47
+    (if (file-exists-p rel-path)
48
+        rel-path
49
+        (make-pathname :directory (namestring (user-homedir-pathname)) :name ".coleslawrc"))))
50
+
51
+(defun load-config (config-key)
41
   "Load the coleslaw configuration from DIR/.coleslawrc, using CONFIG-KEY
52
   "Load the coleslaw configuration from DIR/.coleslawrc, using CONFIG-KEY
42
 if necessary. DIR is ~ by default."
53
 if necessary. DIR is ~ by default."
43
-  (with-open-file (in (merge-pathnames ".coleslawrc" dir))
54
+
55
+  (with-open-file (in (discover-config-path config-key))
44
     (let ((config-form (read in)))
56
     (let ((config-form (read in)))
45
       (if (symbolp (car config-form))
57
       (if (symbolp (car config-form))
46
           ;; Single site config: ignore CONFIG-KEY.
58
           ;; Single site config: ignore CONFIG-KEY.

+ 2 - 2
src/content.lisp

51
          (read-tags (str)
51
          (read-tags (str)
52
            (mapcar #'make-tag (cl-ppcre:split "," str))))
52
            (mapcar #'make-tag (cl-ppcre:split "," str))))
53
     (with-open-file (in file)
53
     (with-open-file (in file)
54
-      (unless (string= (read-line in) ";;;;;")
54
+      (unless (string= (read-line in) (separator *config*))
55
         (error "The provided file lacks the expected header."))
55
         (error "The provided file lacks the expected header."))
56
       (let ((meta (loop for line = (read-line in nil)
56
       (let ((meta (loop for line = (read-line in nil)
57
-                     until (string= line ";;;;;")
57
+                     until (string= line (separator *config*))
58
                      appending (list (field-name line)
58
                      appending (list (field-name line)
59
                                      (aref (parse-field line) 0))))
59
                                      (aref (parse-field line) 0))))
60
             (content (slurp-remainder in)))
60
             (content (slurp-remainder in)))

+ 1 - 0
src/packages.lisp

5
                             #:make-keyword
5
                             #:make-keyword
6
                             #:mappend
6
                             #:mappend
7
                             #:compose)
7
                             #:compose)
8
+  (:import-from :cl-fad #:file-exists-p)
8
   (:import-from :closure-template #:compile-template)
9
   (:import-from :closure-template #:compile-template)
9
   (:export #:main
10
   (:export #:main
10
            #:preview
11
            #:preview

+ 14 - 9
src/posts.lisp

2
 
2
 
3
 (defclass post (content)
3
 (defclass post (content)
4
   ((title :initform nil :initarg :title :accessor post-title)
4
   ((title :initform nil :initarg :title :accessor post-title)
5
+   (author :initform nil :initarg :author :accessor post-author)
5
    (format :initform nil :initarg :format :accessor post-format)))
6
    (format :initform nil :initarg :format :accessor post-format)))
6
 
7
 
8
+(defmethod initialize-instance :after ((object post) &key)
9
+  (with-accessors ((title post-title)
10
+                   (author post-author)
11
+                   (format post-format)
12
+                   (text content-text)) object
13
+      (setf (content-slug object) (slugify title)
14
+            format (make-keyword (string-upcase format))
15
+            text (render-content text format)
16
+            author (if author
17
+                       author
18
+                       (author *config*)))))
19
+
7
 (defmethod render ((object post) &key prev next)
20
 (defmethod render ((object post) &key prev next)
8
   (funcall (theme-fn 'post) (list :config *config*
21
   (funcall (theme-fn 'post) (list :config *config*
9
                                   :post object
22
                                   :post object
11
                                   :next next)))
24
                                   :next next)))
12
 
25
 
13
 (defmethod page-url ((object post))
26
 (defmethod page-url ((object post))
14
-  (format nil "posts/~a" (content-slug object)))
15
-
16
-(defmethod initialize-instance :after ((object post) &key)
17
-  (with-accessors ((title post-title)
18
-                   (format post-format)
19
-                   (text content-text)) object
20
-      (setf (content-slug object) (slugify title)
21
-            format (make-keyword (string-upcase format))
22
-            text (render-content text format))))
27
+  (format nil "~a/~a" (posts-dir *config*) (content-slug object)))
23
 
28
 
24
 (defmethod publish ((content-type (eql :post)))
29
 (defmethod publish ((content-type (eql :post)))
25
   (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))
30
   (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))