1 6b4d9ef2 2020-11-09 op (in-package #:phos/gemtext)
3 6b4d9ef2 2020-11-09 op (defclass element ()
4 4800325e 2022-01-17 op ((text :initform ""
7 4800325e 2022-01-17 op :type string)))
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
13 4800325e 2022-01-17 op :documentation "The nesting level of the title.
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.")))
17 6b4d9ef2 2020-11-09 op (defclass link (element)
18 a7349379 2022-01-17 op ((url :initarg :url
20 a7349379 2022-01-17 op :type quri:uri)))
22 6b4d9ef2 2020-11-09 op (defclass item (element)
25 6b4d9ef2 2020-11-09 op (defclass paragraph (element)
28 880e5010 2022-01-13 noreply (defclass blockquote (element)
31 6b4d9ef2 2020-11-09 op (defclass verbatim (element)
32 4800325e 2022-01-17 op ((alt :initform nil
35 4800325e 2022-01-17 op :type (or null string)
36 4800325e 2022-01-17 op :documentation "The alternative text for the verbatim block.
38 4800325e 2022-01-17 op Is usually put at the same line as the opening backquotes.
40 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 (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))
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)
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))))
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))))))
81 6b4d9ef2 2020-11-09 op (defmacro markerp (line)
82 6b4d9ef2 2020-11-09 op `(uiop:string-prefix-p "```" ,line))
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)
89 6b4d9ef2 2020-11-09 op return (nreverse doc)
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 721a55a9 2022-01-17 op when (or (not line)
96 721a55a9 2022-01-17 op (markerp line))
97 6b4d9ef2 2020-11-09 op return (make-instance 'verbatim
98 721a55a9 2022-01-17 op :alt (unless (string-equal 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))
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)
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."))
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)))
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)))
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)))
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)))
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)))
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)))
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)))
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))
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)
151 385d8c27 2022-01-17 op (equal (text a) (text b))))
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)))
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)))
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)))