Browse Source

Assorted cleanups.

Brit Butler 11 years ago
parent
commit
e96f7f58b9
6 changed files with 36 additions and 41 deletions
  1. 6 29
      src/coleslaw.lisp
  2. 9 0
      src/content.lisp
  3. 8 7
      src/documents.lisp
  4. 1 1
      src/indexes.lisp
  5. 1 0
      src/packages.lisp
  6. 11 4
      src/util.lisp

+ 6 - 29
src/coleslaw.lisp

47
         (update-symlink prev (truename curr)))
47
         (update-symlink prev (truename curr)))
48
       (update-symlink curr new-build))))
48
       (update-symlink curr new-build))))
49
 
49
 
50
+(defun update-symlink (path target)
51
+  "Update the symlink at PATH to point to TARGET."
52
+  (run-program "ln -sfn ~a ~a" target path))
53
+
50
 (defun preview (path &optional (content-type 'post))
54
 (defun preview (path &optional (content-type 'post))
51
   "Render the content at PATH under user's configured repo and save it to
55
   "Render the content at PATH under user's configured repo and save it to
52
 ~/tmp.html. Load the user's config and theme if necessary."
56
 ~/tmp.html. Load the user's config and theme if necessary."
58
            (content (construct content-type (read-content file))))
62
            (content (construct content-type (read-content file))))
59
       (write-file "tmp.html" (render-page content)))))
63
       (write-file "tmp.html" (render-page content)))))
60
 
64
 
61
-(defgeneric render-text (text format)
62
-  (:documentation "Render TEXT of the given FORMAT to HTML for display.")
63
-  (:method (text (format (eql :html)))
64
-    text)
65
-  (:method (text (format (eql :md)))
66
-    (let ((3bmd-code-blocks:*code-blocks* t))
67
-      (with-output-to-string (str)
68
-        (3bmd:parse-string-and-print-to-stream text str)))))
69
-
70
-(defun make-pubdate ()
71
-  "Make a RFC1123 pubdate representing the current time."
72
-  (local-time:format-rfc1123-timestring nil (local-time:now)))
73
-
74
-(defun page-path (object)
75
-  "The path to store OBJECT at once rendered."
76
-  (rel-path (staging-dir *config*) (namestring (page-url object))))
77
-
78
 (defun render-page (content &optional theme-fn &rest render-args)
65
 (defun render-page (content &optional theme-fn &rest render-args)
79
-  "Render the given CONTENT to disk using THEME-FN if supplied.
66
+  "Render the given CONTENT to HTML using THEME-FN if supplied.
80
 Additional args to render CONTENT can be passed via RENDER-ARGS."
67
 Additional args to render CONTENT can be passed via RENDER-ARGS."
81
   (funcall (or theme-fn (theme-fn 'base))
68
   (funcall (or theme-fn (theme-fn 'base))
82
            (list :config *config*
69
            (list :config *config*
83
                  :content content
70
                  :content content
84
                  :raw (apply 'render content render-args)
71
                  :raw (apply 'render content render-args)
85
-                 :pubdate (make-pubdate)
72
+                 :pubdate (format-rfc1123-timestring nil (local-time:now))
86
                  :injections (find-injections content))))
73
                  :injections (find-injections content))))
87
-
88
-(defun write-file (filepath page)
89
-  "Write the given PAGE to FILEPATH."
90
-  (ensure-directories-exist filepath)
91
-  (with-open-file (out filepath
92
-                   :direction :output
93
-                   :if-exists :supersede
94
-                   :if-does-not-exist :create
95
-                   :external-format '(:utf-8))
96
-    (write page :stream out :escape nil)))

+ 9 - 0
src/content.lisp

76
 (defun by-date (content)
76
 (defun by-date (content)
77
   "Sort CONTENT in reverse chronological order."
77
   "Sort CONTENT in reverse chronological order."
78
   (sort content #'string> :key #'content-date))
78
   (sort content #'string> :key #'content-date))
79
+
80
+(defgeneric render-text (text format)
81
+  (:documentation "Render TEXT of the given FORMAT to HTML for display.")
82
+  (:method (text (format (eql :html)))
83
+    text)
84
+  (:method (text (format (eql :md)))
85
+    (let ((3bmd-code-blocks:*code-blocks* t))
86
+      (with-output-to-string (str)
87
+        (3bmd:parse-string-and-print-to-stream text str)))))

+ 8 - 7
src/documents.lisp

5
 ;; Data Storage
5
 ;; Data Storage
6
 
6
 
7
 (defvar *site* (make-hash-table :test #'equal)
7
 (defvar *site* (make-hash-table :test #'equal)
8
-  "An in-memory database to hold all site documents, keyed on page-url.")
8
+  "An in-memory database to hold all site documents, keyed on relative URLs.")
9
 
9
 
10
 ;; Class Methods
10
 ;; Class Methods
11
 
11
 
46
 
46
 
47
 ;; Helper Functions
47
 ;; Helper Functions
48
 
48
 
49
-(defun add-document (doc)
50
-  "Add DOC to the in-memory database. Error if a matching entry is present."
51
-  (let ((url (page-url doc)))
49
+(defun add-document (document)
50
+  "Add DOCUMENT to the in-memory database. Error if a matching entry is present."
51
+  (let ((url (page-url document)))
52
     (if (gethash url *site*)
52
     (if (gethash url *site*)
53
         (error "There is already an existing document with the url ~a" url)
53
         (error "There is already an existing document with the url ~a" url)
54
-        (setf (gethash url *site*) doc))))
54
+        (setf (gethash url *site*) document))))
55
 
55
 
56
 (defun write-document (document &optional theme-fn &rest render-args)
56
 (defun write-document (document &optional theme-fn &rest render-args)
57
   "Write the given DOCUMENT to disk as HTML. If THEME-FN is present,
57
   "Write the given DOCUMENT to disk as HTML. If THEME-FN is present,
58
 use it as the template passing any RENDER-ARGS."
58
 use it as the template passing any RENDER-ARGS."
59
   (let ((html (if (or theme-fn render-args)
59
   (let ((html (if (or theme-fn render-args)
60
                   (apply #'render-page document theme-fn render-args)
60
                   (apply #'render-page document theme-fn render-args)
61
-                  (render-page document nil))))
62
-    (write-file (page-path document) html)))
61
+                  (render-page document nil)))
62
+        (url (namestring (page-url document))))
63
+    (write-file (rel-path (staging-dir *config*) url) html)))
63
 
64
 
64
 (defun find-all (doc-type)
65
 (defun find-all (doc-type)
65
   "Return a list of all instances of a given DOC-TYPE."
66
   "Return a list of all instances of a given DOC-TYPE."

+ 1 - 1
src/indexes.lisp

87
 (defun all-tags ()
87
 (defun all-tags ()
88
   "Retrieve a list of all tags used in content."
88
   "Retrieve a list of all tags used in content."
89
   (let* ((dupes (mappend #'content-tags (find-all 'post)))
89
   (let* ((dupes (mappend #'content-tags (find-all 'post)))
90
-         (tags (remove-duplicates dupes :test #'string= :key #'tag-slug)))
90
+         (tags (remove-duplicates dupes :test #'tag-slug=)))
91
     (sort tags #'string< :key #'tag-name)))
91
     (sort tags #'string< :key #'tag-name)))

+ 1 - 0
src/packages.lisp

7
                             #:compose)
7
                             #:compose)
8
   (:import-from :cl-fad #:file-exists-p)
8
   (:import-from :cl-fad #:file-exists-p)
9
   (:import-from :closure-template #:compile-template)
9
   (:import-from :closure-template #:compile-template)
10
+  (:import-from :local-time #:format-rfc1123-timestring)
10
   (:export #:main
11
   (:export #:main
11
            #:preview
12
            #:preview
12
            #:*config*
13
            #:*config*

+ 11 - 4
src/util.lisp

82
 use (fmt program args) as the value of PROGRAM."
82
 use (fmt program args) as the value of PROGRAM."
83
   (inferior-shell:run (fmt program args) :show t))
83
   (inferior-shell:run (fmt program args) :show t))
84
 
84
 
85
-(defun update-symlink (path target)
86
-  "Update the symlink at PATH to point to TARGET."
87
-  (run-program "ln -sfn ~a ~a" target path))
88
-
89
 (defun take-up-to (n seq)
85
 (defun take-up-to (n seq)
90
   "Take elements from SEQ until all elements or N have been taken."
86
   "Take elements from SEQ until all elements or N have been taken."
91
   (subseq seq 0 (min (length seq) n)))
87
   (subseq seq 0 (min (length seq) n)))
88
+
89
+(defun write-file (path text)
90
+  "Write the given TEXT to PATH. PATH is overwritten if it exists and created
91
+along with any missing parent directories otherwise."
92
+  (ensure-directories-exist path)
93
+  (with-open-file (out path
94
+                   :direction :output
95
+                   :if-exists :supersede
96
+                   :if-does-not-exist :create
97
+                   :external-format '(:utf-8))
98
+    (write text :stream out :escape nil)))