website.lisp 4.37 KB
Newer Older
Antoine Martin's avatar
Antoine Martin committed
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
(in-package :quickref)

(defun get-columns-length (size)
  (if (equal size 1) (values 1 0 0)
      (multiple-value-bind (split remainder) (floor size 3)
	(case remainder
	  (0 (values split split split))
	  (1 (values (+ split 1) (+ split 1) (- split 1)))
	  (2 (values (+ split 1) (+ split 1) split))))))

(defun build-cell (s)
  (format nil "<td></td><td><a href=\"~A\">~A</a></td>" s s))

(defun print-columns (l size file)
  (multiple-value-bind (lfirst lsecond lthird)
      (get-columns-length size)
    (do ((n 0 (+ n 1))
	 (f l (cdr f))
	 (s (nthcdr lfirst l) (cdr s))
	 (th (nthcdr (+ lfirst lsecond) l) (cdr th)))
	((= n lfirst) nil)
      (if (>= n lsecond)
	  (format file
		  "<tr>~A</tr>~%"
		  (build-cell (car f)))
          (if (>= n lthird)
	      (format file
		      "<tr>~A~A</tr>~%"
		      (build-cell (car f)) (build-cell (car s)))
	      (format file
		      "<tr>~A~A~A</tr>~%"
Antoine Martin's avatar
Antoine Martin committed
32
33
34
		      (build-cell (car f))
		      (build-cell (car s))
		      (build-cell (car th))))))))
Antoine Martin's avatar
Antoine Martin committed
35

Antoine Martin's avatar
Antoine Martin committed
36

Antoine Martin's avatar
Antoine Martin committed
37
(defun get-first-letter (sequence)
38
  (subseq (remove-cl-prefix sequence) 0 1))
Antoine Martin's avatar
Antoine Martin committed
39
40
41
42
43
44

(defun is-number (string)
  (let ((chara (char string 0)))
    (and (>= (char-code chara) (char-code #\0))
	 (<= (char-code chara) (char-code #\9)))))

45
(defun letter-has-not-changed (previous new)
Antoine Martin's avatar
Antoine Martin committed
46
47
48
49
50
51
52
53
54
  (if (and (is-number previous)
	   (is-number new))
      t
      (string= previous new)))

(defun print-index-letter (letter file)
  (if (is-number letter)
      (format file "~%<tr><th><a name=\"number\">#</a></th></tr>~%~%")
      (let ((upletter (string-upcase letter)))
Antoine Martin's avatar
Antoine Martin committed
55
56
	(format file "~%<tr><th><a name=\"~A\">~A</a></th></tr>~%~%"
		upletter upletter))))
Antoine Martin's avatar
Antoine Martin committed
57
58
59
60
61
62

(defun print-index-header (file)
  (format file "<!DOCTYPE html>
<html>
<head>
<title>Quickref</title>
63
64
<link rel=\"stylesheet\" type=\"text/css\" href=\"/document.css\">
<link rel=\"stylesheet\" type=\"text/css\" href=\"/main.css\">
Antoine Martin's avatar
Antoine Martin committed
65
66
67
68
69
70
71
72
</head>
<body>

<div class=\"header\">
<p>Documentation generated with <a href=\"https://www.lrde.epita.fr/~~didier/software/lisp/misc.php#declt\">Declt</a>.</p>
</div>

<h1>Quickref</h1>
Antoine Martin's avatar
Antoine Martin committed
73
<h4>Reference manuals for Quicklisp libraries.</h4>
Antoine Martin's avatar
Antoine Martin committed
74
75
76
77
78
79

<div class=\"floating\">
<table><tr><th valign=\"top\">Jump to: &nbsp; </th>
<td>

<a class=\"summary-letter\" href=\"#number\"><b>#</b></a>
Antoine Martin's avatar
Antoine Martin committed
80
&nbsp;~%")
Antoine Martin's avatar
Antoine Martin committed
81
82
83
84
85
86
87
88
89
90
  (loop for c across "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
     do (format file "<a class=\"summary-letter\" href=\"#~C\"><b>~C</b></a>
&nbsp;~%" c c))
  (format file "</td>
</tr></table>
</div>

<table class=\"index-cp\" border=\"0\">
<tr><td></td><th align=\"left\">Index Entry</th></tr>~%"))

91
(defun build-index ()
Antoine Martin's avatar
Antoine Martin committed
92
  (let ((quickref-dir (from-homedir "quickref/")))
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
    (with-open-file (file (merge-pathnames "index.html" quickref-dir)
			  :direction :output
			  :if-exists :supersede
			  :if-does-not-exist :create)
      (print-index-header file)
      (let* ((dir-list (sort (get-directory-list quickref-dir) #'string<
			     :key #'remove-cl-prefix))
	     (current-letter (get-first-letter (first dir-list)))
	     (length 0)
	     (pos dir-list))
	(loop until (endp pos)
	   do (if (letter-has-not-changed current-letter (get-first-letter (car pos)))
		  (progn (setq length (+ length 1))
			 (setq pos (cdr pos)))
		  (progn
		    (print-index-letter current-letter file)
		    (print-columns dir-list length file)
		    (setq length 0)
		    (setq dir-list pos)
		    (setq current-letter (get-first-letter (car pos))))))
	(print-index-letter current-letter file)
	(print-columns dir-list length file))
      (format file "</body>~%"))))
Antoine Martin's avatar
Antoine Martin committed
116

Antoine Martin's avatar
Antoine Martin committed
117
(defun log-texi-error (err texi)
Antoine Martin's avatar
Antoine Martin committed
118
119
  (with-open-file (file (format nil "texi-logfiles/~A.logfile"
				(pathname-name texi))
Antoine Martin's avatar
Antoine Martin committed
120
			:direction :output
Antoine Martin's avatar
Antoine Martin committed
121
122
123
124
			:if-exists :supersede
			:if-does-not-exist :create)
    (format file err)))

Antoine Martin's avatar
Antoine Martin committed
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
(defun build-texi (texi makeinfo-path)
  (let ((out (with-output-to-string (out)
	       (sb-ext:run-program
		makeinfo-path
		(list "--html" (namestring texi)
		      "-o" (namestring
			    (from-homedir
			     (format nil "quickref/~A" (pathname-name texi))))
		      "--css-ref" "/document.css"
		      "-c" "TOP_NODE_UP_URL=/"
		      "--force")
		:output out))))
    (when (not (string= out ""))
      (log-texi-error out texi))))

140
(defun build-texis (makeinfo-path)
Antoine Martin's avatar
Antoine Martin committed
141
142
143
144
  (let ((quickref-dir (from-homedir "quickref/")))
    (if (probe-file quickref-dir)
	(clean-directory quickref-dir)
	(ensure-directories-exist quickref-dir)))
145
  (let ((texis (get-texi-pathnames)))
Antoine Martin's avatar
Antoine Martin committed
146
    (dolist (texi texis)
Antoine Martin's avatar
Antoine Martin committed
147
      (build-texi texi makeinfo-path))))