X-Git-Url: https://git.hcoop.net/clinton/website/site-support.git/blobdiff_plain/429c80253e6afa094349859b6c542a0eb67fe8ec..HEAD:/books.lisp

diff --git a/books.lisp b/books.lisp
dissimilarity index 74%
index b7c537f..0715e2f 100644
--- a/books.lisp
+++ b/books.lisp
@@ -1,79 +1,78 @@
-;; (((author name as symbols)
-;;   "description"
-;;   ("book name" :fiction-or-nonfiction rating/10 "description")))
-
-(asdf:oos 'asdf:load-op :split-sequence)
-
-(in-package :cl-user)
-
-(defparameter *book-pathname*
-  #p"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")
-
-(defparameter *muse-pathname*
-  #p"/home/clinton/html/muse/site/unknownlamer.org-repo/Book List.muse")
-
-;; need to collapse whitespace in descriptions
-
-;; (defun collapse-whitespace (string)
-;;   (format nil "~{~A ~}"
-;; 	  (split-sequence:split-sequence-if
-;; 	   (lambda (char) (member char '(#\space #\newline))) string
-;; 	   :remove-empty-subseqs t)))
-
-(defun collapse-whitespace (string)
-  string)
-
-
-(defun print-book-entry (book &optional (stream t))
-  (labels ((ratings-stars (rating)
-	     (labels ((stars (rating)
-			(if (> rating 0)
-			    (make-string rating :initial-element #\bullet)
-			    nil)))
-	       (when rating
-		 (format nil "<class name=\"rating-good\">~A</class>~@[<class name=\"rating-bad\">~A</class>~] (~A)"
-			 (stars rating) (stars (- 10 rating)) rating)))))
-    (destructuring-bind (title fiction? rating description)
-	book
-      (format stream "** ~A~%~%~@[*Rating:* ~A / ~]*~A*~%~%~A~%~%"
-	      title
-	      (ratings-stars rating)
-	      (case fiction?
-		(:fiction "Fiction")
-		(:nonfiction "Nonfiction"))
-	      (collapse-whitespace description)))))
-
-(defun print-author-entry (entry &optional (stream t))
-  (destructuring-bind (author description &rest books)
-      entry
-    (format stream "* ~{~A ~}~%~%~A~%~%"
-	    author (collapse-whitespace description))
-    (mapc (lambda (book) (print-book-entry book stream)) books)))
-
-(defun print-book-database (all-books &optional (stream t))
-  (format stream "#title A Not So Fancy Listing of Books~%~%")
-  (mapc (lambda (author) (print-author-entry author stream))
-	all-books))
-
-(defun print-sorted-book-database (all-books &optional (stream t))
-  (print-book-database (sort (copy-list all-books)
-			     (lambda (name-1 name-2)
-			       ;; obviously fails to sort properly
-			       ;; when two authors have the same last
-			       ;; name
-			       (string< (symbol-name name-1)
-					(symbol-name name-2)))
-			     :key (lambda (entry) (car (last (car entry)))))
-		       stream))
-
-(defun dump-muse-books-file (&optional (muse-path *muse-pathname*)
-			               (book-path *book-pathname*))
-  (with-open-file (muse-stream muse-path
-			       :direction :output
-			       :element-type 'extended-char
-			       :if-exists :overwrite
-			       :if-does-not-exist :create)
-    (print-sorted-book-database
-     (with-open-file (book-stream book-path :element-type 'extended-char)
-       (read book-stream))
-     muse-stream)))
\ No newline at end of file
+;; (((author name as symbols)
+;;   "description"
+;;   ("book name" :fiction-or-nonfiction rating/10 "description")))
+
+(asdf:oos 'asdf:load-op :split-sequence)
+(asdf:oos 'asdf:load-op :html-template)
+
+(in-package :cl-user)
+
+(defparameter *book-pathname*
+  #p"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")
+
+(defparameter *template-pathname*
+  #p"/home/clinton/html/muse/site-support/templates/book-list.template")
+
+(defparameter *muse-pathname*
+  #p"/home/clinton/html/muse/site/unknownlamer.org-repo/Book List.muse")
+
+;; need to collapse whitespace in descriptions
+
+;; (defun collapse-whitespace (string)
+;;   (format nil "~{~A ~}"
+;; 	  (split-sequence:split-sequence-if
+;; 	   (lambda (char) (member char '(#\space #\newline))) string
+;; 	   :remove-empty-subseqs t)))
+
+(defun collapse-whitespace (string)
+  string)
+
+(defun book-entry-vars (book)
+  (destructuring-bind (title fiction? &optional rating description)
+      book
+    `(:title ,title
+      :ratingp ,rating
+      :rating-good ,rating
+      :rating-bad ,(if rating (- 10 rating))
+      :classification ,(case fiction?
+			     (:fiction "Fiction")
+			     (:nonfiction "Nonfiction"))
+      :description ,(collapse-whitespace description))))
+
+(defun author-vars (author)
+  (destructuring-bind (name description &rest books)
+      author
+    `(:name ,(format nil "~{~A ~}" name)
+      :description ,description
+      :books ,(mapcar #'book-entry-vars books))))
+
+(defun book-database-vars (book-database)
+  `(:authors ,(mapcar #'author-vars book-database)))
+
+(defun dump-muse-books-file (&key (muse-path *muse-pathname*)
+			          (book-path *book-pathname*)
+			          (template-path *template-pathname*)
+			          (force nil))
+  (when (or force
+	    (> (file-write-date book-path) (file-write-date muse-path))
+	    (> (file-write-date template-path) (file-write-date muse-path)))
+    (with-open-file (muse-stream muse-path
+				 :direction :output
+				 :element-type 'extended-char
+				 :if-exists :supersede
+				 :if-does-not-exist :create)
+      (let ((html-template:*string-modifier* #'identity)
+	    (html-template:*template-start-marker* "<<")
+	    (html-template:*template-end-marker* ">>"))
+	(html-template:fill-and-print-template
+	 template-path
+	 (book-database-vars
+	  (sort (copy-list (with-open-file
+			       (book-stream book-path :element-type 'extended-char)
+			     (read book-stream)))
+		(lambda (e1 e2)
+		  (let ((se1 (string-upcase (symbol-name (car (last e1)))))
+			(se2 (string-upcase (symbol-name (car (last e2))))))
+		    (string< se1 se2)))
+		:key #'car))
+	 :stream muse-stream)))))