/[guile]/guile/guile-core/ice-9/documentation.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/documentation.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by mvo, Sat Apr 5 19:04:27 2003 UTC revision 1.9 by kryde, Sat May 10 00:38:24 2003 UTC
# Line 1  Line 1 
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
# Line 115  Line 115 
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    
# Line 151  Line 152 
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)

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26