72 lines
1.9 KiB
Scheme
Executable File
72 lines
1.9 KiB
Scheme
Executable File
#!/usr/bin/env ikarus --script
|
|
(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))])))
|
|
|
|
(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))))))))))
|
|
|
|
(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. |#
|
|
(define usage
|
|
(lambda ()
|
|
(printf "Usage: ikarusdoc token files ...\n")
|
|
(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)])
|
|
(when (null? args) (usage))
|
|
(let ([me (car args)] [args (cdr args)])
|
|
(when (null? args) (usage))
|
|
(let ([tok (car args)] [files (cdr args)])
|
|
(for-each
|
|
(lambda (file)
|
|
(print-comments file (get-matching tok file)))
|
|
files))))
|
|
|
|
;;; vim:syntax=scheme
|