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

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

Antoine Martin's avatar
Antoine Martin committed
123
(defun build-texis (path-to-texis texinfo-path)
124
  (clean-directory "quickref")
Antoine Martin's avatar
Antoine Martin committed
125
126
  (let ((texis (get-texi-pathnames path-to-texis)))
    (dolist (texi texis)
Antoine Martin's avatar
Antoine Martin committed
127
128
129
130
131
132
133
134
135
136
137
      (let ((out (with-output-to-string (out)
		   (sb-ext:run-program texinfo-path
				       (list "--html" (namestring texi)
					     "-o" (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))))))