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
.