diff options
Diffstat (limited to 'src/okur.lisp')
| -rw-r--r-- | src/okur.lisp | 241 |
1 files changed, 241 insertions, 0 deletions
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))) |