From 80152b609225285251a49d1532bf8746bfbab35d Mon Sep 17 00:00:00 2001 From: riton Date: Fri, 28 Mar 2025 21:52:26 +0300 Subject: =?UTF-8?q?kaynak=20dosyalar=20src=20dizinine=20ta=C5=9F=C4=B1nd?= =?UTF-8?q?=C4=B1?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- ana.lisp | 36 ------- html-jen.asd | 3 +- okur.lisp | 241 ----------------------------------------------- paket.lisp | 5 - src/ana.lisp | 36 +++++++ src/okur.lisp | 241 +++++++++++++++++++++++++++++++++++++++++++++++ src/paket.lisp | 5 + "src/tan\304\261m.lisp" | 20 ++++ "src/\303\274retim.lisp" | 64 +++++++++++++ "tan\304\261m.lisp" | 20 ---- "\303\274retim.lisp" | 64 ------------- 11 files changed, 368 insertions(+), 367 deletions(-) delete mode 100644 ana.lisp delete mode 100644 okur.lisp delete mode 100644 paket.lisp create mode 100644 src/ana.lisp create mode 100644 src/okur.lisp create mode 100644 src/paket.lisp create mode 100644 "src/tan\304\261m.lisp" create mode 100644 "src/\303\274retim.lisp" delete mode 100644 "tan\304\261m.lisp" delete mode 100644 "\303\274retim.lisp" diff --git a/ana.lisp b/ana.lisp deleted file mode 100644 index 4b74169..0000000 --- a/ana.lisp +++ /dev/null @@ -1,36 +0,0 @@ -(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) - (ebeveyn-node! :html - (list (ebeveyn-node! :head - (list (çocuk-node! :title (başlık-bul node)) - ;;; geçici hack çünkü /> ile biten tagleri düzgün basamıyorum - " -")) - (ebeveyn-node! :body - (list node))))) - -(defun şablonlu-yazdır (node &optional (stream *standard-output*)) - (format stream "~%~%") - (node->html (şablon-yap node) stream)) - -(defun markdown->html (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ış))))) - -(defun ana () - (let ((args sb-ext:*posix-argv*)) - (assert (= 3 (length args))) - (let ((kaynak (nth 1 args)) - (hedef (nth 2 args))) - (markdown->html kaynak hedef)))) diff --git a/html-jen.asd b/html-jen.asd index 200e777..737c3a7 100644 --- a/html-jen.asd +++ b/html-jen.asd @@ -3,13 +3,14 @@ :license "GPLv3" :depends-on (uiop) :description "Markdown dosyalarından HTML jenerasyonu yapan yazılım." + :pathname "src/" :components ((:file "paket") (:file "tanım") (:file "okur") (:file "üretim") (:file "ana")) :build-operation "program-op" - :build-pathname "html-üret" + :build-pathname "../html-üret" :entry-point "html-jen::ana" :in-order-to ((test-op (test-op "html-jen/testler")))) diff --git a/okur.lisp b/okur.lisp deleted file mode 100644 index 108d648..0000000 --- a/okur.lisp +++ /dev/null @@ -1,241 +0,0 @@ -(in-package :html-jen) - -(defun dosya-metni-oku (dosya) - (let* ((uzunluk 0) - (metin - (with-output-to-string (out) - (with-open-file (in dosya :external-format :utf-8) - (loop :with arabellek := (make-array 8192 :element-type 'character) - :for n := (read-sequence arabellek in) - :while (< 0 n) - :do (incf uzunluk n) - (write-sequence arabellek out :start 0 :end n)))))) - (values metin uzunluk))) - -(defclass okur () - ((metin :initarg :metin :accessor metin - :documentation "Markdown string") - (i :initform 0 :accessor i - :documentation "Metin indeksi") - (uzunluk :initarg :uzunluk :accessor uzunluk - :documentation "Metin uzunluğu") - (blok-baş :accessor blok-baş :initform 0 - :documentation "Bloğun başının indexi") - (blok-son :accessor blok-son :initform 0 - :documentation "Bloğun sonunun indexi") - (dosya-ismi :initarg :dosya-ismi - :documentation "Okunan markdown dosyasının ismi"))) - -(defun okur! (dosya-ismi) - (multiple-value-bind (metin uzunluk) - (dosya-metni-oku dosya-ismi) - (make-instance 'okur :metin metin :uzunluk uzunluk :dosya-ismi dosya-ismi))) - -(defun metin-okur! (metin) - (make-instance 'okur :metin metin :uzunluk (length metin) :dosya-ismi "")) - -(defmethod son? ((okur okur) index) - (>= index - (uzunluk okur))) - -(defmethod index-reset ((okur okur)) - (setf (i okur) 0 - (blok-son okur) 0)) - -(defmethod blok-reset ((okur okur)) - (setf (i okur) (blok-baş okur))) - -(let ((blok-sonu (format nil "~%~%"))) - (defmethod sonraki-blok ((okur okur)) - "blok-baş ve blok-son indexlerinin atamasını yapar. Başka blok kalmadıysa nil döndürür." - (unless (son? okur (blok-son okur)) - (with-slots (i uzunluk metin blok-son blok-baş) okur - (let ((önceki-son blok-son) - (yeni-son (search blok-sonu metin :start2 blok-son)) - ;; TODO kod bloğunun içinde yeni blok oluşmadan 2 yeni satır olabilir - ) - (setf blok-son (if (numberp yeni-son) - (+ 2 yeni-son) - uzunluk) - blok-baş önceki-son ;; TODO blok başındaki boşluk ve yeni satırları geç - i blok-baş)))))) - -(defmethod boşluk-yut ((okur okur)) - (with-slots (i metin) okur - (loop :while (char= #\Space (char metin i)) - :do (incf i)))) - -(defmethod metin-parçası ((okur okur) uzunluk baş) - (make-array uzunluk - :element-type 'character - :displaced-to (metin okur) - :displaced-index-offset baş)) - -(defgeneric ayrıştır (okur tag) - (:documentation "Tag'a göre bloktaki elementleri belirler.")) - -(defmethod ayrıştır ((okur okur) (tag (eql :h))) - (with-slots (i blok-son metin) okur - (let ((h-sayı 0)) - (loop :while (char= #\# (char metin i)) - :do (incf i) - (incf h-sayı)) - (assert (char= #\Space (char metin i))) - (assert (< h-sayı 7)) - (boşluk-yut okur) - (çocuk-node! (intern (format nil "H~D" h-sayı) "KEYWORD") - (metin-parçası okur - (- (or (position #\Newline metin :start i) - blok-son) - i) - i))))) - -(defmethod ayrıştır ((okur okur) (tag (eql :ul))) - (with-slots (i blok-son metin) okur - (let ((itemler (loop :while (and (< i blok-son) - (not (char= #\Newline (char metin i)))) - :do (assert (string= "- " metin :start2 i :end2 (+ i 2))) - (incf i 2) - :collect (let ((yeni (or (position #\Newline metin :start i) - blok-son))) - (prog1 (metin-parçası okur (- yeni i) i) - (setf i (+ yeni 1))))))) - (ebeveyn-node! :ul - (mapcar (lambda (item) - (çocuk-node! :li item)) - itemler))))) - -(defmethod ayrıştır ((okur okur) (tag (eql :ol))) - (with-slots (i blok-son metin) okur - (let ((item-sayısı 1)) - (let ((itemler - (loop :while (and (< i blok-son) - (not (char= #\Newline (char metin i)))) - :do (let ((i2 i)) - (loop :while (char<= #\0 (char metin i2) #\9) - :do (incf i2)) - (assert (string= ". " metin :start2 i2 :end2 (+ i2 2))) - (assert (= item-sayısı (parse-integer metin :start i :end i2))) - (incf item-sayısı) - (setf i (+ i2 2))) - :collect (let ((yeni (or (position #\Newline metin :start i) - blok-son))) - (prog1 (metin-parçası okur (- yeni i) i) - (setf i (+ yeni 1))))))) - (ebeveyn-node! :ol - (mapcar (lambda (item) - (çocuk-node! :li item)) - itemler)))))) - -(defmethod ayrıştır ((okur okur) (tag (eql :code))) - (with-slots (i metin blok-son blok-baş) okur - (assert (string= "```" metin :start2 blok-baş :end2 (+ blok-baş 3))) - (let ((kod-baş (+ 1 (position #\Newline metin :start (+ blok-baş 3))))) - (let ((kod (metin-parçası okur - (- (search "```" metin :from-end t :end2 blok-son) - kod-baş) - kod-baş))) - (ebeveyn-node! :pre - (list (çocuk-node! :code - kod))))))) - - - -(defgeneric inline-ayrıştır (okur tag son) - (:documentation "Paragraf içindeki elementleri ayrıştırır")) - -(defmethod inline-ayrıştır ((okur okur) tag str) - (with-slots (i metin blok-son) okur - (let ((son (search str metin - :start2 i - :end2 blok-son))) - (prog1 (çocuk-node! tag (metin-parçası okur (- son i) i)) - (setf i (+ son (length str))))))) - -(defmethod link-ayrıştır ((okur okur)) - (with-slots (i metin blok-son) okur - (let* ((son (search "]" metin - :start2 i - :end2 blok-son)) - (link-metni (metin-parçası okur (- son i) i))) - (setf i (+ son 1)) - (assert (char= #\( (char metin i))) - (incf i) - (let ((son (search ")" metin - :start2 i - :end2 blok-son))) - (prog1 (çocuk-node! :a link-metni - (list :href (metin-parçası okur (- son i) i))) - (setf i (+ 1 son))))))) - -(defmethod paragraf-ayrıştır ((okur okur)) - (with-slots (i blok-son metin) okur - (let ((elementler (list)) - (baş i)) - (labels ((pushla-ve-ayrıştır (tag str) - (push (metin-parçası okur (- i baş) baş) elementler) - (incf i (length str)) - (push (inline-ayrıştır okur tag str) elementler) - (setf baş i))) - (loop :while (< i blok-son) - :do (case (char metin i) - (#\[ (if (char= #\( (char metin (+ 1 (position #\] metin :start i)))) - (progn - (push (metin-parçası okur (- i baş) baş) elementler) - (incf i 1) - (push (link-ayrıştır okur) elementler) - (setf baş i)) - (incf i))) - (#\` (pushla-ve-ayrıştır :code "`")) - (#\_ (pushla-ve-ayrıştır :i "_")) - (#\* (if (char= #\* (char metin (+ i 1))) - (pushla-ve-ayrıştır :b "**") - (pushla-ve-ayrıştır :i "*"))) - (t (incf i))) - :finally (loop :while (char= #\Newline (char metin (- i 1))) - :do (decf i)) - (when (/= baş i) - (push (metin-parçası okur (- i baş) baş) elementler))) - (ebeveyn-node! :p (reverse elementler)))))) - -(defmethod blok-ayrıştır ((okur okur)) - (when (sonraki-blok okur) - (with-slots (i metin) okur - (boşluk-yut okur) - (case (char metin i) - (#\# (ayrıştır okur :h)) - (#\- (ayrıştır okur :ul)) - (#\` (ayrıştır okur :code)) - (#\> "") - (t (if (char<= #\0 (char metin i) #\9) - (ayrıştır okur :ol) - (paragraf-ayrıştır okur))))))) - -(defmethod markdown-ayrıştır ((okur okur)) - (labels ((öz (okur) - (let ((blok-node (blok-ayrıştır okur))) - (if (null blok-node) - nil - (cons blok-node (öz okur)))))) - (ebeveyn-node! :div - (öz okur)))) - - -(defparameter *okur* (okur! "/home/riton/projects/html-jen/cheat.md")) - -(defmethod blok-yazdır ((okur okur) &optional (stream *standard-output*)) - (write-sequence (metin okur) stream - :start (blok-baş okur) - :end (blok-son okur)) - (values)) - -(defmethod blok-metni ((okur okur)) - (with-slots (blok-son blok-baş metin) okur - (make-array (- blok-son blok-baş) - :element-type 'character - :displaced-to metin - :displaced-index-offset blok-baş))) - -(defmethod okur-blok-listesi ((okur okur)) - (loop :while (sonraki-blok okur) - :collect (blok-metni okur))) diff --git a/paket.lisp b/paket.lisp deleted file mode 100644 index f37b84b..0000000 --- a/paket.lisp +++ /dev/null @@ -1,5 +0,0 @@ -(defpackage :html-jen - (:use :common-lisp) - (:export - :tag :props :children :value - :okur! :metin-okur! :markdown-ayrıştır)) diff --git a/src/ana.lisp b/src/ana.lisp new file mode 100644 index 0000000..4b74169 --- /dev/null +++ b/src/ana.lisp @@ -0,0 +1,36 @@ +(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) + (ebeveyn-node! :html + (list (ebeveyn-node! :head + (list (çocuk-node! :title (başlık-bul node)) + ;;; geçici hack çünkü /> ile biten tagleri düzgün basamıyorum + " +")) + (ebeveyn-node! :body + (list node))))) + +(defun şablonlu-yazdır (node &optional (stream *standard-output*)) + (format stream "~%~%") + (node->html (şablon-yap node) stream)) + +(defun markdown->html (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ış))))) + +(defun ana () + (let ((args sb-ext:*posix-argv*)) + (assert (= 3 (length args))) + (let ((kaynak (nth 1 args)) + (hedef (nth 2 args))) + (markdown->html kaynak hedef)))) diff --git a/src/okur.lisp b/src/okur.lisp new file mode 100644 index 0000000..108d648 --- /dev/null +++ b/src/okur.lisp @@ -0,0 +1,241 @@ +(in-package :html-jen) + +(defun dosya-metni-oku (dosya) + (let* ((uzunluk 0) + (metin + (with-output-to-string (out) + (with-open-file (in dosya :external-format :utf-8) + (loop :with arabellek := (make-array 8192 :element-type 'character) + :for n := (read-sequence arabellek in) + :while (< 0 n) + :do (incf uzunluk n) + (write-sequence arabellek out :start 0 :end n)))))) + (values metin uzunluk))) + +(defclass okur () + ((metin :initarg :metin :accessor metin + :documentation "Markdown string") + (i :initform 0 :accessor i + :documentation "Metin indeksi") + (uzunluk :initarg :uzunluk :accessor uzunluk + :documentation "Metin uzunluğu") + (blok-baş :accessor blok-baş :initform 0 + :documentation "Bloğun başının indexi") + (blok-son :accessor blok-son :initform 0 + :documentation "Bloğun sonunun indexi") + (dosya-ismi :initarg :dosya-ismi + :documentation "Okunan markdown dosyasının ismi"))) + +(defun okur! (dosya-ismi) + (multiple-value-bind (metin uzunluk) + (dosya-metni-oku dosya-ismi) + (make-instance 'okur :metin metin :uzunluk uzunluk :dosya-ismi dosya-ismi))) + +(defun metin-okur! (metin) + (make-instance 'okur :metin metin :uzunluk (length metin) :dosya-ismi "")) + +(defmethod son? ((okur okur) index) + (>= index + (uzunluk okur))) + +(defmethod index-reset ((okur okur)) + (setf (i okur) 0 + (blok-son okur) 0)) + +(defmethod blok-reset ((okur okur)) + (setf (i okur) (blok-baş okur))) + +(let ((blok-sonu (format nil "~%~%"))) + (defmethod sonraki-blok ((okur okur)) + "blok-baş ve blok-son indexlerinin atamasını yapar. Başka blok kalmadıysa nil döndürür." + (unless (son? okur (blok-son okur)) + (with-slots (i uzunluk metin blok-son blok-baş) okur + (let ((önceki-son blok-son) + (yeni-son (search blok-sonu metin :start2 blok-son)) + ;; TODO kod bloğunun içinde yeni blok oluşmadan 2 yeni satır olabilir + ) + (setf blok-son (if (numberp yeni-son) + (+ 2 yeni-son) + uzunluk) + blok-baş önceki-son ;; TODO blok başındaki boşluk ve yeni satırları geç + i blok-baş)))))) + +(defmethod boşluk-yut ((okur okur)) + (with-slots (i metin) okur + (loop :while (char= #\Space (char metin i)) + :do (incf i)))) + +(defmethod metin-parçası ((okur okur) uzunluk baş) + (make-array uzunluk + :element-type 'character + :displaced-to (metin okur) + :displaced-index-offset baş)) + +(defgeneric ayrıştır (okur tag) + (:documentation "Tag'a göre bloktaki elementleri belirler.")) + +(defmethod ayrıştır ((okur okur) (tag (eql :h))) + (with-slots (i blok-son metin) okur + (let ((h-sayı 0)) + (loop :while (char= #\# (char metin i)) + :do (incf i) + (incf h-sayı)) + (assert (char= #\Space (char metin i))) + (assert (< h-sayı 7)) + (boşluk-yut okur) + (çocuk-node! (intern (format nil "H~D" h-sayı) "KEYWORD") + (metin-parçası okur + (- (or (position #\Newline metin :start i) + blok-son) + i) + i))))) + +(defmethod ayrıştır ((okur okur) (tag (eql :ul))) + (with-slots (i blok-son metin) okur + (let ((itemler (loop :while (and (< i blok-son) + (not (char= #\Newline (char metin i)))) + :do (assert (string= "- " metin :start2 i :end2 (+ i 2))) + (incf i 2) + :collect (let ((yeni (or (position #\Newline metin :start i) + blok-son))) + (prog1 (metin-parçası okur (- yeni i) i) + (setf i (+ yeni 1))))))) + (ebeveyn-node! :ul + (mapcar (lambda (item) + (çocuk-node! :li item)) + itemler))))) + +(defmethod ayrıştır ((okur okur) (tag (eql :ol))) + (with-slots (i blok-son metin) okur + (let ((item-sayısı 1)) + (let ((itemler + (loop :while (and (< i blok-son) + (not (char= #\Newline (char metin i)))) + :do (let ((i2 i)) + (loop :while (char<= #\0 (char metin i2) #\9) + :do (incf i2)) + (assert (string= ". " metin :start2 i2 :end2 (+ i2 2))) + (assert (= item-sayısı (parse-integer metin :start i :end i2))) + (incf item-sayısı) + (setf i (+ i2 2))) + :collect (let ((yeni (or (position #\Newline metin :start i) + blok-son))) + (prog1 (metin-parçası okur (- yeni i) i) + (setf i (+ yeni 1))))))) + (ebeveyn-node! :ol + (mapcar (lambda (item) + (çocuk-node! :li item)) + itemler)))))) + +(defmethod ayrıştır ((okur okur) (tag (eql :code))) + (with-slots (i metin blok-son blok-baş) okur + (assert (string= "```" metin :start2 blok-baş :end2 (+ blok-baş 3))) + (let ((kod-baş (+ 1 (position #\Newline metin :start (+ blok-baş 3))))) + (let ((kod (metin-parçası okur + (- (search "```" metin :from-end t :end2 blok-son) + kod-baş) + kod-baş))) + (ebeveyn-node! :pre + (list (çocuk-node! :code + kod))))))) + + + +(defgeneric inline-ayrıştır (okur tag son) + (:documentation "Paragraf içindeki elementleri ayrıştırır")) + +(defmethod inline-ayrıştır ((okur okur) tag str) + (with-slots (i metin blok-son) okur + (let ((son (search str metin + :start2 i + :end2 blok-son))) + (prog1 (çocuk-node! tag (metin-parçası okur (- son i) i)) + (setf i (+ son (length str))))))) + +(defmethod link-ayrıştır ((okur okur)) + (with-slots (i metin blok-son) okur + (let* ((son (search "]" metin + :start2 i + :end2 blok-son)) + (link-metni (metin-parçası okur (- son i) i))) + (setf i (+ son 1)) + (assert (char= #\( (char metin i))) + (incf i) + (let ((son (search ")" metin + :start2 i + :end2 blok-son))) + (prog1 (çocuk-node! :a link-metni + (list :href (metin-parçası okur (- son i) i))) + (setf i (+ 1 son))))))) + +(defmethod paragraf-ayrıştır ((okur okur)) + (with-slots (i blok-son metin) okur + (let ((elementler (list)) + (baş i)) + (labels ((pushla-ve-ayrıştır (tag str) + (push (metin-parçası okur (- i baş) baş) elementler) + (incf i (length str)) + (push (inline-ayrıştır okur tag str) elementler) + (setf baş i))) + (loop :while (< i blok-son) + :do (case (char metin i) + (#\[ (if (char= #\( (char metin (+ 1 (position #\] metin :start i)))) + (progn + (push (metin-parçası okur (- i baş) baş) elementler) + (incf i 1) + (push (link-ayrıştır okur) elementler) + (setf baş i)) + (incf i))) + (#\` (pushla-ve-ayrıştır :code "`")) + (#\_ (pushla-ve-ayrıştır :i "_")) + (#\* (if (char= #\* (char metin (+ i 1))) + (pushla-ve-ayrıştır :b "**") + (pushla-ve-ayrıştır :i "*"))) + (t (incf i))) + :finally (loop :while (char= #\Newline (char metin (- i 1))) + :do (decf i)) + (when (/= baş i) + (push (metin-parçası okur (- i baş) baş) elementler))) + (ebeveyn-node! :p (reverse elementler)))))) + +(defmethod blok-ayrıştır ((okur okur)) + (when (sonraki-blok okur) + (with-slots (i metin) okur + (boşluk-yut okur) + (case (char metin i) + (#\# (ayrıştır okur :h)) + (#\- (ayrıştır okur :ul)) + (#\` (ayrıştır okur :code)) + (#\> "") + (t (if (char<= #\0 (char metin i) #\9) + (ayrıştır okur :ol) + (paragraf-ayrıştır okur))))))) + +(defmethod markdown-ayrıştır ((okur okur)) + (labels ((öz (okur) + (let ((blok-node (blok-ayrıştır okur))) + (if (null blok-node) + nil + (cons blok-node (öz okur)))))) + (ebeveyn-node! :div + (öz okur)))) + + +(defparameter *okur* (okur! "/home/riton/projects/html-jen/cheat.md")) + +(defmethod blok-yazdır ((okur okur) &optional (stream *standard-output*)) + (write-sequence (metin okur) stream + :start (blok-baş okur) + :end (blok-son okur)) + (values)) + +(defmethod blok-metni ((okur okur)) + (with-slots (blok-son blok-baş metin) okur + (make-array (- blok-son blok-baş) + :element-type 'character + :displaced-to metin + :displaced-index-offset blok-baş))) + +(defmethod okur-blok-listesi ((okur okur)) + (loop :while (sonraki-blok okur) + :collect (blok-metni okur))) diff --git a/src/paket.lisp b/src/paket.lisp new file mode 100644 index 0000000..f37b84b --- /dev/null +++ b/src/paket.lisp @@ -0,0 +1,5 @@ +(defpackage :html-jen + (:use :common-lisp) + (:export + :tag :props :children :value + :okur! :metin-okur! :markdown-ayrıştır)) diff --git "a/src/tan\304\261m.lisp" "b/src/tan\304\261m.lisp" new file mode 100644 index 0000000..43af26c --- /dev/null +++ "b/src/tan\304\261m.lisp" @@ -0,0 +1,20 @@ +(in-package :html-jen) + +(defclass node () + ((tag :initarg :tag :accessor tag :initform nil + :documentation "HTML element tag keyword'ü") + (children :initarg :children :accessor children :initform nil + :documentation "Bu node'un altındaki node'lar") + (props :initarg :props :accessor props :initform nil + :documentation "HTML element attribute'ları ve değerleri") + (value :initarg :value :accessor value :initform nil + :documentation "HTML element metin içeriği"))) + +(defun node! (tag children props value) + (make-instance 'node :tag tag :children children :props props :value value)) + +(defun ebeveyn-node! (tag children &optional props) + (make-instance 'node :tag tag :children children :props props)) + +(defun çocuk-node! (tag value &optional props) + (make-instance 'node :tag tag :props props :value value)) diff --git "a/src/\303\274retim.lisp" "b/src/\303\274retim.lisp" new file mode 100644 index 0000000..3b3530d --- /dev/null +++ "b/src/\303\274retim.lisp" @@ -0,0 +1,64 @@ +(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 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 "" (tag node)) + (when (tag-sonu-yeni-satır? (tag node)) + (yeni-satır-yaz stream))) + diff --git "a/tan\304\261m.lisp" "b/tan\304\261m.lisp" deleted file mode 100644 index 43af26c..0000000 --- "a/tan\304\261m.lisp" +++ /dev/null @@ -1,20 +0,0 @@ -(in-package :html-jen) - -(defclass node () - ((tag :initarg :tag :accessor tag :initform nil - :documentation "HTML element tag keyword'ü") - (children :initarg :children :accessor children :initform nil - :documentation "Bu node'un altındaki node'lar") - (props :initarg :props :accessor props :initform nil - :documentation "HTML element attribute'ları ve değerleri") - (value :initarg :value :accessor value :initform nil - :documentation "HTML element metin içeriği"))) - -(defun node! (tag children props value) - (make-instance 'node :tag tag :children children :props props :value value)) - -(defun ebeveyn-node! (tag children &optional props) - (make-instance 'node :tag tag :children children :props props)) - -(defun çocuk-node! (tag value &optional props) - (make-instance 'node :tag tag :props props :value value)) diff --git "a/\303\274retim.lisp" "b/\303\274retim.lisp" deleted file mode 100644 index 3b3530d..0000000 --- "a/\303\274retim.lisp" +++ /dev/null @@ -1,64 +0,0 @@ -(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 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 "" (tag node)) - (when (tag-sonu-yeni-satır? (tag node)) - (yeni-satır-yaz stream))) - -- cgit v1.2.3