igenerator.lisp - 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 igenerator.lisp (20812B) Err bitreich.org 70 i--- Err bitreich.org 70 i 1 ;;;; GLOBAL VARIABLES Err bitreich.org 70 i 2 Err bitreich.org 70 i 3 (defparameter *articles* '()) Err bitreich.org 70 i 4 (defparameter *converters* '()) Err bitreich.org 70 i 5 (defparameter *days* '("Monday" "Tuesday" "Wednesday" "Thursday" Err bitreich.org 70 i 6 "Friday" "Saturday" "Sunday")) Err bitreich.org 70 i 7 (defparameter *months* '("January" "February" "March" "April" Err bitreich.org 70 i 8 "May" "June" "July" "August" "September" Err bitreich.org 70 i 9 "October" "November" "December")) Err bitreich.org 70 i 10 Err bitreich.org 70 i 11 ;; structure to store links Err bitreich.org 70 i 12 (defstruct article title tag date id tiny author rawdate converter) Err bitreich.org 70 i 13 (defstruct converter name command extension) Err bitreich.org 70 i 14 Err bitreich.org 70 i 15 ;;;; FUNCTIONS Err bitreich.org 70 i 16 Err bitreich.org 70 i 17 (require 'asdf) Err bitreich.org 70 i 18 Err bitreich.org 70 i 19 ;; return the day of the week Err bitreich.org 70 i 20 (defun get-day-of-week(day month year) Err bitreich.org 70 i 21 (multiple-value-bind Err bitreich.org 70 i 22 (second minute hour date month year day-of-week dst-p tz) Err bitreich.org 70 i 23 (decode-universal-time (encode-universal-time 0 0 0 day month year)) Err bitreich.org 70 i 24 (declare (ignore second minute hour date month year dst-p tz)) Err bitreich.org 70 i 25 day-of-week)) Err bitreich.org 70 i 26 Err bitreich.org 70 i 27 ;; parse the date to Err bitreich.org 70 i 28 (defun date-parse(date) Err bitreich.org 70 i 29 (if (= 8 (length date)) Err bitreich.org 70 i 30 (let* ((year (parse-integer date :start 0 :end 4)) Err bitreich.org 70 i 31 (monthnum (parse-integer date :start 4 :end 6)) Err bitreich.org 70 i 32 (daynum (parse-integer date :start 6 :end 8)) Err bitreich.org 70 i 33 (day (nth (get-day-of-week daynum monthnum year) *days*)) Err bitreich.org 70 i 34 (month (nth (- monthnum 1) *months*))) Err bitreich.org 70 i 35 (list Err bitreich.org 70 i 36 :dayname day Err bitreich.org 70 i 37 :daynumber daynum Err bitreich.org 70 i 38 :monthname month Err bitreich.org 70 i 39 :monthnumber monthnum Err bitreich.org 70 i 40 :year year)) Err bitreich.org 70 i 41 nil)) Err bitreich.org 70 i 42 Err bitreich.org 70 i 43 (defun post(&optional &key title tag date id (tiny nil) (author (getf *config* :webmaster)) (converter nil)) Err bitreich.org 70 i 44 (push (make-article :title title Err bitreich.org 70 i 45 :tag tag Err bitreich.org 70 i 46 :date (date-parse date) Err bitreich.org 70 i 47 :rawdate date Err bitreich.org 70 i 48 :tiny tiny Err bitreich.org 70 i 49 :author author Err bitreich.org 70 i 50 :id id Err bitreich.org 70 i 51 :converter converter) Err bitreich.org 70 i 52 *articles*)) Err bitreich.org 70 i 53 Err bitreich.org 70 i 54 ;; we add a converter to the list of the one availables Err bitreich.org 70 i 55 (defun converter(&optional &key name command extension) Err bitreich.org 70 i 56 (setf *converters* Err bitreich.org 70 i 57 (append Err bitreich.org 70 i 58 (list name Err bitreich.org 70 i 59 (make-converter :name name Err bitreich.org 70 i 60 :command command Err bitreich.org 70 i 61 :extension extension)) Err bitreich.org 70 i 62 *converters*))) Err bitreich.org 70 i 63 Err bitreich.org 70 i 64 ;; load data from metadata and load config Err bitreich.org 70 i 65 (load "data/articles.lisp") Err bitreich.org 70 i 66 (setf *articles* (reverse *articles*)) Err bitreich.org 70 i 67 Err bitreich.org 70 i 68 Err bitreich.org 70 i 69 ;; common-lisp don't have a replace string function natively Err bitreich.org 70 i 70 (defun replace-all (string part replacement &key (test #'char=)) Err bitreich.org 70 i 71 (with-output-to-string (out) Err bitreich.org 70 i 72 (loop with part-length = (length part) Err bitreich.org 70 i 73 for old-pos = 0 then (+ pos part-length) Err bitreich.org 70 i 74 for pos = (search part string Err bitreich.org 70 i 75 :start2 old-pos Err bitreich.org 70 i 76 :test test) Err bitreich.org 70 i 77 do (write-string string out Err bitreich.org 70 i 78 :start old-pos Err bitreich.org 70 i 79 :end (or pos (length string))) Err bitreich.org 70 i 80 when pos do (write-string replacement out) Err bitreich.org 70 i 81 while pos))) Err bitreich.org 70 i 82 Err bitreich.org 70 i 83 ;; common-lisp don't have a split string function natively Err bitreich.org 70 i 84 (defun split-str(text &optional (separator #\Space)) Err bitreich.org 70 i 85 "this function split a string with separator and return a list" Err bitreich.org 70 i 86 (let ((text (concatenate 'string text (string separator)))) Err bitreich.org 70 i 87 (loop for char across text Err bitreich.org 70 i 88 counting char into count Err bitreich.org 70 i 89 when (char= char separator) Err bitreich.org 70 i 90 collect Err bitreich.org 70 i 91 ;; we look at the position of the left separator from right to left Err bitreich.org 70 i 92 (let ((left-separator-position (position separator text :from-end t :end (- count 1)))) Err bitreich.org 70 i 93 (subseq text Err bitreich.org 70 i 94 ;; if we can't find a separator at the left of the current, then it's the start of Err bitreich.org 70 i 95 ;; the string Err bitreich.org 70 i 96 (if left-separator-position (+ 1 left-separator-position) 0) Err bitreich.org 70 i 97 (- count 1)))))) Err bitreich.org 70 i 98 Err bitreich.org 70 i 99 ;; load a file as a string Err bitreich.org 70 i 100 ;; we escape ~ to avoid failures with format Err bitreich.org 70 i 101 (defun load-file(path) Err bitreich.org 70 i 102 (if (probe-file path) Err bitreich.org 70 i 103 (with-open-file (stream path) Err bitreich.org 70 i 104 (let ((contents (make-string (file-length stream)))) Err bitreich.org 70 i 105 (read-sequence contents stream) Err bitreich.org 70 i 106 contents)) Err bitreich.org 70 i 107 (progn Err bitreich.org 70 i 108 (format t "ERROR : file ~a not found. Aborting~%" path) Err bitreich.org 70 i 109 (quit)))) Err bitreich.org 70 i 110 Err bitreich.org 70 i 111 ;; save a string in a file Err bitreich.org 70 i 112 (defun save-file(path data) Err bitreich.org 70 i 113 (with-open-file (stream path :direction :output :if-exists :supersede) Err bitreich.org 70 i 114 (write-sequence data stream))) Err bitreich.org 70 i 115 Err bitreich.org 70 i 116 ;; simplify the str replace work Err bitreich.org 70 i 117 (defmacro template(before &body after) Err bitreich.org 70 i 118 `(progn Err bitreich.org 70 i 119 (setf output (replace-all output ,before ,@after)))) Err bitreich.org 70 i 120 Err bitreich.org 70 i 121 ;; get the converter object of "article" Err bitreich.org 70 i 122 (defmacro with-converter(&body code) Err bitreich.org 70 i 123 `(progn Err bitreich.org 70 i 124 (let ((converter-name (if (article-converter article) Err bitreich.org 70 i 125 (article-converter article) Err bitreich.org 70 i 126 (getf *config* :default-converter)))) Err bitreich.org 70 i 127 (let ((converter-object (getf *converters* converter-name))) Err bitreich.org 70 i 128 ,@code)))) Err bitreich.org 70 i 129 Err bitreich.org 70 i 130 ;; generate the html file from the source file Err bitreich.org 70 i 131 ;; using the converter associated with the post Err bitreich.org 70 i 132 (defun use-converter-to-html(filename &optional (converter-name nil)) Err bitreich.org 70 i 133 (let* ((converter-object (getf *converters* Err bitreich.org 70 i 134 (or converter-name Err bitreich.org 70 i 135 converter-name Err bitreich.org 70 i 136 (getf *config* :default-converter)))) Err bitreich.org 70 i 137 (output (converter-command converter-object)) Err bitreich.org 70 i 138 (src-file (format nil "~a~a" filename (converter-extension converter-object))) Err bitreich.org 70 i 139 (dst-file (format nil "temp/data/~a.html" filename )) Err bitreich.org 70 i 140 (full-src-file (format nil "data/~a" src-file))) Err bitreich.org 70 i 141 ;; skip generating if the destination exists Err bitreich.org 70 i 142 ;; and is more recent than source Err bitreich.org 70 i 143 (unless (and Err bitreich.org 70 i 144 (probe-file dst-file) Err bitreich.org 70 i 145 (>= Err bitreich.org 70 i 146 (file-write-date dst-file) Err bitreich.org 70 i 147 (file-write-date full-src-file))) Err bitreich.org 70 i 148 (ensure-directories-exist "temp/data/") Err bitreich.org 70 i 149 (template "%IN" src-file) Err bitreich.org 70 i 150 (template "%OUT" dst-file) Err bitreich.org 70 i 151 (format t "~a~%" output) Err bitreich.org 70 i 152 (uiop:run-program output)))) Err bitreich.org 70 i 153 Err bitreich.org 70 i 154 ;; format the date Err bitreich.org 70 i 155 (defun date-format(format date) Err bitreich.org 70 i 156 (let ((output format)) Err bitreich.org 70 i 157 (template "%DayName" (getf date :dayname)) Err bitreich.org 70 i 158 (template "%DayNumber" (format nil "~2,'0d" (getf date :daynumber))) Err bitreich.org 70 i 159 (template "%MonthName" (getf date :monthname)) Err bitreich.org 70 i 160 (template "%MonthNumber" (format nil "~2,'0d" (getf date :monthnumber))) Err bitreich.org 70 i 161 (template "%Year" (write-to-string (getf date :year ))) Err bitreich.org 70 i 162 output)) Err bitreich.org 70 i 163 Err bitreich.org 70 i 164 ;; simplify the declaration of a new page type Err bitreich.org 70 i 165 (defmacro prepare(template &body code) Err bitreich.org 70 i 166 `(progn Err bitreich.org 70 i 167 (let ((output (load-file ,template))) Err bitreich.org 70 i 168 ,@code Err bitreich.org 70 i 169 output))) Err bitreich.org 70 i 170 Err bitreich.org 70 i 171 ;; simplify the file saving by using the layout Err bitreich.org 70 i 172 (defmacro generate(name &body data) Err bitreich.org 70 i 173 `(progn Err bitreich.org 70 i 174 (save-file ,name (generate-layout ,@data)))) Err bitreich.org 70 i 175 Err bitreich.org 70 i 176 ;; generate a gemini index file Err bitreich.org 70 i 177 (defun generate-gemini-index(articles) Err bitreich.org 70 i 178 (let ((output (load-file "templates/gemini_head.tpl"))) Err bitreich.org 70 i 179 (dolist (article articles) Err bitreich.org 70 i 180 (setf output Err bitreich.org 70 i 181 (string Err bitreich.org 70 i 182 (concatenate 'string output Err bitreich.org 70 i 183 (format nil "=> ~a/articles/~a.gmi ~a-~2,'0d-~2,'0d ~a~%" Err bitreich.org 70 i 184 (getf *config* :gemini-path) Err bitreich.org 70 i 185 (article-id article) Err bitreich.org 70 i 186 (getf (article-date article) :year) Err bitreich.org 70 i 187 (getf (article-date article) :monthnumber) Err bitreich.org 70 i 188 (getf (article-date article) :daynumber) Err bitreich.org 70 i 189 (article-title article)))))) Err bitreich.org 70 i 190 output)) Err bitreich.org 70 i 191 Err bitreich.org 70 i 192 ;; generate a gopher index file Err bitreich.org 70 i 193 (defun generate-gopher-index(articles) Err bitreich.org 70 i 194 (let ((output (load-file "templates/gopher_head.tpl"))) Err bitreich.org 70 i 195 (dolist (article articles) Err bitreich.org 70 i 196 (setf output Err bitreich.org 70 i 197 (string Err bitreich.org 70 i 198 (concatenate 'string output Err bitreich.org 70 i 199 (format nil (getf *config* :gopher-format) Err bitreich.org 70 i 200 0 ;;;; gopher type, 0 for text files Err bitreich.org 70 i 201 ;; here we create a 80 width char string with title on the left Err bitreich.org 70 i 202 ;; and date on the right Err bitreich.org 70 i 203 ;; we truncate the article title if it's too large Err bitreich.org 70 i 204 (let ((title (format nil "~80a" Err bitreich.org 70 i 205 (if (< 80 (length (article-title article))) Err bitreich.org 70 i 206 (subseq (article-title article) 0 80) Err bitreich.org 70 i 207 (article-title article))))) Err bitreich.org 70 i 208 (replace title (article-rawdate article) :start1 (- (length title) (length (article-rawdate article))))) Err bitreich.org 70 i 209 (concatenate 'string Err bitreich.org 70 i 210 (getf *config* :gopher-path) "/article-" (article-id article) ".txt") Err bitreich.org 70 i 211 (getf *config* :gopher-server) Err bitreich.org 70 i 212 (getf *config* :gopher-port) Err bitreich.org 70 i 213 ))))) Err bitreich.org 70 i 214 output)) Err bitreich.org 70 i 215 Err bitreich.org 70 i 216 ;; generate the list of tags Err bitreich.org 70 i 217 (defun articles-by-tag() Err bitreich.org 70 i 218 (let ((tag-list)) Err bitreich.org 70 i 219 (loop for article in *articles* do Err bitreich.org 70 i 220 (when (article-tag article) ;; we don't want an error if no tag Err bitreich.org 70 i 221 (loop for tag in (split-str (article-tag article)) do ;; for each word in tag keyword Err bitreich.org 70 i 222 (setf (getf tag-list (intern tag "KEYWORD")) ;; we create the keyword is inexistent and add ID to :value Err bitreich.org 70 i 223 (list Err bitreich.org 70 i 224 :name tag Err bitreich.org 70 i 225 :value (push (article-id article) (getf (getf tag-list (intern tag "KEYWORD")) :value))))))) Err bitreich.org 70 i 226 (loop for i from 1 to (length tag-list) by 2 collect ;; removing the keywords Err bitreich.org 70 i 227 (nth i tag-list)))) Err bitreich.org 70 i 228 Err bitreich.org 70 i 229 ;; generates the html of the list of tags for an article Err bitreich.org 70 i 230 (defun get-tag-list-article(&optional article) Err bitreich.org 70 i 231 (apply #'concatenate 'string Err bitreich.org 70 i 232 (mapcar #'(lambda (item) Err bitreich.org 70 i 233 (prepare "templates/one-tag.tpl" (template "%%Name%%" item))) Err bitreich.org 70 i 234 (split-str (article-tag article))))) Err bitreich.org 70 i 235 Err bitreich.org 70 i 236 ;; generates the html of the whole list of tags Err bitreich.org 70 i 237 (defun get-tag-list() Err bitreich.org 70 i 238 (apply #'concatenate 'string Err bitreich.org 70 i 239 (mapcar #'(lambda (item) Err bitreich.org 70 i 240 (prepare "templates/one-tag.tpl" Err bitreich.org 70 i 241 (template "%%Name%%" (getf item :name)))) Err bitreich.org 70 i 242 (articles-by-tag)))) Err bitreich.org 70 i 243 Err bitreich.org 70 i 244 Err bitreich.org 70 i 245 ;; generates the html of only one article Err bitreich.org 70 i 246 ;; this is called in a loop to produce the homepage Err bitreich.org 70 i 247 (defun create-article(article &optional &key (tiny t) (no-text nil)) Err bitreich.org 70 i 248 (prepare "templates/article.tpl" Err bitreich.org 70 i 249 (template "%%Author%%" (let ((author (article-author article))) Err bitreich.org 70 i 250 (or author (getf *config* :webmaster)))) Err bitreich.org 70 i 251 (template "%%Date%%" (date-format (getf *config* :date-format) Err bitreich.org 70 i 252 (article-date article))) Err bitreich.org 70 i 253 (template "%%Raw-Date%%" (article-rawdate article)) Err bitreich.org 70 i 254 (template "%%Title%%" (article-title article)) Err bitreich.org 70 i 255 (template "%%Id%%" (article-id article)) Err bitreich.org 70 i 256 (template "%%Tags%%" (get-tag-list-article article)) Err bitreich.org 70 i 257 (template "%%Date-Url%%" (date-format "%Year-%MonthNumber-%DayNumber" Err bitreich.org 70 i 258 (article-date article))) Err bitreich.org 70 i 259 (template "%%Text%%" (if no-text Err bitreich.org 70 i 260 "" Err bitreich.org 70 i 261 (if (and tiny (article-tiny article)) Err bitreich.org 70 i 262 (format nil "

~a

" (article-tiny article)) Err bitreich.org 70 i 263 (load-file (format nil "temp/data/~d.html" (article-id article)))))))) Err bitreich.org 70 i 264 Err bitreich.org 70 i 265 ;; return a html string Err bitreich.org 70 i 266 ;; produce the code of a whole page with title+layout with the parameter as the content Err bitreich.org 70 i 267 (defun generate-layout(body &optional &key (title nil)) Err bitreich.org 70 i 268 (prepare "templates/layout.tpl" Err bitreich.org 70 i 269 (template "%%Title%%" (if title title (getf *config* :title))) Err bitreich.org 70 i 270 (template "%%Tags%%" (get-tag-list)) Err bitreich.org 70 i 271 (template "%%Body%%" body) Err bitreich.org 70 i 272 output)) Err bitreich.org 70 i 273 Err bitreich.org 70 i 274 Err bitreich.org 70 i 275 ;; html generation of index homepage Err bitreich.org 70 i 276 (defun generate-semi-mainpage(&key (tiny t) (no-text nil)) Err bitreich.org 70 i 277 (apply #'concatenate 'string Err bitreich.org 70 i 278 (loop for article in *articles* collect Err bitreich.org 70 i 279 (create-article article :tiny tiny :no-text no-text)))) Err bitreich.org 70 i 280 Err bitreich.org 70 i 281 ;; html generation of a tag homepage Err bitreich.org 70 i 282 (defun generate-tag-mainpage(articles-in-tag) Err bitreich.org 70 i 283 (apply #'concatenate 'string Err bitreich.org 70 i 284 (loop for article in *articles* Err bitreich.org 70 i 285 when (member (article-id article) articles-in-tag :test #'equal) Err bitreich.org 70 i 286 collect (create-article article :tiny t)))) Err bitreich.org 70 i 287 Err bitreich.org 70 i 288 ;; xml generation of the items for the rss Err bitreich.org 70 i 289 (defun generate-rss-item(&key (gopher nil)) Err bitreich.org 70 i 290 (apply #'concatenate 'string Err bitreich.org 70 i 291 (loop for article in *articles* Err bitreich.org 70 i 292 for i from 1 to (min (length *articles*) (getf *config* :rss-item-number)) Err bitreich.org 70 i 293 collect Err bitreich.org 70 i 294 (prepare "templates/rss-item.tpl" Err bitreich.org 70 i 295 (template "%%Title%%" (article-title article)) Err bitreich.org 70 i 296 (template "%%Description%%" (load-file (format nil "temp/data/~d.html" (article-id article)))) Err bitreich.org 70 i 297 (template "%%Date%%" (format nil Err bitreich.org 70 i 298 (date-format "~a, %DayNumber ~a %Year 00:00:00 GMT" Err bitreich.org 70 i 299 (article-date article)) Err bitreich.org 70 i 300 (subseq (getf (article-date article) :dayname) 0 3) Err bitreich.org 70 i 301 (subseq (getf (article-date article) :monthname) 0 3))) Err bitreich.org 70 i 302 (template "%%Url%%" Err bitreich.org 70 i 303 (if gopher Err bitreich.org 70 i 304 (format nil "gopher://~a:~d/0~a/article-~a.txt" Err bitreich.org 70 i 305 (getf *config* :gopher-server) Err bitreich.org 70 i 306 (getf *config* :gopher-port) Err bitreich.org 70 i 307 (getf *config* :gopher-path) Err bitreich.org 70 i 308 (article-id article)) Err bitreich.org 70 i 309 (format nil "~d~d-~d.html" Err bitreich.org 70 i 310 (getf *config* :url) Err bitreich.org 70 i 311 (date-format "%Year-%MonthNumber-%DayNumber" Err bitreich.org 70 i 312 (article-date article)) Err bitreich.org 70 i 313 (article-id article)))))))) Err bitreich.org 70 i 314 Err bitreich.org 70 i 315 Err bitreich.org 70 i 316 ;; Generate the rss xml data Err bitreich.org 70 i 317 (defun generate-rss(&key (gopher nil)) Err bitreich.org 70 i 318 (prepare "templates/rss.tpl" Err bitreich.org 70 i 319 (template "%%Description%%" (getf *config* :description)) Err bitreich.org 70 i 320 (template "%%Title%%" (getf *config* :title)) Err bitreich.org 70 i 321 (template "%%Url%%" (getf *config* :url)) Err bitreich.org 70 i 322 (template "%%Items%%" (generate-rss-item :gopher gopher)))) Err bitreich.org 70 i 323 Err bitreich.org 70 i 324 ;; We do all the website Err bitreich.org 70 i 325 (defun create-html-site() Err bitreich.org 70 i 326 Err bitreich.org 70 i 327 ;; produce each article file Err bitreich.org 70 i 328 (loop for article in *articles* Err bitreich.org 70 i 329 do Err bitreich.org 70 i 330 ;; use the article's converter to get html code of it Err bitreich.org 70 i 331 (use-converter-to-html (article-id article) (article-converter article)) Err bitreich.org 70 i 332 Err bitreich.org 70 i 333 (generate (format nil "output/html/~d-~d.html" Err bitreich.org 70 i 334 (date-format "%Year-%MonthNumber-%DayNumber" Err bitreich.org 70 i 335 (article-date article)) Err bitreich.org 70 i 336 (article-id article)) Err bitreich.org 70 i 337 (create-article article :tiny nil) Err bitreich.org 70 i 338 :title (concatenate 'string (getf *config* :title) " : " (article-title article)))) Err bitreich.org 70 i 339 Err bitreich.org 70 i 340 ;; produce index.html Err bitreich.org 70 i 341 (generate "output/html/index.html" (generate-semi-mainpage)) Err bitreich.org 70 i 342 Err bitreich.org 70 i 343 ;; produce index-titles.html where there are only articles titles Err bitreich.org 70 i 344 (generate "output/html/index-titles.html" (generate-semi-mainpage :no-text t)) Err bitreich.org 70 i 345 Err bitreich.org 70 i 346 ;; produce index file for each tag Err bitreich.org 70 i 347 (loop for tag in (articles-by-tag) do Err bitreich.org 70 i 348 (generate (format nil "output/html/tag-~d.html" (getf tag :NAME)) Err bitreich.org 70 i 349 (generate-tag-mainpage (getf tag :VALUE)))) Err bitreich.org 70 i 350 Err bitreich.org 70 i 351 ;; generate rss gopher in html folder if gopher is t Err bitreich.org 70 i 352 (when (getf *config* :gopher) Err bitreich.org 70 i 353 (save-file "output/html/rss-gopher.xml" (generate-rss :gopher t))) Err bitreich.org 70 i 354 Err bitreich.org 70 i 355 ;;(generate-file-rss) Err bitreich.org 70 i 356 (save-file "output/html/rss.xml" (generate-rss))) Err bitreich.org 70 i 357 Err bitreich.org 70 i 358 ;; we do all the gemini capsule Err bitreich.org 70 i 359 (defun create-gemini-capsule() Err bitreich.org 70 i 360 Err bitreich.org 70 i 361 ;; produce the index.gmi file Err bitreich.org 70 i 362 (save-file (concatenate 'string "output/gemini/" (getf *config* :gemini-index)) Err bitreich.org 70 i 363 (generate-gemini-index *articles*)) Err bitreich.org 70 i 364 Err bitreich.org 70 i 365 ;; produce a tag list menu Err bitreich.org 70 i 366 (let* ((directory-path "output/gemini/_tags_/") Err bitreich.org 70 i 367 (index-path (concatenate 'string directory-path (getf *config* :gemini-index)))) Err bitreich.org 70 i 368 (ensure-directories-exist directory-path) Err bitreich.org 70 i 369 (save-file index-path Err bitreich.org 70 i 370 (let ((output (load-file "templates/gemini_head.tpl"))) Err bitreich.org 70 i 371 (loop for tag in Err bitreich.org 70 i 372 ;; sort tags per articles in it Err bitreich.org 70 i 373 (sort (articles-by-tag) #'> Err bitreich.org 70 i 374 :key #'(lambda (x) (length (getf x :value)))) Err bitreich.org 70 i 375 do Err bitreich.org 70 i 376 (setf output Err bitreich.org 70 i 377 (string Err bitreich.org 70 i 378 (concatenate Err bitreich.org 70 i 379 'string output Err bitreich.org 70 i 380 (format nil "=> ~a/~a/index.gmi ~a ~d~%" Err bitreich.org 70 i 381 (getf *config* :gemini-path) Err bitreich.org 70 i 382 (getf tag :name) Err bitreich.org 70 i 383 (getf tag :name) Err bitreich.org 70 i 384 (length (getf tag :value))))))) Err bitreich.org 70 i 385 output))) Err bitreich.org 70 i 386 Err bitreich.org 70 i 387 ;; produce each tag gemini index Err bitreich.org 70 i 388 (loop for tag in (articles-by-tag) do Err bitreich.org 70 i 389 (let* ((directory-path (concatenate 'string "output/gemini/" (getf tag :NAME) "/")) Err bitreich.org 70 i 390 (index-path (concatenate 'string directory-path (getf *config* :gemini-index))) Err bitreich.org 70 i 391 (articles-with-tag (loop for article in *articles* Err bitreich.org 70 i 392 when (member (article-id article) (getf tag :VALUE) :test #'equal) Err bitreich.org 70 i 393 collect article))) Err bitreich.org 70 i 394 (ensure-directories-exist directory-path) Err bitreich.org 70 i 395 (save-file index-path (generate-gemini-index articles-with-tag)))) Err bitreich.org 70 i 396 Err bitreich.org 70 i 397 ;; produce each article file (adding some headers) Err bitreich.org 70 i 398 (loop for article in *articles* Err bitreich.org 70 i 399 do Err bitreich.org 70 i 400 (with-converter Err bitreich.org 70 i 401 (let ((id (article-id article))) Err bitreich.org 70 i 402 (save-file (format nil "output/gemini/articles/~a.gmi" id) Err bitreich.org 70 i 403 (format nil "~{~a~}" Err bitreich.org 70 i 404 (list Err bitreich.org 70 i 405 "Title : " (article-title article) #\Newline Err bitreich.org 70 i 406 "Author: " (article-author article) #\Newline Err bitreich.org 70 i 407 "Date : " (date-format (getf *config* :date-format) (article-date article)) #\Newline Err bitreich.org 70 i 408 "Tags : " (article-tag article) #\Newline #\Newline Err bitreich.org 70 i 409 (load-file (format nil "data/~d~d" id (converter-extension converter-object)))))))))) Err bitreich.org 70 i 410 Err bitreich.org 70 i 411 ;; we do all the gopher hole Err bitreich.org 70 i 412 (defun create-gopher-hole() Err bitreich.org 70 i 413 Err bitreich.org 70 i 414 ;;(generate-file-rss) Err bitreich.org 70 i 415 (save-file "output/gopher/rss.xml" (generate-rss :gopher t)) Err bitreich.org 70 i 416 Err bitreich.org 70 i 417 ;; produce the gophermap file Err bitreich.org 70 i 418 (save-file (concatenate 'string "output/gopher/" (getf *config* :gopher-index)) Err bitreich.org 70 i 419 (generate-gopher-index *articles*)) Err bitreich.org 70 i 420 Err bitreich.org 70 i 421 ;; produce a tag list menu Err bitreich.org 70 i 422 (let* ((directory-path "output/gopher/_tags_/") Err bitreich.org 70 i 423 (index-path (concatenate 'string directory-path (getf *config* :gopher-index)))) Err bitreich.org 70 i 424 (ensure-directories-exist directory-path) Err bitreich.org 70 i 425 (save-file index-path Err bitreich.org 70 i 426 (let ((output (load-file "templates/gopher_head.tpl"))) Err bitreich.org 70 i 427 (loop for tag in Err bitreich.org 70 i 428 ;; sort tags per articles in it Err bitreich.org 70 i 429 (sort (articles-by-tag) #'> Err bitreich.org 70 i 430 :key #'(lambda (x) (length (getf x :value)))) Err bitreich.org 70 i 431 do Err bitreich.org 70 i 432 (setf output Err bitreich.org 70 i 433 (string Err bitreich.org 70 i 434 (concatenate Err bitreich.org 70 i 435 'string output Err bitreich.org 70 i 436 (format nil (getf *config* :gopher-format) Err bitreich.org 70 i 437 1 ;; gopher type, 1 for menus Err bitreich.org 70 i 438 ;; here we create a 72 width char string with title on the left Err bitreich.org 70 i 439 ;; and number of articles on the right Err bitreich.org 70 i 440 ;; we truncate the article title if it's too large Err bitreich.org 70 i 441 (let ((title (format nil "~72a" Err bitreich.org 70 i 442 (if (< 72 (length (getf tag :NAME))) Err bitreich.org 70 i 443 (subseq (getf tag :NAME) 0 80) Err bitreich.org 70 i 444 (getf tag :NAME)))) Err bitreich.org 70 i 445 (article-number (format nil "~d article~p" (length (getf tag :value)) (length (getf tag :value))))) Err bitreich.org 70 i 446 (replace title article-number :start1 (- (length title) (length article-number)))) Err bitreich.org 70 i 447 (concatenate 'string Err bitreich.org 70 i 448 (getf *config* :gopher-path) "/" (getf tag :NAME) "/") Err bitreich.org 70 i 449 (getf *config* :gopher-server) Err bitreich.org 70 i 450 (getf *config* :gopher-port) Err bitreich.org 70 i 451 ))))) Err bitreich.org 70 i 452 output))) Err bitreich.org 70 i 453 Err bitreich.org 70 i 454 ;; produce each tag gophermap index Err bitreich.org 70 i 455 (loop for tag in (articles-by-tag) do Err bitreich.org 70 i 456 (let* ((directory-path (concatenate 'string "output/gopher/" (getf tag :NAME) "/")) Err bitreich.org 70 i 457 (index-path (concatenate 'string directory-path (getf *config* :gopher-index))) Err bitreich.org 70 i 458 (articles-with-tag (loop for article in *articles* Err bitreich.org 70 i 459 when (member (article-id article) (getf tag :VALUE) :test #'equal) Err bitreich.org 70 i 460 collect article))) Err bitreich.org 70 i 461 (ensure-directories-exist directory-path) Err bitreich.org 70 i 462 (save-file index-path (generate-gopher-index articles-with-tag)))) Err bitreich.org 70 i 463 Err bitreich.org 70 i 464 ;; produce each article file (adding some headers) Err bitreich.org 70 i 465 (loop for article in *articles* Err bitreich.org 70 i 466 do Err bitreich.org 70 i 467 (with-converter Err bitreich.org 70 i 468 (let ((id (article-id article))) Err bitreich.org 70 i 469 (save-file (format nil "output/gopher/article-~d.txt" id) Err bitreich.org 70 i 470 (format nil "Title: ~a~%Author: ~a~%Date: ~a~%Tags: ~a~%============~%~%~a" Err bitreich.org 70 i 471 (article-title article) Err bitreich.org 70 i 472 (article-author article) Err bitreich.org 70 i 473 (date-format (getf *config* :date-format) (article-date article)) Err bitreich.org 70 i 474 (article-tag article) Err bitreich.org 70 i 475 (load-file (format nil "data/~d~d" id (converter-extension converter-object))))))))) Err bitreich.org 70 i 476 Err bitreich.org 70 i 477 Err bitreich.org 70 i 478 ;; This is function called when running the tool Err bitreich.org 70 i 479 (defun generate-site() Err bitreich.org 70 i 480 (if (getf *config* :html) Err bitreich.org 70 i 481 (create-html-site)) Err bitreich.org 70 i 482 (if (getf *config* :gemini) Err bitreich.org 70 i 483 (create-gemini-capsule)) Err bitreich.org 70 i 484 (if (getf *config* :gopher) Err bitreich.org 70 i 485 (create-gopher-hole))) Err bitreich.org 70 i 486 Err bitreich.org 70 i 487 ;;;; EXECUTION Err bitreich.org 70 i 488 Err bitreich.org 70 i 489 (generate-site) Err bitreich.org 70 i 490 Err bitreich.org 70 i 491 (quit) Err bitreich.org 70 .