source: project/doc-indices/grovel @ 2432

Last change on this file since 2432 was 2432, checked in by felix winkelmann, 14 years ago

added doc indices for eggs, minor fixes

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