source: project/doc-indices/grovel @ 12216

Last change on this file since 12216 was 12216, checked in by felix, 11 years ago

small fixes, untested

  • Property svn:executable set to *
File size: 2.2 KB
Line 
1#!/bin/sh
2#| ;;; grovel -*- Scheme -*-
3exec csi -s $0 "$@"
4|#
5
6(use utils posix matchable)
7
8(set-sharp-read-syntax!                 ; we need this to handle egg code that uses the ffi
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"))
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               (let rec ((x x))
48               (match x
49                 (('module (? symbol?) '* . body)
50                  (for-each rec body))
51                 (('module (? symbol?) (exports ...) . _)
52                  (for-each
53                   (match-lambda
54                     ((exp . _) (emit (list exp)))
55                     (exp (emit (list exp))))
56                   exports))
57                 (('declare . decls)
58                  (for-each
59                   (match-lambda
60                     (('export . exports)
61                      (emit exports)
62                      (return #f) )
63                     (_ #f) )
64                   decls) )
65                 (('define (? symbol? s) _) (emit (list s)))
66                 (('define ((? symbol? s) . _) . _) (emit (list s)))
67                 (('define-macro ((? symbol? s) . _) . _) (emit (list s)))
68                 (('define-syntax (? symbol? s) _) (emit (list s)))
69                 (('define-syntax ((? symbol? s) . _) . _) (emit (list s)))
70                 (_ #f) )
71               (loop) ) ) ) ) ) ) ) )
72
73(define (emit syms)
74  (for-each
75   (lambda (s) 
76     (unless (##sys#qualified-symbol-prefix s)
77       (pp (cons s (conc "http://www.call-with-current-continuation.org/eggs/" *top* ".html")))) )
78   syms) )
79
80(for-each grovel (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.