132 lines
4.7 KiB
Common Lisp
132 lines
4.7 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")
|
||
(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))
|
||
|
||
(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))))))))
|
||
|
||
(defmethod okur-blok-listesi ((okur okur))
|
||
(let ((blok (sonraki-blok okur)))
|
||
(if (null blok)
|
||
nil
|
||
(cons blok (okur-blok-listesi okur)))))
|
||
|
||
(defgeneric ayrıştır (tag blok baş)
|
||
(: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ş)
|
||
: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))
|
||
)))
|