123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171 |
- ;;;; Copyright (c) 2020 Farooq Karimi Zadeh <fkz@riseup.net>
- ;;;; It's under ISC license.
- (ql:quickload :str)
- (ql:quickload :3bmd)
- (ql:quickload :3bmd-ext-code-blocks)
- (ql:quickload :cl-mustache)
- (ql:quickload :osicat)
- (ql:quickload :jonathan)
- (setf 3bmd:*smart-quotes* t)
- (setf 3bmd-code-blocks:*code-blocks* t)
- (defun random-color ()
- ;; A list of W3.css colors... change this if you
- ;; use some other CSS framework...
- (nth (random 28)
- '("red" "purple" "indigo" "light-blue" "aqua"
- "green" "lime" "khaki" "amber" "deep-orange"
- "brown" "gray" "pale-red" "pale-green"
- "pink" "deep-purple" "blue" "cyan" "teal"
- "light-green" "sand" "yellow" "orange"
- "blue-gray" "light-gray" "dark-gray"
- "pale-yellow" "pale-blue")))
- (defun convert-to-html (md)
- (with-output-to-string (stream)
- (3bmd:parse-string-and-print-to-stream md stream)))
- (defun get-title (html)
- (let ((start (search "<h3>" html))
- (end (search "</h3>" html)))
- (subseq html (+ start 4) end)))
- (defun get-summary (html)
- (let ((start (search "<p>" html))
- (end (search "</p>" html)))
- (subseq html (+ start 3) end)))
- (defun markdown? (path)
- (equalp "md" (pathname-type path)))
- (defun make-link (path name)
- (str:concat "<a href='" path "'>" name "</a>"))
- (defun join-links (links)
- (str:join " | " links))
- (defun get-file-size (path)
- (let ((stat (osicat-posix:stat path)))
- (osicat-posix:stat-size stat)))
- (defun get-human-readable-size (size)
- (let ((units '("B" "KB" "MB" "GB" "TB"))
- (unit 0))
- (loop when (< size 1024)
- return (str:concat
- (with-output-to-string (out) (format out "~a" (round size)))
- (nth unit units))
- do (setf size (/ size 1024))
- (incf unit))))
- (defun fobil (&optional filesp)
- (let* ((posts (uiop:directory-files #P"./posts/"))
- (pages (uiop:directory-files #P"./pages/"))
- (post-template (mustache:compile-template #P"./templates/post.html"))
- (page-template (mustache:compile-template #P"./templates/page.html"))
- (index-template (mustache:compile-template #P"./templates/index.html"))
- (pages-html (loop for page in pages
- when (markdown? page)
- collect (convert-to-html
- (uiop:read-file-string page))))
- (posts-html (loop for post in posts
- when (markdown? post)
- collect (convert-to-html
- (uiop:read-file-string post))))
- (pages-names (loop for page in pages
- when (markdown? page)
- collect (str:concat
- (pathname-name page) ".html")))
- (pages-titles (loop for page-html in pages-html
- collect (get-title page-html)))
- (posts-titles (loop for post-html in posts-html
- collect (get-title post-html)))
- (links-for-index '())
- (links-for-posts '())
- (links-for-pages '())
- (posts-names (loop for post in posts
- when (markdown? post)
- collect (str:concat
- (pathname-name post) ".html"))))
- (ensure-directories-exist "./out/")
- (ensure-directories-exist "./out/pages/")
- (ensure-directories-exist "./out/posts/")
- (loop for page-name in pages-names
- for page-title in pages-titles
- do
- (push
- (make-link (str:concat "./" page-name) page-title)
- links-for-pages)
- (push
- (make-link (str:concat "../pages/" page-name) page-title)
- links-for-posts)
- (push
- (make-link (str:concat "./pages/" page-name) page-title)
- links-for-index))
- (loop for page-name in pages-names
- for page-html in pages-html
- for page-title in pages-titles
- with links = (join-links links-for-pages)
- do (str:to-file
- (str:concat "./out/pages/" page-name)
- (with-output-to-string (out)
- (funcall page-template (list
- (cons "title" page-title)
- (cons "content" page-html)
- (cons "links" links))
- out))))
- (loop for post-name in posts-names
- for post-html in posts-html
- for post-title in posts-titles
- with links = (join-links links-for-posts)
- do (str:to-file
- (str:concat "./out/posts/" post-name)
- (with-output-to-string (out)
- (funcall post-template (list
- (cons "title" post-title)
- (cons "content" post-html)
- (cons "links" links))
- out))))
- (let* ((posts-data (loop for post-title in posts-titles
- for post-html in posts-html
- for post-summary = (get-summary post-html)
- for post-name in posts-names
- for post-link = (make-link
- (str:concat "./posts/" post-name)
- "Read more")
- collect (list (cons "post-title" (get-title post-html))
- (cons "post-summary" post-summary)
- (cons "post-link" post-link)))))
- (str:to-file #P"./out/index.html"
- (with-output-to-string (out)
- (funcall index-template
- (list (cons "links" (join-links links-for-index))
- (cons "foreach" posts-data))
- out))))
- (when (and (probe-file #P"./files") filesp)
- (let* ((files-template (mustache:compile-template #P"./templates/files.html"))
- (files-list (jonathan:parse
- (uiop:read-file-string #P"./files/list.json")))
- (files-list- (loop for file in files-list
- for addr = (getf file :|addr|)
- collect (list (cons "color"
- (random-color))
- (cons "addr"
- (file-namestring addr))
- (cons "title"
- (file-namestring addr))
- (cons "description"
- (getf file :|description|))
- (cons "size"
- (get-human-readable-size
- (get-file-size addr)))))))
- (ensure-directories-exist #P"./out/files/")
- (str:to-file #P"./out/files/index.html"
- (with-output-to-string (out)
- (funcall files-template
- (list (cons "links" (join-links links-for-posts))
- (cons "foreach" files-list-))
- out)))))))
|