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