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