 |
generator.lisp - cl-yag - Common Lisp Yet Another website Generator |
 |
git clone git://bitreich.org/cl-yag/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws… |
 |
Log |
|
Files |
|
Refs |
|
Tags |
|
README |
|
LICENSE |
|
--- |
|
generator.lisp (20812B) |
|
--- |
|
1 ;;;; GLOBAL VARIABLES |
|
2 |
|
3 (defparameter *articles* '()) |
|
4 (defparameter *converters* '()) |
|
5 (defparameter *days* '("Monday" "Tuesday" "Wednesday" "Thursday" |
|
6 "Friday" "Saturday" "Sunday")) |
|
7 (defparameter *months* '("January" "February" "March" "April" |
|
8 "May" "June" "July" "August" "September" |
|
9 "October" "November" "December")) |
|
10 |
|
11 ;; structure to store links |
|
12 (defstruct article title tag date id tiny author rawdate converter) |
|
13 (defstruct converter name command extension) |
|
14 |
|
15 ;;;; FUNCTIONS |
|
16 |
|
17 (require 'asdf) |
|
18 |
|
19 ;; return the day of the week |
|
20 (defun get-day-of-week(day month year) |
|
21 (multiple-value-bind |
|
22 (second minute hour date month year day-of-week dst-p tz) |
|
23 (decode-universal-time (encode-universal-time 0 0 0 day month year)) |
|
24 (declare (ignore second minute hour date month year dst-p tz)) |
|
25 day-of-week)) |
|
26 |
|
27 ;; parse the date to |
|
28 (defun date-parse(date) |
|
29 (if (= 8 (length date)) |
|
30 (let* ((year (parse-integer date :start 0 :end 4)) |
|
31 (monthnum (parse-integer date :start 4 :end 6)) |
|
32 (daynum (parse-integer date :start 6 :end 8)) |
|
33 (day (nth (get-day-of-week daynum monthnum year) *days… |
|
34 (month (nth (- monthnum 1) *months*))) |
|
35 (list |
|
36 :dayname day |
|
37 :daynumber daynum |
|
38 :monthname month |
|
39 :monthnumber monthnum |
|
40 :year year)) |
|
41 nil)) |
|
42 |
|
43 (defun post(&optional &key title tag date id (tiny nil) (author (getf *c… |
|
44 (push (make-article :title title |
|
45 :tag tag |
|
46 :date (date-parse date) |
|
47 :rawdate date |
|
48 :tiny tiny |
|
49 :author author |
|
50 :id id |
|
51 :converter converter) |
|
52 *articles*)) |
|
53 |
|
54 ;; we add a converter to the list of the one availables |
|
55 (defun converter(&optional &key name command extension) |
|
56 (setf *converters* |
|
57 (append |
|
58 (list name |
|
59 (make-converter :name name |
|
60 :command command |
|
61 :extension extension)) |
|
62 *converters*))) |
|
63 |
|
64 ;; load data from metadata and load config |
|
65 (load "data/articles.lisp") |
|
66 (setf *articles* (reverse *articles*)) |
|
67 |
|
68 |
|
69 ;; common-lisp don't have a replace string function natively |
|
70 (defun replace-all (string part replacement &key (test #'char=)) |
|
71 (with-output-to-string (out) |
|
72 (loop with part-length = (length part) |
|
73 for old-pos = 0 then (+ pos part-length) |
|
74 for pos = (search part string |
|
75 :start2 old-pos |
|
76 :test test) |
|
77 do (write-string string out |
|
78 :start old-pos |
|
79 :end (or pos (length string))) |
|
80 when pos do (write-string replacement out) |
|
81 while pos))) |
|
82 |
|
83 ;; common-lisp don't have a split string function natively |
|
84 (defun split-str(text &optional (separator #\Space)) |
|
85 "this function split a string with separator and return a list" |
|
86 (let ((text (concatenate 'string text (string separator)))) |
|
87 (loop for char across text |
|
88 counting char into count |
|
89 when (char= char separator) |
|
90 collect |
|
91 ;; we look at the position of the left separator from right to le… |
|
92 (let ((left-separator-position (position separator text :from-e… |
|
93 (subseq text |
|
94 ;; if we can't find a separator at the left of the cu… |
|
95 ;; the string |
|
96 (if left-separator-position (+ 1 left-separator-posit… |
|
97 (- count 1)))))) |
|
98 |
|
99 ;; load a file as a string |
|
100 ;; we escape ~ to avoid failures with format |
|
101 (defun load-file(path) |
|
102 (if (probe-file path) |
|
103 (with-open-file (stream path) |
|
104 (let ((contents (make-string (file-length stream)))) |
|
105 (read-sequence contents stream) |
|
106 contents)) |
|
107 (progn |
|
108 (format t "ERROR : file ~a not found. Aborting~%" path) |
|
109 (quit)))) |
|
110 |
|
111 ;; save a string in a file |
|
112 (defun save-file(path data) |
|
113 (with-open-file (stream path :direction :output :if-exists :supersede) |
|
114 (write-sequence data stream))) |
|
115 |
|
116 ;; simplify the str replace work |
|
117 (defmacro template(before &body after) |
|
118 `(progn |
|
119 (setf output (replace-all output ,before ,@after)))) |
|
120 |
|
121 ;; get the converter object of "article" |
|
122 (defmacro with-converter(&body code) |
|
123 `(progn |
|
124 (let ((converter-name (if (article-converter article) |
|
125 (article-converter article) |
|
126 (getf *config* :default-converter)))) |
|
127 (let ((converter-object (getf *converters* converter-name))) |
|
128 ,@code)))) |
|
129 |
|
130 ;; generate the html file from the source file |
|
131 ;; using the converter associated with the post |
|
132 (defun use-converter-to-html(filename &optional (converter-name nil)) |
|
133 (let* ((converter-object (getf *converters* |
|
134 (or converter-name |
|
135 converter-name |
|
136 (getf *config* :default-converter))… |
|
137 (output (converter-command converter-object)) |
|
138 (src-file (format nil "~a~a" filename (converter-extension conv… |
|
139 (dst-file (format nil "temp/data/~a.html" filename )) |
|
140 (full-src-file (format nil "data/~a" src-file))) |
|
141 ;; skip generating if the destination exists |
|
142 ;; and is more recent than source |
|
143 (unless (and |
|
144 (probe-file dst-file) |
|
145 (>= |
|
146 (file-write-date dst-file) |
|
147 (file-write-date full-src-file))) |
|
148 (ensure-directories-exist "temp/data/") |
|
149 (template "%IN" src-file) |
|
150 (template "%OUT" dst-file) |
|
151 (format t "~a~%" output) |
|
152 (uiop:run-program output)))) |
|
153 |
|
154 ;; format the date |
|
155 (defun date-format(format date) |
|
156 (let ((output format)) |
|
157 (template "%DayName" (getf date :dayname)) |
|
158 (template "%DayNumber" (format nil "~2,'0d" (getf date :daynumber)… |
|
159 (template "%MonthName" (getf date :monthname)) |
|
160 (template "%MonthNumber" (format nil "~2,'0d" (getf date :monthnumbe… |
|
161 (template "%Year" (write-to-string (getf date :year ))) |
|
162 output)) |
|
163 |
|
164 ;; simplify the declaration of a new page type |
|
165 (defmacro prepare(template &body code) |
|
166 `(progn |
|
167 (let ((output (load-file ,template))) |
|
168 ,@code |
|
169 output))) |
|
170 |
|
171 ;; simplify the file saving by using the layout |
|
172 (defmacro generate(name &body data) |
|
173 `(progn |
|
174 (save-file ,name (generate-layout ,@data)))) |
|
175 |
|
176 ;; generate a gemini index file |
|
177 (defun generate-gemini-index(articles) |
|
178 (let ((output (load-file "templates/gemini_head.tpl"))) |
|
179 (dolist (article articles) |
|
180 (setf output |
|
181 (string |
|
182 (concatenate 'string output |
|
183 (format nil "=> ~a/articles/~a.gmi ~a-~2,'0d-~… |
|
184 (getf *config* :gemini-path) |
|
185 (article-id article) |
|
186 (getf (article-date article) :year) |
|
187 (getf (article-date article) :monthnum… |
|
188 (getf (article-date article) :daynumbe… |
|
189 (article-title article)))))) |
|
190 output)) |
|
191 |
|
192 ;; generate a gopher index file |
|
193 (defun generate-gopher-index(articles) |
|
194 (let ((output (load-file "templates/gopher_head.tpl"))) |
|
195 (dolist (article articles) |
|
196 (setf output |
|
197 (string |
|
198 (concatenate 'string output |
|
199 (format nil (getf *config* :gopher-format) |
|
200 0 ;;;; gopher type, 0 for text files |
|
201 ;; here we create a 80 width char stri… |
|
202 ;; and date on the right |
|
203 ;; we truncate the article title if it… |
|
204 (let ((title (format nil "~80a" |
|
205 (if (< 80 (length… |
|
206 (subseq (arti… |
|
207 (article-titl… |
|
208 (replace title (article-rawdate arti… |
|
209 (concatenate 'string |
|
210 (getf *config* :gopher-pa… |
|
211 (getf *config* :gopher-server) |
|
212 (getf *config* :gopher-port) |
|
213 ))))) |
|
214 output)) |
|
215 |
|
216 ;; generate the list of tags |
|
217 (defun articles-by-tag() |
|
218 (let ((tag-list)) |
|
219 (loop for article in *articles* do |
|
220 (when (article-tag article) ;; we don't want an error if no tag |
|
221 (loop for tag in (split-str (article-tag article)) do ;; for… |
|
222 (setf (getf tag-list (intern tag "KEYWORD")) ;; we cre… |
|
223 (list |
|
224 :name tag |
|
225 :value (push (article-id article) (getf (getf t… |
|
226 (loop for i from 1 to (length tag-list) by 2 collect ;; removing the… |
|
227 (nth i tag-list)))) |
|
228 |
|
229 ;; generates the html of the list of tags for an article |
|
230 (defun get-tag-list-article(&optional article) |
|
231 (apply #'concatenate 'string |
|
232 (mapcar #'(lambda (item) |
|
233 (prepare "templates/one-tag.tpl" (template "%%Name%… |
|
234 (split-str (article-tag article))))) |
|
235 |
|
236 ;; generates the html of the whole list of tags |
|
237 (defun get-tag-list() |
|
238 (apply #'concatenate 'string |
|
239 (mapcar #'(lambda (item) |
|
240 (prepare "templates/one-tag.tpl" |
|
241 (template "%%Name%%" (getf item :name)))) |
|
242 (articles-by-tag)))) |
|
243 |
|
244 |
|
245 ;; generates the html of only one article |
|
246 ;; this is called in a loop to produce the homepage |
|
247 (defun create-article(article &optional &key (tiny t) (no-text nil)) |
|
248 (prepare "templates/article.tpl" |
|
249 (template "%%Author%%" (let ((author (article-author article)… |
|
250 (or author (getf *config* :webmaster… |
|
251 (template "%%Date%%" (date-format (getf *config* :date-form… |
|
252 (article-date article))) |
|
253 (template "%%Raw-Date%%" (article-rawdate article)) |
|
254 (template "%%Title%%" (article-title article)) |
|
255 (template "%%Id%%" (article-id article)) |
|
256 (template "%%Tags%%" (get-tag-list-article article)) |
|
257 (template "%%Date-Url%%" (date-format "%Year-%MonthNumber-%D… |
|
258 (article-date article)… |
|
259 (template "%%Text%%" (if no-text |
|
260 "" |
|
261 (if (and tiny (article-tiny articl… |
|
262 (format nil "<p>~a</p>" (artic… |
|
263 (load-file (format nil "temp/d… |
|
264 |
|
265 ;; return a html string |
|
266 ;; produce the code of a whole page with title+layout with the parameter… |
|
267 (defun generate-layout(body &optional &key (title nil)) |
|
268 (prepare "templates/layout.tpl" |
|
269 (template "%%Title%%" (if title title (getf *config* :title))) |
|
270 (template "%%Tags%%" (get-tag-list)) |
|
271 (template "%%Body%%" body) |
|
272 output)) |
|
273 |
|
274 |
|
275 ;; html generation of index homepage |
|
276 (defun generate-semi-mainpage(&key (tiny t) (no-text nil)) |
|
277 (apply #'concatenate 'string |
|
278 (loop for article in *articles* collect |
|
279 (create-article article :tiny tiny :no-text no-text)))) |
|
280 |
|
281 ;; html generation of a tag homepage |
|
282 (defun generate-tag-mainpage(articles-in-tag) |
|
283 (apply #'concatenate 'string |
|
284 (loop for article in *articles* |
|
285 when (member (article-id article) articles-in-tag :test #'eq… |
|
286 collect (create-article article :tiny t)))) |
|
287 |
|
288 ;; xml generation of the items for the rss |
|
289 (defun generate-rss-item(&key (gopher nil)) |
|
290 (apply #'concatenate 'string |
|
291 (loop for article in *articles* |
|
292 for i from 1 to (min (length *articles*) (getf *config* :rss… |
|
293 collect |
|
294 (prepare "templates/rss-item.tpl" |
|
295 (template "%%Title%%" (article-title article)) |
|
296 (template "%%Description%%" (load-file (format ni… |
|
297 (template "%%Date%%" (format nil |
|
298 (date-format "~a, %D… |
|
299 (articl… |
|
300 (subseq (getf (artic… |
|
301 (subseq (getf (artic… |
|
302 (template "%%Url%%" |
|
303 (if gopher |
|
304 (format nil "gopher://~a:~d/0~a/art… |
|
305 (getf *config* :gopher-serv… |
|
306 (getf *config* :gopher-port) |
|
307 (getf *config* :gopher-path) |
|
308 (article-id article)) |
|
309 (format nil "~d~d-~d.html" |
|
310 (getf *config* :url) |
|
311 (date-format "%Year-%MonthN… |
|
312 (article-date … |
|
313 (article-id article)))))))) |
|
314 |
|
315 |
|
316 ;; Generate the rss xml data |
|
317 (defun generate-rss(&key (gopher nil)) |
|
318 (prepare "templates/rss.tpl" |
|
319 (template "%%Description%%" (getf *config* :description)) |
|
320 (template "%%Title%%" (getf *config* :title)) |
|
321 (template "%%Url%%" (getf *config* :url)) |
|
322 (template "%%Items%%" (generate-rss-item :gopher gopher)))) |
|
323 |
|
324 ;; We do all the website |
|
325 (defun create-html-site() |
|
326 |
|
327 ;; produce each article file |
|
328 (loop for article in *articles* |
|
329 do |
|
330 ;; use the article's converter to get html code of it |
|
331 (use-converter-to-html (article-id article) (article-converter ar… |
|
332 |
|
333 (generate (format nil "output/html/~d-~d.html" |
|
334 (date-format "%Year-%MonthNumber-%DayNumber" |
|
335 (article-date article)) |
|
336 (article-id article)) |
|
337 (create-article article :tiny nil) |
|
338 :title (concatenate 'string (getf *config* :title) " … |
|
339 |
|
340 ;; produce index.html |
|
341 (generate "output/html/index.html" (generate-semi-mainpage)) |
|
342 |
|
343 ;; produce index-titles.html where there are only articles titles |
|
344 (generate "output/html/index-titles.html" (generate-semi-mainpage :no-… |
|
345 |
|
346 ;; produce index file for each tag |
|
347 (loop for tag in (articles-by-tag) do |
|
348 (generate (format nil "output/html/tag-~d.html" (getf tag :NAME)) |
|
349 (generate-tag-mainpage (getf tag :VALUE)))) |
|
350 |
|
351 ;; generate rss gopher in html folder if gopher is t |
|
352 (when (getf *config* :gopher) |
|
353 (save-file "output/html/rss-gopher.xml" (generate-rss :gopher t))) |
|
354 |
|
355 ;;(generate-file-rss) |
|
356 (save-file "output/html/rss.xml" (generate-rss))) |
|
357 |
|
358 ;; we do all the gemini capsule |
|
359 (defun create-gemini-capsule() |
|
360 |
|
361 ;; produce the index.gmi file |
|
362 (save-file (concatenate 'string "output/gemini/" (getf *config* :gemin… |
|
363 (generate-gemini-index *articles*)) |
|
364 |
|
365 ;; produce a tag list menu |
|
366 (let* ((directory-path "output/gemini/_tags_/") |
|
367 (index-path (concatenate 'string directory-path (getf *config* … |
|
368 (ensure-directories-exist directory-path) |
|
369 (save-file index-path |
|
370 (let ((output (load-file "templates/gemini_head.tpl"))) |
|
371 (loop for tag in |
|
372 ;; sort tags per articles in it |
|
373 (sort (articles-by-tag) #'> |
|
374 :key #'(lambda (x) (length (getf x :value)))) |
|
375 do |
|
376 (setf output |
|
377 (string |
|
378 (concatenate |
|
379 'string output |
|
380 (format nil "=> ~a/~a/index.gmi ~a ~d~%" |
|
381 (getf *config* :gemini-path) |
|
382 (getf tag :name) |
|
383 (getf tag :name) |
|
384 (length (getf tag :value))))))) |
|
385 output))) |
|
386 |
|
387 ;; produce each tag gemini index |
|
388 (loop for tag in (articles-by-tag) do |
|
389 (let* ((directory-path (concatenate 'string "output/gemini/" (get… |
|
390 (index-path (concatenate 'string directory-path (getf *con… |
|
391 (articles-with-tag (loop for article in *articles* |
|
392 when (member (article-id article) (g… |
|
393 collect article))) |
|
394 (ensure-directories-exist directory-path) |
|
395 (save-file index-path (generate-gemini-index articles-with-tag)… |
|
396 |
|
397 ;; produce each article file (adding some headers) |
|
398 (loop for article in *articles* |
|
399 do |
|
400 (with-converter |
|
401 (let ((id (article-id article))) |
|
402 (save-file (format nil "output/gemini/articles/~a.gmi" id) |
|
403 (format nil "~{~a~}" |
|
404 (list |
|
405 "Title : " (article-title article) #\Ne… |
|
406 "Author: " (article-author article) #\N… |
|
407 "Date : " (date-format (getf *config* … |
|
408 "Tags : " (article-tag article) #\Newl… |
|
409 (load-file (format nil "data/~d~d" id (… |
|
410 |
|
411 ;; we do all the gopher hole |
|
412 (defun create-gopher-hole() |
|
413 |
|
414 ;;(generate-file-rss) |
|
415 (save-file "output/gopher/rss.xml" (generate-rss :gopher t)) |
|
416 |
|
417 ;; produce the gophermap file |
|
418 (save-file (concatenate 'string "output/gopher/" (getf *config* :gophe… |
|
419 (generate-gopher-index *articles*)) |
|
420 |
|
421 ;; produce a tag list menu |
|
422 (let* ((directory-path "output/gopher/_tags_/") |
|
423 (index-path (concatenate 'string directory-path (getf *config* … |
|
424 (ensure-directories-exist directory-path) |
|
425 (save-file index-path |
|
426 (let ((output (load-file "templates/gopher_head.tpl"))) |
|
427 (loop for tag in |
|
428 ;; sort tags per articles in it |
|
429 (sort (articles-by-tag) #'> |
|
430 :key #'(lambda (x) (length (getf x :value)))) |
|
431 do |
|
432 (setf output |
|
433 (string |
|
434 (concatenate |
|
435 'string output |
|
436 (format nil (getf *config* :gopher-format) |
|
437 1 ;; gopher type, 1 for menus |
|
438 ;; here we create a 72 width char … |
|
439 ;; and number of articles on the r… |
|
440 ;; we truncate the article title i… |
|
441 (let ((title (format nil "~72a" |
|
442 (if (< 72 (le… |
|
443 (subseq (… |
|
444 (getf tag… |
|
445 (article-number (format nil … |
|
446 (replace title article-number :s… |
|
447 (concatenate 'string |
|
448 (getf *config* :gophe… |
|
449 (getf *config* :gopher-server) |
|
450 (getf *config* :gopher-port) |
|
451 ))))) |
|
452 output))) |
|
453 |
|
454 ;; produce each tag gophermap index |
|
455 (loop for tag in (articles-by-tag) do |
|
456 (let* ((directory-path (concatenate 'string "output/gopher/" (get… |
|
457 (index-path (concatenate 'string directory-path (getf *con… |
|
458 (articles-with-tag (loop for article in *articles* |
|
459 when (member (article-id article) (g… |
|
460 collect article))) |
|
461 (ensure-directories-exist directory-path) |
|
462 (save-file index-path (generate-gopher-index articles-with-tag)… |
|
463 |
|
464 ;; produce each article file (adding some headers) |
|
465 (loop for article in *articles* |
|
466 do |
|
467 (with-converter |
|
468 (let ((id (article-id article))) |
|
469 (save-file (format nil "output/gopher/article-~d.txt" id) |
|
470 (format nil "Title: ~a~%Author: ~a~%Date: ~a~%Ta… |
|
471 (article-title article) |
|
472 (article-author article) |
|
473 (date-format (getf *config* :date-forma… |
|
474 (article-tag article) |
|
475 (load-file (format nil "data/~d… |
|
476 |
|
477 |
|
478 ;; This is function called when running the tool |
|
479 (defun generate-site() |
|
480 (if (getf *config* :html) |
|
481 (create-html-site)) |
|
482 (if (getf *config* :gemini) |
|
483 (create-gemini-capsule)) |
|
484 (if (getf *config* :gopher) |
|
485 (create-gopher-hole))) |
|
486 |
|
487 ;;;; EXECUTION |
|
488 |
|
489 (generate-site) |
|
490 |
|
491 (quit) |
