From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 20 Apr 1989 08:19:38 +0000 (+0000)
Subject: Add new operations `os/file-directory?', `os/make-filename', and
X-Git-Tag: 20090517-FFI~12153
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d9919094362d0c9995057e162741dc9f3ae2e5fe;p=mit-scheme.git

Add new operations `os/file-directory?', `os/make-filename', and
`os/filename-as-directory'.  These operations replicate the action of
existing operations, but they allow the performance of filename
completion to be improved significantly over what could previously be
achieved.

Add new operation `os/completion-ignored-extensions' which is used to
initialize the variable of that name.

Change `os/directory-list-completions' to special case the null-string
prefix for added performance.
---

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index d541a4d42..24c9059ca 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.3 1989/04/15 00:53:52 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.4 1989/04/20 08:19:38 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -219,10 +219,26 @@ Includes the new backup.  Must be > 0"
 	result)))
 
 (define (os/directory-list-completions directory prefix)
-  (let loop
-      ((name ((ucode-primitive open-directory) directory))
-       (result '()))
-    (if name
-	(loop ((ucode-primitive directory-read))
-	      (if (string-prefix? prefix name) (cons name result) result))
-	result)))
\ No newline at end of file
+  (if (string-null? prefix)
+      (os/directory-list directory)
+      (let loop
+	  ((name ((ucode-primitive open-directory) directory))
+	   (result '()))
+	(if name
+	    (loop ((ucode-primitive directory-read))
+		  (if (string-prefix? prefix name) (cons name result) result))
+	    result))))
+(define-integrable os/file-directory?
+  (ucode-primitive file-directory?))
+
+(define-integrable (os/make-filename directory filename)
+  (string-append directory filename))
+
+(define-integrable (os/filename-as-directory filename)
+  (string-append filename "/"))
+
+(define (os/completion-ignored-extensions)
+  (list-copy
+   '(".o" ".elc" "~" ".bin" ".lbin" ".fasl"
+     ".dvi" ".toc" ".log" ".aux"
+     ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot")))
\ No newline at end of file