lbs: Aesthetical and utility changes

diff --git a/blog.lisp b/blog.lisp
index f782029..fd23155 100644 (file)
--- a/blog.lisp
+++ b/blog.lisp
@@ -8,23 +8,24 @@
 ;; - *lbs-path*: an emulation of unix's PATH envvar
 ;; - *lbs-site*: directory where the output files will be stored
 
-;; Add LBS dependencies
-(push (concatenate 'string *lbs-base* "cl-who/") *lbs-path*) ; cl-who
-(push (concatenate 'string *lbs-base* "cl-ppcre/") *lbs-path*) ; cl-ppcre
-(push (concatenate 'string *lbs-base* "lbs-utils/") *lbs-path*) ; cl-ppcre
-
-; Set paths and change dir (SBCL-specific)
-(dolist (path *lbs-path*)
-  (if (not (member path asdf:*central-registry*))
-      (push path asdf:*central-registry*)))
-(sb-posix:chdir *lbs-base*)
-(setq *default-pathname-defaults* (pathname *lbs-base*))
-
-; Load libraries
-(require 'asdf)
-(asdf:load-system :cl-who)
-(asdf:load-system :cl-ppcre)
-(asdf:load-system :lbs-utils)
+(eval-when (:compile-toplevel :execute :load-toplevel)
+  ;; Add LBS dependencies
+  (push (concatenate 'string *lbs-base* "cl-who/") *lbs-path*) ; cl-who
+  (push (concatenate 'string *lbs-base* "cl-ppcre/") *lbs-path*) ; cl-ppcre
+  (push (concatenate 'string *lbs-base* "lbs-utils/") *lbs-path*) ; lbs-utils
+
+  ; Set paths and change dir (SBCL-specific)
+  (dolist (path *lbs-path*)
+    (if (not (member path asdf:*central-registry*))
+        (push path asdf:*central-registry*)))
+  (sb-posix:chdir *lbs-base*)
+  (setq *default-pathname-defaults* (pathname *lbs-base*))
+
+  ; Load libraries
+  (require 'asdf)
+  (asdf:load-system :cl-who)
+  (asdf:load-system :cl-ppcre)
+  (asdf:load-system :lbs-utils))
 
 ; TLBS global variables
 (defvar *posts* nil) ; list of post blists
@@ -33,8 +34,8 @@
 
 ; Load template definitions
 (load (concatenate 'string *lbs-base* "templates/default.lisp"))
-(load (concatenate 'string *lbs-base* "templates/index.lisp"))
 (load (concatenate 'string *lbs-base* "templates/post.lisp"))
+(load (concatenate 'string *lbs-base* "templates/index.lisp"))
 (load (concatenate 'string *lbs-base* "templates/archive.lisp"))
 (load (concatenate 'string *lbs-base* "templates/rss.lisp"))
 

diff --git a/lbs-utils/utils.lisp b/lbs-utils/utils.lisp
index b55976c..620a869 100644 (file)
--- a/lbs-utils/utils.lisp
+++ b/lbs-utils/utils.lisp
@@ -37,6 +37,10 @@
 (defun count->string (L)
   (write-to-string (length L)))
 
+(defmacro with-gensyms (syms &body body)
+  `(let ,(loop for s in syms collect `(,s (gensym)))
+    ,@body))
+
 (defvar *months*
   '("January" "February" "March" "April" "May" "June" "July"
     "August" "September" "October" "November" "December"))

diff --git a/templates/archive.lisp b/templates/archive.lisp
index 5ed3d2e..70fb608 100644 (file)
--- a/templates/archive.lisp
+++ b/templates/archive.lisp
@@ -3,25 +3,28 @@
 ;; TODO: Make a macro to obtain general forms such as the ones below
 
 ; Macros go first
+(defmacro make-label (name uri count)
+  `(cl-who:htm
+    (:a :href ,uri
+        (cl-who:str (format nil "~A (~D)"
+                            ,name ,count)))))
+
 (defmacro make-label-list ()
-  (let ((tag (gensym))
-        (tags (gensym))
-        (all-but-last (gensym))
-        (last (gensym)))
-    `(let* ((,tags (sort *tags* #'tlist-lessp))
-            (,all-but-last (but-last ,tags))
-            (,last (just-last ,tags)))
-       (setq *tags* ,tags) ; sort destroys *tags*, so update it
-       (cl-who:htm
-        (dolist (,tag ,all-but-last)
-          (make-label (gethash "tagid" ,tag)
-                      (gethash "uri" ,tag)
-                      (length (gethash "posts" ,tag)))
-          (cl-who:str ", "))
-        (when (not (null ,last))
-          (make-label (gethash "tagid" ,last)
-                      (gethash "uri" ,last)
-                      (length (gethash "posts" ,last))))))))
+  (with-gensyms (tag tags all-but-last last)
+   `(let* ((,tags (sort *tags* #'tlist-lessp))
+           (,all-but-last (but-last ,tags))
+           (,last (just-last ,tags)))
+      (setq *tags* ,tags)         ; sort destroys *tags*, so update it
+      (cl-who:htm
+       (dolist (,tag ,all-but-last)
+         (make-label (gethash "tagid" ,tag)
+                     (gethash "uri" ,tag)
+                     (length (gethash "posts" ,tag)))
+         (cl-who:str ", "))
+       (when (not (null ,last))
+         (make-label (gethash "tagid" ,last)
+                     (gethash "uri" ,last)
+                     (length (gethash "posts" ,last))))))))
 
 (defun tlbs-out-archive (output-stream)
   (cl-who:with-html-output (output-stream nil :indent nil)
@@ -48,12 +51,6 @@
     (setf (gethash "body" tlist) body)
     tlist))
 
-(defmacro make-label (name uri count)
-  `(cl-who:htm
-    (:a :href ,uri
-        (cl-who:str (format nil "~A (~D)"
-                            ,name ,count)))))
-
 (defun tlist-lessp (tlist1 tlist2)
   (string-lessp (gethash "tagid" tlist1)
                 (gethash "tagid" tlist2)))

diff --git a/templates/post.lisp b/templates/post.lisp
index 1cd480d..184f711 100644 (file)
--- a/templates/post.lisp
+++ b/templates/post.lisp
@@ -4,44 +4,39 @@
 
 ; Macros go first
 (defmacro make-tag-list (tag-list)
-  (let ((tag (gensym))
-        (tlist (gensym)))
-    `(cl-who:htm
-      (cl-who:str "(")
-       (dolist (,tag (but-last ,tag-list))
-         (let ((,tlist (find-tag ,tag)))
-           (cl-who:htm (:a :href (gethash "uri" ,tlist) (cl-who:str ,tag))
-                       " ")))
-       (let* ((,tag (just-last ,tag-list))
-              (,tlist (find-tag ,tag)))
-         (cl-who:htm (:a :href (gethash "uri" ,tlist)
-                         (cl-who:str ,tag))))
-         (cl-who:str ")"))))
+  (with-gensyms (tag tlist)
+   `(cl-who:htm
+     (cl-who:str "(")
+     (dolist (,tag (but-last ,tag-list))
+       (let ((,tlist (find-tag ,tag)))
+         (cl-who:htm (:a :href (gethash "uri" ,tlist) (cl-who:str ,tag))
+                     " ")))
+     (let* ((,tag (just-last ,tag-list))
+            (,tlist (find-tag ,tag)))
+       (cl-who:htm (:a :href (gethash "uri" ,tlist)
+                       (cl-who:str ,tag))))
+     (cl-who:str ")"))))
        
 
 (defmacro make-post-list (blist-list)
-  (let ((blist (gensym))
-        (date (gensym))
-        (uri (gensym))
-        (title (gensym))
-        (excerpt (gensym)))
-    `(cl-who:htm
-      (:ul :class "postlist"
-           (dolist (,blist ,blist-list)
-             (let ((,date (gethash "date" ,blist))
-                   (,uri (gethash "uri" ,blist))
-                   (,title (gethash "title" ,blist))
-                   (,excerpt (gethash "excerpt" ,blist)))
-               (cl-who:htm
-                (:li :class "plitem"
-                 (cl-who:str ,date)
-                 (cl-who:str ": ")
-                 (:a :href ,uri (cl-who:str ,title))
-                 (if ,excerpt
-                     (cl-who:htm
-                      (cl-who:str ": ")
-                      (:span :class "plexcerpt"
-                             (cl-who:str ,excerpt))))))))))))
+  (with-gensyms (blist date uri title excerpt)
+   `(cl-who:htm
+     (:ul :class "postlist"
+          (dolist (,blist ,blist-list)
+            (let ((,date (gethash "date" ,blist))
+                  (,uri (gethash "uri" ,blist))
+                  (,title (gethash "title" ,blist))
+                  (,excerpt (gethash "excerpt" ,blist)))
+              (cl-who:htm
+               (:li :class "plitem"
+                    (cl-who:str ,date)
+                    (cl-who:str ": ")
+                    (:a :href ,uri (cl-who:str ,title))
+                    (if ,excerpt
+                        (cl-who:htm
+                         (cl-who:str ": ")
+                         (:span :class "plexcerpt"
+                                (cl-who:str ,excerpt))))))))))))
 
 (defun tlbs-make-post (blist)
   (let ((new-body