From e0a82235801dbff046422481ad546ee1b74c5de0 Mon Sep 17 00:00:00 2001 From: riton Date: Tue, 1 Apr 2025 17:41:43 +0300 Subject: =?UTF-8?q?=C3=BCretilen=20sayfalara=20linkleyen=20index=20sayfas?= =?UTF-8?q?=C4=B1=20olu=C5=9Ftur?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/ana.lisp | 51 +++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 39 insertions(+), 12 deletions(-) diff --git a/src/ana.lisp b/src/ana.lisp index ef47ecc..7502331 100644 --- a/src/ana.lisp +++ b/src/ana.lisp @@ -5,19 +5,23 @@ :do (when (eq :h1 (tag çocuk)) (return (value çocuk))))) -(defun şablon-yap (node) +(defun şablon-yap (node &optional başlık geri-link) (ebeveyn-node! :html (list (ebeveyn-node! :head - (list (çocuk-node! :title (başlık-bul node)) + (list (çocuk-node! :title (or başlık (başlık-bul node))) ;;; geçici hack çünkü /> ile biten tagleri düzgün basamıyorum " ")) (ebeveyn-node! :body - (list node))))) + (if (null geri-link) + (list node) + (list node + (çocuk-node! :a "geri dön" + '(:href "index.html")))))))) -(defun şablonlu-yazdır (node &optional (stream *standard-output*)) +(defun şablonlu-yazdır (node &optional (stream *standard-output*) başlık geri-link) (format stream "~%~%") - (node->html (şablon-yap node) stream)) + (node->html (şablon-yap node başlık geri-link) stream)) (defun markdown->html (kaynak hedef) (format t "~s -> ~s~%" kaynak hedef) @@ -27,7 +31,7 @@ (with-open-file (dış hedef :direction :output :if-does-not-exist :create :if-exists :supersede) - (şablonlu-yazdır root dış))))) + (şablonlu-yazdır root dış nil t))))) (defun md-dosyası? (yol) (or (string= "md" (pathname-type yol)) @@ -67,18 +71,41 @@ Dosya değişmediyse yeniden oluşturma." (loop :for d :in (uiop:subdirectories kaynak) :do (dizin-kopyala d (yol-çeviri d kaynak hedef)))) +(defun index-üret (dosyalar hedef) + (let ((index-html + (ebeveyn-node! + :div + (list + (ebeveyn-node! + :ul + (loop :for dosya :in dosyalar + :collect (ebeveyn-node! + :li + (list (çocuk-node! + :a + (file-namestring dosya) + (list :href (file-namestring dosya))))))))))) + (with-open-file (dış (merge-pathnames "index.html" hedef) + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (şablonlu-yazdır index-html dış "Blog Index")))) + (declaim (ftype (function (pathname pathname pathname)) tamamen-üret)) (defun tamamen-üret (statik içerik hedef) ;; isim skill issue (assert (and (uiop:directory-exists-p statik) (uiop:directory-exists-p içerik))) (ensure-directories-exist hedef) (dizin-kopyala statik hedef) - (loop :for dosya :in (uiop:directory-files içerik) - :do (when (md-dosyası? dosya) - (let ((html-dosyası (tip-değiştir (yol-çeviri dosya içerik hedef) - "html"))) - (when (dönüştürmeli? dosya html-dosyası) - (markdown->html dosya html-dosyası)))))) + (let ((dosyalar (list))) + (loop :for dosya :in (uiop:directory-files içerik) + :do (when (md-dosyası? dosya) + (let ((html-dosyası (tip-değiştir (yol-çeviri dosya içerik hedef) + "html"))) + (push html-dosyası dosyalar) + (when (dönüştürmeli? dosya html-dosyası) + (markdown->html dosya html-dosyası))))) + (index-üret (reverse dosyalar) hedef))) (defun ana () (let ((args sb-ext:*posix-argv*)) -- cgit v1.2.3