Blame


1 6b4d9ef2 2020-11-09 op (in-package #:phos/gemtext)
2 6b4d9ef2 2020-11-09 op
3 6b4d9ef2 2020-11-09 op (defclass element ()
4 e9a5e4f6 2022-01-14 op ((text :initarg :text
5 e9a5e4f6 2022-01-14 op :initform "")))
6 6b4d9ef2 2020-11-09 op
7 6b4d9ef2 2020-11-09 op (defclass title (element)
8 6b4d9ef2 2020-11-09 op ((level :initarg :level)))
9 6b4d9ef2 2020-11-09 op
10 6b4d9ef2 2020-11-09 op (defclass link (element)
11 6b4d9ef2 2020-11-09 op ((url :initarg :url)))
12 6b4d9ef2 2020-11-09 op
13 6b4d9ef2 2020-11-09 op (defclass item (element)
14 6b4d9ef2 2020-11-09 op ())
15 6b4d9ef2 2020-11-09 op
16 6b4d9ef2 2020-11-09 op (defclass paragraph (element)
17 6b4d9ef2 2020-11-09 op ())
18 6b4d9ef2 2020-11-09 op
19 880e5010 2022-01-13 noreply (defclass blockquote (element)
20 880e5010 2022-01-13 noreply ())
21 880e5010 2022-01-13 noreply
22 6b4d9ef2 2020-11-09 op (defclass verbatim (element)
23 6b4d9ef2 2020-11-09 op ((alt :initarg :alt)))
24 6b4d9ef2 2020-11-09 op
25 6b4d9ef2 2020-11-09 op (defun make-link (url &optional text)
26 0276d770 2020-11-11 op (make-instance 'link :url (quri:uri url)
27 0276d770 2020-11-11 op :text text))
28 6b4d9ef2 2020-11-09 op
29 6b4d9ef2 2020-11-09 op (defun parse-link (s)
30 6b4d9ef2 2020-11-09 op "Parse a line into link."
31 6b4d9ef2 2020-11-09 op (match (cl-ppcre:split "\\s+" s :limit 2)
32 bcb8cfe7 2022-01-14 op ((list url) (make-instance 'link :url (quri:uri url)))
33 bcb8cfe7 2022-01-14 op ((list url text) (make-instance 'link :url (quri:uri url)
34 bcb8cfe7 2022-01-14 op :text text))))
35 6b4d9ef2 2020-11-09 op
36 6b4d9ef2 2020-11-09 op (defun parse-line (s)
37 bcb8cfe7 2022-01-14 op (flet ((strim (s n)
38 bcb8cfe7 2022-01-14 op (string-trim '(#\Space #\Tab) (subseq s n)))
39 bcb8cfe7 2022-01-14 op (prefix-p (prfx str)
40 bcb8cfe7 2022-01-14 op (uiop:string-prefix-p prfx str)))
41 bcb8cfe7 2022-01-14 op (cond ((prefix-p "###" s) (make-instance 'title :level 3
42 bcb8cfe7 2022-01-14 op :text (strim s 3)))
43 bcb8cfe7 2022-01-14 op ((prefix-p "##" s) (make-instance 'title :level 2
44 bcb8cfe7 2022-01-14 op :text (strim s 2)))
45 bcb8cfe7 2022-01-14 op ((prefix-p "#" s) (make-instance 'title :level 1
46 bcb8cfe7 2022-01-14 op :text (strim s 1)))
47 bcb8cfe7 2022-01-14 op ((prefix-p "=>" s) (parse-link (strim s 2)))
48 bcb8cfe7 2022-01-14 op ((prefix-p "* " s) (make-instance 'item :text (strim s 1)))
49 bcb8cfe7 2022-01-14 op ((prefix-p ">" s) (make-instance 'blockquote :text (strim s 1)))
50 bcb8cfe7 2022-01-14 op (t (make-instance 'paragraph :text (strim s 0))))))
51 6b4d9ef2 2020-11-09 op
52 6b4d9ef2 2020-11-09 op (defmacro markerp (line)
53 6b4d9ef2 2020-11-09 op `(uiop:string-prefix-p "```" ,line))
54 6b4d9ef2 2020-11-09 op
55 0276d770 2020-11-11 op (defun parse (in)
56 0276d770 2020-11-11 op "Parse gemtext from the stream IN."
57 6b4d9ef2 2020-11-09 op (loop with doc = nil
58 6b4d9ef2 2020-11-09 op for line = (read-line in nil)
59 6b4d9ef2 2020-11-09 op unless line
60 6b4d9ef2 2020-11-09 op return (nreverse doc)
61 6b4d9ef2 2020-11-09 op do (push
62 6b4d9ef2 2020-11-09 op (if (markerp line)
63 6b4d9ef2 2020-11-09 op (loop with label = (subseq line 3)
64 6b4d9ef2 2020-11-09 op with content = nil
65 6b4d9ef2 2020-11-09 op for line = (read-line in nil)
66 6b4d9ef2 2020-11-09 op unless line
67 6b4d9ef2 2020-11-09 op do (error "non-closed verbatim")
68 6b4d9ef2 2020-11-09 op when (markerp line)
69 6b4d9ef2 2020-11-09 op return (make-instance 'verbatim
70 6b4d9ef2 2020-11-09 op :alt label
71 073b25eb 2020-11-09 op :text (format nil "~{~A~%~^~}"
72 073b25eb 2020-11-09 op (nreverse content)))
73 6b4d9ef2 2020-11-09 op do (push line content))
74 6b4d9ef2 2020-11-09 op (parse-line line))
75 6b4d9ef2 2020-11-09 op doc)))
76 6b4d9ef2 2020-11-09 op
77 0276d770 2020-11-11 op (defun parse-string (str)
78 0276d770 2020-11-11 op "Parse the string STR as gemtext."
79 6b4d9ef2 2020-11-09 op (with-input-from-string (s str)
80 0276d770 2020-11-11 op (parse s)))
81 6b4d9ef2 2020-11-09 op
82 6b4d9ef2 2020-11-09 op (defgeneric unparse (obj stream)
83 6b4d9ef2 2020-11-09 op (:documentation "Print a textual representation of OBJ onto STREAM."))
84 6b4d9ef2 2020-11-09 op
85 6b4d9ef2 2020-11-09 op (defmethod unparse ((l list) stream)
86 6b4d9ef2 2020-11-09 op (dolist (item l)
87 6b4d9ef2 2020-11-09 op (unparse item stream)))
88 6b4d9ef2 2020-11-09 op
89 6b4d9ef2 2020-11-09 op (defmethod unparse ((title title) stream)
90 6b4d9ef2 2020-11-09 op (with-slots (text level) title
91 6b4d9ef2 2020-11-09 op (dotimes (_ level)
92 6b4d9ef2 2020-11-09 op (format stream "#"))
93 6b4d9ef2 2020-11-09 op (format stream " ~a~%" text)))
94 6b4d9ef2 2020-11-09 op
95 6b4d9ef2 2020-11-09 op (defmethod unparse ((link link) stream)
96 6b4d9ef2 2020-11-09 op (with-slots (url text) link
97 6b4d9ef2 2020-11-09 op (format stream "=> ~a ~a~%" url text)))
98 6b4d9ef2 2020-11-09 op
99 6b4d9ef2 2020-11-09 op (defmethod unparse ((item item) stream)
100 6b4d9ef2 2020-11-09 op (with-slots (text) item
101 272dc9db 2022-01-14 op (format stream "* ~a~%" text)))
102 6b4d9ef2 2020-11-09 op
103 6b4d9ef2 2020-11-09 op (defmethod unparse ((p paragraph) stream)
104 6b4d9ef2 2020-11-09 op (with-slots (text) p
105 272dc9db 2022-01-14 op (format stream "~a~%" text)))
106 6b4d9ef2 2020-11-09 op
107 6b4d9ef2 2020-11-09 op (defmethod unparse ((v verbatim) stream)
108 6b4d9ef2 2020-11-09 op (with-slots (alt text) v
109 6b4d9ef2 2020-11-09 op (format stream "```~a~%~a```~%" alt text)))
110 880e5010 2022-01-13 noreply
111 880e5010 2022-01-13 noreply (defmethod unparse ((b blockquote) stream)
112 880e5010 2022-01-13 noreply (with-slots (text) b
113 880e5010 2022-01-13 noreply (format stream "> ~a~%" text)))
114 336bee9c 2022-01-14 op
115 336bee9c 2022-01-14 op (defgeneric line-eq (a b)
116 336bee9c 2022-01-14 op (:documentation "t if the lines A and B are equals.")
117 336bee9c 2022-01-14 op (:method-combination and))
118 336bee9c 2022-01-14 op
119 336bee9c 2022-01-14 op (defmethod line-eq and ((a element) (b element))
120 336bee9c 2022-01-14 op (and (eq (type-of a)
121 336bee9c 2022-01-14 op (type-of b))
122 336bee9c 2022-01-14 op (equal (slot-value a 'text)
123 336bee9c 2022-01-14 op (slot-value b 'text))))
124 336bee9c 2022-01-14 op
125 336bee9c 2022-01-14 op (defmethod line-eq and ((a title) (b title))
126 336bee9c 2022-01-14 op (eq (slot-value a 'level)
127 336bee9c 2022-01-14 op (slot-value b 'level)))
128 336bee9c 2022-01-14 op
129 336bee9c 2022-01-14 op (defmethod line-eq and ((a link) (b link))
130 336bee9c 2022-01-14 op (quri:uri-equal (slot-value a 'url)
131 336bee9c 2022-01-14 op (slot-value b 'url)))
132 336bee9c 2022-01-14 op
133 336bee9c 2022-01-14 op (defmethod line-eq and ((a verbatim) (b verbatim))
134 336bee9c 2022-01-14 op (equal (slot-value a 'alt)
135 336bee9c 2022-01-14 op (slot-value b 'alt)))