summaryrefslogtreecommitdiff
path: root/src/ana.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/ana.lisp')
-rw-r--r--src/ana.lisp51
1 files 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
" <link href=\"index.css\" rel=\"stylesheet\">
"))
(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 "<!DOCTYPE html>~%~%")
- (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*))