Преглед на файлове

adding additional data to the environment, making more build factors configurable

tycho garen преди 11 години
родител
ревизия
25891fb7ca
променени са 5 файла, в които са добавени 57 реда и са изтрити 35 реда
  1. 16 11
      src/coleslaw.lisp
  2. 24 13
      src/config.lisp
  3. 2 2
      src/content.lisp
  4. 1 0
      src/packages.lisp
  5. 14 9
      src/posts.lisp

+ 16 - 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-equal (pageext *config*) "/")
21
+                       "html"
22
+                       (pageext *config*))))
23
+    (when (string= (char extension 0) ".")
24
+      (setf extension (string-trim "." extension)))
20
     (if (pathname-type result)
25
     (if (pathname-type result)
21
         result
26
         result
22
-        (make-pathname :type "html" :defaults result))))
27
+        (make-pathname :type extension :defaults result)
28
+        )))
23
 
29
 
24
 (defun page-path (object)
30
 (defun page-path (object)
25
   "The path to store OBJECT at once rendered."
31
   "The path to store OBJECT at once rendered."
46
 
52
 
47
 (defun compile-blog (staging)
53
 (defun compile-blog (staging)
48
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
54
   "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)
55
   (ensure-directories-exist staging)
52
   (with-current-directory staging
56
   (with-current-directory staging
53
     (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
57
     (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
55
                        (app-path "themes/~a/js" (theme *config*))
59
                        (app-path "themes/~a/js" (theme *config*))
56
                        (merge-pathnames "static" (repo *config*))))
60
                        (merge-pathnames "static" (repo *config*))))
57
       (when (probe-file dir)
61
       (when (probe-file dir)
58
-        (run-program "cp -R ~a ." dir)))
62
+        (run-program "rsync --delete -raz ~a ." dir)))
59
     (do-ctypes (publish (make-keyword ctype)))
63
     (do-ctypes (publish (make-keyword ctype)))
60
     (render-indices)
64
     (render-indices)
61
     (update-symlink "index.html" "1.html")
65
     (update-symlink "index.html" "1.html")
88
 (defun preview (path &optional (content-type 'post))
92
 (defun preview (path &optional (content-type 'post))
89
   "Render the content at PATH under user's configured repo and save it to
93
   "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."
94
 ~/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))))
95
+  (let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
96
+    (unless *config*
97
+      (load-config (namestring current-working-directory))
98
+      (compile-theme (theme *config*)))
99
+    (let* ((file (rel-path (repo *config*) path))
100
+           (content (construct content-type (read-content file))))
101
+      (write-page "tmp.html" (render-page content)))))

+ 24 - 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
+   (postsdir        :initarg :postsdir       :accessor postsdir      :initform "posts") 
14
+   (separator       :initarg :separator      :accessor separator     :initform ";;;;;")
15
+   (pageext         :initarg :pageext        :accessor pageext       :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
+  (let ((default-path (make-pathname :directory (namestring (user-homedir-pathname)) :name ".coleslawrc"))
45
+        (custom-path (make-pathname :directory path :name ".coleslawrc")))
46
+    (cond
47
+      ((file-exists-p custom-path) custom-path)
48
+      ((file-exists-p default-path) default-path))))
49
+
50
+(defun load-config (config-key)
41
   "Load the coleslaw configuration from DIR/.coleslawrc, using CONFIG-KEY
51
   "Load the coleslaw configuration from DIR/.coleslawrc, using CONFIG-KEY
42
 if necessary. DIR is ~ by default."
52
 if necessary. DIR is ~ by default."
43
-  (with-open-file (in (merge-pathnames ".coleslawrc" dir))
53
+
54
+  (with-open-file (in (discover-config-path config-key))
44
     (let ((config-form (read in)))
55
     (let ((config-form (read in)))
45
       (if (symbolp (car config-form))
56
       (if (symbolp (car config-form))
46
           ;; Single site config: ignore CONFIG-KEY.
57
           ;; 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" (postsdir *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)))