blog: Add support for drafts
authorLucian Mogosanu <lucian.mogosanu@gmail.com>
Mon, 18 Feb 2019 20:00:05 +0000 (22:00 +0200)
committerLucian Mogosanu <lucian.mogosanu@gmail.com>
Mon, 18 Feb 2019 20:00:05 +0000 (22:00 +0200)
This will sorta render tarpit-drafts obsolete, but what can I say, this
has been a long time coming.

Basically, I want a decent way to check how posts look inline without
getting stuck in markdown arcana all the time, and so the drafts/ folder
was created.

blog.lisp

index 9e12271..71b9f98 100644 (file)
--- a/blog.lisp
+++ b/blog.lisp
@@ -29,6 +29,7 @@
 
 ; TLBS global variables
 (defvar *posts* nil) ; list of post blists
+(defvar *drafts* nil) ; list of draft post blists
 (defvar *pages* nil)
 (defvar *tags* nil)
 (defvar *busybox-process* nil)
     (write-string (gethash "body" blist) out))
   blist)
 
-(defun tlbs-process-posts (relative-wildcard)
-  (format t "Processing posts...~%")
+(defun tlbs-process-posts (relative-wildcard &key (draft nil))
+  (format t "Processing~a posts...~%"
+          (if draft " draft" ""))
   ; clean up old posts first...
-  (setq *posts* nil
-        *tags* nil)
+  (if draft
+      (setq *drafts* nil)
+      (setq *posts* nil
+            *tags* nil))
   (let ((postlist (directory
                    (concatenate 'string *lbs-base* relative-wildcard))))
     (assert (not (null postlist)))
             ;; make sure body is erased when done writing
             ;; XXX: the body might still be needed when generating RSS
             (setf (gethash "body" blist) nil))
-        ;; add to post list
-        (push blist *posts*))))
+        ;; add to post list, or draft list, depending on post type
+        (if draft
+            (push blist *drafts*)
+            (push blist *posts*)))))
   nil)
 
 (defun tlbs-process-page (out-path blist)
 (defun tlbs-process-everything ()
   ; posts: needed for everything, so process them first
   (tlbs-process-posts "posts/**/*.markdown")
+  ; process drafts
+  (tlbs-process-posts "drafts/*.markdown" :draft t)
   ; tags
   (tlbs-process-tags)
   ; other files
   (tlbs-process-index))
 
 (defun tlbs-deploy-site ()
-  (uiop:run-program (format nil "rsync -avz -e '~a' ~a/* ~a"
+  (uiop:run-program (format nil "rsync -avz --exclude 'drafts/' -e '~a' ~a/* ~a"
                             "ssh -p 2200"
                             *lbs-site*
                             "mogosanu.ro:/virtual/sites/thetarpit.org")