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
85
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
(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>
&nbsp~%")
  (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>~%")))