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