iusing article struct - cl-yag - Common Lisp Yet Another website Generator Err bitreich.org 70
hgit clone git://bitreich.org/cl-yag/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/cl-yag/ URL:git://bitreich.org/cl-yag/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/cl-yag/ bitreich.org 70
1Log /scm/cl-yag/log.gph bitreich.org 70
1Files /scm/cl-yag/files.gph bitreich.org 70
1Refs /scm/cl-yag/refs.gph bitreich.org 70
1Tags /scm/cl-yag/tag bitreich.org 70
1README /scm/cl-yag/file/README.md.gph bitreich.org 70
1LICENSE /scm/cl-yag/file/LICENSE.gph bitreich.org 70
i--- Err bitreich.org 70
1commit bbf0687d3956613d10973d651dd4154337a34880 /scm/cl-yag/commit/bbf0687d3956613d10973d651dd4154337a34880.gph bitreich.org 70
1parent 4d6a22dcec3fc6754b817c6f01a4271bf9a93118 /scm/cl-yag/commit/4d6a22dcec3fc6754b817c6f01a4271bf9a93118.gph bitreich.org 70
hAuthor: Solene Rapenne <solene@perso.pw> URL:mailto:solene@perso.pw bitreich.org 70
iDate: Tue, 12 Dec 2017 19:37:45 +0100 Err bitreich.org 70
i Err bitreich.org 70
iusing article struct Err bitreich.org 70
i Err bitreich.org 70
iDiffstat: Err bitreich.org 70
i M generator.lisp | 65 ++++++++++++++++++++----------- Err bitreich.org 70
i Err bitreich.org 70
i1 file changed, 42 insertions(+), 23 deletions(-) Err bitreich.org 70
i--- Err bitreich.org 70
1diff --git a/generator.lisp b/generator.lisp /scm/cl-yag/file/generator.lisp.gph bitreich.org 70
i@@ -1,5 +1,21 @@ Err bitreich.org 70
i+(defparameter *articles* '()) Err bitreich.org 70
i+ Err bitreich.org 70
i+;; structure to store links Err bitreich.org 70
i+(defstruct article title tag date id tiny author short) Err bitreich.org 70
i+ Err bitreich.org 70
i+(defun post(&optional &key title tag date id (tiny nil) (author nil) (short nil)) Err bitreich.org 70
i+ (push (make-article :title title Err bitreich.org 70
i+ :tag tag Err bitreich.org 70
i+ :date date Err bitreich.org 70
i+ :tiny tiny Err bitreich.org 70
i+ :author author Err bitreich.org 70
i+ :short short Err bitreich.org 70
i+ :id id) Err bitreich.org 70
i+ *articles*)) Err bitreich.org 70
i+ Err bitreich.org 70
i (load "data/articles.lisp") Err bitreich.org 70
i Err bitreich.org 70
i+ Err bitreich.org 70
i ;; common-lisp don't have a replace string function natively Err bitreich.org 70
i (defun replace-all (string part replacement &key (test #'char=)) Err bitreich.org 70
i (with-output-to-string (out) Err bitreich.org 70
i@@ -72,12 +88,12 @@ Err bitreich.org 70
i (defun articles-by-tag() Err bitreich.org 70
i (let ((tag-list)) Err bitreich.org 70
i (loop for article in *articles* do Err bitreich.org 70
i- (when (getf article :tag nil) ;; we don't want an error if no tag Err bitreich.org 70
i- (loop for tag in (split-str (getf article :tag)) do ;; for each word in tag keyword Err bitreich.org 70
i+ (when (article-tag article) ;; we don't want an error if no tag Err bitreich.org 70
i+ (loop for tag in (split-str (article-tag article)) do ;; for each word in tag keyword Err bitreich.org 70
i (setf (getf tag-list (intern tag "KEYWORD")) ;; we create the keyword is inexistent and add ID to :value Err bitreich.org 70
i (list Err bitreich.org 70
i :name tag Err bitreich.org 70
i- :value (push (getf article :id) (getf (getf tag-list (intern tag "KEYWORD")) :value))))))) Err bitreich.org 70
i+ :value (push (article-id article) (getf (getf tag-list (intern tag "KEYWORD")) :value))))))) Err bitreich.org 70
i (loop for i from 1 to (length tag-list) by 2 collect ;; removing the keywords Err bitreich.org 70
i (nth i tag-list)))) Err bitreich.org 70
i Err bitreich.org 70
i@@ -86,7 +102,7 @@ Err bitreich.org 70
i (apply #'concatenate 'string Err bitreich.org 70
i (mapcar #'(lambda (item) Err bitreich.org 70
i (prepare "templates/one-tag.tpl" (template "%%Name%%" item))) Err bitreich.org 70
i- (split-str (getf article :tag))))) Err bitreich.org 70
i+ (split-str (article-tag article))))) Err bitreich.org 70
i Err bitreich.org 70
i ;; generates the html of the whole list of tags Err bitreich.org 70
i (defun get-tag-list() Err bitreich.org 70
i@@ -101,16 +117,17 @@ Err bitreich.org 70
i ;; this is called in a loop to produce the homepage Err bitreich.org 70
i (defun create-article(article &optional &key (tiny t) (no-text nil)) Err bitreich.org 70
i (prepare "templates/article.tpl" Err bitreich.org 70
i- (template "%%Author%%" (getf article :author (getf *config* :webmaster))) Err bitreich.org 70
i- (template "%%Date%%" (getf article :date)) Err bitreich.org 70
i- (template "%%Title%%" (getf article :title)) Err bitreich.org 70
i- (template "%%Id%%" (getf article :id)) Err bitreich.org 70
i+ (template "%%Author%%" (let ((author (article-author article))) Err bitreich.org 70
i+ (or author (getf *config* :webmaster)))) Err bitreich.org 70
i+ (template "%%Date%%" (article-date article)) Err bitreich.org 70
i+ (template "%%Title%%" (article-title article)) Err bitreich.org 70
i+ (template "%%Id%%" (article-id article)) Err bitreich.org 70
i (template "%%Tags%%" (get-tag-list-article article)) Err bitreich.org 70
i (template "%%Text%%" (if no-text Err bitreich.org 70
i "" Err bitreich.org 70
i- (if (and tiny (member :tiny article)) Err bitreich.org 70
i- (getf article :tiny) Err bitreich.org 70
i- (load-file (format nil "temp/data/~d.html" (getf article :id)))))))) Err bitreich.org 70
i+ (if (and tiny (article-tiny article)) Err bitreich.org 70
i+ (article-tiny article) Err bitreich.org 70
i+ (load-file (format nil "temp/data/~d.html" (article-id article)))))))) Err bitreich.org 70
i Err bitreich.org 70
i ;; return a html string Err bitreich.org 70
i ;; produce the code of a whole page with title+layout with the parameter as the content Err bitreich.org 70
i@@ -132,7 +149,7 @@ Err bitreich.org 70
i (defun generate-tag-mainpage(articles-in-tag) Err bitreich.org 70
i (apply #'concatenate 'string Err bitreich.org 70
i (loop for article in *articles* Err bitreich.org 70
i- when (member (getf article :id) articles-in-tag :test #'equal) Err bitreich.org 70
i+ when (member (article-id article) articles-in-tag :test #'equal) Err bitreich.org 70
i collect (create-article article :tiny t)))) Err bitreich.org 70
i Err bitreich.org 70
i ;; xml generation of the items for the rss Err bitreich.org 70
i@@ -142,12 +159,12 @@ Err bitreich.org 70
i for i from 1 to (if (> (length *articles*) (getf *config* :rss-item-number)) (getf *config* :rss-item-number) (length *articles*)) Err bitreich.org 70
i collect Err bitreich.org 70
i (prepare "templates/rss-item.tpl" Err bitreich.org 70
i- (template "%%Title%%" (getf article :title)) Err bitreich.org 70
i- (template "%%Description%%" (load-file (format nil "temp/data/~d.html" (getf article :id)))) Err bitreich.org 70
i+ (template "%%Title%%" (article-title article)) Err bitreich.org 70
i+ (template "%%Description%%" (load-file (format nil "temp/data/~d.html" (article-id article)))) Err bitreich.org 70
i (template "%%Url%%" Err bitreich.org 70
i (format nil "~darticle-~d.html" Err bitreich.org 70
i (getf *config* :url) Err bitreich.org 70
i- (getf article :id))))))) Err bitreich.org 70
i+ (article-id article))))))) Err bitreich.org 70
i Err bitreich.org 70
i ;; Generate the rss xml data Err bitreich.org 70
i (defun generate-rss() Err bitreich.org 70
i@@ -167,9 +184,9 @@ Err bitreich.org 70
i Err bitreich.org 70
i ;; produce each article file Err bitreich.org 70
i (dolist (article *articles*) Err bitreich.org 70
i- (generate (format nil "output/html/article-~d.html" (getf article :id)) Err bitreich.org 70
i+ (generate (format nil "output/html/article-~d.html" (article-id article)) Err bitreich.org 70
i (create-article article :tiny nil) Err bitreich.org 70
i- :title (concatenate 'string (getf *config* :title) " : " (getf article :title)))) Err bitreich.org 70
i+ :title (concatenate 'string (getf *config* :title) " : " (article-title article)))) Err bitreich.org 70
i Err bitreich.org 70
i ;; produce index file for each tag Err bitreich.org 70
i (loop for tag in (articles-by-tag) do Err bitreich.org 70
i@@ -195,14 +212,14 @@ Err bitreich.org 70
i ;; and date on the right Err bitreich.org 70
i ;; we truncate the article title if it's too large Err bitreich.org 70
i (let ((title (format nil "~80a" Err bitreich.org 70
i- (if (< 80 (length (getf article :title))) Err bitreich.org 70
i- (subseq (getf article :title) 0 80) Err bitreich.org 70
i- (getf article :title))))) Err bitreich.org 70
i- (replace title (getf article :date) :start1 (- (length title) (length (getf article :date))))) Err bitreich.org 70
i+ (if (< 80 (length (article-title article))) Err bitreich.org 70
i+ (subseq (article-title article) 0 80) Err bitreich.org 70
i+ (article-title article))))) Err bitreich.org 70
i+ (replace title (article-date article) :start1 (- (length title) (length (article-date article))))) Err bitreich.org 70
i Err bitreich.org 70
i Err bitreich.org 70
i (getf *config* :gopher-path) Err bitreich.org 70
i- (getf article :id) Err bitreich.org 70
i+ (article-id article) Err bitreich.org 70
i (getf *config* :gopher-server) Err bitreich.org 70
i (getf *config* :gopher-port) Err bitreich.org 70
i ))))) Err bitreich.org 70
i@@ -210,7 +227,7 @@ Err bitreich.org 70
i Err bitreich.org 70
i ;; produce each article file (only a copy/paste in fact) Err bitreich.org 70
i (dolist (article *articles*) Err bitreich.org 70
i- (let ((id (getf article :id))) Err bitreich.org 70
i+ (let ((id (article-id article))) Err bitreich.org 70
i (save-file (format nil "output/gopher/article-~d.txt" id) Err bitreich.org 70
i (load-file (format nil "data/~d.md" id))))) Err bitreich.org 70
i Err bitreich.org 70
i@@ -225,5 +242,7 @@ Err bitreich.org 70
i (if (getf *config* :gopher) Err bitreich.org 70
i (create-gopher-hole))) Err bitreich.org 70
i Err bitreich.org 70
i+ Err bitreich.org 70
i (generate-site) Err bitreich.org 70
i+ Err bitreich.org 70
i (quit) Err bitreich.org 70
.
Response:
text/plain