mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

(file-commentary, find-documentation-in-file): Use

Browse source 
call-with-input-file, to close ports when done.
This commit is contained in:
Kevin Ryde 2003-05-10 00:38:24 +00:00
parent c851e00339
commit a3e013683a
1 changed files with 32 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

16
ice-9/documentation.scm
View file

@ -1,4 +1,4 @@
;;;; Copyright (C) 2000,2001, 2002 Free Software Foundation, Inc. ;;;; Copyright (C) 2000,2001, 2002, 2003 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -115,8 +115,9 @@
default-scrub default-scrub
(let ((v (caddr cust))) (let ((v (caddr cust)))
(cond ((procedure? v) v) (cond ((procedure? v) v)
(else default-scrub))))) (else default-scrub))))))
(port (open-input-file filename))) (call-with-input-file filename
(lambda (port)
(let loop ((line (read-delimited "\n" port)) (let loop ((line (read-delimited "\n" port))
(doc "") (doc "")
(parse-state 'before)) (parse-state 'before))
@ -132,7 +133,7 @@
(if (and (eq? 'in new-state) (eq? 'in parse-state)) (if (and (eq? 'in new-state) (eq? 'in parse-state))
(string-append doc (scrub line) "\n") (string-append doc (scrub line) "\n")
doc) doc)
new-state))))))) new-state)))))))))
@ -151,8 +152,9 @@
(define (find-documentation-in-file name file) (define (find-documentation-in-file name file)
(and (file-exists? file) (and (file-exists? file)
(let ((port (open-input-file file)) (call-with-input-file file
(name (symbol->string name))) (lambda (port)
(let ((name (symbol->string name)))
(let ((len (string-length name))) (let ((len (string-length name)))
(read-delimited entry-delimiter port) ;skip to first entry (read-delimited entry-delimiter port) ;skip to first entry
(let loop ((entry (read-delimited entry-delimiter port))) (let loop ((entry (read-delimited entry-delimiter port)))
@ -166,7 +168,7 @@
(memq (string-ref entry len) '(#\newline))) (memq (string-ref entry len) '(#\newline)))
;; cut away name tag and extra surrounding newlines ;; cut away name tag and extra surrounding newlines
(substring entry (+ len 2) (- (string-length entry) 2))) (substring entry (+ len 2) (- (string-length entry) 2)))
(else (loop (read-delimited entry-delimiter port))))))))) (else (loop (read-delimited entry-delimiter port)))))))))))
(define (search-documentation-files name . files) (define (search-documentation-files name . files)
(or-map (lambda (file) (or-map (lambda (file)