Handle trailing slashes more gracefully. Kick off 0.9.7-dev.

NEWS.md

@@ -7,6 +7,12 @@ Legend:
     A change to Coleslaw's exported interface. Plugins or Themes that have
     not been upstreamed are effected and may require minor effort to fix.
 
+## Changes for 0.9.7 (20xx):
+
+* Coleslaw now handles **deploy-dir**, **repo**, and **staging-dir**
+  config options more gracefully. Previously, various errors could be
+  encountered if directory options lacked a trailing slash.
+
 ## Changes for 0.9.6 (2014-09-27):
 
 * **SITE-BREAKING CHANGE**: Coleslaw now defaults to a "basic" deploy

coleslaw.asd

@@ -1,7 +1,7 @@
 (defsystem #:coleslaw
   :name "coleslaw"
   :description "Flexible Lisp Blogware"
-  :version "0.9.6"
+  :version "0.9.7-dev"
   :license "BSD"
   :author "Brit Butler <redline6561@gmail.com>"
   :pathname "src/"

plugins/import.lisp

@@ -40,7 +40,7 @@
                    (format nil "~a.post" slug) output))))
 
 (defun export-post (title tags date content path output)
-  (with-open-file (out (merge-pathnames path (or output (repo *config*)))
+  (with-open-file (out (merge-pathnames path (or output (repo-dir *config*)))
                    :direction :output
                    :if-exists :supersede
                    :if-does-not-exist :create
@@ -56,7 +56,7 @@
 
 (defun import-posts (filepath output &optional since)
   (when (probe-file filepath)
-    (ensure-directories-exist (or output (repo *config*)))
+    (ensure-directories-exist (or output (repo-dir *config*)))
     (let* ((xml (cxml:parse-file filepath (cxml-dom:make-dom-builder)))
            (posts (dom:get-elements-by-tag-name xml "item")))
       (loop for post across posts do (import-post post output since))

plugins/incremental.lisp

@@ -41,7 +41,7 @@
   (let ((db-file (rel-path (user-homedir-pathname) ".coleslaw.db")))
     (setf coleslaw::*site* (cl-store:restore db-file))
     (loop for (status path) in (get-updated-files)
-       for file-path = (rel-path (repo *config*) path)
+       for file-path = (rel-path (repo-dir *config*) path)
        do (update-content status file-path))
     (update-content-metadata)
     ;; Discover's :before method will delete any possibly outdated indexes.

src/coleslaw.lisp

@@ -24,12 +24,12 @@ in REPO-DIR. Optionally, OLDREV is the revision prior to the last push."
 
 (defun compile-blog (staging)
   "Compile the blog to a STAGING directory as specified in .coleslawrc."
-  (ensure-directories-exist (ensure-directory-pathname staging))
+  (ensure-directories-exist staging)
   (with-current-directory staging
     (dolist (dir (list (app-path "themes/~a/css" (theme *config*))
                        (app-path "themes/~a/img" (theme *config*))
                        (app-path "themes/~a/js" (theme *config*))
-                       (merge-pathnames "static" (repo *config*))))
+                       (merge-pathnames "static" (repo-dir *config*))))
       (when (probe-file dir)
         (run-program "rsync --delete -raz ~a ." dir)))
     (do-subclasses (ctype content)
@@ -54,7 +54,7 @@ in REPO-DIR. Optionally, OLDREV is the revision prior to the last push."
     (unless *config*
       (load-config (namestring current-working-directory))
       (compile-theme (theme *config*)))
-    (let* ((file (rel-path (repo *config*) path))
+    (let* ((file (rel-path (repo-dir *config*) path))
            (content (construct content-type (read-content file))))
       (write-file "tmp.html" (render-page content)))))
 

src/config.lisp

@@ -10,7 +10,7 @@
    (license         :initarg :license        :reader license)
    (page-ext        :initarg :page-ext       :reader page-ext)
    (plugins         :initarg :plugins        :reader plugins)
-   (repo            :initarg :repo           :accessor repo)
+   (repo            :initarg :repo           :accessor repo-dir)
    (routing         :initarg :routing        :reader routing)
    (separator       :initarg :separator      :reader separator)
    (sitenav         :initarg :sitenav        :reader sitenav)
@@ -28,6 +28,14 @@
    :separator    ";;;;;"
    :staging-dir  "/tmp/coleslaw"))
 
+(defun dir-slot-reader (config name)
+  "Take CONFIG and NAME, and return a directory pathname for the matching SLOT."
+  (ensure-directory-pathname (slot-value config name)))
+
+(defmethod deploy-dir  ((config blog)) (dir-slot-reader config 'deploy-dir))
+(defmethod repo-dir    ((config blog)) (dir-slot-reader config 'repo))
+(defmethod staging-dir ((config blog)) (dir-slot-reader config 'staging-dir))
+
 (defparameter *config* nil
   "A variable to store the blog configuration and plugin settings.")
 
@@ -71,5 +79,5 @@ preferred over the home directory if provided."
   (with-open-file (in (discover-config-path repo-dir) :external-format :utf-8)
     (let ((config-form (read in)))
       (setf *config* (construct 'blog config-form)
-            (repo *config*) repo-dir)))
+            (repo-dir *config*) repo-dir)))
   (load-plugins (plugins *config*)))

src/content.lisp

@@ -75,7 +75,7 @@
     (with-open-file (in file :external-format :utf-8)
       (let ((metadata (parse-metadata in))
             (content (slurp-remainder in))
-            (filepath (enough-namestring file (repo *config*))))
+            (filepath (enough-namestring file (repo-dir *config*))))
         (append metadata (list :text content :file filepath))))))
 
 ;; Helper Functions

src/documents.lisp

@@ -16,7 +16,7 @@
   (:documentation "Load all documents of the given DOC-TYPE into memory.")
   (:method (doc-type)
     (let ((file-type (format nil "~(~A~)" (class-name doc-type))))
-      (do-files (file (repo *config*) file-type)
+      (do-files (file (repo-dir *config*) file-type)
         (let ((obj (construct (class-name doc-type) (read-content file))))
           (add-document obj))))))
 

src/packages.lisp

@@ -9,9 +9,7 @@
   (:import-from :closure-template #:compile-template)
   (:import-from :local-time #:format-rfc1123-timestring)
   (:import-from :uiop #:getcwd
-                      #:chdir
-                      #:ensure-directory-pathname
-                      #:directory-exists-p)
+                      #:ensure-directory-pathname)
   (:export #:main
            #:preview
            #:*config*

src/util.lisp

@@ -38,8 +38,8 @@ BODY on files that match the given extension."
 (defun (setf getcwd) (path)
   "Change the operating system's current directory to PATH."
   (setf path (ensure-directory-pathname path))
-  (unless (and (directory-exists-p path)
-               (chdir path))
+  (unless (and (uiop:directory-exists-p path)
+               (uiop:chdir path))
     (error 'directory-does-not-exist :dir path))
   path)