[7cfd61]: generate-page.lisp Maximize Restore History

Download this file

generate-page.lisp    78 lines (68 with data), 3.2 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
(defpackage :sbcl-page (:use :cl :xml-mixed-mode :cl-ppcre)
(:export :generate-pages))
(in-package :sbcl-page)
(defmacro push-end (elt list)
`(setf ,list (nconc ,list (list ,elt))))
(defvar *pages* nil)
(defmacro define-page (keyword title name body-fun &key (index-order :middle))
`(progn
(setf *pages* (remove ,keyword *pages* :key #'car))
(push-end (list ,keyword ,title ,name ',body-fun ,index-order) *pages*)))
(defvar *sidebar-links* nil)
(defmacro define-sidebar-link (title url)
`(progn
(setf *sidebar-links* (remove ,title *sidebar-links* :key #'car))
(push-end (list ,title ,url) *sidebar-links*)))
(defparameter *root*
(if #.*compile-file-truename*
(make-pathname :directory (pathname-directory #.*compile-file-truename*))
(if *load-truename*
(make-pathname :directory (pathname-directory *load-truename*))
(if (boundp '*root*)
(symbol-value '*root*)
nil))))
(defun page-link (key)
(concatenate 'string (third (assoc key *pages*)) ".html"))
(defun wrap-page-body-fun (title body-fun)
(<html>
(<head>
(<title> title " - Steel Bank Common Lisp")
<link rel= "stylesheet" type= "text/css" href= "sbcl.css"/>
<meta http-equiv= "Content-Type" content= "text/html;charset=utf-8"/>)
(<body>
(<div class= "header">
(<h1> "Steel Bank Common Lisp"))
(<div class= "sidebar">
(<ul>
(loop for i in (remove :top *pages* :key #'fifth :test-not #'eq)
collect (<li>
(<a href=,(page-link (car i))> (second i))))
(loop for i in (remove :middle *pages* :key #'fifth :test-not #'eq)
collect (<li>
(<a href=,(page-link (car i))> (second i))))
(loop for i in *sidebar-links*
collect (<li>
(<a href=,(second i)>
(first i))))
(loop for i in (remove :bottom *pages* :key #'fifth :test-not #'eq)
collect (<li>
(<a href=,(page-link (car i))> (second i)))))
(<a href= "http://sourceforge.net" class= "no-highlight">
<img src= "http://sourceforge.net/sflogo.php?group_id=1373"
width= "88" height= "31" border= "0" alt="SourceForge Logo"/>)
" "
(<a href= "http://www.sbcl.org/" class= "no-highlight">
<img src= "sbclbutton.png" width= "88" height= "31" border= "0" alt= "(get 'sbcl)"/>))
(<div class= "body-contents">
(<h1> title)
(funcall body-fun)))))
(defun generate-pages ()
(loop for (keyword title fname body-fun) in *pages*
do
(let ((file-name (merge-pathnames (make-pathname :type "html")
(merge-pathnames fname *root*))))
(with-open-file (f file-name :direction :output :if-exists :supersede :external-format :utf-8)
(format f "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">~%")
(let ((*xml-print-mode* :html))
(xml-output-to-stream
f (wrap-page-body-fun title body-fun)))))))