Blame


1 6b4d9ef2 2020-11-09 op (in-package #:phos/gemtext)
2 6b4d9ef2 2020-11-09 op
3 073b25eb 2020-11-09 op (defparameter *relative-to* nil)
4 073b25eb 2020-11-09 op
5 6b4d9ef2 2020-11-09 op (defclass element ()
6 6b4d9ef2 2020-11-09 op ((text :initarg :text)))
7 6b4d9ef2 2020-11-09 op
8 6b4d9ef2 2020-11-09 op (defclass title (element)
9 6b4d9ef2 2020-11-09 op ((level :initarg :level)))
10 6b4d9ef2 2020-11-09 op
11 6b4d9ef2 2020-11-09 op (defclass link (element)
12 6b4d9ef2 2020-11-09 op ((url :initarg :url)))
13 6b4d9ef2 2020-11-09 op
14 6b4d9ef2 2020-11-09 op (defclass item (element)
15 6b4d9ef2 2020-11-09 op ())
16 6b4d9ef2 2020-11-09 op
17 6b4d9ef2 2020-11-09 op (defclass paragraph (element)
18 6b4d9ef2 2020-11-09 op ())
19 6b4d9ef2 2020-11-09 op
20 6b4d9ef2 2020-11-09 op (defclass verbatim (element)
21 6b4d9ef2 2020-11-09 op ((alt :initarg :alt)))
22 6b4d9ef2 2020-11-09 op
23 6b4d9ef2 2020-11-09 op (defun parse-title (s)
24 6b4d9ef2 2020-11-09 op "Parse a line into a title."
25 6b4d9ef2 2020-11-09 op (destructuring-bind (h text)
26 6b4d9ef2 2020-11-09 op (cl-ppcre:split "\\s+" s :limit 2)
27 6b4d9ef2 2020-11-09 op (make-instance 'title :level (length h)
28 6b4d9ef2 2020-11-09 op :text text)))
29 6b4d9ef2 2020-11-09 op
30 6b4d9ef2 2020-11-09 op (defun make-link (url &optional text)
31 073b25eb 2020-11-09 op (if *relative-to*
32 073b25eb 2020-11-09 op (let ((u (quri:copy-uri *relative-to*)))
33 073b25eb 2020-11-09 op (setf (quri:uri-path u) url)
34 073b25eb 2020-11-09 op (make-instance 'link :url u
35 073b25eb 2020-11-09 op :text text))
36 073b25eb 2020-11-09 op (make-instance 'link :url (quri:uri url)
37 073b25eb 2020-11-09 op :text text)))
38 6b4d9ef2 2020-11-09 op
39 6b4d9ef2 2020-11-09 op (defun parse-link (s)
40 6b4d9ef2 2020-11-09 op "Parse a line into link."
41 6b4d9ef2 2020-11-09 op (match (cl-ppcre:split "\\s+" s :limit 3)
42 6b4d9ef2 2020-11-09 op ((list _ url) (make-link url))
43 6b4d9ef2 2020-11-09 op ((list _ url text) (make-link url text))))
44 6b4d9ef2 2020-11-09 op
45 6b4d9ef2 2020-11-09 op (defun parse-item (s)
46 6b4d9ef2 2020-11-09 op "Parse a line into an item"
47 6b4d9ef2 2020-11-09 op (match (cl-ppcre:split "\\s+" s :limit 2)
48 6b4d9ef2 2020-11-09 op ((list _ text) (make-instance 'item :text text))))
49 6b4d9ef2 2020-11-09 op
50 6b4d9ef2 2020-11-09 op (defun parse-line (s)
51 6b4d9ef2 2020-11-09 op (if (string= s "")
52 6b4d9ef2 2020-11-09 op (make-instance 'paragraph :text s)
53 6b4d9ef2 2020-11-09 op (case (char s 0)
54 6b4d9ef2 2020-11-09 op (#\# (parse-title s))
55 6b4d9ef2 2020-11-09 op (#\= (parse-link s))
56 6b4d9ef2 2020-11-09 op (#\* (parse-item s))
57 6b4d9ef2 2020-11-09 op (otherwise (make-instance 'paragraph :text s)))))
58 6b4d9ef2 2020-11-09 op
59 6b4d9ef2 2020-11-09 op (defmacro markerp (line)
60 6b4d9ef2 2020-11-09 op `(uiop:string-prefix-p "```" ,line))
61 6b4d9ef2 2020-11-09 op
62 073b25eb 2020-11-09 op (defun parse (in &optional relative-to)
63 073b25eb 2020-11-09 op "Parse gemtext from the stream IN.
64 073b25eb 2020-11-09 op
65 073b25eb 2020-11-09 op RELATIVE-TO is the base URL of the page, it is used to transform url
66 073b25eb 2020-11-09 op to absolute urls, if null the transformation does not happen."
67 6b4d9ef2 2020-11-09 op (loop with doc = nil
68 073b25eb 2020-11-09 op with *relative-to* = (when relative-to
69 073b25eb 2020-11-09 op (quri:uri relative-to))
70 6b4d9ef2 2020-11-09 op for line = (read-line in nil)
71 6b4d9ef2 2020-11-09 op unless line
72 6b4d9ef2 2020-11-09 op return (nreverse doc)
73 6b4d9ef2 2020-11-09 op do (push
74 6b4d9ef2 2020-11-09 op (if (markerp line)
75 6b4d9ef2 2020-11-09 op (loop with label = (subseq line 3)
76 6b4d9ef2 2020-11-09 op with content = nil
77 6b4d9ef2 2020-11-09 op for line = (read-line in nil)
78 6b4d9ef2 2020-11-09 op unless line
79 6b4d9ef2 2020-11-09 op do (error "non-closed verbatim")
80 6b4d9ef2 2020-11-09 op when (markerp line)
81 6b4d9ef2 2020-11-09 op return (make-instance 'verbatim
82 6b4d9ef2 2020-11-09 op :alt label
83 073b25eb 2020-11-09 op :text (format nil "~{~A~%~^~}"
84 073b25eb 2020-11-09 op (nreverse content)))
85 6b4d9ef2 2020-11-09 op do (push line content))
86 6b4d9ef2 2020-11-09 op (parse-line line))
87 6b4d9ef2 2020-11-09 op doc)))
88 6b4d9ef2 2020-11-09 op
89 073b25eb 2020-11-09 op (defun parse-string (str &optional relative-to)
90 073b25eb 2020-11-09 op "Parse the string STR as gemtext. See the documentation of `parse'
91 073b25eb 2020-11-09 op for more info."
92 6b4d9ef2 2020-11-09 op (with-input-from-string (s str)
93 073b25eb 2020-11-09 op (parse s relative-to)))
94 6b4d9ef2 2020-11-09 op
95 6b4d9ef2 2020-11-09 op ;; (unparse
96 6b4d9ef2 2020-11-09 op ;; (with-open-file (stream #P"~/quicklisp/local-projects/phos/test.gmi")
97 6b4d9ef2 2020-11-09 op ;; (parse stream))
98 6b4d9ef2 2020-11-09 op ;; *standard-output*)
99 6b4d9ef2 2020-11-09 op
100 6b4d9ef2 2020-11-09 op (defgeneric unparse (obj stream)
101 6b4d9ef2 2020-11-09 op (:documentation "Print a textual representation of OBJ onto STREAM."))
102 6b4d9ef2 2020-11-09 op
103 6b4d9ef2 2020-11-09 op (defmethod unparse ((l list) stream)
104 6b4d9ef2 2020-11-09 op (dolist (item l)
105 6b4d9ef2 2020-11-09 op (unparse item stream)))
106 6b4d9ef2 2020-11-09 op
107 6b4d9ef2 2020-11-09 op (defmethod unparse ((title title) stream)
108 6b4d9ef2 2020-11-09 op (with-slots (text level) title
109 6b4d9ef2 2020-11-09 op (dotimes (_ level)
110 6b4d9ef2 2020-11-09 op (format stream "#"))
111 6b4d9ef2 2020-11-09 op (format stream " ~a~%" text)))
112 6b4d9ef2 2020-11-09 op
113 6b4d9ef2 2020-11-09 op (defmethod unparse ((link link) stream)
114 6b4d9ef2 2020-11-09 op (with-slots (url text) link
115 6b4d9ef2 2020-11-09 op (format stream "=> ~a ~a~%" url text)))
116 6b4d9ef2 2020-11-09 op
117 6b4d9ef2 2020-11-09 op (defmethod unparse ((item item) stream)
118 6b4d9ef2 2020-11-09 op (with-slots (text) item
119 6b4d9ef2 2020-11-09 op (format stream "* ~a" text)
120 6b4d9ef2 2020-11-09 op (terpri)))
121 6b4d9ef2 2020-11-09 op
122 6b4d9ef2 2020-11-09 op (defmethod unparse ((p paragraph) stream)
123 6b4d9ef2 2020-11-09 op (with-slots (text) p
124 6b4d9ef2 2020-11-09 op (format stream "~a" text)
125 6b4d9ef2 2020-11-09 op (terpri)))
126 6b4d9ef2 2020-11-09 op
127 6b4d9ef2 2020-11-09 op (defmethod unparse ((v verbatim) stream)
128 6b4d9ef2 2020-11-09 op (with-slots (alt text) v
129 6b4d9ef2 2020-11-09 op (format stream "```~a~%~a```~%" alt text)))