Skip to content
/ lisp-project-of-the-day Public

Here I'll post notes about Quicklisp projects. Also I publish them on Twitter account svetlyak40wt.

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

License

BSD-2-Clause license
51 stars 6 forks Branches Tags Activity
Star
Notifications You must be signed in to change notification settings

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

BranchesTags

Folders and files

NameName
Last commit message
Last commit date

Latest commit

 

History

593 Commits

.github/workflows

.github/workflows

 
 

content

content

 
 

docs

docs

 
 

playground

playground

 
 

test

test

 
 

.gitignore

.gitignore

 
 

LICENSE

LICENSE

 
 

poftheday.asd

poftheday.asd

 
 

qlfile

qlfile

 
 

qlfile.lock

qlfile.lock

 
 

readme.org

readme.org

 
 

Repository files navigation

Here I’ll post notes about Quicklisp projects. Also I published them 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

2021

March

Junuary

2020

December

November

October

September

August

July

June

May

April

March

Code, used to choose a project

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

(defpackage #:poftheday
  (:use #:cl)
  (:import-from #:rutils
                #:iter
                #:with
                #:fmt)
  (:export
   #:choose))
(in-package poftheday)

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

(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))))))

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

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>)

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

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

Here is how a website is rendered

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:

(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))))

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:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *google-code* "
      <!-- Google tag (gtag.js) -->
      <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* "
      <!-- Yandex.Metrika counter -->
      <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&nbsp;")
                  (: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")))))))))))

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:

(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))))

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.

(defvar *rss-mode* nil)

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

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

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

(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))

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:

  • :) everything is good
  • :| means, for example, that documentation exists as a short readme and dont cover all functionality
  • :( the project lack of this category at all.

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

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

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

(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.
  )

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

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/

into HTML:

<p>Today’s Common Lisp project of the Day is: rate-monotonic.</p>

<p>It is a periodic thread scheduler inspired by RTEMS:</p>

<a href=”http://quickdocs.org/rate-monotonic/”>http://quickdocs.org/rate-monotonic/</a>

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:

(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</a>"))

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

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

(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)))))

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

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

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

(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>
</script>
" stream))))))

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.

(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")))))

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:

(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)))

(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))))))))

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:

(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)))

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

(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"))

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:

(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))

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

(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)))))

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

(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)))

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

(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)))

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:

(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)))

Some utilities

Org-mode helpers

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

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

(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))))

Cl-org-mode from the Quicklisp is a 10 years old library which seems unmaintained. Probably it is better to move to a library I’ve found on the GitHub or to this library.

Converting pathnames to strings

To work with files we will use ppath. This library is able to make relative path. However, it operates with strings, not pathnames.

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

A way to find interesting stats from Quicklisp

This morning I decided to do a week of ASDF extensions review. There is incomplete 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”.

(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)))))))

Good candidates for review

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:

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

Thanks

In this project I’ve used RSS Icon by Alex Prunici.

About

Here I'll post notes about Quicklisp projects. Also I publish them on Twitter account svetlyak40wt.

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

Topics

challenge website libraries common-lisp catalogue

Resources

Readme

License

BSD-2-Clause license
Activity
Custom properties

Stars

51 stars

Watchers

14 watching

Forks

6 forks
Report repository

Releases

No releases published

Packages

No packages published

Contributors 3

  •  
  •  
  •  

Languages