source: project/release/3/svnwiki-chicken/trunk/svnwiki-chicken.scm @ 12656

Last change on this file since 12656 was 12656, checked in by azul, 11 years ago

Better support for defining unit tests in a wiki file.

  • Property svn:keywords set to id
File size: 5.0 KB
Line 
1; $id$
2;
3; License: GPL-3
4
5(declare (export))
6(use svnwiki-extensions-support svn-post-commit-hooks orders format-modular srfi-40 html-stream stream-ext)
7
8(define *url-eggs*
9  "http://www.call-with-current-continuation.org/eggs/")
10
11(define (chicken-egg-html env)
12  (let-from-environment env (params parse path-in)
13    (or
14      (and-let* ((name-stream (assoc 'name params))
15                 (name (stream->string (cdr name-stream)))
16                 (description (assoc 'description params))
17                 (license (assoc 'license params))
18                 (author (assoc 'author params))
19                 (major (assoc 'major params))
20                 )
21        (parse
22          (html-stream 
23            (tr (td (if (file-exists? (svnwiki-make-pathname path-in name))
24                      (format #f "[[~A]]" name)
25                      (if major 
26                          (format #f "[[~A~A/~A.html|~A]]" *url-eggs* (stream->string (cdr major)) name name)
27                          (format #f "[[~A~A.html|~A]]" *url-eggs* name name))))
28                (td (cdr description))
29                (td (cdr license))
30                (td "[[" (cdr author) "]]")
31                (td "[[http://chicken.wiki.br/dep-graphs/" name ".png|Dependencies]]")))))
32      stream-null)))
33
34(define (chicken-def name env)
35  (let-from-environment env (text parse)
36    ; Remove whitespace at beginning or end
37    (let ((text (stream-reverse
38                  (stream-drop-while
39                    char-whitespace?
40                    (stream-reverse
41                      (stream-drop-while
42                        char-whitespace?
43                        text))))))
44      (parse
45        (html-stream
46          "["
47          name
48          "] {{"
49          (if (and (not (stream-null? text))
50                   (char=? (stream-car text) #\()
51                   (char=? (stream-last text) #\)))
52              (receive (symbol rest)
53                       (stream-break char-whitespace?
54                                     (stream-cdr (stream-butlast text)))
55                (html-stream
56                  "('''"
57                  symbol
58                  "'''"
59                  rest
60                  ")}}\n\n"))
61              text))))))
62
63(define (chicken-examples env)
64  (let-from-environment env (params parse text output-format)
65    (let ((filename (assoc 'filename params))
66          (group (assoc 'testgroup params)))
67      (if (or (not (eq? output-format 'enscript))
68              (and filename group))
69        (parse
70          (html-stream
71            "Examples:\n\n"
72            "<enscript highlight=scheme"
73            (if (and filename group)
74              (format #f " filename='~A'"
75                      (stream->string
76                        (stream-remove (cut char=? <> #\')
77                                       (cdr filename))))
78              "")
79            ">"
80            (if (and filename group (eq? output-format 'enscript))
81              (format #f "(test-group ~A" (stream->string (cdr group)))
82              "")
83            (parse text)
84            (if (and filename group (eq? output-format 'enscript))
85              ")\n"
86              "")
87            "</enscript>"))
88        stream-null))))
89
90(define (chicken-example env)
91  (let-from-environment env (text output-format parse)
92    (html-stream
93      (if (eq? output-format 'enscript)
94        "\n  (test "
95        "")
96      (parse text)
97      (if (eq? output-format 'enscript)
98        ")"
99        ""))))
100
101(define (chicken-expr env)
102  (let-from-environment env (text output-format)
103    (if (eq? output-format 'enscript)
104      (html-stream " " text)
105      (html-stream text "\n"))))
106
107(define (chicken-result include prefix env)
108  (let-from-environment env (text output-format)
109    (if (eq? output-format 'enscript)
110      (html-stream prefix " " text)
111      (html-stream prefix " " text "\n"))))
112
113(define (chicken-result-cmp include prefix env)
114  (let-from-environment env (text output-format)
115    (if (eq? output-format 'enscript)
116      (html-stream prefix " " text)
117      stream-null)))
118
119(svnwiki-extension-define 'code-break 'chickenegg chicken-egg-html)
120(svnwiki-extension-define 'code-span 'procedure (cut chicken-def "procedure" <>))
121(svnwiki-extension-define 'code-span 'macro (cut chicken-def "macro" <>))
122(svnwiki-extension-define 'code-span 'read (cut chicken-def "read" <>))
123(svnwiki-extension-define 'code-span 'parameter (cut chicken-def "parameter" <>))
124(svnwiki-extension-define 'code-span 'record (cut chicken-def "record" <>))
125(svnwiki-extension-define 'code-span 'string (cut chicken-def "string" <>))
126(svnwiki-extension-define 'code-span 'class (cut chicken-def "class" <>))
127(svnwiki-extension-define 'code-span 'method (cut chicken-def "method" <>))
128(svnwiki-extension-define 'code-span 'examples chicken-examples)
129(svnwiki-extension-define 'code-span 'example chicken-example)
130(svnwiki-extension-define 'code-span 'expr chicken-expr)
131(svnwiki-extension-define 'code-span 'result (cut chicken-result #t "=>" <>))
132(svnwiki-extension-define 'code-span 'resultcmp chicken-result-cmp)
133(svnwiki-extension-define 'code-span 'input (cut chicken-result #f "[input]" <>))
134(svnwiki-extension-define 'code-span 'output (cut chicken-result #f "[output]" <>))
Note: See TracBrowser for help on using the repository browser.