1 ;; (((author name as symbols)
3 ;; ("book name" :fiction-or-nonfiction rating/10 "description")))
5 (asdf:oos
'asdf
:load-op
:split-sequence
)
6 (asdf:oos
'asdf
:load-op
:html-template
)
10 (defparameter *book-pathname
*
11 #p
"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")
13 (defparameter *template-pathname
*
14 #p
"/home/clinton/html/muse/site-support/templates/book-list.template")
16 (defparameter *muse-pathname
*
17 #p
"/home/clinton/html/muse/site/unknownlamer.org-repo/Book List.muse")
19 ;; need to collapse whitespace in descriptions
21 ;; (defun collapse-whitespace (string)
22 ;; (format nil "~{~A ~}"
23 ;; (split-sequence:split-sequence-if
24 ;; (lambda (char) (member char '(#\space #\newline))) string
25 ;; :remove-empty-subseqs t)))
27 (defun collapse-whitespace (string)
30 (defun book-entry-vars (book)
31 (destructuring-bind (title fiction?
&optional rating description
)
36 :rating-bad
,(if rating
(- 10 rating
))
37 :classification
,(case fiction?
39 (:nonfiction
"Nonfiction"))
40 :description
,(collapse-whitespace description
))))
42 (defun author-vars (author)
43 (destructuring-bind (name description
&rest books
)
45 `(:name
,(format nil
"~{~A ~}" name
)
46 :description
,description
47 :books
,(mapcar #'book-entry-vars books
))))
49 (defun book-database-vars (book-database)
50 `(:authors
,(mapcar #'author-vars book-database
)))
52 (defun dump-muse-books-file (&key
(muse-path *muse-pathname
*)
53 (book-path *book-pathname
*)
54 (template-path *template-pathname
*)
57 (> (file-write-date book-path
) (file-write-date muse-path
))
58 (> (file-write-date template-path
) (file-write-date muse-path
)))
59 (with-open-file (muse-stream muse-path
61 :element-type
'extended-char
63 :if-does-not-exist
:create
)
64 (let ((html-template:*string-modifier
* #'identity
)
65 (html-template:*template-start-marker
* "<<")
66 (html-template:*template-end-marker
* ">>"))
67 (html-template:fill-and-print-template
70 (sort (copy-list (with-open-file
71 (book-stream book-path
:element-type
'extended-char
)
74 (let ((se1 (string-upcase (symbol-name (car (last e1
)))))
75 (se2 (string-upcase (symbol-name (car (last e2
))))))
78 :stream muse-stream
)))))