Merge pull request #44 from tychoish/more-data

adding additional configurable options

src/coleslaw.lisp

@@ -16,10 +16,14 @@
   (:documentation "The url to the object, without the domain."))
 
 (defmethod page-url :around ((object t))
-  (let ((result (call-next-method)))
+  (let ((result (call-next-method))
+        (extension (if (string= (page-ext *config*) "/")
+                       "html"
+                       (page-ext *config*))))
     (if (pathname-type result)
         result
-        (make-pathname :type "html" :defaults result))))
+        (make-pathname :type extension :defaults result)
+        )))
 
 (defun page-path (object)
   "The path to store OBJECT at once rendered."
@@ -46,8 +50,6 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
 
 (defun compile-blog (staging)
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
-  (when (probe-file staging)
-    (run-program "rm -R ~a" staging))
   (ensure-directories-exist staging)
   (with-current-directory staging
     (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
@@ -55,7 +57,7 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
                        (app-path "themes/~a/js" (theme *config*))
                        (merge-pathnames "static" (repo *config*))))
       (when (probe-file dir)
-        (run-program "cp -R ~a ." dir)))
+        (run-program "rsync --delete -raz ~a ." dir)))
     (do-ctypes (publish (make-keyword ctype)))
     (render-indices)
     (update-symlink "index.html" "1.html")
@@ -88,9 +90,10 @@ Additional args to render CONTENT can be passed via RENDER-ARGS."
 (defun preview (path &optional (content-type 'post))
   "Render the content at PATH under user's configured repo and save it to
 ~/tmp.html. Load the user's config and theme if necessary."
-  (unless *config*
-    (load-config nil)
-    (compile-theme (theme *config*)))
-  (let* ((file (rel-path (repo *config*) path))
-         (content (construct content-type (read-content file))))
-    (write-page "~/tmp.html" (render-page content))))
+  (let ((current-working-directory (cl-fad:pathname-directory-pathname path)))
+    (unless *config*
+      (load-config (namestring current-working-directory))
+      (compile-theme (theme *config*)))
+    (let* ((file (rel-path (repo *config*) path))
+           (content (construct content-type (read-content file))))
+      (write-page "tmp.html" (render-page content)))))

src/config.lisp

@@ -1,17 +1,20 @@
 (in-package :coleslaw)
 
 (defclass blog ()
-  ((author      :initarg :author      :accessor author)
-   (deploy-dir  :initarg :deploy-dir  :accessor deploy-dir)
-   (domain      :initarg :domain      :accessor domain)
-   (feeds       :initarg :feeds       :accessor feeds)
-   (license     :initarg :license     :accessor license)
-   (plugins     :initarg :plugins     :accessor plugins)
-   (repo        :initarg :repo        :accessor repo)
-   (sitenav     :initarg :sitenav     :accessor sitenav)
-   (staging-dir :initarg :staging-dir :accessor staging-dir)
-   (title       :initarg :title       :accessor title)
-   (theme       :initarg :theme       :accessor theme)))
+  ((author          :initarg :author         :accessor author)
+   (deploy-dir      :initarg :deploy-dir     :accessor deploy-dir)
+   (domain          :initarg :domain         :accessor domain)
+   (feeds           :initarg :feeds          :accessor feeds)
+   (license         :initarg :license        :accessor license)
+   (plugins         :initarg :plugins        :accessor plugins)
+   (repo            :initarg :repo           :accessor repo)
+   (sitenav         :initarg :sitenav        :accessor sitenav)
+   (staging-dir     :initarg :staging-dir    :accessor staging-dir)
+   (posts-dir       :initarg :posts-dir      :accessor posts-dir      :initform "posts")
+   (separator       :initarg :separator      :accessor separator      :initform ";;;;;")
+   (page-ext        :initarg :page-ext       :accessor page-ext       :initform "html")
+   (title           :initarg :title          :accessor title)
+   (theme           :initarg :theme          :accessor theme)))
 
 (define-condition unknown-config-section-error (error)
   ((text :initarg :text :reader text)))
@@ -37,10 +40,19 @@ are in the plugins folder in coleslaw's source directory."
       (destructuring-bind (name &rest args) plugin
         (apply 'enable-plugin (plugin-path name) args)))))
 
-(defun load-config (&optional config-key (dir (user-homedir-pathname)))
+(defun discover-config-path (&optional (path ""))
+  "Checks the project directory for a coleslawrc and if one
+doesn't exist, uses the coleslawrc in the home directory."
+  (let ((rel-path (make-pathname :directory path :name ".coleslawrc")))
+    (if (file-exists-p rel-path)
+        rel-path
+        (make-pathname :directory (namestring (user-homedir-pathname)) :name ".coleslawrc"))))
+
+(defun load-config (config-key)
   "Load the coleslaw configuration from DIR/.coleslawrc, using CONFIG-KEY
 if necessary. DIR is ~ by default."
-  (with-open-file (in (merge-pathnames ".coleslawrc" dir))
+
+  (with-open-file (in (discover-config-path config-key))
     (let ((config-form (read in)))
       (if (symbolp (car config-form))
           ;; Single site config: ignore CONFIG-KEY.

src/content.lisp

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

src/packages.lisp

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

src/posts.lisp

@@ -2,8 +2,21 @@
 
 (defclass post (content)
   ((title :initform nil :initarg :title :accessor post-title)
+   (author :initform nil :initarg :author :accessor post-author)
    (format :initform nil :initarg :format :accessor post-format)))
 
+(defmethod initialize-instance :after ((object post) &key)
+  (with-accessors ((title post-title)
+                   (author post-author)
+                   (format post-format)
+                   (text content-text)) object
+      (setf (content-slug object) (slugify title)
+            format (make-keyword (string-upcase format))
+            text (render-content text format)
+            author (if author
+                       author
+                       (author *config*)))))
+
 (defmethod render ((object post) &key prev next)
   (funcall (theme-fn 'post) (list :config *config*
                                   :post object
@@ -11,15 +24,7 @@
                                   :next next)))
 
 (defmethod page-url ((object post))
-  (format nil "posts/~a" (content-slug object)))
-
-(defmethod initialize-instance :after ((object post) &key)
-  (with-accessors ((title post-title)
-                   (format post-format)
-                   (text content-text)) object
-      (setf (content-slug object) (slugify title)
-            format (make-keyword (string-upcase format))
-            text (render-content text format))))
+  (format nil "~a/~a" (posts-dir *config*) (content-slug object)))
 
 (defmethod publish ((content-type (eql :post)))
   (loop for (next post prev) on (append '(nil) (by-date (find-all 'post)))