Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 94 lines (71 sloc) 3.563 kb
d3e78ff @archimag added registration and authentication
archimag authored
1 ;;;; markup.lisp
2
3 (in-package #:cliki2)
4
5
6 (defun generate-html-from-markup (markup)
7 (let ((doc (docutils:read-rst (ppcre:regex-replace-all "\\r\\n" markup (string #\Newline) )))
8 (writer (make-instance 'docutils.writer.html:html-writer)))
9 (docutils:visit-node writer doc)
10 (with-output-to-string (out)
11 (iter (for part in '(docutils.writer.html:body-pre-docinfo
12 docutils.writer.html:docinfo
13 docutils.writer.html:body))
14 (docutils:write-part writer part out))
15 (format out "</div>"))))
5606e43 @archimag added to markup: hyperspec-ref and code-block
archimag authored
16
17416b2 @archimag added markup: article-ref and person-ref
archimag authored
17 (defun append-template (template &rest args &key &allow-other-keys)
18 (docutils:part-append
19 (funcall template args)))
20
21
22 ;;;; article-ref
23
24 (defclass article-ref (docutils.nodes:raw)
25 ((title :initarg :title :reader article-ref-title)))
26
27 (defmethod docutils:visit-node ((write docutils.writer.html:html-writer) (node article-ref)
28 &aux (title (article-ref-title node)))
29 (append-template 'cliki2.view:article-link
30 :title title
31 :href (restas:genurl 'view-article
32 :title title)))
33
34 (docutils.parser.rst:def-role article (title)
35 (make-instance 'article-ref
36 :title title))
37
38 ;;;; person-ref
39
40 (defclass person-ref (docutils.nodes:raw)
41 ((name :initarg :name :reader person-ref-name)))
42
43 (defmethod docutils:visit-node ((write docutils.writer.html:html-writer) (node person-ref)
44 &aux (name (person-ref-name node)))
45 (append-template 'cliki2.view:person-link
46 :name name
47 :href (restas:genurl 'view-person
48 :name name)))
49
50 (docutils.parser.rst:def-role person (name)
51 (make-instance 'person-ref
52 :name name))
53
5606e43 @archimag added to markup: hyperspec-ref and code-block
archimag authored
54 ;;;; hypespec-ref
55
56 (defclass hyperspec-ref (docutils.nodes:raw)
17416b2 @archimag added markup: article-ref and person-ref
archimag authored
57 ((symbol :initarg :symbol :reader hyperspec-ref-symbol)))
5606e43 @archimag added to markup: hyperspec-ref and code-block
archimag authored
58
17416b2 @archimag added markup: article-ref and person-ref
archimag authored
59 (defmethod docutils:visit-node ((write docutils.writer.html:html-writer) (node hyperspec-ref)
60 &aux (symbol (hyperspec-ref-symbol node)))
61 (append-template 'cliki2.view:hyperspec-link
62 :symbol symbol
63 :href (clhs-lookup:spec-lookup (hyperspec-ref-symbol node))))
5606e43 @archimag added to markup: hyperspec-ref and code-block
archimag authored
64
17416b2 @archimag added markup: article-ref and person-ref
archimag authored
65 (docutils.parser.rst:def-role hs (symbol)
66 (make-instance 'hyperspec-ref
67 :symbol symbol))
5606e43 @archimag added to markup: hyperspec-ref and code-block
archimag authored
68
69 ;;;; code-block
70
71 (defclass code-block (docutils.nodes:raw)
72 ((lang :initarg :lang :initform nil :reader code-block-lang)
73 (code :initarg :code :initform nil :reader code-block-code)))
74
75 (defmethod docutils:visit-node ((writer docutils.writer.html:html-writer) (node code-block))
17416b2 @archimag added markup: article-ref and person-ref
archimag authored
76 (let ((lang (car (assoc (code-block-lang node)
77 (colorize:coloring-types)
78 :test #'string-equal))))
79 (if lang
80 (append-template 'cliki2.view:code-block
81 :code (colorize::html-colorization :common-lisp
82 (code-block-code node)))
83 (docutils:part-append
84 (format nil "<pre>~A</pre>" (code-block-code node))))))
85
5606e43 @archimag added to markup: hyperspec-ref and code-block
archimag authored
86
87 (docutils.parser.rst:def-directive code-block (parent lang &content content)
88 (let ((node (docutils:make-node 'docutils.nodes:paragraph)))
89 (docutils:add-child node
90 (make-instance 'code-block
91 :lang lang
92 :code (docutils::join-strings content #\Newline)))
93 (docutils:add-child parent node)))
Something went wrong with that request. Please try again.