Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 97 lines (84 sloc) 4.495 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"
14 "em" "i" "small" "strike" "strong" "dfn" "s" "sub" "sup" "u"
15 "abbr" "ruby" "rp" "rt" "bdo" "mark")
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">]
39 (princ (parse-cliki-markup (sanitize:clean markup +cliki-tags+))
40 *html-stream*)
41 #H[</div>])
41b9d56 @vsedach Removed RESTAS, simplified some things.
authored
42
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
43 (defun parse-cliki-markup (markup)
44 (loop for prefix in '("_" "_H" "\\*" "\\/" "_P")
45 for formatter in '(pprint-article-link format-hyperspec-link pprint-category-link format-category-list format-package-link)
46 do (setf markup (process-cliki-rule markup prefix formatter)))
47 (ppcre:regex-replace-all "\\n\\n" (colorize-code markup) "<p>"))
48
49 (defun process-cliki-rule (markup prefix formatter)
50 (ppcre:regex-replace-all #?/${prefix}\((.*?)\)/
51 markup
52 (lambda (match r1)
53 (declare (ignore match))
54 (with-output-to-string (*html-stream*)
55 (funcall formatter r1)))
56 :simple-calls t))
e666c10 @archimag "category list" markup extension - add short article description (as …
archimag authored
57
e20b495 @vsedach Added article deletion/undeletion
authored
58 (defmethod pprint-article-summary-li ((article article) separator)
230b297 @vsedach Made markdown parser print directly to *html-stream*
authored
59 #H[<li>] (pprint-article-link (title article)) #H[ ${separator}
60 ${(sanitize:clean (with-output-to-string (*html-stream*)
61 (generate-html-from-markup (article-description article)))
62 +links-only+)}
f26f020 @vsedach Replaced css-based pprint-article-summary-li rules with a simpler sep…
authored
63 </li>])
a4f1460 @vsedach Synced with 3bmd changes, factored out article description printing
authored
64
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
65 (defun format-category-list (category) ;; /(
66 #H[<ul>] (dolist (article (sort (copy-list
67 (articles-with-category
68 (category-keyword category)))
f26f020 @vsedach Replaced css-based pprint-article-summary-li rules with a simpler sep…
authored
69 #'string< :key 'canonical-title))
70 (pprint-article-summary-li article "-"))
41b9d56 @vsedach Removed RESTAS, simplified some things.
authored
71 #H[</ul>])
9873a6f @archimag added categories
archimag authored
72
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
73 (defun format-hyperspec-link (symbol) ;; _H(
74 #H[<a href="${(clhs-lookup:spec-lookup symbol)}" class="hyperspec">${symbol}</a>])
b4b73a6 @archimag added "package-link" markup extension
archimag authored
75
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
76 (defun format-package-link (link) ;; _P(
b4c788e @vsedach ASDF-install package links now say that they are obsolete
authored
77 #H[<a href="${link}">ASDF-install package (obsolete) ${link}</a>])
b4b73a6 @archimag added "package-link" markup extension
archimag authored
78
c63849d @vsedach Fuck markdown. Tired of fighting bugs in 3bmd and pandoc, doing thing…
authored
79 ;;;; do something with code-block
80
81 (let ((supported-langs (sort (mapcar (lambda (x)
82 (symbol-name (car x)))
83 colorize::*coloring-types*)
84 #'> :key #'length)))
85 (defun colorize-code (markup)
86 (ppcre:regex-replace-all
87 "<code(.*?)?>(.*?)</code>" markup
88 (lambda (match maybe-lang code)
89 (declare (ignore match))
90 (let ((lang (loop for lang in supported-langs
91 when (search lang maybe-lang :test #'char-equal)
92 return (find-symbol lang :keyword))))
93 (if lang
94 #?[<div class="code">${(colorize::html-colorization lang code)}</div>]
95 #?[<code>${code}</code>])))
96 :simple-calls t)))
Something went wrong with that request. Please try again.