55 lines
1.8 KiB
Common Lisp
55 lines
1.8 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))
|
||
|
||
(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)))))
|