From: Lucian Mogosanu Date: Sat, 28 Jan 2017 13:15:59 +0000 (+0200) Subject: lbs: Aesthetical and utility changes X-Git-Tag: v0.9^2~7 X-Git-Url: https://git.mogosanu.ro/?a=commitdiff_plain;h=84f98956115b791438b72278bea798b3ef5f4b3e;p=thetarpit.git lbs: Aesthetical and utility changes --- diff --git a/blog.lisp b/blog.lisp index f782029..fd23155 100644 --- 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 --- 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 --- 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 --- 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