iAdd per-tag browsing on gopher - 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 142b84ab78cb64423e2781a3e520bbd1e9cb40cd /scm/cl-yag/commit/142b84ab78cb64423e2781a3e520bbd1e9cb40cd.gph bitreich.org 70
1parent 4a5228a3803cf285d220aedb5caa92b731375b62 /scm/cl-yag/commit/4a5228a3803cf285d220aedb5caa92b731375b62.gph bitreich.org 70
hAuthor: Solene Rapenne <solene@perso.pw> URL:mailto:solene@perso.pw bitreich.org 70
iDate: Fri, 12 Oct 2018 11:22:34 +0200 Err bitreich.org 70
i Err bitreich.org 70
iAdd per-tag browsing on gopher Err bitreich.org 70
i Err bitreich.org 70
iDiffstat: Err bitreich.org 70
i M Makefile | 2 +- Err bitreich.org 70
i M data/articles.lisp | 4 ++-- Err bitreich.org 70
i M generator.lisp | 143 +++++++++++++++++++------------ Err bitreich.org 70
i M templates/gopher_head.tpl | 1 + Err bitreich.org 70
i Err bitreich.org 70
i4 files changed, 93 insertions(+), 57 deletions(-) Err bitreich.org 70
i--- Err bitreich.org 70
1diff --git a/Makefile b/Makefile /scm/cl-yag/file/Makefile.gph bitreich.org 70
i@@ -3,7 +3,7 @@ LISP= ecl Err bitreich.org 70
i all: dirs html Err bitreich.org 70
i Err bitreich.org 70
i html: $(HTML) css Err bitreich.org 70
i- $(LISP) -load generator.lisp Err bitreich.org 70
i+ $(LISP) --load generator.lisp Err bitreich.org 70
i Err bitreich.org 70
i dirs: Err bitreich.org 70
i mkdir -p "output/html/static" Err bitreich.org 70
1diff --git a/data/articles.lisp b/data/articles.lisp /scm/cl-yag/file/data/articles.lisp.gph bitreich.org 70
i@@ -17,9 +17,9 @@ Err bitreich.org 70
i :gopher-path "/user" ;; absolute path of your gopher directory Err bitreich.org 70
i :gopher-server "my.website" ;; hostname of the gopher server Err bitreich.org 70
i :gopher-port "70" ;; tcp port of the gopher server, 70 usually Err bitreich.org 70
i- :gopher-format "[0|~a|~a/article-~d.txt|~a|~a]~%~%" ;; menu format (geomyidae) Err bitreich.org 70
i+ :gopher-format "[~d|~a|~a|~a|~a]~%" ;; menu format (geomyidae) Err bitreich.org 70
i :gopher-index "index.gph" ;; menu file (geomyidae) Err bitreich.org 70
i- ;; :gopher-format "0~a ~a/article-~d.txt ~a ~a~%~%" ;; menu format (gophernicus and others) Err bitreich.org 70
i+ ;; :gopher-format "~d~a ~a ~a ~a~%" ;; menu format (gophernicus and others) Err bitreich.org 70
i ;; :gopher-index "gophermap" ;; menu file (gophernicus and others) Err bitreich.org 70
i )) 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@@ -45,22 +45,22 @@ Err bitreich.org 70
i (push (make-article :title title Err bitreich.org 70
i :tag tag Err bitreich.org 70
i :date (date-parse date) Err bitreich.org 70
i- :rawdate date Err bitreich.org 70
i+ :rawdate date Err bitreich.org 70
i :tiny tiny Err bitreich.org 70
i :author author Err bitreich.org 70
i :id id Err bitreich.org 70
i- :converter converter) Err bitreich.org 70
i+ :converter converter) Err bitreich.org 70
i *articles*)) Err bitreich.org 70
i Err bitreich.org 70
i ;; we add a converter to the list of the one availables Err bitreich.org 70
i (defun converter(&optional &key name command extension) Err bitreich.org 70
i (setf *converters* Err bitreich.org 70
i- (append Err bitreich.org 70
i- (list name Err bitreich.org 70
i- (make-converter :name name Err bitreich.org 70
i- :command command Err bitreich.org 70
i- :extension extension)) Err bitreich.org 70
i- *converters*))) Err bitreich.org 70
i+ (append Err bitreich.org 70
i+ (list name Err bitreich.org 70
i+ (make-converter :name name Err bitreich.org 70
i+ :command command Err bitreich.org 70
i+ :extension extension)) Err bitreich.org 70
i+ *converters*))) Err bitreich.org 70
i Err bitreich.org 70
i ;; load data from metadata and load config Err bitreich.org 70
i (load "data/articles.lisp") Err bitreich.org 70
i@@ -70,32 +70,32 @@ 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- (loop with part-length = (length part) Err bitreich.org 70
i- for old-pos = 0 then (+ pos part-length) Err bitreich.org 70
i- for pos = (search part string Err bitreich.org 70
i- :start2 old-pos Err bitreich.org 70
i- :test test) Err bitreich.org 70
i- do (write-string string out Err bitreich.org 70
i- :start old-pos Err bitreich.org 70
i- :end (or pos (length string))) Err bitreich.org 70
i- when pos do (write-string replacement out) Err bitreich.org 70
i- while pos))) Err bitreich.org 70
i+ (loop with part-length = (length part) Err bitreich.org 70
i+ for old-pos = 0 then (+ pos part-length) Err bitreich.org 70
i+ for pos = (search part string Err bitreich.org 70
i+ :start2 old-pos Err bitreich.org 70
i+ :test test) Err bitreich.org 70
i+ do (write-string string out Err bitreich.org 70
i+ :start old-pos Err bitreich.org 70
i+ :end (or pos (length string))) Err bitreich.org 70
i+ when pos do (write-string replacement out) Err bitreich.org 70
i+ while pos))) Err bitreich.org 70
i Err bitreich.org 70
i ;; common-lisp don't have a split string function natively Err bitreich.org 70
i (defun split-str(text &optional (separator #\Space)) Err bitreich.org 70
i "this function split a string with separator and return a list" Err bitreich.org 70
i (let ((text (concatenate 'string text (string separator)))) Err bitreich.org 70
i (loop for char across text Err bitreich.org 70
i- counting char into count Err bitreich.org 70
i- when (char= char separator) Err bitreich.org 70
i- collect Err bitreich.org 70
i- ;; we look at the position of the left separator from right to left Err bitreich.org 70
i- (let ((left-separator-position (position separator text :from-end t :end (- count 1)))) Err bitreich.org 70
i- (subseq text Err bitreich.org 70
i- ;; if we can't find a separator at the left of the current, then it's the start of Err bitreich.org 70
i- ;; the string Err bitreich.org 70
i- (if left-separator-position (+ 1 left-separator-position) 0) Err bitreich.org 70
i- (- count 1)))))) Err bitreich.org 70
i+ counting char into count Err bitreich.org 70
i+ when (char= char separator) Err bitreich.org 70
i+ collect Err bitreich.org 70
i+ ;; we look at the position of the left separator from right to left Err bitreich.org 70
i+ (let ((left-separator-position (position separator text :from-end t :end (- count 1)))) Err bitreich.org 70
i+ (subseq text Err bitreich.org 70
i+ ;; if we can't find a separator at the left of the current, then it's the start of Err bitreich.org 70
i+ ;; the string Err bitreich.org 70
i+ (if left-separator-position (+ 1 left-separator-position) 0) Err bitreich.org 70
i+ (- count 1)))))) Err bitreich.org 70
i Err bitreich.org 70
i ;; load a file as a string Err bitreich.org 70
i ;; we escape ~ to avoid failures with format Err bitreich.org 70
i@@ -175,6 +175,30 @@ Err bitreich.org 70
i `(progn Err bitreich.org 70
i (save-file ,name (generate-layout ,@data)))) Err bitreich.org 70
i Err bitreich.org 70
i+;; generate a gopher index file Err bitreich.org 70
i+(defun generate-gopher-index(articles) Err bitreich.org 70
i+ (let ((output (load-file "templates/gopher_head.tpl"))) Err bitreich.org 70
i+ (dolist (article articles) Err bitreich.org 70
i+ (setf output Err bitreich.org 70
i+ (string Err bitreich.org 70
i+ (concatenate 'string output Err bitreich.org 70
i+ (format nil (getf *config* :gopher-format) Err bitreich.org 70
i+ 0 ;;;; gopher type, 0 for text files Err bitreich.org 70
i+ ;; here we create a 80 width char string with title on the left 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 (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-rawdate article) :start1 (- (length title) (length (article-rawdate article))))) Err bitreich.org 70
i+ (concatenate 'string Err bitreich.org 70
i+ (getf *config* :gopher-path) "/article-" (article-id article) ".txt") 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+ output)) Err bitreich.org 70
i+ Err bitreich.org 70
i ;; generate the list of tags Err bitreich.org 70
i (defun articles-by-tag() Err bitreich.org 70
i (let ((tag-list)) Err bitreich.org 70
i@@ -243,7 +267,7 @@ Err bitreich.org 70
i ;; html generation of a tag homepage 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+ (loop for article in *articles* 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@@ -304,10 +328,10 @@ Err bitreich.org 70
i Err bitreich.org 70
i ;; produce index-titles.html where there are only articles titles Err bitreich.org 70
i (generate "output/html/index-titles.html" (generate-semi-mainpage :no-text t)) Err bitreich.org 70
i- 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- (generate (format nil "output/html/tag-~d.html" (getf tag :NAME)) Err bitreich.org 70
i+ (generate (format nil "output/html/tag-~d.html" (getf tag :NAME)) Err bitreich.org 70
i (generate-tag-mainpage (getf tag :VALUE)))) Err bitreich.org 70
i Err bitreich.org 70
i ;; generate rss gopher in html folder if gopher is t Err bitreich.org 70
i@@ -325,29 +349,40 @@ Err bitreich.org 70
i Err bitreich.org 70
i ;; produce the gophermap file Err bitreich.org 70
i (save-file (concatenate 'string "output/gopher/" (getf *config* :gopher-index)) Err bitreich.org 70
i- (let ((output (load-file "templates/gopher_head.tpl"))) Err bitreich.org 70
i- (dolist (article *articles*) Err bitreich.org 70
i- (setf output Err bitreich.org 70
i- (string Err bitreich.org 70
i- (concatenate 'string output Err bitreich.org 70
i- (format nil (getf *config* :gopher-format) Err bitreich.org 70
i- ;; here we create a 80 width char string with title on the left 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 (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-rawdate article) :start1 (- (length title) (length (article-rawdate 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- (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- output)) Err bitreich.org 70
i- Err bitreich.org 70
i+ (generate-gopher-index *articles*)) Err bitreich.org 70
i+ Err bitreich.org 70
i+ ;; produce a tag list menu Err bitreich.org 70
i+ (let* ((directory-path "output/gopher/_tags_/") Err bitreich.org 70
i+ (index-path (concatenate 'string directory-path (getf *config* :gopher-index)))) Err bitreich.org 70
i+ (ensure-directories-exist directory-path) Err bitreich.org 70
i+ (save-file index-path Err bitreich.org 70
i+ (let ((output (load-file "templates/gopher_head.tpl"))) Err bitreich.org 70
i+ (loop for tag in (articles-by-tag) Err bitreich.org 70
i+ do Err bitreich.org 70
i+ (setf output Err bitreich.org 70
i+ (string Err bitreich.org 70
i+ (concatenate Err bitreich.org 70
i+ 'string output Err bitreich.org 70
i+ (format nil (getf *config* :gopher-format) Err bitreich.org 70
i+ 1 ;; gopher type, 1 for menus Err bitreich.org 70
i+ (getf tag :NAME) Err bitreich.org 70
i+ (concatenate 'string Err bitreich.org 70
i+ (getf *config* :gopher-path) "/" (getf tag :NAME) "/") 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+ output))) Err bitreich.org 70
i+ Err bitreich.org 70
i+ ;; produce each tag gophermap index Err bitreich.org 70
i+ (loop for tag in (articles-by-tag) do Err bitreich.org 70
i+ (let* ((directory-path (concatenate 'string "output/gopher/" (getf tag :NAME) "/")) Err bitreich.org 70
i+ (index-path (concatenate 'string directory-path (getf *config* :gopher-index))) Err bitreich.org 70
i+ (articles-with-tag (loop for article in *articles* Err bitreich.org 70
i+ when (member (article-id article) (getf tag :VALUE) :test #'equal) Err bitreich.org 70
i+ collect article))) Err bitreich.org 70
i+ (ensure-directories-exist directory-path) Err bitreich.org 70
i+ (save-file index-path (generate-gopher-index articles-with-tag)))) 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 (loop for article in *articles* Err bitreich.org 70
i do Err bitreich.org 70
1diff --git a/templates/gopher_head.tpl b/templates/gopher_head.tpl /scm/cl-yag/file/templates/gopher_head.tpl.gph bitreich.org 70
i@@ -2,6 +2,7 @@ Hello, this is the head of your gophermap page, you can Err bitreich.org 70
i customize it how you want ! Err bitreich.org 70
i Err bitreich.org 70
i [0|RSS Feed|/~me/rss.xml|server|port] Err bitreich.org 70
i+[1|Browse by tag|/~me/_tags_/|server|port] Err bitreich.org 70
i Err bitreich.org 70
i ----------------------------------------------------------------- Err bitreich.org 70
i Err bitreich.org 70
.
Response:
text/plain