From 1f85d4e8073910b8ad901aed9ddd7e26f05d7643 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 19 Nov 1999 14:10:49 +0000 Subject: [PATCH] New procedure DIRECTORY-FILE-NAMES for those cases when DIRECTORY-READ is a pain. --- v7/src/runtime/sfile.scm | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm index 728b6e30f..358f3c1a0 100644 --- a/v7/src/runtime/sfile.scm +++ b/v7/src/runtime/sfile.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: sfile.scm,v 14.20 1999/01/02 06:19:10 cph Exp $ +$Id: sfile.scm,v 14.21 1999/11/19 14:10:49 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -50,6 +50,25 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ((ucode-primitive file-eq?) (->namestring (merge-pathnames x)) (->namestring (merge-pathnames y)))) +(define (current-file-time) + (call-with-temporary-file-pathname file-modification-time)) + +(define (directory-file-names directory) + (let ((channel + (directory-channel-open + (->namestring (pathname-as-directory directory))))) + (let loop ((result '())) + (let ((name (directory-channel-read channel))) + (if name + (loop + (if (or (string=? "." name) + (string=? ".." name)) + result + (cons name result))) + (begin + (directory-channel-close channel) + result)))))) + (define (call-with-temporary-filename receiver) (call-with-temporary-file-pathname (lambda (pathname) @@ -86,9 +105,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (vector-set! objects slot (delete! filename (vector-ref objects slot))) ((ucode-primitive set-fixed-objects-vector! 1) objects))))) - -(define (current-file-time) - (call-with-temporary-file-pathname file-modification-time)) (define (guarantee-init-file-specifier object procedure) (if (not (init-file-specifier? object)) -- 2.25.1