source: project/stream-wiki/trunk/extensions/chicken.scm @ 8523

Last change on this file since 8523 was 8523, checked in by azul, 13 years ago

Tweaks.

File size: 2.3 KB
Line 
1(use syntax-case svn-post-commit-hooks orders format-modular srfi-40)
2
3(define-syntax environment
4  (syntax-rules ()
5    ((environment original ((name expr) ...))
6     (lambda (op)
7       (case op
8         ((name) expr)
9         ...
10         (else (original op)))))
11    ((environment ((name expr) ...))
12     (environment (lambda (op)
13                    (warning "unbound variable (dynamic environment)" op)
14                    (if #f #f))
15                  ((name expr) ...)))))
16
17(define-syntax environment-get
18  (syntax-rules ()
19    ((environment-get env sym) (env 'sym))))
20
21(define-syntax let-from-environment
22  (syntax-rules ()
23    ((let-from-environment env (sym ...) body ...)
24     (let ((sym (environment-get env sym)) ...) body ...))))
25
26(define-syntax environment-capture
27  (syntax-rules ()
28    ((environment-capture env (sym ...))
29     (environment env ((sym sym) ...)))
30    ((environment-capture (sym ...))
31     (environment ((sym sym) ...)))))
32
33(define *url-eggs*
34  "http://www.call-with-current-continuation.org/eggs/")
35
36(define (chicken-egg-html env)
37  (let-from-environment env (params parse path-in)
38    (or
39      (and-let* ((name-stream (assoc 'name params))
40                 (name (stream->string (cdr name-stream)))
41                 (description (assoc 'description params))
42                 (license (assoc 'license params))
43                 (author (assoc 'author params)))
44        (parse
45          (html-stream 
46            (tr (td (if (file-exists? (svnwiki-make-pathname path-in name))
47                      (format #f "[[~A]]" name)
48                      (format #f "[[~A~A.html|~A]]" *url-eggs* name name)))
49                (td (cdr description))
50                (td (cdr license))
51                (td "[[" (cdr author) "]]")
52                (td "[[http://chicken.wiki.br/dep-graphs/" name ".png|Dependencies]]")))))
53      stream-null)))
54
55(define (chicken-procedure env)
56  (let-from-environment env (params parse text)
57    (or
58      (and-let* ((name (assoc 'name params))
59                 (retval (assoc 'retval params))
60                 (args (assoc 'args params)))
61        (parse
62          (html-stream
63            "=== name \n\n"
64            " ( '''" name "''' " args ")\n\n"
65            "Returns: {{" retval "}}\n\n"
66            text))))))
67
68(define *extensions*
69  `((chickenegg (code-break ,chicken-egg-html))
70    (procedure (code-span ,chicken-procedure))))
Note: See TracBrowser for help on using the repository browser.