summaryrefslogtreecommitdiff
path: root/okur.lisp
blob: 639e780ffa131135b8da971f1b689907a54d00f5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
(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 (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))
  (let ((blok-node (blok-ayrıştır okur)))
    (ebeveyn-node! :div
                   (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 metin
                :displaced-index-offset blok-baş)))

(defmethod okur-blok-listesi ((okur okur))
  (loop :while (sonraki-blok okur)
        :collect (blok-metni okur)))