Use new predicate DIRECTORY-PATHNAME? to replace various ad-hoc

mechanisms previously used to detect the same thing.

diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index b7c5c5d306e4a3c3727bb2fc31f88b9aaa912200..1ad5b6cc3fcd76abbb08ae42094ac1f6150b7ea8 100644 (file)
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: filcom.scm,v 1.216 2001/05/10 19:06:17 cph Exp $
+;;; $Id: filcom.scm,v 1.217 2001/05/12 20:02:19 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
@@ -471,15 +471,10 @@ all buffers."
   boolean?)
 
 (define (pathname->buffer-name pathname)
-  (let ((pathname
-        (let ((pathname (->pathname pathname)))
-          (if (pathname-name pathname)
-              pathname
-              (directory-pathname-as-file pathname)))))
-    (let ((name (file-namestring pathname)))
-      (if (string-null? name)
-         (->namestring pathname)
-         name))))
+  (let ((pathname (directory-pathname-as-file (->pathname pathname))))
+    (if (directory-pathname? pathname)
+       (->namestring pathname)
+       (file-namestring pathname))))
 
 (define (pathname->buffer pathname)
   (let ((pathname (->pathname pathname)))
@@ -497,11 +492,11 @@ if you wish to make buffer not be visiting any file."
     (set-visited-pathname
      (selected-buffer)
      (let ((pathname (->pathname filename)))
-       (and (not (string-null? (file-namestring pathname)))
+       (and (not (directory-pathname? pathname))
            pathname)))))
 
 (define (set-visited-pathname buffer pathname)
-  (if (and pathname (not (pathname-name pathname)))
+  (if (and pathname (directory-pathname? pathname))
       (editor-error "File name cannot be a directory: "
                    (->namestring pathname)))
   (set-buffer-pathname! buffer pathname)
@@ -808,7 +803,6 @@ Prefix arg means treat the plaintext file as binary data."
 (define (filename-complete-string pathname
                                  if-unique if-not-unique if-not-found)
   (let ((directory (directory-namestring pathname))
-       (prefix (file-namestring pathname))
        (if-directory
         (lambda (directory)
           (if-not-unique directory
@@ -818,10 +812,12 @@ Prefix arg means treat the plaintext file as binary data."
                             (os/directory-list directory)))))))
     (cond ((not (file-test-no-errors file-directory? directory))
           (if-not-found))
-         ((string-null? prefix)
+         ((directory-pathname? pathname)
           (if-directory directory))
          (else
-          (let ((filenames (os/directory-list-completions directory prefix))
+          (let ((filenames
+                 (os/directory-list-completions directory
+                                                (file-namestring pathname)))
                 (unique-case
                  (lambda (filename)
                    (let ((pathname (merge-pathnames filename directory)))

diff --git a/v7/src/edwin/print.scm b/v7/src/edwin/print.scm
index c1f83c443afda419471f2f3dc146725dff4a4e15..591bd93a7db560dc8f07835eeeca334cbae15757 100644 (file)
--- a/v7/src/edwin/print.scm
+++ b/v7/src/edwin/print.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: print.scm,v 1.19 2000/04/30 22:17:07 cph Exp $
+;;; $Id: print.scm,v 1.20 2001/05/12 20:02:33 cph Exp $
 ;;;
-;;; Copyright (c) 1991-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1991-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,7 +16,8 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; Print Buffers and Regions
 
@@ -107,9 +108,8 @@ Variable LPR-SWITCHES is a list of extra switches (strings) to pass to lpr."
           (and buffer
                (or (let ((pathname (buffer-pathname buffer)))
                      (and pathname
-                          (let ((filename (file-namestring pathname)))
-                            (and (not (string-null? filename))
-                                 filename))))
+                          (not (directory-pathname? pathname))
+                          (file-namestring pathname)))
                    (string-append "Edwin buffer " (buffer-name buffer)))))))
     (if (or (not buffer-title)
            (and (group-start? (region-start region))

diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm
index 857646c2393cc41359808f24f74cc3868bb8315e..98c4779301cab09df6266bd76da94ce8dfdde1df 100644 (file)
--- a/v7/src/imail/imail-util.scm
+++ b/v7/src/imail/imail-util.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-util.scm,v 1.35 2001/03/19 22:17:37 cph Exp $
+;;; $Id: imail-util.scm,v 1.36 2001/05/12 20:03:21 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -329,7 +329,7 @@
                          (lambda () (filtered-list pathname filter))))))
     (cond ((not (safe-file-directory? (directory-pathname pathname)))
           (if-not-found))
-         ((string-null? (file-namestring pathname))
+         ((directory-pathname? pathname)
           (if-directory pathname))
          (else
           (let ((pathnames (filtered-completions pathname filter)))
@@ -340,7 +340,7 @@
                                    (string-greatest-common-prefix
                                     (map ->namestring pathnames)))
                                   (lambda () pathnames)))
-                  ((string-null? (file-namestring (car pathnames)))
+                  ((directory-pathname? (car pathnames))
                    (if-directory (car pathnames)))
                   (else
                    (if-unique (car pathnames)))))))))

diff --git a/v7/src/runtime/dosdir.scm b/v7/src/runtime/dosdir.scm
index 01043935c264cfba51adb8867e2096eed7ad463e..cd9a29ac80c9e2860e065eb56aebb264740d8221 100644 (file)
--- a/v7/src/runtime/dosdir.scm
+++ b/v7/src/runtime/dosdir.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dosdir.scm,v 1.9 1999/06/21 21:05:27 cph Exp $
+$Id: dosdir.scm,v 1.10 2001/05/12 20:03:01 cph Exp $
 
-Copyright (c) 1992, 1999 Massachusetts Institute of Technology
+Copyright (c) 1992, 1999-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
 |#
 
 ;;;; DOS Directory Reader
@@ -35,16 +36,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (directory-read-nosort pattern)
   (let ((pattern
         (let ((pattern (adjust-directory-pattern (merge-pathnames pattern))))
-          (let ((name (pathname-name pattern))
-                (type (pathname-type pattern)))
-            (if (or name type)
-                pattern
-                (make-pathname (pathname-host pattern)
-                               (pathname-device pattern)
-                               (pathname-directory pattern)
-                               'WILD
-                               'WILD
-                               (pathname-version pattern)))))))
+          (if (directory-pathname? pattern)
+              (make-pathname (pathname-host pattern)
+                             (pathname-device pattern)
+                             (pathname-directory pattern)
+                             'WILD
+                             'WILD
+                             (pathname-version pattern))
+              pattern))))
     (let ((directory-path (directory-pathname pattern)))
       (map (lambda (pathname)
             (merge-pathnames pathname directory-path))

diff --git a/v7/src/runtime/unxdir.scm b/v7/src/runtime/unxdir.scm
index 33be8daf3b791a6549b66f810ff5aa359794544e..df4c846c0fca0305e66e8e02933863ccdd41b0a4 100644 (file)
--- a/v7/src/runtime/unxdir.scm
+++ b/v7/src/runtime/unxdir.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: unxdir.scm,v 14.11 1999/01/02 06:19:10 cph Exp $
+$Id: unxdir.scm,v 14.12 2001/05/12 20:03:03 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
 |#
 
 ;;;; Directory Operations -- unix
@@ -34,16 +35,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (directory-read-nosort pattern)
   (let ((pattern
         (let ((pattern (merge-pathnames pattern)))
-          (let ((name (pathname-name pattern))
-                (type (pathname-type pattern)))
-            (if (or name type)
-                pattern
-                (make-pathname (pathname-host pattern)
-                               (pathname-device pattern)
-                               (pathname-directory pattern)
-                               'WILD
-                               'WILD
-                               (pathname-version pattern)))))))
+          (if (directory-pathname? pattern)
+              (make-pathname (pathname-host pattern)
+                             (pathname-device pattern)
+                             (pathname-directory pattern)
+                             'WILD
+                             'WILD
+                             (pathname-version pattern))
+              pattern))))
     (let ((directory-path (directory-pathname pattern)))
       (map (lambda (pathname)
             (merge-pathnames pathname directory-path))