lisp project of the day
1.0.0
هنا سأقوم بنشر ملاحظات حول مشاريع QuickLisp. كما قمت بنشرها على حساب Twitter Svetlyak40wt . تم إغلاق المشروع على Twitter ، وانتقل إلى YouTube https://www.youtube.com/@40ants و peertube: https://diode.zone/c/40ants!
بادئ ذي بدء ، نحتاج إلى تحديد حزمة للرمز الخاص بنا:
( defpackage #:poftheday
( :use # :cl)
( :import-from # :rutils
# :iter
# :with
# :fmt)
( :export
# :choose))
( in-package poftheday)ثم وظيفة لاختيار مشروع عشوائي بين جميع المشاريع ، التي توفرها QuickLisp. عميل QuickLisp اتصل بهم "الإصدارات".
( 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))))))بالمناسبة ، ستختار هذه الوظيفة جميع المشاريع من جميع توزيعات QuickLisp المثبتة. يمكنك الحصول على الكثير منهم:
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>)لجعل Randomizer اختيار حزم مختلفة بعد إعادة تشغيل LISP ، نحتاج إلى تهيئته:
( setf *random-state*
( make-random-state t ))
أولاً ، نحتاج إلى قراءة Walk All Org-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))))لكل صفحة نحتاج إلى هيكل عظمي مع رأس وتذييل وأنماط التمهيد اللازمة.
مع أسهل طريقة "Cl-Who" لإنشاء قالب هي استخدام Macro LISP مثل ذلك:
( 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 " )))))))))))
عند جمع ملفات المصدر ، نحتاج إلى تقديمها إلى HTML داخل مجلد "المستندات". سيستخدم Github محتوى هذا المجلد ، لخدمة الموقع على http://40ants.com/lisp-project-of-ny-day/
لتقديم الصفحة ، نحتاج إلى استخراج عنوان من أول مخطط تفصيلي لملف وضع 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))))
سأحتاج إلى تقديم HTML في وضعين. أول واحد - لصفحة الويب ، والثانية - لتغذية RSS. بالنسبة لتغذية RSS ، أحتاج إلى حذف رأس H1 الأول وجدول الخصائص.
( defvar *rss-mode* nil )
يمكن أن يحتوي ملف وضع ORG على عقد من أنواع مختلفة ، وسوف نقوم بتقديمها باستخدام هذه الوظيفة العامة:
( defgeneric render-node (node stream )
( :documentation " Renders org-mode node into the HTML stream " ))
تحتوي عقدة المخطط التفصيلي على رأس قسم ويجب تقديمه كـ H1 و H2 ، إلخ:
( 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 ))
يمكن أن يكون للمخطط الأول للمقال خصائص. تصف هذه الخصائص حالة المشروع ، إذا كان لديها وثائق ، ومدى نشاطه ، وما إلى ذلك. هذه الخصائص لديها درجات:
أيضًا ، سنقوم بتحويل الروابط إلى عقد HTML المناسبة.
( 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))))))))
تحتوي العقدة النصية على قصاصات رمز ، نحتاج إلى لفها في علامات <code> وإضافة تمييز بناء الجملة:
( 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.
)
في العقدة النصية ، نحتاج إلى معالجة الفقرات والروابط والصور والاقتباسات. سوف نستخدم وظيفة منفصلة لمعالجة نص مثل هذا:
مشروع LISP المشترك اليوم هو: معدل المعدل.
إنه جدولة مؤشرات ترابط دورية مستوحاة من RTEMS:
http://quickdocs.org/rate-monotonic/
في HTML:
<p> مشروع LISP المشترك اليوم هو: معدل المعدل. </p>
<p> إنه جدولة مؤشرات ترابط دورية مستوحاة من RTEMS: </p>
<a href = "http://quickdocs.org/rate-monotonic/"> http://quickdocs.org/rate-monotonic/ </a>
للقيام بذلك ، سنكتب جهاز حالة بسيط ، والذي سيقرأ خط النص من سطره ولفه في علامات HTML المناسبة:
( 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)))))
الآن ، سوف نستخدم وظيفة معالجة النص هذه لتقديم جميع العقد النصية في ملفات وضع org:
( defmethod render-node ((node cl-org-mode ::text-node) stream )
(render-text ( cl-org-mode ::node.text node)
stream ))
لقد حان الوقت الآن لكتابة رمز سيؤدي إلى جعل جميع ملفات وضع ORG في 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 ))))))
نريد أن نعرض في مشاركات RSS فقط ، المنشورة على Twitter. يمكن استخراج هذه المعلومات من readme.org ، لأنني أضيف رابطًا إلى تغريدة. إذا كان هناك رابط ، يتم نشر المنشور.
لذلك ، يتعين علينا العثور على جميع عناصر القائمة داخل عنوان "2020" ونختار فقط تلك ، ولديها رابط إلى 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 " )))))
أيضًا ، لكل ملف نحتاج إلى معرفته متى تم إنشاؤه. بدون تاريخ ، سيعرض العديد من عملاء RSS التغذية بطرق خاطئة.
الوظيفة التالية Get's The Timestamp للالتزام مع الكلمة الرئيسية "Publish" في نص. أو الطابع الزمني للالتزام الأول حيث تمت إضافة الملف إلى المستودع.
كقيمة ثانية ، فإنه يعيد رسالة التزام تم أخذها من الطابع الزمني. كان هذا مفيدًا لتصحيح الأخطاء:
( 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))))))))
في صفحة الفهرس ، نريد إخراج قائمة بجميع المقالات. ربما في وقت لاحق ، سنرغب في طباعة الأحدث فقط وإنشاء كتالوج يعتمد على العلامات ، ولكن الآن قائمة بسيطة كافية.
سنستخدم عدد قليل من المساعدين لإنشاء عناوين URL والعناوين لصفحة الفهرس:
( 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)))
سنعيد استخدام هذه الوظيفة للصفحة الأولى وللصفحات العلامات:
( 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 " ))
لكل علامة نريد إنشاء صفحة منفصلة حيث سيتم سرد المشاركات فقط التي لها علامة.
أولاً ، نحتاج إلى وظيفة لجمع مجموعة من العلامات ، تستخدمها جميع المنشورات:
( 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))
كما نحتاج إلى وظيفة لتصفية الملفات التي لها علامة محددة:
( 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)))))
الآن يمكننا كتابة وظيفة ستقدم صفحة واحدة:
( 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 )))
أيضًا ، نحتاج إلى وظيفة نقطة الدخول التي سيفعل جميع الوظائف - قراءة الملفات واكتب 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))))
وضع Cl-Org من QuickLisp هو مكتبة عمرها 10 سنوات والتي يبدو أنها غير محفوظة. ربما من الأفضل الانتقال إلى مكتبة وجدتها على Github أو إلى هذه المكتبة.
للعمل مع الملفات سوف نستخدم PPATH. هذه المكتبة قادرة على جعل المسار النسبي. ومع ذلك ، فإنه يعمل مع السلاسل ، وليس أسماء المسارات.
( defun pathname-to-string (p)
( format nil " ~A " p))
قررت هذا الصباح القيام بأسبوع من مراجعة امتدادات ASDF. هناك قائمة غير مكتملة لتمديدات ASDF في وثائقها ، ولكن كيفية العثور على جميع ملحقات ASDF المتاحة؟ من الواضح ، من خلال تحليل جميع ملفات "*.ASD" ، واستخراج ": 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)))))))-لوججر
darts.lib.* مكتبات على github.بسيط
يتم استضافة الموقع في صفحات Github مباشرة من مجلد docs . وبالتالي تحتاج إلى إنشاء الموقع على جهازك ودفع النتائج إلى الفرع الرئيسي.
لبناء موقع قم بذلك في Repl:
(QL: Quickload: Poftheday)
(Poftheday :: Render Site)
في هذا المشروع ، استخدمت أيقونة RSS بواسطة Alex Prunici.
