lisp project of the day
1.0.0
Di sini saya akan memposting catatan tentang proyek Quicklisp. Saya juga menerbitkannya di akun twitter svetlyak40wt . Proyek di Twitter ditutup, dan dipindahkan ke YouTube https://www.youtube.com/@40ants dan Peertube: https://diode.zone/c/40ants!
Pertama -tama, kita perlu mendefinisikan paket untuk kode kita:
( defpackage #:poftheday
( :use # :cl)
( :import-from # :rutils
# :iter
# :with
# :fmt)
( :export
# :choose))
( in-package poftheday)Kemudian fungsi untuk memilih proyek acak di antara semua proyek, disediakan oleh Quicklisp. Klien Quicklisp memanggil mereka "rilis".
( 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))))))Ngomong -ngomong, fungsi ini akan memilih semua proyek dari semua distribusi QuickLisp yang diinstal. Anda dapat memiliki banyak dari mereka:
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>)Untuk membuat randomizer, pilih berbagai paket setelah restart lisp, kita perlu menginisialisasi:
( setf *random-state*
( make-random-state t ))
Pertama, kita perlu membaca file walk all org-mode di folder "konten". Kami akan menjaga jalur relatif menunjuk ke file dan menguraikan file ini dengan mode 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))))Untuk setiap halaman kita membutuhkan kerangka dengan header, footer, dan gaya bootstrap yang diperlukan.
Dengan cara termudah “Cl-Who” untuk membuat template adalah dengan menggunakan Lisp Macro seperti itu:
( 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 " )))))))))))
Ketika file sumber dikumpulkan, kita perlu membuat mereka ke HTML di dalam folder "Docs". GitHub akan menggunakan konten folder ini, untuk melayani situs di http://40ants.com/lisp-project-of-the-day/
Untuk membuat halaman, kita perlu mengekstrak judul dari simpul garis pertama file 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))))
Saya perlu membuat HTML dalam dua mode. Yang pertama - untuk halaman web, dan kedua - untuk umpan RSS. Untuk umpan RSS saya perlu menghilangkan header H1 pertama dan tabel properti.
( defvar *rss-mode* nil )
File mode org dapat berisi node dari berbagai jenis, kami akan membuatnya menggunakan fungsi generik ini:
( defgeneric render-node (node stream )
( :documentation " Renders org-mode node into the HTML stream " ))
Garis besar node berisi header suatu bagian dan harus diterjemahkan sebagai H1, H2, dll:
( 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 ))
Garis besar artikel pertama dapat memiliki properti. Properti ini menggambarkan keadaan proyek, jika memiliki dokumentasi, seberapa aktifnya, dll. Properti ini memiliki nilai:
Juga, kami akan mengubah tautan menjadi node HTML yang tepat.
( 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))))))))
Node teks berisi cuplikan kode, kita perlu membungkusnya ke dalam tag <code> dan menambahkan sintaksis sintaksis:
( 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.
)
Dalam simpul teks kita perlu memproses paragraf, tautan, gambar, dan kutipan. Kami akan menggunakan fungsi terpisah untuk memproses teks seperti ini:
Proyek Lisp umum hari ini adalah: tingkat-monotonik.
Ini adalah penjadwal utas periodik yang terinspirasi oleh rtems:
http://quickdocs.org/rate-monotonic/
menjadi html:
<p> Proyek Lisp umum hari ini adalah: rate-monotonic. </p>
<p> Ini adalah penjadwal utas periodik yang terinspirasi oleh rtems: </p>
<a href = ”http://quickdocs.org/rate-monotonic/”> http://quickdocs.org/rate-monotonic/ </a>
Untuk melakukan ini, kami akan menulis mesin negara bagian sederhana, yang akan membaca baris teks demi baris dan membungkus potongan -potongannya dalam tag HTML yang sesuai:
( 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)))))
Sekarang, kami akan menggunakan fungsi pemrosesan teks ini untuk membuat semua node teks dalam file mode org kami:
( defmethod render-node ((node cl-org-mode ::text-node) stream )
(render-text ( cl-org-mode ::node.text node)
stream ))
Sekarang saatnya menulis kode yang akan membuat semua file mode org ke 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 ))))))
Kami ingin menampilkan dalam posting RSS saja, yang diterbitkan di Twitter. Informasi ini dapat diekstraksi dari readme.org, karena di sana saya menambahkan tautan ke tweet. Jika ada tautan, posting diterbitkan.
Jadi, kita harus menemukan semua item daftar di dalam judul "2020" dan hanya memilihnya, memiliki tautan ke 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 " )))))
Juga, untuk setiap file yang perlu kita ketahui kapan itu dibuat. Tanpa tanggal, banyak klien RSS akan menampilkan feed dengan cara yang salah.
Fungsi Berikutnya Dapatkan stempel waktu komitmen dengan kata kunci "publikasi" dalam teks. Atau cap waktu dari komit pertama di mana file ditambahkan ke repositori.
Sebagai nilai kedua, ia mengembalikan pesan komit cap waktu. Ini berguna untuk 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))))))))
Pada halaman indeks kami ingin mengeluarkan daftar semua artikel. Mungkin nanti, kami hanya ingin mencetak yang terbaru dan membuat katalog berbasis tag, tetapi sekarang daftar sederhana sudah cukup.
Kami akan menggunakan beberapa pembantu untuk membuat URL dan judul untuk halaman indeks:
( 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)))
Kami akan menggunakan kembali fungsi ini untuk halaman depan dan untuk halaman 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 " ))
Untuk setiap tag kami ingin menghasilkan halaman terpisah di mana akan terdaftar hanya posting yang memiliki tag.
Pertama, kita membutuhkan fungsi untuk mengumpulkan satu set tag, digunakan oleh semua posting:
( 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))
Kami juga membutuhkan fungsi untuk memfilter file yang memiliki tag spesifik:
( 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)))))
Sekarang kita dapat menulis fungsi yang akan membuat satu halaman:
( 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 )))
Juga, kita memerlukan fungsi titik entri yang akan melakukan semua pekerjaan - baca file dan tulis 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))))
Mode CL-org dari Quicklisp adalah perpustakaan berusia 10 tahun yang tampaknya tidak terawat. Mungkin lebih baik pindah ke perpustakaan yang saya temukan di github atau ke perpustakaan ini.
Untuk bekerja dengan file, kami akan menggunakan ppath. Perpustakaan ini mampu membuat jalur relatif. Namun, beroperasi dengan string, bukan nama path.
( defun pathname-to-string (p)
( format nil " ~A " p))
Pagi ini saya memutuskan untuk melakukan ulasan ekstensi ASDF selama seminggu. Ada daftar ekstensi ASDF yang tidak lengkap dalam dokumentasinya, tetapi bagaimana menemukan semua ekstensi ASDF yang tersedia? Jelas, dengan parsing semua file "*.asd", dan mengekstraksi ": Defsystem-Depends-on" mereka.
( 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.* Perpustakaan di GitHub.Sederhana
Situs ini di -host di halaman GitHub langsung dari folder docs . Dengan demikian Anda perlu membangun situs di mesin Anda dan mendorong hasil ke cabang master.
Untuk membangun situs lakukan ini di repl:
(QL: Quickload: Poftheday)
(poftheday :: render-site)
Dalam proyek ini saya telah menggunakan ikon RSS oleh Alex Prunici.
