markdown parser başlangıcı

html-jen.asd

@@ -3,4 +3,7 @@
   :license "GPLv3"
   :depends-on (uiop)
   :description "Markdown dosyalarından HTML jenerasyonu yapan yazılım."
-  :components ((:file "paket")))
+  :components ((:file "paket")
+               (:file "tanım")
+               (:file "okur")
+               (:file "html-jen")))

okur.lisp

@@ -0,0 +1,54 @@
+(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")
+   (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)))
+
+(defmethod son? ((okur okur))
+  (>= (i okur)
+      (uzunluk okur)))
+
+(defmethod index-reset ((okur okur))
+  (setf (i oo) 0))
+
+(defparameter *blok-sonu* (format nil "~%~%"))
+
+(defmethod blok-oku ((okur okur))
+  (unless (son? okur)
+    (with-slots (i uzunluk metin) okur
+      (let ((son (or (search *blok-sonu* metin :start2 i)
+                     uzunluk)))
+        (prog1 (make-array (- son i)
+                           :element-type 'character
+                           :displaced-to metin
+                           :displaced-index-offset i)
+          (setf i (+ son 2)))))))
+
+(defmethod okur-blok-listesi ((okur okur))
+  (let ((blok (blok-oku okur)))
+    (if (null blok)
+        nil
+        (cons blok (okur-blok-listesi okur)))))