source: project/doc-indices/grovel @ 2904

Last change on this file since 2904 was 2904, checked in by felix winkelmann, 13 years ago

bugfix in tinyclos

  • Property svn:executable set to *
File size: 2.0 KB
Line 
1#!/bin/sh
2#| ;;; grovel -*- Hen -*-
3exec csi -s $0 "$@"
4|#
5
6(use utils posix)
7
8(set-sharp-read-syntax!
9 #\>
10 (lambda (p)
11   (let loop ()
12     (let ((c (read-char p)))
13       (cond ((eof-object? c) #f)
14             ((char=? #\< c)
15              (if (char=? #\# (read-char p)) #f (loop)))
16             (else (loop)) ) ) ) ) )
17
18(define *ignored* '("comet" "chicken" "doc-indices"))
19(define *top* #f)
20
21(define (grovel f)
22  (cond ((directory? f)
23         (unless (member f *ignored*)
24           (unless *top*
25             (fprintf (current-error-port) "~a ...~%" f) )
26           (parameterize ((current-directory f))
27             (fluid-let ((*top* (or *top* f)))
28               (match (glob "*.meta")
29                 ((meta)
30                  (let* ((meta (car (read-file meta)))
31                         (files (assq 'files meta)) )
32                    (for-each grovel (if (pair? files) (cdr files) (cdr (assq 'file meta))))))
33                 (_ (for-each grovel (glob "trunk"))) ) ) ) ) )
34        ((member (pathname-extension f) '("scm" "ss"))
35         (print ";; " (pathname-strip-directory f))
36         (process f) ) ) )
37
38(define (process file)
39  (with-input-from-file file
40    (lambda ()
41      (call/cc
42       (lambda (return)
43         (let loop ()
44           (let ((x (handle-exceptions ex (begin (print-error-message ex) #f)
45                      (read))))
46             (unless (eof-object? x)
47               (match x
48                 (('module (? symbol?) (exports ...))
49                  (emit exports) )
50                 (('declare . decls)
51                  (for-each
52                   (match-lambda
53                     (('export . exports)
54                      (emit exports)
55                      (return #f) )
56                     (_ #f) )
57                   decls) )
58                 (('define (? symbol? s) _) (emit (list s)))
59                 (('define ((? symbol? s) . _) . _) (emit (list s)))
60                 (('define-macro ((? symbol? s) . _) . _) (emit (list s)))
61                 (('define-syntax (? symbol? s) _) (emit (list s)))
62                 (('define-syntax ((? symbol? s) . _) . _) (emit (list s)))
63                 (_ #f) )
64               (loop) ) ) ) ) ) ) ) )
65
66(define (emit syms)
67  (for-each
68   (lambda (s) 
69     (unless (##sys#qualified-symbol-prefix s)
70       (pp (cons s (conc "http://www.call-with-current-continuation.org/eggs/" *top* ".html")))) )
71   syms) )
72
73(for-each grovel (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.