lisp project of the day
1.0.0
Ici, je publierai des notes sur les projets QuickLisp. Je les ai également publiés sur le compte Twitter svetlyak40wt . Le projet sur Twitter est fermé et déménagé sur YouTube https://www.youtube.com/@40ants et peertube: https://diode.zone/c/40ants!
Tout d'abord, nous devons définir un package pour notre code:
( defpackage #:poftheday
( :use # :cl)
( :import-from # :rutils
# :iter
# :with
# :fmt)
( :export
# :choose))
( in-package poftheday)Puis une fonction pour sélectionner un projet aléatoire parmi tous les projets, fourni par QuickLisp. Le client QuickLisp les appelle des «versions».
( 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))))))Soit dit en passant, cette fonction choisira tous les projets de toutes les distributions QuickLisp installées. Vous pouvez en avoir beaucoup:
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>)Pour faire de Randomizer, choisissez différents packages après redémarrage LISP, nous devons l'initialiser:
( setf *random-state*
( make-random-state t ))
Tout d'abord, nous devons lire Walk Tous les fichiers en mode org dans le dossier «Contenu». Nous garderons un chemin relatif pointant vers le fichier et analyserons ce fichier avec 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))))Pour chaque page, nous avons besoin d'un squelette avec en-tête, pied de page et des styles bootstrap nécessaires.
Avec le modèle le plus simple de créer «Cl-Who» est d'utiliser une macro LISP comme celle-là:
( 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 " ~A index.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 " )))))))))))
Lorsque des fichiers source sont collectés, nous devons les rendre sur HTML dans le dossier «DOCS». GitHub utilisera le contenu de ce dossier, pour servir le site à http://40ants.com/lisp-project-of-the-day//
Pour rendre la page, nous devons extraire un titre du premier nœud de contour du fichier en mode org:
( 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))))
Je devrai rendre HTML en deux modes. Le premier - pour la page Web, et deuxième - pour le flux RSS. Pour RSS Feed, j'ai besoin d'omettre le premier en-tête H1 et une table de propriétés.
( defvar *rss-mode* nil )
Le fichier de mode organ peut contenir des nœuds de différents types, nous les rendrons en utilisant cette fonction générique:
( defgeneric render-node (node stream )
( :documentation " Renders org-mode node into the HTML stream " ))
Le nœud de contour contient une en-tête d'une section et doit être rendu en 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 ))
Le premier aperçu de l'article peut avoir des propriétés. Ces propriétés décrivent l'état du projet, si elle a une documentation, à quel point elle est activée, etc. Ces propriétés ont des notes:
De plus, nous transformerons les liens en nœuds HTML appropriés.
( 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))))))))
Le nœud de texte contient des extraits de code, nous devons les envelopper dans des balises <code> et ajouter une syntaxe en surbrillance:
( 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.
)
Dans le nœud de texte, nous devons traiter les paragraphes, les liens, les images et les citations. Nous utiliserons une fonction distincte pour traiter le texte comme ceci:
Le projet LISP commun d'aujourd'hui est: les taux-monotoniques.
Il s'agit d'un planificateur de threads périodique inspiré par RTEMS:
http://quickdocs.org/rate-monotonic/
dans HTML:
<p> Le projet LISP commun d'aujourd'hui est: Rate-Monotonic. </p>
<p> Il s'agit d'un planificateur de threads périodique inspiré par RTEMS: </p>
<a href = ”http://quickdocs.org/rate-monotonic/”> http://quickdocs.org/rate-monotonic/ </a>
Pour ce faire, nous rédigerons une machine d'état simple, qui lira le texte en ligne par ligne et enveloppera ses pièces dans des balises HTML appropriées:
( 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)))))
Maintenant, nous utiliserons cette fonction de traitement de texte pour rendre tous les nœuds de texte dans nos fichiers en mode org:
( defmethod render-node ((node cl-org-mode ::text-node) stream )
(render-text ( cl-org-mode ::node.text node)
stream ))
Maintenant, il est temps d'écrire un code qui rendra tous les fichiers de mode Org dans 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 ))))))
Nous voulons afficher dans RSS Only Posts, publié sur Twitter. Ces informations peuvent être extraites de Readme.org, car j'ajoute un lien vers le tweet. S'il y a un lien, le message est publié.
Donc, nous devons trouver tous les éléments de liste à l'intérieur de la rubrique «2020» et les choisir uniquement, ayant un lien vers le 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 " )))))
De plus, pour chaque fichier, nous devons savoir quand il a été créé. Sans rendez-vous, de nombreux clients RSS afficheront le flux de mauvaise manière.
La fonction suivante obtient l'horodatage du commit avec un mot-clé «publier» dans un texte. Ou l'horodatage du premier engagement où le fichier a été ajouté au référentiel.
En tant que deuxième valeur, il renvoie un message de validation dont un horodatage a été tiré. Cela était utile pour le débogage:
( 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))))))))
Sur la page d'index, nous voulons publier une liste de tous les articles. Probablement plus tard, nous voulons imprimer uniquement les derniers et créer un catalogue basé sur des balises, mais maintenant une liste simple suffit.
Nous utiliserons quelques aides pour créer des URL et des titres pour la page d'index:
( 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)))
Nous réutiliserons cette fonction pour la première page et pour les pages de balises:
( 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 " ))
Pour chaque balise, nous souhaitons générer une page séparée où ne sera répertorié que les publications ayant une balise.
Tout d'abord, nous avons besoin d'une fonction pour collecter un ensemble de balises, utilisées par tous les messages:
( 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))
Nous avons également besoin d'une fonction pour filtrer les fichiers ayant une balise spécifique:
( 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)))))
Nous pouvons maintenant écrire une fonction qui rendra une page d'une seule fois:
( 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)))
( 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 )))
De plus, nous avons besoin d'une fonction de point d'entrée qui fera tout le travail - lire des fichiers et écrire 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 )))
( defun make-description (file)
( let (( *rss-mode* t ))
( with-output-to-string (s)
(render-node file s))))
( 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))))
Le mode Cl-Org du Quicklisp est une bibliothèque de 10 ans qui semble non entretenue. Il est probablement préférable de déménager dans une bibliothèque que j'ai trouvée sur le github ou dans cette bibliothèque.
Pour travailler avec des fichiers, nous utiliserons PPATH. Cette bibliothèque est capable de faire un chemin relatif. Cependant, il fonctionne avec des chaînes, pas des noms de chemin.
( defun pathname-to-string (p)
( format nil " ~A " p))
Ce matin, j'ai décidé de faire une semaine d'extensions de l'ASDF. Il existe une liste incomplète des extensions ASDF dans sa documentation, mais comment trouver toutes les extensions ASDF disponibles? Évidemment, en analysant tous les fichiers «* .asd» et en extraction de leur «: defSystem-Deprends-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)))))))-logger
darts.lib.* Bibliothèques sur le github.Simple
Le site est hébergé aux pages GitHub directement à partir du dossier docs . Ainsi, vous devez construire le site sur votre machine et pousser les résultats vers la branche maître.
Pour construire le site, faites-le dans le REP:
(QL: Quickload: PoftheDay)
(PoftheDay :: Render-Site)
Dans ce projet, j'ai utilisé l'icône RSS par Alex Prunici.
