237 lines
9.3 KiB
Common Lisp
237 lines
9.3 KiB
Common Lisp
(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)))
|
||
|
||
(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)))
|
||
(setf blok-son (if (numberp yeni-son)
|
||
(+ 2 yeni-son)
|
||
uzunluk)
|
||
blok-baş önceki-son
|
||
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
|
||
(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 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)))
|