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