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 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 .