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 4800325e 2022-01-17 op ((text :initform ""
5 4800325e 2022-01-17 op :initarg :text
6 4800325e 2022-01-17 op :accessor text
7 4800325e 2022-01-17 op :type string)))
8 6b4d9ef2 2020-11-09 op
9 6b4d9ef2 2020-11-09 op (defclass title (element)
10 4800325e 2022-01-17 op ((level :initarg :level
11 4800325e 2022-01-17 op :accessor level
12 4800325e 2022-01-17 op :type integer
13 4800325e 2022-01-17 op :documentation "The nesting level of the title.
14 6b4d9ef2 2020-11-09 op
15 4800325e 2022-01-17 op Synonymous to the HTML heading levels, i.e. level 1 is <h1> tag, level 2 is <h2> tag etc.")))
16 4800325e 2022-01-17 op
17 6b4d9ef2 2020-11-09 op (defclass link (element)
18 4800325e 2022-01-17 op ((url :initform nil
19 4800325e 2022-01-17 op :initarg :url
20 4800325e 2022-01-17 op :accessor url
21 4800325e 2022-01-17 op :type (or null string))))
22 6b4d9ef2 2020-11-09 op
23 6b4d9ef2 2020-11-09 op (defclass item (element)
24 6b4d9ef2 2020-11-09 op ())
25 6b4d9ef2 2020-11-09 op
26 6b4d9ef2 2020-11-09 op (defclass paragraph (element)
27 6b4d9ef2 2020-11-09 op ())
28 6b4d9ef2 2020-11-09 op
29 880e5010 2022-01-13 noreply (defclass blockquote (element)
30 880e5010 2022-01-13 noreply ())
31 880e5010 2022-01-13 noreply
32 6b4d9ef2 2020-11-09 op (defclass verbatim (element)
33 4800325e 2022-01-17 op ((alt :initform nil
34 4800325e 2022-01-17 op :initarg :alt
35 4800325e 2022-01-17 op :accessor alt
36 4800325e 2022-01-17 op :type (or null string)
37 4800325e 2022-01-17 op :documentation "The alternative text for the verbatim block.
38 6b4d9ef2 2020-11-09 op
39 4800325e 2022-01-17 op Is usually put at the same line as the opening backquotes.
40 4800325e 2022-01-17 op
41 4800325e 2022-01-17 op Can be a programming language name or alternative text for, e.g., ASCII art.")))
42 4800325e 2022-01-17 op
43 4800325e 2022-01-17 op (defun element-p (element) (typep element 'element))
44 4800325e 2022-01-17 op (defun title-p (title) (typep title 'title))
45 4800325e 2022-01-17 op (defun link-p (link) (typep link 'link))
46 4800325e 2022-01-17 op (defun item-p (item) (typep item 'item))
47 4800325e 2022-01-17 op (defun paragraph-p (paragraph) (typep paragraph 'paragraph))
48 4800325e 2022-01-17 op (defun blockquote-p (blockquote) (typep blockquote 'blockquote))
49 4800325e 2022-01-17 op (defun verbatim-p (verbatim) (typep verbatim 'verbatim))
50 4800325e 2022-01-17 op
51 4800325e 2022-01-17 op
52 6b4d9ef2 2020-11-09 op (defun make-link (url &optional text)
53 0276d770 2020-11-11 op (make-instance 'link :url (quri:uri url)
54 0276d770 2020-11-11 op :text text))
55 6b4d9ef2 2020-11-09 op
56 6b4d9ef2 2020-11-09 op (defun parse-link (s)
57 6b4d9ef2 2020-11-09 op "Parse a line into link."
58 6b4d9ef2 2020-11-09 op (match (cl-ppcre:split "\\s+" s :limit 2)
59 bcb8cfe7 2022-01-14 op ((list url) (make-instance 'link :url (quri:uri url)))
60 bcb8cfe7 2022-01-14 op ((list url text) (make-instance 'link :url (quri:uri url)
61 bcb8cfe7 2022-01-14 op :text text))))
62 6b4d9ef2 2020-11-09 op
63 6b4d9ef2 2020-11-09 op (defun parse-line (s)
64 bcb8cfe7 2022-01-14 op (flet ((strim (s n)
65 bcb8cfe7 2022-01-14 op (string-trim '(#\Space #\Tab) (subseq s n)))
66 bcb8cfe7 2022-01-14 op (prefix-p (prfx str)
67 bcb8cfe7 2022-01-14 op (uiop:string-prefix-p prfx str)))
68 bcb8cfe7 2022-01-14 op (cond ((prefix-p "###" s) (make-instance 'title :level 3
69 bcb8cfe7 2022-01-14 op :text (strim s 3)))
70 bcb8cfe7 2022-01-14 op ((prefix-p "##" s) (make-instance 'title :level 2
71 bcb8cfe7 2022-01-14 op :text (strim s 2)))
72 bcb8cfe7 2022-01-14 op ((prefix-p "#" s) (make-instance 'title :level 1
73 bcb8cfe7 2022-01-14 op :text (strim s 1)))
74 588b55fb 2022-01-17 op ((prefix-p "=>" s) (let ((s (strim s 2)))
75 588b55fb 2022-01-17 op (if (string-equal s "")
76 588b55fb 2022-01-17 op (make-instance 'paragraph :text "=>")
77 588b55fb 2022-01-17 op (parse-link s))))
78 bcb8cfe7 2022-01-14 op ((prefix-p "* " s) (make-instance 'item :text (strim s 1)))
79 bcb8cfe7 2022-01-14 op ((prefix-p ">" s) (make-instance 'blockquote :text (strim s 1)))
80 bcb8cfe7 2022-01-14 op (t (make-instance 'paragraph :text (strim s 0))))))
81 6b4d9ef2 2020-11-09 op
82 6b4d9ef2 2020-11-09 op (defmacro markerp (line)
83 6b4d9ef2 2020-11-09 op `(uiop:string-prefix-p "```" ,line))
84 6b4d9ef2 2020-11-09 op
85 0276d770 2020-11-11 op (defun parse (in)
86 0276d770 2020-11-11 op "Parse gemtext from the stream IN."
87 6b4d9ef2 2020-11-09 op (loop with doc = nil
88 6b4d9ef2 2020-11-09 op for line = (read-line in nil)
89 6b4d9ef2 2020-11-09 op unless line
90 6b4d9ef2 2020-11-09 op return (nreverse doc)
91 6b4d9ef2 2020-11-09 op do (push
92 6b4d9ef2 2020-11-09 op (if (markerp line)
93 6b4d9ef2 2020-11-09 op (loop with label = (subseq line 3)
94 6b4d9ef2 2020-11-09 op with content = nil
95 6b4d9ef2 2020-11-09 op for line = (read-line in nil)
96 6b4d9ef2 2020-11-09 op unless line
97 6b4d9ef2 2020-11-09 op do (error "non-closed verbatim")
98 6b4d9ef2 2020-11-09 op when (markerp line)
99 6b4d9ef2 2020-11-09 op return (make-instance 'verbatim
100 6b4d9ef2 2020-11-09 op :alt label
101 073b25eb 2020-11-09 op :text (format nil "~{~A~%~^~}"
102 073b25eb 2020-11-09 op (nreverse content)))
103 6b4d9ef2 2020-11-09 op do (push line content))
104 6b4d9ef2 2020-11-09 op (parse-line line))
105 6b4d9ef2 2020-11-09 op doc)))
106 6b4d9ef2 2020-11-09 op
107 0276d770 2020-11-11 op (defun parse-string (str)
108 0276d770 2020-11-11 op "Parse the string STR as gemtext."
109 6b4d9ef2 2020-11-09 op (with-input-from-string (s str)
110 0276d770 2020-11-11 op (parse s)))
111 6b4d9ef2 2020-11-09 op
112 6b4d9ef2 2020-11-09 op (defgeneric unparse (obj stream)
113 6b4d9ef2 2020-11-09 op (:documentation "Print a textual representation of OBJ onto STREAM."))
114 6b4d9ef2 2020-11-09 op
115 6b4d9ef2 2020-11-09 op (defmethod unparse ((l list) stream)
116 6b4d9ef2 2020-11-09 op (dolist (item l)
117 6b4d9ef2 2020-11-09 op (unparse item stream)))
118 6b4d9ef2 2020-11-09 op
119 6b4d9ef2 2020-11-09 op (defmethod unparse ((title title) stream)
120 6b4d9ef2 2020-11-09 op (with-slots (text level) title
121 6b4d9ef2 2020-11-09 op (dotimes (_ level)
122 6b4d9ef2 2020-11-09 op (format stream "#"))
123 6b4d9ef2 2020-11-09 op (format stream " ~a~%" text)))
124 6b4d9ef2 2020-11-09 op
125 6b4d9ef2 2020-11-09 op (defmethod unparse ((link link) stream)
126 6b4d9ef2 2020-11-09 op (with-slots (url text) link
127 6b4d9ef2 2020-11-09 op (format stream "=> ~a ~a~%" url text)))
128 6b4d9ef2 2020-11-09 op
129 6b4d9ef2 2020-11-09 op (defmethod unparse ((item item) stream)
130 6b4d9ef2 2020-11-09 op (with-slots (text) item
131 272dc9db 2022-01-14 op (format stream "* ~a~%" text)))
132 6b4d9ef2 2020-11-09 op
133 6b4d9ef2 2020-11-09 op (defmethod unparse ((p paragraph) stream)
134 6b4d9ef2 2020-11-09 op (with-slots (text) p
135 272dc9db 2022-01-14 op (format stream "~a~%" text)))
136 6b4d9ef2 2020-11-09 op
137 6b4d9ef2 2020-11-09 op (defmethod unparse ((v verbatim) stream)
138 6b4d9ef2 2020-11-09 op (with-slots (alt text) v
139 6b4d9ef2 2020-11-09 op (format stream "```~a~%~a```~%" alt text)))
140 880e5010 2022-01-13 noreply
141 880e5010 2022-01-13 noreply (defmethod unparse ((b blockquote) stream)
142 880e5010 2022-01-13 noreply (with-slots (text) b
143 880e5010 2022-01-13 noreply (format stream "> ~a~%" text)))
144 336bee9c 2022-01-14 op
145 336bee9c 2022-01-14 op (defgeneric line-eq (a b)
146 336bee9c 2022-01-14 op (:documentation "t if the lines A and B are equals.")
147 336bee9c 2022-01-14 op (:method-combination and))
148 336bee9c 2022-01-14 op
149 336bee9c 2022-01-14 op (defmethod line-eq and ((a element) (b element))
150 336bee9c 2022-01-14 op (and (eq (type-of a)
151 336bee9c 2022-01-14 op (type-of b))
152 336bee9c 2022-01-14 op (equal (slot-value a 'text)
153 336bee9c 2022-01-14 op (slot-value b 'text))))
154 336bee9c 2022-01-14 op
155 336bee9c 2022-01-14 op (defmethod line-eq and ((a title) (b title))
156 336bee9c 2022-01-14 op (eq (slot-value a 'level)
157 336bee9c 2022-01-14 op (slot-value b 'level)))
158 336bee9c 2022-01-14 op
159 336bee9c 2022-01-14 op (defmethod line-eq and ((a link) (b link))
160 336bee9c 2022-01-14 op (quri:uri-equal (slot-value a 'url)
161 336bee9c 2022-01-14 op (slot-value b 'url)))
162 336bee9c 2022-01-14 op
163 336bee9c 2022-01-14 op (defmethod line-eq and ((a verbatim) (b verbatim))
164 336bee9c 2022-01-14 op (equal (slot-value a 'alt)
165 336bee9c 2022-01-14 op (slot-value b 'alt)))