website.lisp 3.54 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
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
78
79
80
81
82
83
84
(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>~%"
		      (build-cell (car f)) (build-cell (car s)) (build-cell (car th))))))))

(defun format-dir-path (path)
  (if (char= (char path (- (length path) 1))
	     #\/)
      (concatenate 'string path "*.*")
      (concatenate 'string path "/*.*")))

(defun get-directory-list (path)
  (loop for dir in (directory (format-dir-path path))
     collect (car (last (pathname-directory dir)))))

(defun get-first-letter (sequence)
  (subseq sequence 0 1))

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

(defun letter-has-changed (previous new)
  (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)))
	(format file "~%<tr><th><a name=\"~A\">~A</a></th></tr>~%~%" upletter upletter))))

(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>

<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
85
&nbsp;~%")
Antoine Martin's avatar
Antoine Martin committed
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
  (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>~%"))

(defun build-index (path file-path)
  (with-open-file (file file-path
			:direction :output
			:if-exists :supersede
			:if-does-not-exist :create)
    (print-index-header file)
    (let* ((dir-list (get-directory-list path))
	   (first-letter (get-first-letter (first dir-list)))
	   (length 0)
	   (pos dir-list))
      (loop until (endp pos)
	 do (if (letter-has-changed first-letter (get-first-letter (car pos)))
		(progn (setq length (+ length 1))
		       (setq pos (cdr pos)))
		(progn
		  (print-index-letter first-letter file)
		  (print-columns dir-list length file)
		  (setq length 0)
		  (setq dir-list pos)
		  (setq first-letter (get-first-letter (car pos))))))
      (print-index-letter first-letter file)
      (print-columns dir-list length file))
    (format file "</body>~%")))