83 lines
2.9 KiB
Common Lisp
83 lines
2.9 KiB
Common Lisp
(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))
|
||
|
||
;;;; https://stackoverflow.com/questions/7381974/which-characters-need-to-be-escaped-in-html
|
||
;;; TODO geliştirme mümkün... ama şimdilik yeter (#\" """) (#\' "'")
|
||
(defun kaçışlı-içerik-yazdır (metin stream)
|
||
(loop :for karakter :across metin
|
||
:do (case karakter
|
||
(#\< (write-string "<" stream))
|
||
(#\> (write-string ">" stream))
|
||
(#\& (write-string "&" 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)
|
||
: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))
|
||
(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)))
|
||
(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))
|