inline ayrıştırma

1 files changed, 191 insertions, 91 deletions

diff --git a/okur.lisp b/okur.lisp
index db19f84..7daf658 100644
--- a/okur.lisp
+++ b/okur.lisp
@@ -19,6 +19,10 @@
       :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")))
 
@@ -27,105 +31,201 @@
       (dosya-metni-oku dosya-ismi)
     (make-instance 'okur :metin metin :uzunluk uzunluk :dosya-ismi dosya-ismi)))
 
-(defmethod son? ((okur okur))
-  (>= (i okur)
+(defmethod son? ((okur okur) index)
+  (>= index
       (uzunluk okur)))
 
 (defmethod index-reset ((okur okur))
-  (setf (i oo) 0))
+  (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))
-    (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))))))))
+    "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)))
+          (setf blok-son (if (numberp yeni-son)
+                             (+ 2 yeni-son)
+                             uzunluk)
+                blok-baş önceki-son
+                i blok-baş))))))
 
-(defmethod okur-blok-listesi ((okur okur))
-  (let ((blok (sonraki-blok okur)))
-    (if (null blok)
-        nil
-        (cons blok (okur-blok-listesi okur)))))
+(defmethod boşluk-yut ((okur okur))
+  (with-slots (i metin) okur
+    (loop :while (char= #\Space (char metin i))
+          :do (incf i))))
 
-(defgeneric ayrıştır (tag blok baş)
+(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 ((tag (eql :h)) blok baş)
-  (let ((i baş)
-        (son (length blok))
-        (h-sayı 0))
-    (loop :while (char= #\# (char blok i))
-          :do (incf i)
-              (incf h-sayı))
-    (assert (char= #\Space (char blok i)))
-    (assert (< h-sayı 7))
-    (incf i)
-    (values (make-array (- son i)
-                        :element-type 'character
-                        :displaced-to blok
-                        :displaced-index-offset i)
-            h-sayı)))
-
-(defmethod ayrıştır ((tag (eql :ul)) blok baş)
-  (let ((i baş)
-        (son (length blok)))
-    (loop :while (< i son)
-          :do (assert (string= "- " blok :start2 i :end2 (+ i 2)))
-              (incf i 2)
-          :collect (let ((yeni (or (position #\Newline blok :start i)
-                                   son)))
-                     (prog1 (make-array (- yeni i)
-                                        :element-type 'character
-                                        :displaced-to blok
-                                        :displaced-index-offset i)
-                       (setf i (+ yeni 1)))))))
-
-(defmethod ayrıştır ((tag (eql :ol)) blok baş)
-  (let ((i baş)
-        (son (length blok))
-        (item-sayısı 1))
-    (loop :while (< i son)
-          :do (let ((i2 i))
-                (loop :while (char<= #\0 (char blok i2) #\9)
-                      :do (incf i2))
-                (assert (string= ". " blok :start2 i2 :end2 (+ i2 2)))
-                (assert (= item-sayısı (parse-integer blok :start i :end i2)))
-                (incf item-sayısı)
-                (setf i (+ i2 2)))
-          :collect (let ((yeni (or (position #\Newline blok :start i)
-                                   son)))
-                     (prog1 (make-array (- yeni i)
-                                        :element-type 'character
-                                        :displaced-to blok
-                                        :displaced-index-offset i)
-                       (setf i (+ yeni 1)))))))
-
-(defmethod ayrıştır ((tag (eql :code)) blok baş)
-  (let ((son (length blok))
-        (kod-baş (+ baş 3))
-        (kod-son (- (length blok) 3)))
-    (assert (string= "```" blok :start2 baş :end2 kod-baş))
-    (assert (string= "```" blok :start2 kod-son :end2 son))
-    (make-array (- kod-son kod-baş)
+(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
+    (let ((kod-baş (+ blok-baş 3)))
+      (assert (string= "```" metin :start2 blok-baş :end2 kod-baş))
+      (let ((kod (metin-parçası okur
+                                (- (search "```" metin :start2 kod-baş)
+                                   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 (metin-parçası okur (- son i) i)
+                            (list :href link-metni))
+          (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 (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 tümünü-ayrıştır ((okur okur))
+  (let ((blok-node (blok-ayrıştır okur)))
+    (if (null blok-node)
+        nil
+        (cons blok-node (tümünü-ayrıştır 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 blok
-                :displaced-index-offset kod-baş)))
-
-(defun blok-ayrıştır (blok)
-  (let ((i 0))
-    (loop :while (char= #\Space (char blok i))
-          :do (incf i))
-    (case (char blok i)
-      (#\# (ayrıştır :h blok i))
-      (#\- (ayrıştır :ul blok i))
-      (#\` (ayrıştır :code blok i))
-      ;; (#\> :blockquote)
-      (t (if (char<= #\0 (char blok i) #\9)
-             (ayrıştır :ol blok i)
-             :p))
-      )))
+                :displaced-to metin
+                :displaced-index-offset blok-baş)))
+
+(defmethod okur-blok-listesi ((okur okur))
+  (loop :while (sonraki-blok okur)
+        :collect (blok-metni okur)))