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 e9a5e4f6 2022-01-14 op   ((text :initarg :text
  5 e9a5e4f6 2022-01-14 op          :initform "")))
  6 6b4d9ef2 2020-11-09 op 
  7 6b4d9ef2 2020-11-09 op (defclass title (element)
  8 6b4d9ef2 2020-11-09 op   ((level :initarg :level)))
  9 6b4d9ef2 2020-11-09 op 
 10 6b4d9ef2 2020-11-09 op (defclass link (element)
 11 6b4d9ef2 2020-11-09 op   ((url :initarg :url)))
 12 6b4d9ef2 2020-11-09 op 
 13 6b4d9ef2 2020-11-09 op (defclass item (element)
 14 6b4d9ef2 2020-11-09 op   ())
 15 6b4d9ef2 2020-11-09 op 
 16 6b4d9ef2 2020-11-09 op (defclass paragraph (element)
 17 6b4d9ef2 2020-11-09 op   ())
 18 6b4d9ef2 2020-11-09 op 
 19 880e5010 2022-01-13 noreply (defclass blockquote (element)
 20 880e5010 2022-01-13 noreply   ())
 21 880e5010 2022-01-13 noreply 
 22 6b4d9ef2 2020-11-09 op (defclass verbatim (element)
 23 6b4d9ef2 2020-11-09 op   ((alt :initarg :alt)))
 24 6b4d9ef2 2020-11-09 op 
 25 6b4d9ef2 2020-11-09 op (defun parse-title (s)
 26 6b4d9ef2 2020-11-09 op   "Parse a line into a title."
 27 6b4d9ef2 2020-11-09 op   (destructuring-bind (h text)
 28 6b4d9ef2 2020-11-09 op       (cl-ppcre:split "\\s+" s :limit 2)
 29 6b4d9ef2 2020-11-09 op     (make-instance 'title :level (length h)
 30 6b4d9ef2 2020-11-09 op                           :text text)))
 31 6b4d9ef2 2020-11-09 op 
 32 6b4d9ef2 2020-11-09 op (defun make-link (url &optional text)
 33 0276d770 2020-11-11 op   (make-instance 'link :url (quri:uri url)
 34 0276d770 2020-11-11 op                        :text text))
 35 6b4d9ef2 2020-11-09 op 
 36 6b4d9ef2 2020-11-09 op (defun parse-link (s)
 37 6b4d9ef2 2020-11-09 op   "Parse a line into link."
 38 6b4d9ef2 2020-11-09 op   (match (cl-ppcre:split "\\s+" s :limit 3)
 39 6b4d9ef2 2020-11-09 op     ((list _ url)      (make-link url))
 40 6b4d9ef2 2020-11-09 op     ((list _ url text) (make-link url text))))
 41 6b4d9ef2 2020-11-09 op 
 42 6b4d9ef2 2020-11-09 op (defun parse-item (s)
 43 6b4d9ef2 2020-11-09 op   "Parse a line into an item"
 44 6b4d9ef2 2020-11-09 op   (match (cl-ppcre:split "\\s+" s :limit 2)
 45 6b4d9ef2 2020-11-09 op     ((list _ text) (make-instance 'item :text text))))
 46 6b4d9ef2 2020-11-09 op 
 47 880e5010 2022-01-13 noreply (defun parse-blockquote (s)
 48 880e5010 2022-01-13 noreply   "Parse a line into a blockquote."
 49 880e5010 2022-01-13 noreply   (match (cl-ppcre:split "\\s+" s :limit 2)
 50 880e5010 2022-01-13 noreply     ((list _ text) (make-instance 'blockquote :text text))))
 51 880e5010 2022-01-13 noreply 
 52 6b4d9ef2 2020-11-09 op (defun parse-line (s)
 53 6b4d9ef2 2020-11-09 op   (if (string= s "")
 54 6b4d9ef2 2020-11-09 op       (make-instance 'paragraph :text s)
 55 6b4d9ef2 2020-11-09 op       (case (char s 0)
 56 6b4d9ef2 2020-11-09 op         (#\# (parse-title s))
 57 6b4d9ef2 2020-11-09 op         (#\= (parse-link s))
 58 6b4d9ef2 2020-11-09 op         (#\* (parse-item s))
 59 880e5010 2022-01-13 noreply         (#\> (parse-blockquote s))
 60 6b4d9ef2 2020-11-09 op         (otherwise (make-instance 'paragraph :text s)))))
 61 6b4d9ef2 2020-11-09 op 
 62 6b4d9ef2 2020-11-09 op (defmacro markerp (line)
 63 6b4d9ef2 2020-11-09 op   `(uiop:string-prefix-p "```" ,line))
 64 6b4d9ef2 2020-11-09 op 
 65 0276d770 2020-11-11 op (defun parse (in)
 66 0276d770 2020-11-11 op   "Parse gemtext from the stream IN."
 67 6b4d9ef2 2020-11-09 op   (loop with doc = nil
 68 6b4d9ef2 2020-11-09 op         for line = (read-line in nil)
 69 6b4d9ef2 2020-11-09 op         unless line
 70 6b4d9ef2 2020-11-09 op           return (nreverse doc)
 71 6b4d9ef2 2020-11-09 op         do (push
 72 6b4d9ef2 2020-11-09 op             (if (markerp line)
 73 6b4d9ef2 2020-11-09 op                 (loop with label = (subseq line 3)
 74 6b4d9ef2 2020-11-09 op                       with content = nil
 75 6b4d9ef2 2020-11-09 op                       for line = (read-line in nil)
 76 6b4d9ef2 2020-11-09 op                       unless line
 77 6b4d9ef2 2020-11-09 op                         do (error "non-closed verbatim")
 78 6b4d9ef2 2020-11-09 op                       when (markerp line)
 79 6b4d9ef2 2020-11-09 op                         return (make-instance 'verbatim
 80 6b4d9ef2 2020-11-09 op                                               :alt label
 81 073b25eb 2020-11-09 op                                               :text (format nil "~{~A~%~^~}"
 82 073b25eb 2020-11-09 op                                                             (nreverse content)))
 83 6b4d9ef2 2020-11-09 op                       do (push line content))
 84 6b4d9ef2 2020-11-09 op                 (parse-line line))
 85 6b4d9ef2 2020-11-09 op             doc)))
 86 6b4d9ef2 2020-11-09 op 
 87 0276d770 2020-11-11 op (defun parse-string (str)
 88 0276d770 2020-11-11 op   "Parse the string STR as gemtext."
 89 6b4d9ef2 2020-11-09 op   (with-input-from-string (s str)
 90 0276d770 2020-11-11 op     (parse s)))
 91 6b4d9ef2 2020-11-09 op 
 92 6b4d9ef2 2020-11-09 op (defgeneric unparse (obj stream)
 93 6b4d9ef2 2020-11-09 op   (:documentation "Print a textual representation of OBJ onto STREAM."))
 94 6b4d9ef2 2020-11-09 op 
 95 6b4d9ef2 2020-11-09 op (defmethod unparse ((l list) stream)
 96 6b4d9ef2 2020-11-09 op   (dolist (item l)
 97 6b4d9ef2 2020-11-09 op     (unparse item stream)))
 98 6b4d9ef2 2020-11-09 op 
 99 6b4d9ef2 2020-11-09 op (defmethod unparse ((title title) stream)
100 6b4d9ef2 2020-11-09 op   (with-slots (text level) title
101 6b4d9ef2 2020-11-09 op     (dotimes (_ level)
102 6b4d9ef2 2020-11-09 op       (format stream "#"))
103 6b4d9ef2 2020-11-09 op     (format stream " ~a~%" text)))
104 6b4d9ef2 2020-11-09 op 
105 6b4d9ef2 2020-11-09 op (defmethod unparse ((link link) stream)
106 6b4d9ef2 2020-11-09 op   (with-slots (url text) link
107 6b4d9ef2 2020-11-09 op     (format stream "=> ~a ~a~%" url text)))
108 6b4d9ef2 2020-11-09 op 
109 6b4d9ef2 2020-11-09 op (defmethod unparse ((item item) stream)
110 6b4d9ef2 2020-11-09 op   (with-slots (text) item
111 272dc9db 2022-01-14 op     (format stream "* ~a~%" text)))
112 6b4d9ef2 2020-11-09 op 
113 6b4d9ef2 2020-11-09 op (defmethod unparse ((p paragraph) stream)
114 6b4d9ef2 2020-11-09 op   (with-slots (text) p
115 272dc9db 2022-01-14 op     (format stream "~a~%" text)))
116 6b4d9ef2 2020-11-09 op 
117 6b4d9ef2 2020-11-09 op (defmethod unparse ((v verbatim) stream)
118 6b4d9ef2 2020-11-09 op   (with-slots (alt text) v
119 6b4d9ef2 2020-11-09 op     (format stream "```~a~%~a```~%" alt text)))
120 880e5010 2022-01-13 noreply 
121 880e5010 2022-01-13 noreply (defmethod unparse ((b blockquote) stream)
122 880e5010 2022-01-13 noreply   (with-slots (text) b
123 880e5010 2022-01-13 noreply     (format stream "> ~a~%" text)))
124 336bee9c 2022-01-14 op 
125 336bee9c 2022-01-14 op (defgeneric line-eq (a b)
126 336bee9c 2022-01-14 op   (:documentation "t if the lines A and B are equals.")
127 336bee9c 2022-01-14 op   (:method-combination and))
128 336bee9c 2022-01-14 op 
129 336bee9c 2022-01-14 op (defmethod line-eq and ((a element) (b element))
130 336bee9c 2022-01-14 op   (and (eq (type-of a)
131 336bee9c 2022-01-14 op            (type-of b))
132 336bee9c 2022-01-14 op        (equal (slot-value a 'text)
133 336bee9c 2022-01-14 op               (slot-value b 'text))))
134 336bee9c 2022-01-14 op 
135 336bee9c 2022-01-14 op (defmethod line-eq and ((a title) (b title))
136 336bee9c 2022-01-14 op   (eq (slot-value a 'level)
137 336bee9c 2022-01-14 op       (slot-value b 'level)))
138 336bee9c 2022-01-14 op 
139 336bee9c 2022-01-14 op (defmethod line-eq and ((a link) (b link))
140 336bee9c 2022-01-14 op   (quri:uri-equal (slot-value a 'url)
141 336bee9c 2022-01-14 op                   (slot-value b 'url)))
142 336bee9c 2022-01-14 op 
143 336bee9c 2022-01-14 op (defmethod line-eq and ((a verbatim) (b verbatim))
144 336bee9c 2022-01-14 op   (equal (slot-value a 'alt)
145 336bee9c 2022-01-14 op          (slot-value b 'alt)))