kaynak dosyalar src dizinine taşındı

author: riton <riton@riton.home> 2025-03-28 21:52:26 +0300
committer: riton <riton@riton.home> 2025-03-28 21:52:26 +0300
commit: 80152b609225285251a49d1532bf8746bfbab35d (patch)
tree: 50faec2cdc1dea1cb0aa84dffa48ab3970af2952 /src
parent: 4b494af46035e80bb741881c1717c789638607c5 (diff)
5 files changed, 366 insertions, 0 deletions
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
+                                            "    <link href=\"index.css\" rel=\"stylesheet\">
+"))
+                       (ebeveyn-node! :body
+                                      (list node)))))
+
+(defun şablonlu-yazdır (node &optional (stream *standard-output*))
+  (format stream "<!DOCTYPE html>~%~%")
+  (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ım.lisp b/src/tanım.lisp
new file mode 100644
index 0000000..43af26c
--- /dev/null
+++ b/src/tanım.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/üretim.lisp b/src/üretim.lisp
new file mode 100644
index 0000000..3b3530d
--- /dev/null
+++ b/src/üretim.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 (#\" "&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)
+            :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)))
+
author	riton <riton@riton.home>	2025-03-28 21:52:26 +0300
committer	riton <riton@riton.home>	2025-03-28 21:52:26 +0300
commit	80152b609225285251a49d1532bf8746bfbab35d (patch)
tree	50faec2cdc1dea1cb0aa84dffa48ab3970af2952 /src
parent	4b494af46035e80bb741881c1717c789638607c5 (diff)