added a multipart fields for matching keywords

This commit is contained in:
Abdulaziz Ghuloum 2006-12-02 12:09:11 -05:00
parent bd4553ef3a
commit 8d64a3d4b3
1 changed files with 14 additions and 3 deletions

View File

@ -1,5 +1,4 @@
#!/Users/aghuloum/.opt/bin/ikarus --script #!/Users/aghuloum/.opt/bin/ikarus --script
(define get-comments (define get-comments
(lambda (file-name) (lambda (file-name)
(define comments '()) (define comments '())
@ -16,12 +15,24 @@
[(f (car ls)) (cons (car ls) (filter f (cdr ls)))] [(f (car ls)) (cons (car ls) (filter f (cdr ls)))]
[else (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 (define matcher
(lambda (tok) (lambda (tok)
(let ([n (string-length tok)]) (let ([n (string-length tok)])
(lambda (str) (lambda (str)
(and (fx>= (string-length str) n) (let f ([i 0])
(string=? (substring str 0 n) tok)))))) (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 (define get-matching
(lambda (token file-name) (lambda (token file-name)