Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 162 lines (144 sloc) 6.985 kB
41b9d56 @vsedach Removed RESTAS, simplified some things.
authored
1 (in-package #:cliki2)
2 (in-readtable cliki2)
57013f5 @archimag added cliki2 markup extensions: article-link, person-link, hyperspec-…
archimag authored
3
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
4 (sanitize:define-sanitize-mode +links-only+
5 :elements ("a")
6 :attributes (("a" . ("href" "class")))
7 :protocols (("a" . (("href" . (:ftp :http :https :mailto :relative))))))
5a7e779 @archimag refactoring
archimag authored
8
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
9 (sanitize:define-sanitize-mode +cliki-tags+
85a7fdd @vsedach Cleaned up +cliki-tags+ html tags whitelist
authored
10 :elements ("a" "blockquote" "q" "dd" "dl" "dt" "h1" "h2" "h3" "h4" "h5"
11 "h6" "hgroup" "pre" "code" "kbd" "samp" "cite" "var" "time"
12 "figure" "figcaption" "img" "table" "caption" "tbody" "td"
13 "tfoot" "th" "thead" "tr" "col" "colgroup" "ul" "ol" "li" "b"
d613d23 @vsedach Added <big> and <tt> to html whitelist
authored
14 "em" "i" "small" "big" "tt" "strike" "strong" "dfn" "s" "sub"
15 "sup" "u" "abbr" "ruby" "rp" "rt" "bdo" "mark" "br" "hr")
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
16 :attributes ((:all . ("dir" "lang" "title" "class"))
17 ("a" . ("href"))
85a7fdd @vsedach Cleaned up +cliki-tags+ html tags whitelist
authored
18 ("abbr" . ("title"))
19 ("bdo" . ("dir"))
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
20 ("blockquote" . ("cite"))
85a7fdd @vsedach Cleaned up +cliki-tags+ html tags whitelist
authored
21 ("col" . ("span" "width" "align" "valign"))
22 ("colgroup" . ("span" "width" "align" "valign"))
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
23 ("img" . ("align" "alt" "height" "src" "width"))
24 ("ol" . ("start" "reversed" "type"))
25 ("ul" . ("type"))
26 ("code" . ("lang"))
27 ("q" . ("cite"))
28 ("table" . ("summary" "width"))
29 ("td" . ("abbr" "axis" "colspan" "rowspan" "width"))
30 ("th" . ("abbr" "axis" "colspan" "rowspan" "scope" "width")))
31
32 :protocols (("a" . (("href" . (:ftp :http :https :mailto :relative))))
33 ("blockquote" . (("cite" . (:http :https :relative))))
34 ("img" . (("src" . (:http :https :relative))))
35 ("q" . (("cite" . (:http :https :relative))))))
41b9d56 @vsedach Removed RESTAS, simplified some things.
authored
36
230b297 @vsedach Made markdown parser print directly to *html-stream*
authored
37 (defun generate-html-from-markup (markup)
57ed384 @vsedach Fixed history list of revisions display (broken in pretty tables patch).
authored
38 #H[<div id="article">]
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
39 (let ((start 0)
40 tag-start
41 close-tag)
42 (labels ((find-tag (tag start)
43 (search tag markup :start2 start :test #'string-equal))
44 (find-next-tag (start)
45 (let ((next-pre (find-tag "<pre>" start))
46 (next-code (find-tag "<code" start))
47 min)
48 (when next-pre
49 (setf close-tag "</pre>"
50 min next-pre))
51 (when next-code
52 (unless (and next-pre (< next-pre next-code))
53 (setf close-tag "</code>"
54 min next-code)))
55 min)))
56 (loop while (setf tag-start (find-next-tag start))
57 do (write-string (parse-markup-fragment markup start tag-start)
58 *html-stream*)
59 (setf start (+ (length close-tag)
60 (or (find-tag close-tag tag-start)
61 (return))))
62 (write-string (funcall (if (equal close-tag "</pre>")
63 #'escape-pre-block
64 #'markup-code)
65 markup tag-start start)
66 *html-stream*)))
67 (write-string (parse-markup-fragment markup start (length markup))
68 *html-stream*))
57ed384 @vsedach Fixed history list of revisions display (broken in pretty tables patch).
authored
69 #H[</div>])
41b9d56 @vsedach Removed RESTAS, simplified some things.
authored
70
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
71 (defun parse-markup-fragment (markup start end)
874ac09 @vsedach Escape parentheses in href before parsing cliki markup
authored
72 (ppcre:regex-replace-all
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
73 "\\n\\n"
74 (sanitize:clean
75 (cl-ppcre:regex-replace-all
76 "< "
77 (parse-cliki-markup
78 (escape-parens-in-href-links markup start end))
79 "&lt; ")
80 +cliki-tags+)
81 "<p>"))
82
83 (defun escape-pre-block (markup start end)
84 (ppcre:regex-replace
85 "<(?:PRE|pre)>((?:.|\\n)*?)</(?:PRE|pre)>" markup
86 (lambda (match preformatted)
87 (declare (ignore match))
88 #?[<pre>${(escape-for-html preformatted)}</pre>])
89 :simple-calls t :start start :end end))
90
91 (defun escape-parens-in-href-links (markup start end)
92 (ppcre:regex-replace-all
93 #?/(?:href|HREF)="(.*?)"/
874ac09 @vsedach Escape parentheses in href before parsing cliki markup
authored
94 markup
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
95 (lambda (match url)
96 (declare (ignore match))
874ac09 @vsedach Escape parentheses in href before parsing cliki markup
authored
97 (format nil "href=\"~A\""
98 (cl-ppcre:regex-replace-all "\\(|\\)" url #'uri-encode :simple-calls t)))
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
99 :simple-calls t :start start :end end))
874ac09 @vsedach Escape parentheses in href before parsing cliki markup
authored
100
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
101 (defun parse-cliki-markup (markup)
102 (loop for prefix in '("_" "_H" "\\*" "\\/" "_P")
4a89722 @vsedach Added support for page links like _(real name|display name) like on w…
authored
103 for formatter in '(pprint-article-underscore-link format-hyperspec-link pprint-topic-link format-topic-list format-package-link)
1556535 @vsedach Removed bknr.datastore and used file storage for persistence instead.
authored
104 do (setf markup (process-cliki-rule markup prefix formatter)))
e43810d @vsedach Fixed ampersand escaping (annoying because libxml2 handily unescapes …
authored
105 markup)
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
106
4a89722 @vsedach Added support for page links like _(real name|display name) like on w…
authored
107 (defun pprint-article-underscore-link (title)
108 (destructuring-bind (real-title &optional link-title)
109 (cl-ppcre:split "\\|" title)
110 (%print-article-link real-title "internal" (or link-title real-title))))
111
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
112 (defun process-cliki-rule (markup prefix formatter)
113 (ppcre:regex-replace-all #?/${prefix}\((.*?)\)/
114 markup
115 (lambda (match r1)
116 (declare (ignore match))
117 (with-output-to-string (*html-stream*)
118 (funcall formatter r1)))
119 :simple-calls t))
e666c10 @archimag "category list" markup extension - add short article description (as …
archimag authored
120
1556535 @vsedach Removed bknr.datastore and used file storage for persistence instead.
authored
121 (defun article-description (article-title)
122 (let ((c (cached-content article-title)))
123 (subseq c 0 (ppcre:scan "\\.(?:\\s|$)|\\n|$" c))))
124
125 (defun pprint-article-summary-li (article-title separator)
126 #H[<li>] (pprint-article-link article-title) #H[ ${separator}
127 ${(sanitize:clean
128 (with-output-to-string (*html-stream*)
129 (generate-html-from-markup (article-description article-title)))
130 +links-only+)}
f26f020 @vsedach Replaced css-based pprint-article-summary-li rules with a simpler sep…
authored
131 </li>])
a4f1460 @vsedach Synced with 3bmd changes, factored out article description printing
authored
132
a3d77e5 @vsedach Renamed 'categories' to 'topics' in function and variable names
authored
133 (defun format-topic-list (topic) ;; /(
134 #H[<ul>] (dolist (article (articles-by-topic topic))
f26f020 @vsedach Replaced css-based pprint-article-summary-li rules with a simpler sep…
authored
135 (pprint-article-summary-li article "-"))
41b9d56 @vsedach Removed RESTAS, simplified some things.
authored
136 #H[</ul>])
9873a6f @archimag added categories
archimag authored
137
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
138 (defun format-hyperspec-link (symbol) ;; _H(
139 #H[<a href="${(clhs-lookup:spec-lookup symbol)}" class="hyperspec">${symbol}</a>])
b4b73a6 @archimag added "package-link" markup extension
archimag authored
140
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
141 (defun format-package-link (link) ;; _P(
b4c788e @vsedach ASDF-install package links now say that they are obsolete
authored
142 #H[<a href="${link}">ASDF-install package (obsolete) ${link}</a>])
b4b73a6 @archimag added "package-link" markup extension
archimag authored
143
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
144 (let ((supported-langs (sort (mapcar (lambda (x)
145 (symbol-name (car x)))
146 colorize::*coloring-types*)
147 #'> :key #'length)))
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
148 (defun markup-code (markup start end)
149 (ppcre:regex-replace
150 "<(?:CODE|code)(.*?)?>((?:.|\\n)*?)</(?:CODE|code)>" markup
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
151 (lambda (match maybe-lang code)
152 (declare (ignore match))
153 (let ((lang (loop for lang in supported-langs
154 when (search lang maybe-lang :test #'char-equal)
155 return (find-symbol lang :keyword))))
156 (if lang
4c6e9d7 @Goheeca Added *css-background-class*
Goheeca authored
157 (let ((colorize::*css-background-class* "nonparen"))
e4daea4 @Goheeca Fixed a bug caused by the absence of blacklist file.
Goheeca authored
158 #?[<div class="code">${(colorize::html-colorization lang code)}</div>])
4c8259c @vsedach pre and code blocks now processed separately from other wiki markup
authored
159 #?[<code>${(escape-for-html code)}</code>])))
160 :simple-calls t :start start :end end)))
161
Something went wrong with that request. Please try again.