Add per-tag browsing on gopher

Makefile

@@ -3,7 +3,7 @@ LISP=          ecl
 all: dirs html
 
 html: $(HTML) css
-	$(LISP) -load generator.lisp
+	$(LISP) --load generator.lisp
 
 dirs:
 	mkdir -p "output/html/static"

data/articles.lisp

@@ -17,9 +17,9 @@
    :gopher-path      "/user"                            ;; absolute path of your gopher directory
    :gopher-server    "my.website"                       ;; hostname of the gopher server
    :gopher-port      "70"                               ;; tcp port of the gopher server, 70 usually
-   :gopher-format "[0|~a|~a/article-~d.txt|~a|~a]~%~%"  ;; menu format (geomyidae)
+   :gopher-format "[~d|~a|~a|~a|~a]~%"                  ;; menu format (geomyidae)
    :gopher-index "index.gph"                            ;; menu file   (geomyidae)
-   ;; :gopher-format "0~a	~a/article-~d.txt	~a	~a~%~%" ;; menu format (gophernicus and others)
+   ;; :gopher-format "~d~a	~a	~a	~a~%"   ;; menu format (gophernicus and others)
    ;; :gopher-index "gophermap"                         ;; menu file (gophernicus and others)
    ))
 

generator.lisp

@@ -45,22 +45,22 @@
   (push (make-article :title title
                       :tag tag
                       :date (date-parse date)
-		      :rawdate date
+                      :rawdate date
                       :tiny tiny
                       :author author
                       :id id
-		      :converter converter)
+                      :converter converter)
         *articles*))
 
 ;; we add a converter to the list of the one availables
 (defun converter(&optional &key name command extension)
   (setf *converters*
-	(append
+        (append
-	 (list name
+         (list name
-	       (make-converter :name name
+               (make-converter :name name
-			       :command command
+                               :command command
-			       :extension extension))
+                               :extension extension))
-	 *converters*)))
+         *converters*)))
 
 ;; load data from metadata and load config
 (load "data/articles.lisp")
@@ -70,32 +70,32 @@
 ;; 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)
+    (loop with part-length = (length part)
-			       for old-pos = 0 then (+ pos part-length)
+       for old-pos = 0 then (+ pos part-length)
-			       for pos = (search part string
+       for pos = (search part string
-						 :start2 old-pos
+                         :start2 old-pos
-						 :test test)
+                         :test test)
-			       do (write-string string out
+       do (write-string string out
-						:start old-pos
+                        :start old-pos
-						:end (or pos (length string)))
+                        :end (or pos (length string)))
-			       when pos do (write-string replacement out)
+       when pos do (write-string replacement out)
-			       while pos)))
+       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
+       counting char into count
-	  when (char= char separator)
+       when (char= char separator)
-	  collect
+       collect
-	  ;; we look at the position of the left separator from right to left
+       ;; 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))))
+         (let ((left-separator-position (position separator text :from-end t :end (- count 1))))
-	    (subseq text
+           (subseq text
-		    ;; if we can't find a separator at the left of the current, then it's the start of
+                   ;; if we can't find a separator at the left of the current, then it's the start of
-		    ;; the string
+                   ;; the string
-		    (if left-separator-position (+ 1 left-separator-position) 0)
+                   (if left-separator-position (+ 1 left-separator-position) 0)
-		    (- count 1))))))
+                   (- count 1))))))
 
 ;; load a file as a string
 ;; we escape ~ to avoid failures with format
@@ -175,6 +175,30 @@
   `(progn
      (save-file ,name (generate-layout ,@data))))
 
+;; generate a gopher index file
+(defun generate-gopher-index(articles)
+  (let ((output (load-file "templates/gopher_head.tpl")))
+    (dolist (article articles)
+      (setf output
+	    (string
+	     (concatenate 'string output
+                          (format nil (getf *config* :gopher-format)
+                                  0 ;;;; gopher type, 0 for text files
+				  ;; 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-rawdate article) :start1 (- (length title) (length (article-rawdate article)))))
+				  (concatenate 'string
+                                               (getf *config* :gopher-path) "/article-" (article-id article) ".txt")
+				  (getf *config* :gopher-server)
+				  (getf *config* :gopher-port)
+				  )))))
+    output))
+
 ;; generate the list of tags
 (defun articles-by-tag()
   (let ((tag-list))
@@ -243,7 +267,7 @@
 ;; html generation of a tag homepage
 (defun generate-tag-mainpage(articles-in-tag)
   (apply #'concatenate 'string
-         (loop for article in *articles* 
+         (loop for article in *articles*
             when (member (article-id article) articles-in-tag :test #'equal)
             collect (create-article article :tiny t))))
 
@@ -304,10 +328,10 @@
 
   ;; produce index-titles.html where there are only articles titles
   (generate "output/html/index-titles.html" (generate-semi-mainpage :no-text t))
-  
+
   ;; 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 (format nil "output/html/tag-~d.html" (getf tag :NAME))
 		  (generate-tag-mainpage (getf tag :VALUE))))
 
   ;; generate rss gopher in html folder if gopher is t
@@ -325,29 +349,40 @@
 
   ;; produce the gophermap file
   (save-file (concatenate 'string "output/gopher/" (getf *config* :gopher-index))
-	     (let ((output (load-file "templates/gopher_head.tpl")))
+             (generate-gopher-index *articles*))
-	       (dolist (article *articles*)
+
-		 (setf output
+  ;; produce a tag list menu
-		       (string
+  (let* ((directory-path "output/gopher/_tags_/")
-			(concatenate 'string output
+         (index-path (concatenate 'string directory-path (getf *config* :gopher-index))))
-                                     (format nil (getf *config* :gopher-format)
+    (ensure-directories-exist directory-path)
-					     ;; here we create a 80 width char string with title on the left
+    (save-file index-path
-					     ;; and date on the right
+               (let ((output (load-file "templates/gopher_head.tpl")))
-					     ;; we truncate the article title if it's too large
+                 (loop for tag in (articles-by-tag)
-					     (let ((title (format nil "~80a"
+                    do
-								  (if (< 80 (length (article-title article)))
+                      (setf output
-								      (subseq (article-title article) 0 80)
+	                    (string
-								    (article-title article)))))
+	                     (concatenate
-					       (replace title (article-rawdate article) :start1 (- (length title) (length (article-rawdate article)))))
+                              'string output
-					     
+                              (format nil (getf *config* :gopher-format)
-					     
+                                      1 ;; gopher type, 1 for menus
-					     (getf *config* :gopher-path)
+				      (getf tag :NAME)
-					     (article-id article)
+                                      (concatenate 'string
-					     (getf *config* :gopher-server)
+                                                   (getf *config* :gopher-path) "/" (getf tag :NAME) "/")
-					     (getf *config* :gopher-port)
+				      (getf *config* :gopher-server)
-					     )))))	       
+				      (getf *config* :gopher-port)
-	       output))
+				      )))))
-  
+                 output)))
+
+  ;; produce each tag gophermap index
+  (loop for tag in (articles-by-tag) do
+       (let* ((directory-path (concatenate 'string "output/gopher/" (getf tag :NAME) "/"))
+              (index-path (concatenate 'string directory-path (getf *config* :gopher-index)))
+              (articles-with-tag (loop for article in *articles*
+                                    when (member (article-id article) (getf tag :VALUE) :test #'equal)
+                                    collect article)))
+         (ensure-directories-exist directory-path)
+         (save-file index-path (generate-gopher-index articles-with-tag))))
+
   ;; produce each article file (only a copy/paste in fact)
   (loop for article in *articles*
 	do

templates/gopher_head.tpl

@@ -2,6 +2,7 @@ Hello, this is the head of your gophermap page, you can
 customize it how you want !
 
 [0|RSS Feed|/~me/rss.xml|server|port]
+[1|Browse by tag|/~me/_tags_/|server|port]
 
  -----------------------------------------------------------------