source: project/doc-indices/grovel @ 36667

#!/bin/sh
#| ;;; grovel -*- Scheme -*-
exec csi -s $0 "$@"
|#

(use utils posix matchable)

(set-sharp-read-syntax!                 ; we need this to handle egg code that uses the ffi
 #\>
 (lambda (p)
   (let loop ()
     (let ((c (read-char p)))
       (cond ((eof-object? c) #f)
             ((char=? #\< c)
              (if (char=? #\# (read-char p)) #f (loop)))
             (else (loop)) ) ) ) ) )

(define *ignored* '("comet"))
(define *top* #f)

(define (grovel f)
  (cond ((directory? f)
         (unless (member f *ignored*)
           (unless *top* 
             (fprintf (current-error-port) "~a ...~%" f) )
           (parameterize ((current-directory f))
             (fluid-let ((*top* (or *top* f)))
               (match (glob "*.meta")
                 ((meta)
                  (let* ((meta (car (read-file meta)))
                         (files (assq 'files meta)) )
                    (for-each grovel (if (pair? files) (cdr files) (cdr (assq 'file meta))))))
                 (_ (for-each grovel (glob "trunk"))) ) ) ) ) )
        ((member (pathname-extension f) '("scm" "ss"))
         (print ";; " (pathname-strip-directory f))
         (process f) ) ) )

(define (process file)
  (with-input-from-file file
    (lambda ()
      (call/cc
       (lambda (return)
         (let loop ()
           (let ((x (handle-exceptions ex (begin (print-error-message ex) #f)
                      (read))))
             (unless (eof-object? x)
               (let rec ((x x))
               (match x
                 (('module (? symbol?) '* . body)
                  (for-each rec body))
                 (('module (? symbol?) (exports ...) . _)
                  (for-each
                   (match-lambda
                     ((exp . _) (emit (list exp)))
                     (exp (emit (list exp))))
                   exports))
                 (('declare . decls)
                  (for-each
                   (match-lambda
                     (('export . exports) 
                      (emit exports)
                      (return #f) )
                     (_ #f) )
                   decls) )
                 (('define (? symbol? s) _) (emit (list s)))
                 (('define ((? symbol? s) . _) . _) (emit (list s)))
                 (('define-macro ((? symbol? s) . _) . _) (emit (list s)))
                 (('define-syntax (? symbol? s) _) (emit (list s)))
                 (('define-syntax ((? symbol? s) . _) . _) (emit (list s)))
                 (_ #f) )
               (loop) ) ) ) ) ) ) ) )

(define (emit syms)
  (for-each 
   (lambda (s) 
     (unless (##sys#qualified-symbol-prefix s)
       (pp (cons s (conc "http://www.call-with-current-continuation.org/eggs/" *top* ".html")))) )
   syms) )

(for-each grovel (command-line-arguments))