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

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

Improvements.

  • Property svn:keywords set to id
File size: 5.2 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          (testgroup (assoc 'testgroup params)))
67      (format (current-error-port) "Tests: [filename:~A][testgroup:~A]~%"
68              (and filename (stream->string (cdr filename)))
69              (and testgroup (stream->string (cdr testgroup))))
70      (if (or (not (eq? output-format 'enscript))
71              (and filename testgroup))
72        (parse
73          (html-stream
74            "Examples:\n\n"
75            "<enscript highlight=scheme"
76            (if (and filename testgroup)
77              (format #f " filename='~A'"
78                      (stream->string
79                        (stream-remove (cut char=? <> #\')
80                                       (cdr filename))))
81              "")
82            ">"
83            (if (and filename testgroup (eq? output-format 'enscript))
84              (format #f "\n(test-group ~A" (stream->string (cdr testgroup)))
85              "")
86            (parse text)
87            (if (and filename testgroup (eq? output-format 'enscript))
88              ")\n"
89              "")
90            "</enscript>"))
91        stream-null))))
92
93(define (chicken-example env)
94  (let-from-environment env (text output-format parse)
95    (html-stream
96      (if (eq? output-format 'enscript)
97        "\n  (test"
98        "")
99      (parse text)
100      (if (eq? output-format 'enscript)
101        ")"
102        ""))))
103
104(define (chicken-expr env)
105  (let-from-environment env (text output-format)
106    (if (eq? output-format 'enscript)
107      (html-stream " " text)
108      (html-stream text "\n"))))
109
110(define (chicken-result include prefix env)
111  (let-from-environment env (text output-format)
112    (if (eq? output-format 'enscript)
113      (html-stream " " text)
114      (html-stream prefix " " text "\n"))))
115
116(define (chicken-result-cmp env)
117  (let-from-environment env (text output-format)
118    (if (eq? output-format 'enscript)
119      (html-stream " " text)
120      stream-null)))
121
122(svnwiki-extension-define 'code-break 'chickenegg chicken-egg-html)
123(svnwiki-extension-define 'code-span 'procedure (cut chicken-def "procedure" <>))
124(svnwiki-extension-define 'code-span 'macro (cut chicken-def "macro" <>))
125(svnwiki-extension-define 'code-span 'read (cut chicken-def "read" <>))
126(svnwiki-extension-define 'code-span 'parameter (cut chicken-def "parameter" <>))
127(svnwiki-extension-define 'code-span 'record (cut chicken-def "record" <>))
128(svnwiki-extension-define 'code-span 'string (cut chicken-def "string" <>))
129(svnwiki-extension-define 'code-span 'class (cut chicken-def "class" <>))
130(svnwiki-extension-define 'code-span 'method (cut chicken-def "method" <>))
131(svnwiki-extension-define 'code-span 'examples chicken-examples)
132(svnwiki-extension-define 'code-span 'example chicken-example)
133(svnwiki-extension-define 'code-span 'expr chicken-expr)
134(svnwiki-extension-define 'code-span 'result (cut chicken-result #t "=>" <>))
135(svnwiki-extension-define 'code-span 'resultcmp chicken-result-cmp)
136(svnwiki-extension-define 'code-span 'input (cut chicken-result #f "[input]" <>))
137(svnwiki-extension-define 'code-span 'output (cut chicken-result #f "[output]" <>))
Note: See TracBrowser for help on using the repository browser.