blob: 51d75e08e4b43f74393ffe9dd93e91ef0a0e5e70 (
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
|
(in-package :html-jen)
(defparameter *indent* 0)
(defparameter *indent-increment* 2)
(defparameter *satır-başı* t)
(defgeneric node->html (node &optional stream)
(:method (node &optional (stream *standard-output*))
(write-string node stream))
(:documentation "NODE u STREAM e yazar"))
(defun tag-başı-yeni-satır? (tag)
(case tag
((:html :head :body :div :ol :ul :link) t)
((:title :p :b :i :code :li) nil)))
(defun tag-sonu-yeni-satır? (tag)
(case tag
((:html :head :body :div :ol :ul :li :p :title :pre) nil)
((:b :i :code) t)))
(defun yeni-satır-yaz (stream)
(write-char #\Newline stream)
(setf *satır-başı* t))
(defmethod node->html :before ((node node) &optional (stream *standard-output*))
(unless (not *satır-başı*)
(loop :for i :from 0 :below *indent*
:do (write-char #\Space stream)))
(if (null (props node))
(format stream "<~a>" (tag node))
(loop :initially (format stream "<~a" (tag node))
:for (k v) :on (props node) :by #'cddr
:do (format stream " ~a=\"~a\"" k v)
:finally (write-char #\> stream)))
(setf *satır-başı* nil)
(when (tag-başı-yeni-satır? (tag node))
(yeni-satır-yaz stream)))
(defmethod node->html ((node node) &optional (stream *standard-output*))
(if (null (children node))
(format stream "~a" (value node))
(let ((*indent* (+ *indent* *indent-increment*)))
(loop :for child :in (children node)
:do (node->html child stream)))))
(defmethod node->html :after ((node node) &optional (stream *standard-output*))
(unless (not *satır-başı*)
(loop :for i :from 0 :below *indent*
:do (write-char #\Space stream)))
(format stream "</~a>" (tag node))
(when (tag-sonu-yeni-satır? (tag node))
(yeni-satır-yaz stream)))
(defun node->cons (node)
"node u listeye çevirir."
(if (stringp node)
node
(if (null (children node))
(list (tag node) (props node) (value node))
(append (list (tag node) (props node))
(mapcar #'node->cons (children node))))))
(defparameter bir-node
(node! :html (list (node! :head
(list (node! :title nil nil "başlık"))
nil nil)
(node! :body
(list (node! :p nil '(:color "red") "içerik"))
nil nil))
nil nil))
|
