1(defpackage :net.acdw.clarence
2 (:nicknames #:clarence)
3 (:use :cl))
4(in-package :net.acdw.clarence)
5
6(defparameter *tags*
7 '(("###" . :h3)
8 ("##" . :h2)
9 ("#" . :h1)
10 ("=>" . :link)
11 ("> " . :quote)
12 ("* " . :list)
13 ("```" . :verbatim))
14 "Alist of source sigil to internal tags.")
15
16(defclass gemtext ()
17 ((tag :accessor tag
18 :initarg :tag
19 :initform nil
20 :type (or null keyword))
21 (text :accessor text
22 :initarg :text
23 :initform ""
24 :type string))
25 (:documentation "Base class of all gemtext types."))
26
27(defclass line (gemtext)
28 ((content :initform "")))
29
30(defclass gemcollection ()
31 ((content :accessor content
32 :initarg :content
33 :initform ())))
34
35(defclass stanza (gemtext gemcollection))
36
37(defclass document (gemtext gemcollection))
38
39(defclass link (line)
40 ((tag :initform :link)
41 (href :initarg href
42 :initform ""
43 :type string)))
44
45(defclass verbatim (stanza)
46 ((tag :initform :verbatim)
47 (alt :initarg alt
48 :initform ""
49 :type string)
50 (open :initarg open
51 :initform ""
52 :type string)
53 (close :initarg close
54 :initform ""
55 :type string)))
56
57(defun parse-tag (string)
58 "Return the tag of STRING by consulting *TAGS*."
59 (loop for (sigil . tag) in *tags*
60 when (uiop:string-prefix-p sigil string)
61 do (return tag)))
62
63(defgeneric blankp (x)
64 (:documentation "Return wheter X is blank, i.e., it has no text.")
65 (:method ((x gemtext))
66 (or (tag-equal x :blank)
67 (zerop (length (text x)))))
68 )
69
70(defgeneric tag-equal (a b)
71 (:documentation "Return whether the tags of A and B are eq.")
72 (:method ((a null) b) nil)
73 (:method ((b null) a) nil)
74 (:method ((a symbol) (b symbol))
75 (eq a b))
76 (:method ((a symbol) (b tagged-content))
77 (eq a (slot-value b 'tag)))
78 (:method ((a tagged-content) (b symbol))
79 (eq (slot-value a 'tag) b))
80 (:method ((a tagged-content) (b tagged-content))
81 (eq (slot-value a 'tag) (slot-value b 'tag)))
82 (:method ((a string) b)
83 (tag-equal (parse-tag a) b))
84 (:method (a (b string))
85 (tag-equal a (parse-tag b))))
86
87(defun parse-line (string &optional verbatimp)
88 (let* ((tag (parse-tag string))
89 (text (chomp (subseq string (length (car (rassoc tag *tags*)))))))
90 (cond
91 (verbatimp
92 (make-instance 'line :tag :verbatim :text text))
93 ((tag-equal tag :link)
94 (let* ((%split-line (cl-ppcre:split "\\s" text))
95 (href (chomp (car %split-line)))
96 (text (if (cdr %split-line)
97 (chomp (format nil "~{~A~^ ~}" (cdr %split-line)))
98 href)))
99 (make-instance 'link :href href :text text))))))