Blob


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