258 lines
9.4 KiB
Common Lisp
258 lines
9.4 KiB
Common Lisp
(defparameter *articles* '())
|
|
(defparameter *converters* '())
|
|
|
|
;; structure to store links
|
|
(defstruct article title tag date id tiny author short)
|
|
(defstruct converter name command extension)
|
|
|
|
(defun post(&optional &key title tag date id (tiny nil) (author nil) (short nil))
|
|
(push (make-article :title title
|
|
:tag tag
|
|
:date date
|
|
:tiny tiny
|
|
:author author
|
|
:short short
|
|
:id id)
|
|
*articles*))
|
|
|
|
;; we add a converter to the list of the one availables
|
|
(defun converter(&optional &key name command extension)
|
|
(push (make-converter :name name
|
|
:command command
|
|
:extension extension)
|
|
*converters*))
|
|
|
|
(load "data/articles.lisp")
|
|
(setf *articles* (reverse *articles*))
|
|
|
|
|
|
;; common-lisp don't have a replace string function natively
|
|
(defun replace-all (string part replacement &key (test #'char=))
|
|
(with-output-to-string (out)
|
|
(loop with part-length = (length part)
|
|
for old-pos = 0 then (+ pos part-length)
|
|
for pos = (search part string
|
|
:start2 old-pos
|
|
:test test)
|
|
do (write-string string out
|
|
:start old-pos
|
|
:end (or pos (length string)))
|
|
when pos do (write-string replacement out)
|
|
while pos)))
|
|
|
|
;; common-lisp don't have a split string function natively
|
|
(defun split-str(text &optional (separator #\Space))
|
|
"this function split a string with separator and return a list"
|
|
(let ((text (concatenate 'string text (string separator))))
|
|
(loop for char across text
|
|
counting char into count
|
|
when (char= char separator)
|
|
collect
|
|
;; we look at the position of the left separator from right to left
|
|
(let ((left-separator-position (position separator text :from-end t :end (- count 1))))
|
|
(subseq text
|
|
;; if we can't find a separator at the left of the current, then it's the start of
|
|
;; the string
|
|
(if left-separator-position (+ 1 left-separator-position) 0)
|
|
(- count 1))))))
|
|
|
|
;; load a file as a string
|
|
;; we escape ~ to avoid failures with format
|
|
(defun load-file(path)
|
|
(if (probe-file path)
|
|
(replace-all
|
|
(apply #'concatenate 'string
|
|
(with-open-file (stream path)
|
|
(loop for line = (read-line stream nil)
|
|
while line
|
|
collect
|
|
(format nil "~a~%" line))))
|
|
"~" "~~")
|
|
(progn
|
|
(format t "ERROR : file ~a not found. Aborting~%" path)
|
|
(quit))))
|
|
|
|
;; save a string in a file
|
|
(defun save-file(path data)
|
|
(with-open-file (stream path :direction :output :if-exists :supersede)
|
|
(format stream data)))
|
|
|
|
;; simplify the str replace work
|
|
(defmacro template(before &body after)
|
|
`(progn
|
|
(setf output (replace-all output ,before ,@after))))
|
|
|
|
;; simplify the declaration of a new page type
|
|
(defmacro prepare(template &body code)
|
|
`(progn
|
|
(let ((output (load-file ,template)))
|
|
,@code
|
|
output)))
|
|
|
|
;; simplify the file saving by using the layout
|
|
(defmacro generate(name &body data)
|
|
`(progn
|
|
(save-file ,name (generate-layout ,@data))))
|
|
|
|
;; generate the list of tags
|
|
(defun articles-by-tag()
|
|
(let ((tag-list))
|
|
(loop for article in *articles* do
|
|
(when (article-tag article) ;; we don't want an error if no tag
|
|
(loop for tag in (split-str (article-tag article)) do ;; for each word in tag keyword
|
|
(setf (getf tag-list (intern tag "KEYWORD")) ;; we create the keyword is inexistent and add ID to :value
|
|
(list
|
|
:name tag
|
|
:value (push (article-id article) (getf (getf tag-list (intern tag "KEYWORD")) :value)))))))
|
|
(loop for i from 1 to (length tag-list) by 2 collect ;; removing the keywords
|
|
(nth i tag-list))))
|
|
|
|
;; generates the html of the list of tags for an article
|
|
(defun get-tag-list-article(&optional article)
|
|
(apply #'concatenate 'string
|
|
(mapcar #'(lambda (item)
|
|
(prepare "templates/one-tag.tpl" (template "%%Name%%" item)))
|
|
(split-str (article-tag article)))))
|
|
|
|
;; generates the html of the whole list of tags
|
|
(defun get-tag-list()
|
|
(apply #'concatenate 'string
|
|
(mapcar #'(lambda (item)
|
|
(prepare "templates/one-tag.tpl"
|
|
(template "%%Name%%" (getf item :name))))
|
|
(articles-by-tag))))
|
|
|
|
|
|
;; generates the html of one only article
|
|
;; this is called in a loop to produce the homepage
|
|
(defun create-article(article &optional &key (tiny t) (no-text nil))
|
|
(prepare "templates/article.tpl"
|
|
(template "%%Author%%" (let ((author (article-author article)))
|
|
(or author (getf *config* :webmaster))))
|
|
(template "%%Date%%" (article-date article))
|
|
(template "%%Title%%" (article-title article))
|
|
(template "%%Id%%" (article-id article))
|
|
(template "%%Tags%%" (get-tag-list-article article))
|
|
(template "%%Text%%" (if no-text
|
|
""
|
|
(if (and tiny (article-tiny article))
|
|
(article-tiny article)
|
|
(load-file (format nil "temp/data/~d.html" (article-id article))))))))
|
|
|
|
;; return a html string
|
|
;; produce the code of a whole page with title+layout with the parameter as the content
|
|
(defun generate-layout(body &optional &key (title nil))
|
|
(prepare "templates/layout.tpl"
|
|
(template "%%Title%%" (if title title (getf *config* :title)))
|
|
(template "%%Tags%%" (get-tag-list))
|
|
(template "%%Body%%" body)
|
|
output))
|
|
|
|
|
|
;; html generation of index homepage
|
|
(defun generate-semi-mainpage(&key (tiny t) (no-text nil))
|
|
(apply #'concatenate 'string
|
|
(loop for article in *articles* collect
|
|
(create-article article :tiny tiny :no-text no-text))))
|
|
|
|
;; html generation of a tag homepage
|
|
(defun generate-tag-mainpage(articles-in-tag)
|
|
(apply #'concatenate 'string
|
|
(loop for article in *articles*
|
|
when (member (article-id article) articles-in-tag :test #'equal)
|
|
collect (create-article article :tiny t))))
|
|
|
|
;; xml generation of the items for the rss
|
|
(defun generate-rss-item()
|
|
(apply #'concatenate 'string
|
|
(loop for article in *articles*
|
|
for i from 1 to (if (> (length *articles*) (getf *config* :rss-item-number)) (getf *config* :rss-item-number) (length *articles*))
|
|
collect
|
|
(prepare "templates/rss-item.tpl"
|
|
(template "%%Title%%" (article-title article))
|
|
(template "%%Description%%" (load-file (format nil "temp/data/~d.html" (article-id article))))
|
|
(template "%%Url%%"
|
|
(format nil "~darticle-~d.html"
|
|
(getf *config* :url)
|
|
(article-id article)))))))
|
|
|
|
;; Generate the rss xml data
|
|
(defun generate-rss()
|
|
(prepare "templates/rss.tpl"
|
|
(template "%%Description%%" (getf *config* :description))
|
|
(template "%%Title%%" (getf *config* :title))
|
|
(template "%%Url%%" (getf *config* :url))
|
|
(template "%%Items%%" (generate-rss-item))))
|
|
|
|
;; We do all the website
|
|
(defun create-html-site()
|
|
;; produce index.html
|
|
(generate "output/html/index.html" (generate-semi-mainpage))
|
|
|
|
;; produce index-titles.html where there are only articles titles
|
|
(generate "output/html/index-titles.html" (generate-semi-mainpage :no-text t))
|
|
|
|
;; produce each article file
|
|
(dolist (article *articles*)
|
|
(generate (format nil "output/html/article-~d.html" (article-id article))
|
|
(create-article article :tiny nil)
|
|
:title (concatenate 'string (getf *config* :title) " : " (article-title article))))
|
|
|
|
;; produce index file for each tag
|
|
(loop for tag in (articles-by-tag) do
|
|
(generate (format nil "output/html/tag-~d.html" (getf tag :NAME))
|
|
(generate-tag-mainpage (getf tag :VALUE))))
|
|
|
|
;;(generate-file-rss)
|
|
(save-file "output/html/rss.xml" (generate-rss)))
|
|
|
|
;; we do all the gopher hole
|
|
(defun create-gopher-hole()
|
|
|
|
;; produce the gophermap file
|
|
(save-file (concatenate 'string "output/gopher/" (getf *config* :gopher-index))
|
|
(let ((output (load-file "templates/gopher_head.tpl")))
|
|
(dolist (article *articles*)
|
|
(setf output
|
|
(string
|
|
(concatenate 'string output
|
|
(format nil (getf *config* :gopher-format)
|
|
;; here we create a 80 width char string with title on the left
|
|
;; and date on the right
|
|
;; we truncate the article title if it's too large
|
|
(let ((title (format nil "~80a"
|
|
(if (< 80 (length (article-title article)))
|
|
(subseq (article-title article) 0 80)
|
|
(article-title article)))))
|
|
(replace title (article-date article) :start1 (- (length title) (length (article-date article)))))
|
|
|
|
|
|
(getf *config* :gopher-path)
|
|
(article-id article)
|
|
(getf *config* :gopher-server)
|
|
(getf *config* :gopher-port)
|
|
)))))
|
|
output))
|
|
|
|
;; produce each article file (only a copy/paste in fact)
|
|
(dolist (article *articles*)
|
|
(let ((id (article-id article)))
|
|
(save-file (format nil "output/gopher/article-~d.txt" id)
|
|
(load-file (format nil "data/~d.md" id)))))
|
|
|
|
)
|
|
|
|
|
|
;; ENGINE START !
|
|
;; This is function called when running the tool
|
|
(defun generate-site()
|
|
(if (getf *config* :html)
|
|
(create-html-site))
|
|
(if (getf *config* :gopher)
|
|
(create-gopher-hole)))
|
|
|
|
|
|
(generate-site)
|
|
|
|
(quit)
|