ikarus/lab/ikarusdoc

72 lines
1.9 KiB
Plaintext
Raw Normal View History

#!/usr/bin/env ikarus --script
2006-12-02 11:05:44 -05:00
(define get-comments
(lambda (file-name)
(define comments '())
(parameterize ([comment-handler
(lambda (str)
(set! comments (cons str comments)))])
(load file-name (lambda (x) (void))))
(reverse comments)))
(define filter
(lambda (f ls)
(cond
[(null? ls) '()]
[(f (car ls)) (cons (car ls) (filter f (cdr ls)))]
[else (filter f (cdr ls))])))
(define find-end
(lambda (str i)
(cond
[(fx= i (string-length str)) i]
[(memv (string-ref str i) '(#\newline #\space #\tab)) i]
[(char=? (string-ref str i) #\:) i]
[else (find-end str (fxadd1 i))])))
2006-12-02 11:05:44 -05:00
(define matcher
(lambda (tok)
(let ([n (string-length tok)])
(lambda (str)
(let f ([i 0])
(let ([j (find-end str i)])
(or (string=? tok (substring str i j))
(and (fx< j (string-length str))
(char=? (string-ref str j) #\:)
(f (fxadd1 j))))))))))
2006-12-02 11:05:44 -05:00
(define get-matching
(lambda (token file-name)
(filter (matcher token) (get-comments file-name))))
#|Usage:
find.ss token files ...
Prints all the comments matching Hash-Bar-token that are found
in the files. |#
2006-12-02 11:05:44 -05:00
(define usage
2006-12-02 16:04:18 -05:00
(lambda ()
(printf "Usage: ikarusdoc token files ...\n")
2006-12-02 11:05:44 -05:00
(printf " Prints all multiline comments matching #|token<comment>|# from the files\n")
(exit 0)))
(define print-comments
(lambda (file ls)
(unless (null? ls)
(printf "From ~a:\n" file)
(for-each
(lambda (x)
(display x)
(newline))
ls))))
(let ([args (command-line-arguments)])
2006-12-02 16:04:18 -05:00
(when (null? args) (usage))
2006-12-02 11:05:44 -05:00
(let ([me (car args)] [args (cdr args)])
2006-12-02 16:04:18 -05:00
(when (null? args) (usage))
2006-12-02 11:05:44 -05:00
(let ([tok (car args)] [files (cdr args)])
(for-each
(lambda (file)
(print-comments file (get-matching tok file)))
files))))
;;; vim:syntax=scheme