src/üretim.lisp


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 :h1 :h2 :h3 :h4 :h5 :h6) t)
    ((:b :i :code) nil)))

(defun tag-sonu-tagsız? (tag)
  (case tag
    (:img t)))

(defun yeni-satır-yaz (stream)
  (write-char #\Newline stream)
  (setf *satır-başı* t))

;;;; https://stackoverflow.com/questions/7381974/which-characters-need-to-be-escaped-in-html
;;; TODO geliştirme mümkün... ama şimdilik yeter (#\" "&quot;") (#\' "&#39;")
(defun kaçışlı-içerik-yazdır (metin stream)
  (loop :for karakter :across metin
        :do (case karakter
              (#\< (write-string "&lt;" stream))
              (#\> (write-string "&gt;" stream))
              (#\& (write-string "&amp;" stream))
              (t (write-char karakter stream)))))

(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)))
  (if (tag-sonu-tagsız? (tag node))
      (write-string " />" stream)
      (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))
      (when (not (null (value node)))
        (kaçışlı-içerik-yazdır (value node) stream))
      (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)))
  (unless (tag-sonu-tagsız? (tag node))
    (format stream "</~a>" (tag node)))
  (when (tag-sonu-yeni-satır? (tag node))
    (yeni-satır-yaz stream)))