lisp project of the day
1.0.0
Aqui vou postar notas sobre projetos Quicklisp. Também os publiquei na conta do Twitter svetlyak40wt . O projeto no Twitter está fechado e mudado para o YouTube https://www.youtube.com/@40ants and Peertube: https://diode.zone/c/40ants!
Primeiro de tudo, precisamos definir um pacote para o nosso código:
( defpackage #:poftheday
( :use # :cl)
( :import-from # :rutils
# :iter
# :with
# :fmt)
( :export
# :choose))
( in-package poftheday)Em seguida, uma função para selecionar um projeto aleatório entre todos os projetos, fornecido pela Quicklisp. O cliente Quicklisp os chama de "lançamentos".
( 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))))))A propósito, essa função escolherá todos os projetos de todas as distribuições Quicklisp instaladas. Você pode ter muitos deles:
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>)Para fazer o randomizador escolher diferentes pacotes após o reinício do LISP, precisamos inicializá -lo:
( setf *random-state*
( make-random-state t ))
Primeiro, precisamos ler os arquivos Walk todos os modos de organização na pasta "Conteúdo". Manteremos um caminho relativo apontando para o arquivo e analisaremos este arquivo com o modo CL-ORG:
( 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))))Para cada página, precisamos de um esqueleto com cabeçalho, rodapé e estilos de bootstrap necessários.
Com a maneira mais fácil de criar um modelo "CL-WHO" é usar a macro Lisp como essa:
( 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 " )))))))))))
Quando os arquivos de origem são coletados, precisamos renderizá -los para HTML dentro da pasta "Docs". O GitHub usará o conteúdo desta pasta, para servir o site em http://40ants.com/lisp-project-ox-the-day/
Para renderizar a página, precisamos extrair um título do primeiro nó de esboço do arquivo de modo de organização:
( 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))))
Vou precisar renderizar html em dois modos. Primeiro - para a página da web e o segundo - para feed RSS. Para feed RSS, preciso omitir o primeiro cabeçalho H1 e uma tabela de propriedades.
( defvar *rss-mode* nil )
O arquivo de modo org pode conter nós de diferentes tipos, nós os renderizaremos usando esta função genérica:
( defgeneric render-node (node stream )
( :documentation " Renders org-mode node into the HTML stream " ))
O nó de esboço contém um cabeçalho de uma seção e deve ser renderizado como 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 ))
O primeiro esboço do artigo pode ter propriedades. Essas propriedades descrevem o estado do projeto, se tiver documentação, quão ativo é etc. Essas propriedades têm notas:
Além disso, transformaremos os links em nós HTML adequados.
( 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))))))))
O nó de texto contém trechos de código, precisamos envolvê -los em tags <code> e adicionar uma sintaxe destacando:
( 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.
)
No nó de texto, precisamos processar parágrafos, links, imagens e cotações. Usaremos uma função separada para processar texto como este:
O projeto Lisp comum do dia de hoje é: Taxa-monotônico.
É um agendador de threads periódicos inspirado no RTEMS:
http://quickdocs.org/rate-monotonic/
em html:
<p> O projeto comum do dia de hoje é: Taxa-monotônico. </p>
<p> É um agendador de threads periódicos inspirado no RTEMS: </p>
<a href = "http://quickdocs.org/rate-monotonic/" http://quickdocs.org/rate-monotonic/ </a>
Para fazer isso, escreveremos uma máquina de estado simples, que lerá a linha por linha e embrulhar suas peças em tags html apropriadas:
( 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)))))
Agora, usaremos esta função de processamento de texto para renderizar todos os nós de texto em nossos arquivos de modo de organização:
( defmethod render-node ((node cl-org-mode ::text-node) stream )
(render-text ( cl-org-mode ::node.text node)
stream ))
Agora é hora de escrever um código que renderá todos os arquivos de modo org em 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 ))))))
Queremos mostrar apenas postagens RSS, publicadas no Twitter. Essas informações podem ser extraídas do readme.org, porque lá estou adicionando um link ao tweet. Se houver um link, a postagem será publicada.
Portanto, temos que encontrar todos os itens da lista dentro do título “2020” e escolher apenas aqueles, tendo um link para o 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 " )))))
Além disso, para cada arquivo que precisamos saber quando foi criado. Sem uma data, muitos clientes do RSS exibirão feed de uma maneira errada.
A próxima função obtém o carimbo de data e hora do commit com a palavra -chave "publicar" em um texto. Ou o registro de data e hora da primeira confirmação em que o arquivo foi adicionado ao repositório.
Como o segundo valor, ele retorna uma mensagem de compromisso que um registro de data e hora foi retirado. Isso foi útil para depuração:
( 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))))))))
Na página de índice, queremos produzir uma lista de todos os artigos. Provavelmente mais tarde, queremos imprimir apenas o mais recente e criar um catálogo baseado em tags, mas agora uma lista simples é suficiente.
Usaremos poucos ajudantes para criar URLs e títulos para a página de índice:
( 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)))
Vamos reutilizar esta função para a primeira página e para páginas de tag:
( 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 " ))
Para cada tag, queremos gerar uma página separada, onde serão listados apenas postagens com uma tag.
Primeiro, precisamos de uma função para coletar um conjunto de tags, usado por todas as postagens:
( 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))
Também precisamos de uma função para filtrar arquivos com tag específica:
( 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)))))
Agora podemos escrever uma função que renderá uma página uma:
( 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 )))
Além disso, precisamos de uma função de ponto de entrada que faça todo o trabalho - leia os arquivos e escreva 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))))
O modo Cl-Org do Quicklisp é uma biblioteca de 10 anos que parece sem atenção. Provavelmente é melhor mudar para uma biblioteca que encontrei no Github ou nesta biblioteca.
Para trabalhar com arquivos, usaremos o PPath. Esta biblioteca é capaz de fazer um caminho relativo. No entanto, ele opera com strings, não nomes de caminho.
( defun pathname-to-string (p)
( format nil " ~A " p))
Hoje de manhã, decidi fazer uma semana de revisão de extensões ASDF. Há uma lista incompleta de extensões ASDF em sua documentação, mas como encontrar todas as extensões ASDF disponíveis? Obviamente, analisando todos os arquivos "*.asd" e extraindo seus ": depende de defsystem-in".
( 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.* Bibliotecas no Github.Simples
O site está hospedado nas páginas do GitHub diretamente na pasta docs . Assim, você precisa construir o site em sua máquina e pressionar os resultados para a filial principal.
Para construir o site, faça isso no REPL:
(QL: Quickload: Poftheday)
(Poftheday :: Render-Site)
Neste projeto, usei o ícone RSS por Alex Prunici.
