blob: 7502331d2265f7e257278507376bb99a662d78d3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
(in-package :html-jen)
(defun başlık-bul (node)
(loop :for çocuk :in (children node)
:do (when (eq :h1 (tag çocuk))
(return (value çocuk)))))
(defun şablon-yap (node &optional başlık geri-link)
(ebeveyn-node! :html
(list (ebeveyn-node! :head
(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
(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*) başlık geri-link)
(format stream "<!DOCTYPE html>~%~%")
(node->html (şablon-yap node başlık geri-link) stream))
(defun markdown->html (kaynak hedef)
(format t "~s -> ~s~%" kaynak hedef)
(let ((okur (okur! kaynak)))
(let ((root (markdown-ayrıştır okur))
(*print-case* :downcase))
(with-open-file (dış hedef :direction :output
:if-does-not-exist :create
:if-exists :supersede)
(şablonlu-yazdır root dış nil t)))))
(defun md-dosyası? (yol)
(or (string= "md" (pathname-type yol))
(string= "markdown" (pathname-type yol))))
(defun tip-değiştir (yol yeni-tip)
(make-pathname :type yeni-tip :defaults yol))
(defun mod-zamanı (dosya)
(sb-posix:stat-mtime (sb-posix:stat dosya)))
(defun dosya-var? (dosya)
(uiop:file-exists-p dosya))
(defun dönüştürmeli? (kaynak hedef)
"Kaynak dosyadan hedef dosya oluşturulmalı mı ?
Dosya değişmediyse yeniden oluşturma."
(or (not (dosya-var? hedef))
(> (mod-zamanı kaynak)
(mod-zamanı hedef))))
(defun yol-çeviri (yol kaynak-kök hedef-kök)
(merge-pathnames (uiop:enough-pathname yol kaynak-kök)
hedef-kök))
(defun dosya-kopyala (kaynak hedef)
(uiop:copy-file kaynak hedef)
(format t "~s -> ~s~%" kaynak hedef))
(defun dizin-kopyala (kaynak hedef)
(ensure-directories-exist hedef)
(mapc (lambda (kaynak-dosya)
(let ((hedef-dosya (yol-çeviri kaynak-dosya kaynak hedef)))
(when (dönüştürmeli? kaynak-dosya hedef-dosya)
(dosya-kopyala kaynak-dosya hedef-dosya))))
(uiop:directory-files kaynak))
(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)
(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*))
(if (= 4 (length args))
(apply #'tamamen-üret (mapcar (lambda (str)
(merge-pathnames str (uiop:getcwd)))
(cdr args)))
(format *error-output* "Kullanım: [prog-adı] [statik dizin] [içerik dizini] [hedef dizin]~%"))))
|
