website.lisp 3.8 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
63
64
65
66
67
68
69
70
71
72

(defun print-index-header (file)
  (format file "<!DOCTYPE html>
<html>
<head>
<title>Quickref</title>
<link rel=\"stylesheet\" type=\"text/css\" href=\"https://sirgazil.bitbucket.io/static/docs/css/texinfo/tip/document.css\">
<link rel=\"stylesheet\" type=\"text/css\" href=\"main.css\">
</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
116

(defun build-texis (path-to-texis texinfo-path)
117
  (remove-directory "quickref")
Antoine Martin's avatar
Antoine Martin committed
118
119
120
121
122
123
  (let ((texis (get-texi-pathnames path-to-texis)))
    (dolist (texi texis)
      (sb-ext:run-program texinfo-path
			  (list "--html" (namestring texi)
				"-o" (format nil "quickref/~A"
					     (pathname-name texi))
Antoine Martin's avatar
Antoine Martin committed
124
				"--css-ref" "/document.css"
Antoine Martin's avatar
Antoine Martin committed
125
126
				"-c" "TOP_NODE_UP_URL=/")
			  :output *standard-output*))))