40ants / lisp-project-of-the-day

Here I'll post notes about Quicklisp projects. Also I publish them on Twitter account svetlyak40wt.
http://40ants.com/lisp-project-of-the-day/
BSD 2-Clause "Simplified" License
51 stars 6 forks source link
catalogue challenge common-lisp libraries website

-- encoding:utf-8 Mode: POLY-ORG; -- ---

Here I'll post notes about Quicklisp projects. +Also I published them [[https://twitter.com/search?q=%40svetlyak40wt%20%23poftheday&src=typed_query&f=live][on Twitter account svetlyak40wt]]+. Project on twitter is closed, and moved to YouTube https://www.youtube.com/@40Ants and PeerTube: https://diode.zone/c/40ants!

[[https://github.com/40ants/lisp-project-of-the-day/workflows/CI/badge.svg?branch=master]]

** March

** November

** October

** September

** August

** July

** June

** May

** April

** March

First of all, we need to define a package for our code:

+BEGIN_SRC lisp

(defpackage #:poftheday (:use #:cl) (:import-from #:rutils

:iter

            #:with
            #:fmt)

(:export

:choose))

(in-package poftheday)

+END_SRC

Then a function to select random project among all projects, provided by Quicklisp. Quicklisp client call them "releases".

+BEGIN_SRC lisp

(defun choose () (let ((published (find-published-systems))) (flet ((is-published (release) (loop for system-file in (ql::system-files release) for system-name = (str:replace-all ".asd" "" system-file) when (member system-name published :test #'string-equal) do (return-from is-published t)))) (let* ((releases (ql::provided-releases t)) (non-published (remove-if #'is-published releases)) (idx (random (length non-published))) (release (nth idx non-published))) (values (ql::project-name release) (ql::system-files release))))))

+END_SRC

By the way, this function will choose all projects from all installed Quicklisp distributions. You can have many of them:

+BEGIN_SRC lisp :load no :wrap

CL-USER> (ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil) CL-USER> (ql-dist:all-dists) (#<QL-DIST:DIST quicklisp 2019-08-13> #<QL-DIST:DIST ultralisp 20200307123509>)

+END_SRC

To make randomizer choose different packages after Lisp restart, we need to initialize it:

+BEGIN_SRC lisp

(setf random-state (make-random-state t))

+END_SRC

** Collecting source files

First, we need to read walk all org-mode files in folder "content". We will keep a relative path pointing to the file and parse this file with cl-org-mode:

+BEGIN_SRC lisp

(defclass file () ((filename :initarg :filename :type string :documentation "A relative path to the source org-mode file." :reader get-filename) (root :initarg :root :documentation "Parsed org-mode document, root node." :reader get-root)))

(defmethod print-object ((file file) stream) (print-unreadable-object (file stream :type t) (format stream "~A" (get-filename file))))

(defun read-files () (uiop:while-collecting (collect) (flet ((org-mode-p (name) (string-equal (pathname-type name) "org")) (make-file (filename) (collect (let ((relative-filename (ppath:relpath (pathname-to-string filename) "content/"))) (make-instance 'file :filename relative-filename :root (cl-org-mode::read-org-file filename)))))) (cl-fad:walk-directory "content/"

'make-file

                         :test #'org-mode-p))))

+END_SRC

** Rendering org-mode to HTML

*** A page skeleton For each page we need a skeleton with header, footer and necessary Bootstrap styles.

With "cl-who" easiest way to create template is to use lisp macro like that:

+BEGIN_SRC lisp

(eval-when (:compile-toplevel :load-toplevel :execute) (defparameter google-code "

  <script async src=\"https://www.googletagmanager.com/gtag/js?id=G-FL71WXK73K\"></script>
  <script>
    window.dataLayer = window.dataLayer || [];
    function gtag(){dataLayer.push(arguments);}
    gtag('js', new Date());

    gtag('config', 'G-FL71WXK73K');
  </script>

")

(defparameter yandex-metrika-code "

  <script type=\"text/javascript\" >
     (function(m,e,t,r,i,k,a){m[i]=m[i]||function(){(m[i].a=m[i].a||[]).push(arguments)};
     m[i].l=1*new Date();
     for (var j = 0; j < document.scripts.length; j++) {if (document.scripts[j].src === r) { return; }}
     k=e.createElement(t),a=e.getElementsByTagName(t)[0],k.async=1,k.src=r,a.parentNode.insertBefore(k,a)})
     (window, document, \"script\", \"https://mc.yandex.ru/metrika/tag.js\", \"ym\");

     ym(42462884, \"init\", {
          clickmap:true,
          trackLinks:true,
          accurateTrackBounce:true
     });
  </script>
  <noscript><div><img src=\"https://mc.yandex.ru/watch/42462884\" style=\"position:absolute ; left:-9999px;\" alt=\"\" /></div></noscript>
  <!-- /Yandex.Metrika counter -->

"))

(defvar index-uri nil "This is a path to the site's top level. When it is nil, consider we are on the front page.")

(defun construct-uri (uri &rest args) (if index-uri (concatenate 'string index-uri (apply #'rutils:fmt uri args)) (apply #'rutils:fmt uri args)))

(defmacro app-page ((stream &key title index-uri (site-title "Lisp Project of the Day")) &body body) (let ((*index-uri* ,index-uri)) (cl-who:with-html-output (*standard-output* ,stream :prologue t :indent t) (:html :lang "en" (:head (:meta :charset "utf-8") ,@(when title ((:title (cl-who:esc ,title)))) (:link :rel "alternate" :href "https://40ants.com/lisp-project-of-the-day/rss.xml" :type "application/rss+xml") (:meta :name "viewport" :content "width=device-width, initial-scale=1") ,google-code ,yandex-metrika-code (:link :type "text/css" :rel "stylesheet" :href ,cl-bootstrap:bootstrap-css-url) (:script :src ,cl-bootstrap:jquery-url) (:script :src ,cl-bootstrap:bootstrap-js-url) (:link :rel "stylesheet" :href "../../highlight/styles/tomorrow-night.css") (:script :src "../../highlight/highlight.pack.js") (:script "hljs.initHighlightingOnLoad() ;") (:style "

.tags .label { margin-right: 1em; } .posts tr { line-height: 1.7em; } .posts tr td.number { font-weight: bold; padding-right: 0.7em; } .posts tr td.tags { padding-left: 0.7em; } h1 .tags { font-size: 1.2rem; position: relative; left: 1.5rem; top: -1.5rem; } .tags a { text-decoration: none; } ")) (:body (cl-bootstrap:bs-container () (cl-bootstrap:bs-row (:a :href "https://40ants.com/lisp-project-of-the-day/rss.xml" :style "display: block; float: right;" (:img :alt "RSS Feed" :src "https://40ants.com/lisp-project-of-the-day/media/images/rss.png")) (:header (:h1 :style "text-align: center" (if ,index-uri (cl-who:htm (:a :href (rutils:fmt "~Aindex.html" ,index-uri) (cl-who:esc ,site-title))) (cl-who:esc ,site-title))) ,@(when title `((:h2 :style "text-align: center" (cl-who:esc ,title))))) (cl-bootstrap:bs-col-md () (:center (:h3 "You can support this project by donating at:") (:a :href "https://www.patreon.com/bePatron?u=33868637" (:img :alt "Donate using Patreon" :src "https://40ants.com/lisp-project-of-the-day/media/images/patreon-btn.png" :width "160")) (:a :href "https://liberapay.com/poftheday/donate" (:img :alt "Donate using Liberapay" :src "https://liberapay.com/assets/widgets/donate.svg")) (:p "Or see " (:a :href "https://40ants.com/lisp-project-of-the-day/patrons/index.html" "the list of project sponsors") ".")) ,@body)) (:div (:hr) (:center (:p (cl-who:str "Brought to you by 40Ants under ") (:a :rel "license" :href "http://creativecommons.org/licenses/by-sa/4.0/" (:img :alt "Creative Commons License" :style "border-width:0" :src "https://i.creativecommons.org/l/by-sa/4.0/88x31.png")))))))))))

+END_SRC

*** Generation of separate pages for articles

When source files are collected, we need to render them to HTML inside the "docs" folder. Github will use content of this folder, to serve the site at http://40ants.com/lisp-project-of-the-day/

To render the page, we need to extract a title from the first outline node of org-mode file:

+BEGIN_SRC lisp

(defun remove-tags (title) (cl-ppcre:regex-replace-all " :.:$" title ""))

(defun extract-tags (title) (declare (type simple-string title)) (when (find #\: title :test #'char=) (mapcar (alexandria:curry #'str:replace-all "_" "-") (str:split #\: (cl-ppcre:regex-replace-all ".?:(.):$" title "\1")))))

(defun get-title (file) ;; Title can ends with tags, we need to extract them ;; and return as a second value.
(let ((full-title (cl-org-mode::node.heading (cl-org-mode::node.next-node (get-root file))))) (values (remove-tags full-title) (extract-tags full-title))))

+END_SRC

I'll need to render HTML in two modes. First one - for the web page, and second - for RSS feed. For RSS feed I need to omit the first H1 header and a table of properties.

+BEGIN_SRC lisp

(defvar rss-mode nil)

+END_SRC

Org mode file can contain nodes of different types, we will render them using this generic function:

+BEGIN_SRC lisp

(defgeneric render-node (node stream) (:documentation "Renders org-mode node into the HTML stream"))

+END_SRC

Outline node contains a header of a section and should be rendered as H1, H2, etc:

+BEGIN_SRC lisp

(defmethod render-node ((node cl-org-mode::outline-node) stream) (cl-who:with-html-output (stream) ;; First node is a title (with ((level (1- (length (cl-org-mode::node.heading-level-indicator node)))) (full-title (cl-org-mode::node.heading node)) (title (remove-tags full-title))) (ecase level (1 (unless rss-mode (cl-who:htm (:h1 (cl-who:esc title) (:span :class "tags" (loop for tag in (extract-tags full-title) do (cl-who:htm (:a :href (construct-uri "tags/~A.html" tag) (cl-bootstrap:bs-label () (cl-who:esc tag)))))))))) (2 (cl-who:htm (:h2 (cl-who:esc title)))) (3 (cl-who:htm (:h3 (cl-who:esc title))))))) (call-render-for-all-children node stream))

+END_SRC

First outline of the article can have properties. These properties describe the state of the project, if it has documentation, how active it is, etc. These properties have grades:

Also, we'll transform links into proper HTML nodes.

+BEGIN_SRC lisp

(defun autolink (text) (cond ((str:starts-with-p "http" text) (format nil "<a href=\"~A\">~A" text text)) (t text)))

(defun smile->unicode (text) (arrows:->> text (str:replace-all ":)" "😀") (str:replace-all ":|" "🤨") (str:replace-all ":(" "🥺")))

;; This method was removed from cl-org-mode at some moment :( (defmethod cl-org-mode::node.children ((node CL-ORG-MODE::TEXT-NODE)) nil)

(defmethod render-node ((node cl-org-mode::properties-node) stream) (unless rss-mode (cl-who:with-html-output (stream) (:table :style "position: relative; float: right; background-color: #F1F1F1; padding: 1em; margin-left: 1em; margin-bottom: 1em; border: 1px solid #D1D1D1;" (mapcar (lambda (item) (render-node item stream)) (cl-org-mode::node.children node))))))

(defmethod render-node ((node cl-org-mode::property-node) stream) (cl-who:with-html-output (stream) (:tr (:td :style "padding-left: 0.5rem; padding-right: 0.5rem" (cl-who:esc (cl-org-mode::property-node.property node))) (:td :style "padding-left: 0.5rem; padding-right: 0.5rem; border-left: 1px solid #DDD" (cl-who:str (autolink (smile->unicode (cl-org-mode::property-node.value node))))))))

+END_SRC

Text node contains code snippets, we need to wrap them into tags and add a syntax highlighting:

+BEGIN_SRC lisp

(defmethod render-node ((node cl-org-mode::src-node) stream) (let ((mode (str:trim (cl-org-mode::node.emacs-mode node))) (text (str:trim (cl-org-mode::node.text node))))

(cond
  ((and (str:starts-with-p "html " mode)
        (str:containsp ":render-without-code" mode))

   (cl-who:with-html-output (stream)
     (cl-who:str text)))

  ((and (str:starts-with-p "html " mode)
        (str:containsp ":render" mode))

   (cl-who:with-html-output (stream)
     (:h4 "Code")
     (:pre
      (:code :class mode
             (cl-who:esc text))))

   (cl-who:with-html-output (stream)
     (:h4 "Result")
     (cl-who:str text)))
  (t
   (cl-who:with-html-output (stream)
     (:pre
      (:code :class mode
             (cl-who:esc text))))))))

(defmethod render-node ((node cl-org-mode::closing-delimiter-node) stream) ;; Closing delimiters for source code blocks should be ignored. )

+END_SRC

In text node we need to process paragraphs, links, images and quotes. We will use a separate function to process text like this:

+BEGIN_QUOTE

Today's Common Lisp project of the Day is: rate-monotonic.

It is a periodic thread scheduler inspired by RTEMS:

http://quickdocs.org/rate-monotonic/

+END_QUOTE

into HTML:

+BEGIN_QUOTE

Today's Common Lisp project of the Day is: rate-monotonic.

It is a periodic thread scheduler inspired by RTEMS:

http://quickdocs.org/rate-monotonic/

+END_QUOTE

To do this, we'll write a simple state machine, which will read text line by line and wrap it's pieces in appropriate HTML tags:

+BEGIN_SRC lisp

(defun replace-images (text) (cl-ppcre:regex-replace-all "\[\[(.*?\.(png|jpg|gif))\]\]" text "<img style=\"max-width: 100%\" src=\"\1\"/>"))

(defun replace-links (text) (cl-ppcre:regex-replace-all "\[\[(.?)\]\[(.?)\]\]" text "<a href=\"\1\">\2"))

(defun replace-raw-urls (text) (cl-ppcre:regex-replace-all "(^| )(https?://.*?)[,.!]?( |$)" text "\1<a href=\"\2\">\2\3"))

(defun replace-inline-code (text) (cl-ppcre:regex-replace-all "~(.*?)~" text "\1"))

(defun replace-org-mode-markup-with-html (text) (replace-inline-code (replace-raw-urls (replace-links (replace-images text)))))

(defun render-text (text stream) (let ((buffer nil) (reading-quote nil) (reading-list nil)) (labels ((write-paragraph () (cl-who:with-html-output (stream) (:p (cl-who:str ;; Here we don't escape the text, because ;; it is from trusted source and will contain ;; links to the images (replace-org-mode-markup-with-html (str:join " " (nreverse buffer)))))) (write-char #\Newline stream) (setf buffer nil)) (write-quote () (cl-who:with-html-output (stream) (:blockquote (:pre (cl-who:esc (str:join #\Newline (nreverse buffer)))))) (write-char #\Newline stream) (setf buffer nil)) (write-list () (cl-who:with-html-output (stream) (:ul (loop for item in (reverse buffer) do (cl-who:htm (:li (cl-who:str (replace-org-mode-markup-with-html item))))))) (write-char #\Newline stream) (setf buffer nil)) (process (line) (cond ((and (str:starts-with-p "- " line) (not reading-quote)) (push (subseq line 2) buffer) (setf reading-list t)) ((and reading-list (string= line "")) (write-list) (setf reading-list nil)) (reading-list (setf buffer (list* (format nil "~A ~A" (car buffer) line) (cdr buffer)))) ((string-equal line "#+BEGIN_QUOTE") (setf reading-quote t)) ((string-equal line "#+END_QUOTE") (setf reading-quote nil) (write-quote)) ((not (string= line "")) (push line buffer)) ((and (not reading-quote) (and (string= line "") buffer)) (write-paragraph))))) (mapc #'process (str:split #\Newline text)))))

+END_SRC

Now, we will use this text processing function to render all text nodes in our org-mode files:

+BEGIN_SRC lisp

(defmethod render-node ((node cl-org-mode::text-node) stream) (render-text (cl-org-mode::node.text node) stream))

+END_SRC

Now it is time to write a code which will render all org mode files into HTML:

+BEGIN_SRC lisp

(defun make-output-filename (file) (check-type file file) (ppath:join "docs" (format nil "~A.html" (car (ppath:splitext (get-filename file))))))

(defmethod render-node ((file file) stream) (render-node (get-root file) stream))

(defun call-render-for-all-children (node stream) (loop for child in (cl-org-mode::node.children node) do (render-node child stream)))

(defmethod render-node ((file cl-org-mode::org-file) stream) (call-render-for-all-children file stream))

(defun render-file (file) (with ((filename (make-output-filename file)) (title (get-title file))) (ensure-directories-exist filename)

(alexandria:with-output-to-file (stream filename :if-exists :supersede)
  (app-page (stream :index-uri "../../"
                    :title title)
    (cl-who:with-html-output (stream)
      (render-node file stream)
      (write-string "

<script src=\"https://utteranc.es/client.js\" repo=\"40ants/lisp-project-of-the-day\" issue-term=\"title\" label=\"comments\" theme=\"github-light\" crossorigin=\"anonymous\" async> " stream))))))

+END_SRC

*** Writing RSS feed

We want to show in RSS only posts, published at Twitter. This information can be extracted from the README.org, because there I'm adding a link to the tweet. If there is a link, the post is published.

So, we have to find all list items inside "2020" heading and choose only those, having a link to the twitter.

+BEGIN_SRC lisp

(defun find-published-systems () (let ((file (cl-org-mode::read-org-file "README.org")) (years (loop for node = file then (cl-org-mode::node.next-node node) while node when (and (typep node 'cl-org-mode::outline-node) (str:starts-with-p "20" (cl-org-mode::node.heading node))) collect node)) (months (loop for year in years appending (cl-org-mode::node.children year))) (text-nodes (loop for month in months appending (cl-org-mode::node.children month))) (texts (loop for node in text-nodes collect (cl-org-mode::node.text node))) (lines (loop for text in texts appending (str:split #\Newline text)))) (loop for line in lines when (and (str:starts-with-p "-" line) ;; If there are two links, then the second link is to the twitter post. ;; In this case this post is published. (= (str:count-substring "[[" line) 2)) appending (str:split " & " (cl-ppcre:regex-replace ".?\]\[(.?)\]." line "\1")))))

+END_SRC

Also, for each file we need to know when it was created. Without a date, many RSS clients will display feed in a wrong ways.

Next function get's the timestamp of the commit with "publish" keyword in a text. Or the timestamp of the first commit where the file was added to the repository.

As the second value, it returns a commit message a timestamp was take from. This was useful for debugging:

+BEGIN_SRC lisp

(defun get-file-timestamp (file) (let ((all-commits (with-output-to-string (standard-output*) (legit:git-log :paths (fmt "content/~A" (get-filename file)) :reverse t :format "%at %s"))) (lines (str:split #\Newline all-commits)) (first-timestamp (parse-integer (first (str:split #\Space (first lines)))))) (local-time:unix-to-timestamp first-timestamp)))

+END_SRC

+BEGIN_SRC lisp

(defun render-rss (files) (alexandria:with-output-to-file (stream "docs/rss.xml" :if-exists :supersede) (let ((base-url "http://40ants.com/lisp-project-of-the-day/") (published (find-published-systems))) (flet ((is-not-published (file) (let ((title (get-title file)) (filename (get-filename file))) (or (not (member title published :test #'string-equal)) (str:containsp "draft" filename))))) (xml-emitter:with-rss2 (stream) (xml-emitter:rss-channel-header "Common Lisp Project of the Day" base-url) (loop for file in (rutils:take 20 (reverse (remove-if #'is-not-published files))) for title = (get-title file) for uri = (get-uri file) for full-url = (format nil "~A~A" base-url uri) for description = (make-description file) for timestamp = (get-file-timestamp file) do (xml-emitter:rss-item title :description description :link full-url :pubdate (local-time:format-rfc1123-timestring nil timestamp))))))))

+END_SRC

*** Generating index page

On index page we want to output a list of all articles. Probably later, we'll want to print only the latest and to create a tags based catalogue, but now a simple list is enough.

We'll use few helpers to create urls and titles for the index page:

+BEGIN_SRC lisp

(defun strip-doc-folder (filename) "Removes doc/ from beginning of the filename" (cond ((str:starts-with-p "docs/" filename) (subseq filename 5)) (t filename)))

(defun get-uri (file) "Returns a link like 2020/03/001-some.html" (strip-doc-folder (make-output-filename file)))

(defun get-title-for-index (file) (rutils:with ((title tags (get-title file)) (filename (get-filename file)) (splitted (ppath:split filename)) (only-file (cdr splitted)) (number (first (str:split #- only-file)))) (values title number tags)))

+END_SRC

We'll reuse this function for the front page and for tag pages:

+BEGIN_SRC lisp

(defun title-to-systems (title) "Title may contain several systems, separated by &. Like \"skippy-renderer & zpng\". This function returns a list of separate systems." (mapcar #'str:trim (str:split "&" title)))

(defun render-index-page (files filename &key (index-uri nil) (path "docs") (title "Latest posts")) (let ((filename (ppath:join path (rutils:fmt "~A.html" filename))) (published (find-published-systems))) (ensure-directories-exist filename)

(flet ((is-not-published (file)
         (let* ((title (get-title file))
                (systems (title-to-systems title)))
           (and (not (string= title "Day Zero"))
                (loop for system in systems
                      never (member system
                                    published
                                    :test #'string-equal))))))
  (alexandria:with-output-to-file (stream filename :if-exists :supersede)
    (app-page (stream :index-uri index-uri)
      (:section :style "margin-left: auto; margin-right: auto; margin-top: 2em; width: 50%"
        (:h3 :style "margin-left: 1.6em"
             title)
        (:table :class "posts"
                (loop for file in (reverse files)
                      for uri = (get-uri file)
                      do (cl-who:htm
                          (:tr
                           (multiple-value-bind (title number tags)
                               (get-title-for-index file)

                             (unless (string-equal number
                                                   "draft")
                               (cl-who:with-html-output (stream)
                                 (:td :class "number"
                                      (cl-who:esc (format nil "#~A" number)))

                                 (:td (:a :href (construct-uri uri)
                                          (cl-who:esc title)))

                                 (:td :class "tags"
                                      (loop for tag in tags
                                            do (cl-who:htm
                                                (:a :href (construct-uri "tags/~A.html" tag)
                                                    (cl-bootstrap:bs-label ()
                                                      (cl-who:esc tag)))))
                                      (when (is-not-published file)
                                        (cl-bootstrap:bs-label-danger
                                          (cl-who:esc "draft")))))))))))))))
(values)))

(defun render-index (files) (render-index-page files "index"))

+END_SRC

*** Generating of tag pages

For each tag we want to generate a separate page where will be
listed only posts having a tag.

First, we need a function to collect a set of tags, used by all posts:

+BEGIN_SRC lisp

(defun get-all-tags (files) (let (results) (iter outer (:for file :in files) (with (( tags (get-title file))) (declare (ignorable )) (iter (:for tag :in tags) (pushnew tag results :test #'string-equal)))) results))

+END_SRC

Also we need a function to filter files having specific tag:

+BEGIN_SRC lisp

(defun get-files-with-tag (files tag) (iter (:for file :in files) (with (( tags (get-title file))) (declare (ignorable )) (when (member tag tags :test #'string-equal) (:collect file)))))

+END_SRC

Now we can write a function which will render a one page:

+BEGIN_SRC lisp

(defun render-tag (all-files tag) (render-index-page (get-files-with-tag all-files tag) tag :path "docs/tags/" :index-uri "../" :title (rutils:fmt "Posts with tag \"~A\"" tag)))

(defun render-all-tag-pages (all-files) (mapcar (alexandria:curry #'render-tag all-files) (get-all-tags all-files)))

+END_SRC

*** Also, we need a function to render the page with a Patreon patron's listing

+BEGIN_SRC lisp

(defun render-patrons () (let ((filename (ppath:join "docs" "patrons" "index.html")) (patrons '(("Jean-Philippe Paradis (Hexstream)" "https://www.hexstreamsoft.com/")))) (alexandria:with-output-to-file (stream filename :if-exists :supersede) (app-page (stream :index-uri "../") (:section :style " margin-left: auto; margin-right: auto; margin-top: 2em; width: 50%" (:h3 :style "margin-left: 1.6em" "Project Patrons") (:p "Special thanks to these people and companies supporting the project!") (:ul (loop for (name url) in patrons do (cl-who:htm (:li (:a :href url (cl-who:esc name))))))))) (values)))

+END_SRC

*** Main function to render the whole site

Also, we need a entry-point function which will do all the job - read files and write html:

+BEGIN_SRC lisp

(defun render-site (&key (no-tags nil)) (let ((files (read-files))) (mapc #'render-file files) (render-index files) (unless no-tags (render-all-tag-pages files)) (render-patrons) (render-rss files) (values)))

+END_SRC

** Some utilities *** Org-mode helpers

+BEGIN_SRC lisp

(defun make-description (file) (let ((rss-mode t)) (with-output-to-string (s) (render-node file s))))

+END_SRC

*** A hack to make cl-org-mode work with lowercased begin_src

#+begin_src lisp

(defclass lowercased-src-node (cl-org-mode::src-node)
         ()
         (:default-initargs 
          :opening-delimiter "#+begin_src"
          :closing-delimiter (format nil "~%#+end_src")
          :text nil
          :include-end-node nil))

(defmethod cl-org-mode::node-dispatchers ((node cl-org-mode::org-node))
  (or cl-org-mode::*dispatchers* 
      (mapcar #'make-instance '(lowercased-src-node
                                cl-org-mode::src-node
                                cl-org-mode::properties-node
                                cl-org-mode::outline-node))))

+end_src

[[https://common-lisp.net/project/cl-org-mode/][Cl-org-mode]] from the Quicklisp is a 10 years old library which [[https://gitlab.common-lisp.net/cl-org-mode/cl-org-mode][seems unmaintained]]. Probably it is better to move to a library I've found [[https://github.com/deepfire/cl-org-mode][on the GitHub]] or to [[https://github.com/Ferada/cl-org-mode-parser][this library]].

*** Converting pathnames to strings

To work with files we will use [[content/2020/03/0010-ppath.org][ppath]]. This library is able to make relative path. However, it operates with strings, not pathnames.

+BEGIN_SRC lisp

(defun pathname-to-string (p) (format nil "~A" p))

+END_SRC

  • A way to find interesting stats from Quicklisp This morning I decided to do a week of ASDF extensions review. There is incomplete [[https://common-lisp.net/project/asdf/#extensions][listing of ASDF extensions]] in it's documentation, but how to find all available ASDF extensions? Obviously, by parsing all "*.asd" files, and extracting their ":defsystem-depends-on".

+BEGIN_SRC lisp

(defun install-all-quicklisp () (loop with dist = (ql-dist:find-dist "quicklisp") with releases = (ql-dist:provided-releases dist) for release in releases do (ql-dist:install release)))

(defun get-software-dir () (let ((dist (ql-dist:find-dist "quicklisp"))) (ql-dist:relative-to dist (make-pathname :directory (list :relative "software")))))

(defun grep-defsystem-depends () "Returns lines produced by grep" (str:split #\Newline (with-output-to-string (s) (uiop:run-program (format nil "find ~A -name '*.asd' -print0 | xargs -0 grep -i defsystem-depends-on" (get-software-dir)) :output s))))

(defun extract-systems (line) (when (str:contains? "defsystem-depends-on" line) (loop with names = (str:words (cl-ppcre:regex-replace ".:defsystem-depends-on.\((.?)\)." line "\1")) for name in names collect (string-trim "\":#" name))))

(defun get-asdf-extensions (&key show-paths) (loop with result = (make-hash-table :test #'equal) for line in (grep-defsystem-depends) for systems = (extract-systems line) do (loop for system in systems do (push line (gethash system result nil))) finally (return (loop with sorted = (sort (alexandria:hash-table-alist result)

'>

                                         :key (lambda (item)
                                                (length (cdr item))))
                     for (system . lines) in sorted
                     collect (cons system (if show-paths
                                              lines
                                              (length lines)))))))

+END_SRC

Simple

  • cl-sentiment - sentiment text analyze

  • How to update and deploy the site

The site is hosted at GitHub pages right from the =docs= folder. Thus you need to build the site on your machine and to push results to the master branch.

To build site do this in the REPL:

+BEGIN_SRC text

(ql:quickload :poftheday) (poftheday::render-site)

+END_SRC