source: project/release/4/qwiki/trunk/qwiki-sxml.scm @ 18634

Last change on this file since 18634 was 18634, checked in by sjamaan, 10 years ago

qwiki: Copy over the svnwiki-sxml branch to qwiki trunk. No mergetracking??... :(

File size: 9.2 KB
Line 
1;;
2;; qwiki-sxml - SXML rules and tools for qwiki
3;;
4;; Copyright (c) 2009-2010 Peter Bex and Ivan Raikov
5;;
6;;  Redistribution and use in source and binary forms, with or without
7;;  modification, are permitted provided that the following conditions
8;;  are met:
9;;
10;;  - Redistributions of source code must retain the above copyright
11;;  notice, this list of conditions and the following disclaimer.
12;;
13;;  - Redistributions in binary form must reproduce the above
14;;  copyright notice, this list of conditions and the following
15;;  disclaimer in the documentation and/or other materials provided
16;;  with the distribution.
17;;
18;;  - Neither name of the copyright holders nor the names of its
19;;  contributors may be used to endorse or promote products derived
20;;  from this software without specific prior written permission.
21;;
22;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE
23;;  CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
24;;  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
25;;  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26;;  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE
27;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
28;;  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
29;;  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
30;;  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
31;;  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
32;;  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
33;;  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34;;  POSSIBILITY OF SUCH DAMAGE.
35
36(provide 'qwiki-sxml)
37
38(module qwiki-sxml
39
40  (qwiki-html-transformation-rules
41   qwiki-LaTeX-transformation-rules
42   qwiki-Texinfo-transformation-rules)
43
44(import chicken scheme)
45
46(use posix srfi-1 srfi-13 data-structures extras)
47(use matchable sxml-transforms doctype uri-generic sxpath colorize html-parser)
48
49(require-library multidoc)
50(import (rename multidoc
51                (html-transformation-rules multidoc-html-transformation-rules)
52                (LaTeX-transformation-rules multidoc-LaTeX-transformation-rules)))
53
54;;;;
55;;;;  HTML stylesheet
56;;;;
57
58(define (qwiki-html-transformation-rules content)
59  `(
60    (
61
62     (wiki-page 
63      *macro*
64      . ,(lambda (tag elems)
65           `(html:begin . ,elems)))
66
67     ;; Maybe this should be done in multiple steps to make it more "hookable"
68     (history
69      *macro* 
70      . ,(lambda (tag items)
71           `(table
72             (tr (th "revision")
73                 (th "author")
74                 (th "date")
75                 (th "description"))
76             ,@(map (lambda (item)
77                      `(tr (td (link ,(string-append
78                                       "?action=show&rev="
79                                       (number->string (car item)))
80                                     ,(car item)))
81                           (td ,(cadr item))
82                           (td ,(time->string (caddr item)))
83                           (td ,(cadddr item))))
84                    items))))
85
86     (wiki-content
87      *macro* .
88      ,(lambda (tag contents)
89         `(div (@ (id "content")) . ,contents)))
90
91     (tags
92      *preorder* .
93      ,(lambda (tag page-tags)
94         `(ul (@ (class "tags"))
95              . ,(map (lambda (tag) `(li ,tag))
96                      (string-split (car page-tags))))))
97
98     (highlight
99      *macro*
100      . ,(lambda (tag elems)
101           (let* ((lang (car elems))
102                  (classname (conc "highlight " lang "-language"))
103                  (code (handle-exceptions exn
104                          (cdr elems)
105                          (map (lambda (s)
106                                 (cdr (html->sxml (html-colorize lang s))))
107                               (cdr elems)))))
108             `(pre (@ (class ,classname)) . ,code))))
109     
110     (examples
111      ((example
112        ((init
113          *macro*
114          . ,(lambda (tag elems)
115               `(div (@ (class "init")) (highlight scheme . ,elems))))
116         (expr
117          *macro*
118          . ,(lambda (tag elems)
119               `(div (@ (class "expression")) (highlight scheme . ,elems))))
120         (input
121          *macro*
122          . ,(lambda (tag elems)
123               `(div (@ (class "io input")) (em "input: ")
124                     (highlight scheme . ,elems))))
125         (output
126          *macro*
127          . ,(lambda (tag elems)
128               `(div (@ (class "io output")) (em "output: ")
129                     (highlight scheme . ,elems))))
130         (result
131          *macro*
132          . ,(lambda (tag elems)
133               `(div (@ (class "result"))
134                     (span (@ (class "result-symbol")) " => ")
135                     (highlight scheme . ,elems))))) ;; Or use "basic lisp" here?
136        . ,(lambda (tag elems)
137             `(div (@ (class "example")) . ,elems))))
138      . ,(lambda (tag elems)
139           `(div (@ (class "examples"))
140                 (span (@ (class "examples-heading")) "Examples:") . ,elems)))     
141     (page-specific-links
142      *macro* 
143      . ,(lambda (tag elems)
144           `(ul (@ (id "page-specific-links"))
145                (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
146                         `(span (@ (class "disabled")
147                                   (title "This page doesn't exist yet"))
148                                "show")
149                         `(link "?action=show" "show")))
150                (li ,(if ((if-sxpath '(// read-only)) (cons tag elems))
151                         `(span (@ (class "disabled")
152                                   (title "This page has been frozen. "
153                                          "Only someone with direct access "
154                                          "to the repository can edit it."))
155                                "edit")
156                         `(link "?action=edit" "edit")))
157                (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
158                         `(span (@ (class "disabled")
159                                   (title "This page doesn't exist yet"))
160                                "history")
161                         `(link "?action=history" "history"))))))
162
163     ,@alist-conv-rules*
164     )
165   
166     ,@(multidoc-html-transformation-rules content)
167
168  ))
169
170;;;;
171;;;;  LaTeX stylesheet
172;;;;
173
174(define nl (list->string (list #\newline)))
175
176(define (qwiki-LaTeX-transformation-rules content)
177  `(
178    (
179     (wiki-page
180      . ,(lambda (tag elems)
181             (list
182              `(tex
183                "\\documentclass[12pt]{article}" ,nl
184                "\\usepackage[left=3cm]{geometry}" ,nl
185             
186                ,(map (lambda (p) (LaTeX-use-package (car p) (cadr p)))
187                      (LaTeX-packages)) ,nl
188                     
189                      "%%%%%%%%%%%%%%%%%%%%%%%%%% Textclass specific LaTeX commands." ,nl
190                      " \\newenvironment{lyxcode}" ,nl
191                      "   {\\begin{list}{}{" ,nl
192                      "     \\raggedright" ,nl
193                      "     \\setlength{\\itemsep}{-5pt}" ,nl
194                      "     \\setlength{\\parsep}{-3pt}" ,nl
195                      "     \\normalfont\\ttfamily}%" ,nl
196                      "    \\item[]}" ,nl
197                      "   {\\end{list}}" ,nl
198
199                      "\\makeatother" ,nl
200                      "\\sloppy" ,nl
201           
202                      "\\newcommand{\\minitab}[2][l]{\\begin{tabular}{#1}#2\\end{tabular}}" ,nl)
203             
204              nl
205              elems
206              )))
207
208     ;; No syntax highlighting yet, present as preformatted
209     (highlight
210      *macro*
211      . ,(lambda (tag elems)
212           ;; (highlight LANGUAGE "text" ...)
213           `(pre . ,(cdr elems))))
214     
215     (examples
216      ((example
217        ((init
218          *macro*
219          . ,(lambda (tag elems)
220               `(pre . ,elems)))
221         (expr
222          *macro*
223          . ,(lambda (tag elems)
224               `(pre . ,elems)))
225         (input
226          *macro*
227          . ,(lambda (tag elems)
228               `((em "input: ")
229                 (pre . ,elems))))
230         (output
231          *macro*
232          . ,(lambda (tag elems)
233               `((em "output: ")
234                 (pre . ,elems))))
235         (result
236          *macro*
237          . ,(lambda (tag elems)
238               `(pre " => " . ,elems))))
239        . ,(lambda (tag elems)
240             elems)))
241      . ,(lambda (tag elems)
242           elems))
243
244     ,@alist-conv-rules*
245     )
246
247     ,@(multidoc-LaTeX-transformation-rules content)
248     ))
249
250;;;;
251;;;;  Texinfo stylesheet
252;;;;
253
254(define nl (list->string (list #\newline)))
255
256(define (qwiki-Texinfo-transformation-rules content)
257  `(
258    (
259     (wiki-page
260      *macro* .
261      ,(lambda (tag elems) (cons 'body elems)))
262
263
264     ;; No syntax highlighting yet, present as preformatted
265     (highlight
266      *macro*
267      . ,(lambda (tag elems)
268           ;; (highlight LANGUAGE "text" ...)
269           `(pre . ,(cdr elems))))
270     
271     (examples
272      ((example
273        ((init
274          *macro*
275          . ,(lambda (tag elems)
276               `(pre . ,elems)))
277         (expr
278          *macro*
279          . ,(lambda (tag elems)
280               `(pre . ,elems)))
281         (input
282          *macro*
283          . ,(lambda (tag elems)
284               `((em "input: ")
285                 (pre . ,elems))))
286         (output
287          *macro*
288          . ,(lambda (tag elems)
289               `((em "output: ")
290                 (pre . ,elems))))
291         (result
292          *macro*
293          . ,(lambda (tag elems)
294               `(pre " => " . ,elems)))
295         (*text* . ,(lambda (tag elems) elems))
296         (*default* . ,(lambda (tag elems) '())))
297        . ,(lambda (tag elems)
298             elems)))
299      . ,(lambda (tag elems)
300           elems))
301
302     ,@alist-conv-rules
303     )
304
305     ,@(Texinfo-transformation-rules content)
306     ))
307
308
309)
Note: See TracBrowser for help on using the repository browser.