;; (((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)))))