1 |
;;;; Copyright (C) 2000,2001, 2002 Free Software Foundation, Inc. |
;;;; Copyright (C) 2000,2001, 2002, 2003 Free Software Foundation, Inc. |
2 |
;;;; |
;;;; |
3 |
;;;; This library is free software; you can redistribute it and/or |
;;;; This library is free software; you can redistribute it and/or |
4 |
;;;; modify it under the terms of the GNU Lesser General Public |
;;;; modify it under the terms of the GNU Lesser General Public |
115 |
default-scrub |
default-scrub |
116 |
(let ((v (caddr cust))) |
(let ((v (caddr cust))) |
117 |
(cond ((procedure? v) v) |
(cond ((procedure? v) v) |
118 |
(else default-scrub))))) |
(else default-scrub)))))) |
119 |
(port (open-input-file filename))) |
(call-with-input-file filename |
120 |
(let loop ((line (read-delimited "\n" port)) |
(lambda (port) |
121 |
(doc "") |
(let loop ((line (read-delimited "\n" port)) |
122 |
(parse-state 'before)) |
(doc "") |
123 |
(if (or (eof-object? line) (eq? 'after parse-state)) |
(parse-state 'before)) |
124 |
doc |
(if (or (eof-object? line) (eq? 'after parse-state)) |
125 |
(let ((new-state |
doc |
126 |
(cond ((regexp-exec in-line-re line) 'in) |
(let ((new-state |
127 |
((regexp-exec after-line-re line) 'after) |
(cond ((regexp-exec in-line-re line) 'in) |
128 |
(else parse-state)))) |
((regexp-exec after-line-re line) 'after) |
129 |
(if (eq? 'after new-state) |
(else parse-state)))) |
130 |
doc |
(if (eq? 'after new-state) |
131 |
(loop (read-delimited "\n" port) |
doc |
132 |
(if (and (eq? 'in new-state) (eq? 'in parse-state)) |
(loop (read-delimited "\n" port) |
133 |
(string-append doc (scrub line) "\n") |
(if (and (eq? 'in new-state) (eq? 'in parse-state)) |
134 |
doc) |
(string-append doc (scrub line) "\n") |
135 |
new-state))))))) |
doc) |
136 |
|
new-state))))))))) |
137 |
|
|
138 |
|
|
139 |
|
|
152 |
|
|
153 |
(define (find-documentation-in-file name file) |
(define (find-documentation-in-file name file) |
154 |
(and (file-exists? file) |
(and (file-exists? file) |
155 |
(let ((port (open-input-file file)) |
(call-with-input-file file |
156 |
(name (symbol->string name))) |
(lambda (port) |
157 |
(let ((len (string-length name))) |
(let ((name (symbol->string name))) |
158 |
(read-delimited entry-delimiter port) ;skip to first entry |
(let ((len (string-length name))) |
159 |
(let loop ((entry (read-delimited entry-delimiter port))) |
(read-delimited entry-delimiter port) ;skip to first entry |
160 |
(cond ((eof-object? entry) #f) |
(let loop ((entry (read-delimited entry-delimiter port))) |
161 |
;; match? |
(cond ((eof-object? entry) #f) |
162 |
((and ;; large enough? |
;; match? |
163 |
|
((and ;; large enough? |
164 |
(>= (string-length entry) len) |
(>= (string-length entry) len) |
165 |
;; matching name? |
;; matching name? |
166 |
(string=? (substring entry 0 len) name) |
(string=? (substring entry 0 len) name) |
167 |
;; terminated? |
;; terminated? |
168 |
(memq (string-ref entry len) '(#\newline))) |
(memq (string-ref entry len) '(#\newline))) |
169 |
;; cut away name tag and extra surrounding newlines |
;; cut away name tag and extra surrounding newlines |
170 |
(substring entry (+ len 2) (- (string-length entry) 2))) |
(substring entry (+ len 2) (- (string-length entry) 2))) |
171 |
(else (loop (read-delimited entry-delimiter port))))))))) |
(else (loop (read-delimited entry-delimiter port))))))))))) |
172 |
|
|
173 |
(define (search-documentation-files name . files) |
(define (search-documentation-files name . files) |
174 |
(or-map (lambda (file) |
(or-map (lambda (file) |