generator-aux.lisp (6543 bytes)
1 (in-package :cl-yag) 2 3 (setf *articles* (reverse *articles*) 4 *generators* (reverse *generators*)) 5 6 (defun replace-all (string part replacement &key (test #'char=)) 7 "Replace all occurrences of PART with REPLACEMENT in STRING." 8 (with-output-to-string (out) 9 (loop with part-length = (length part) 10 for old-pos = 0 then (+ pos part-length) 11 for pos = (search part string 12 :start2 old-pos 13 :test test) 14 do (write-string string out 15 :start old-pos 16 :end (or pos (length string))) 17 when pos do (write-string replacement out) 18 while pos))) 19 20 (defun split-str(text &optional (separator #\Space)) 21 "This function splits a string with separator and returns a list." 22 (let ((text (concatenate 'string text (string separator)))) 23 (loop for char across text 24 counting char into count 25 when (char= char separator) 26 collect 27 ;; we look at the position of the left separator from right to left 28 (let ((left-separator-position (position separator text :from-end t :end (- count 1)))) 29 (subseq text 30 ;; if we can't find a separator at the left of the current, then it's the start of 31 ;; the string 32 (if left-separator-position (+ 1 left-separator-position) 0) 33 (- count 1)))))) 34 35 36 (defun date-format(format date) 37 "Format a date using the given format string with template substitutions." 38 (let ((output format)) 39 (template "%DayName" (getf date :dayname)) 40 (template "%DayNumber" (format nil "~2,'0d" (getf date :daynumber))) 41 (template "%MonthName" (getf date :monthname)) 42 (template "%MonthNumber" (format nil "~2,'0d" (getf date :monthnumber))) 43 (template "%Year" (write-to-string (getf date :year ))) 44 output)) 45 46 (defun articles-by-tag() 47 "Generate a list of tags with associated article IDs." 48 (let ((tag-list)) 49 (loop for article in *articles* do 50 (when (article-tag article) ;; we don't want an error if no tag 51 (loop for tag in (split-str (article-tag article)) do ;; for each word in tag keyword 52 (setf (getf tag-list (intern tag "KEYWORD")) ;; we create the keyword is inexistent and add ID to :value 53 (list 54 :name tag 55 :value (push (article-id article) (getf (getf tag-list (intern tag "KEYWORD")) :value))))))) 56 (loop for i from 1 to (length tag-list) by 2 collect ;; removing the keywords 57 (nth i tag-list)))) 58 59 (defun get-tag-list-article(&optional article) 60 "Generate HTML for the list of tags for a specific article." 61 (apply #'concatenate 'string 62 (mapcar #'(lambda (item) 63 (prepare "templates/one-tag.tpl" (template "%%Name%%" item))) 64 (split-str (article-tag article))))) 65 66 (defun get-tag-list() 67 "Generate HTML for the complete list of all tags." 68 (apply #'concatenate 'string 69 (mapcar #'(lambda (item) 70 (prepare "templates/one-tag.tpl" 71 (template "%%Name%%" (getf item :name)))) 72 (articles-by-tag)))) 73 74 (defun create-article(article &optional &key (tiny t) (no-text nil)) 75 "Generate HTML for a single article. Called in a loop to produce the homepage." 76 (prepare "templates/article.tpl" 77 (template "%%Author%%" (let ((author (article-author article))) 78 (or author (getf *config* :webmaster)))) 79 (template "%%Date%%" (date-format (getf *config* :date-format) 80 (article-date article))) 81 (template "%%Raw-Date%%" (article-rawdate article)) 82 (template "%%Title%%" (article-title article)) 83 (template "%%Id%%" (article-id article)) 84 (template "%%Tags%%" (get-tag-list-article article)) 85 (template "%%Date-Url%%" (date-format "%Year-%MonthNumber-%DayNumber" 86 (article-date article))) 87 (template "%%Text%%" (if no-text 88 "" 89 (if (and tiny (article-tiny article)) 90 (format nil "<p>~a</p>" (article-tiny article)) 91 (load-file (format nil "temp/data/~d.html" (article-id article)))))))) 92 93 (defun generate-layout(body &optional &key (title nil)) 94 "Return HTML string for a complete page with title and layout, using the parameter as content." 95 (prepare "templates/layout.tpl" 96 (template "%%Title%%" (or title (getf *config* :title))) 97 (template "%%Tags%%" (get-tag-list)) 98 (template "%%Body%%" body) 99 output)) 100 101 (defun generate-semi-mainpage(&key (tiny t) (no-text nil)) 102 "Generate HTML for the index homepage." 103 (apply #'concatenate 'string 104 (loop for article in *articles* collect 105 (create-article article :tiny tiny :no-text no-text)))) 106 107 (defun generate-tag-mainpage(articles-in-tag) 108 "Generate HTML for a tag-specific homepage." 109 (apply #'concatenate 'string 110 (loop for article in *articles* 111 when (member (article-id article) articles-in-tag :test #'equal) 112 collect (create-article article :tiny t)))) 113 114 (defun generate-rss-item (fn) 115 "Generate XML for RSS feed items." 116 (apply #'concatenate 'string 117 (loop for article in *articles* 118 for i from 1 to (min (length *articles*) (getf *config* :rss-item-number)) 119 collect 120 (prepare "templates/rss-item.tpl" 121 (template "%%Title%%" (article-title article)) 122 (template "%%Description%%" (load-file (format nil "temp/data/~d.html" (article-id article)))) 123 (template "%%Date%%" (format nil 124 (date-format "~a, %DayNumber ~a %Year 00:00:00 GMT" 125 (article-date article)) 126 (subseq (getf (article-date article) :dayname) 0 3) 127 (subseq (getf (article-date article) :monthname) 0 3))) 128 (template "%%Url%%" (funcall fn article)))))) 129 130 131 (defun generate-rss(fn) 132 "Generate complete RSS XML data." 133 (prepare "templates/rss.tpl" 134 (template "%%Description%%" (getf *config* :description)) 135 (template "%%Title%%" (getf *config* :title)) 136 (template "%%Url%%" (getf *config* :url)) 137 (template "%%Items%%" (generate-rss-item fn)))) 138 139 (defun generate-site() 140 "Main function called when running the site generation tool." 141 (loop for gen in *generators* 142 do (if (getf *config* (generator-key gen)) 143 (funcall (generator-create-site-fn gen))))) 144 145 ;; Note: generate-site is called manually or via `make`