From dfc94f8a8f06e8f3f0e06b03a59cdef2eb7b1c2a Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sat, 3 Nov 1990 00:23:13 +0000 Subject: [PATCH] Rewrote large chunks to get rid of Dave code. Do pattern matching in directory instead of expecting the lower level code to handle it. Changed the names of routines like %ses-get-useful-part to something reasonable. --- code/filesys.lisp | 629 +++++++++++++++++++++------------------------- 1 file changed, 287 insertions(+), 342 deletions(-) diff --git a/code/filesys.lisp b/code/filesys.lisp index 0f9e00828..319f18a0b 100644 --- a/code/filesys.lisp +++ b/code/filesys.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.3 1990/08/24 18:11:00 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.4 1990/11/03 00:23:13 wlott Exp $ ;;; ;;; Ugly pathname functions for Spice Lisp. ;;; these functions are part of the standard Spice Lisp environment. @@ -338,8 +338,8 @@ (defun namestring (pathname) "Returns the full form of PATHNAME as a string." - (setq pathname (pathname pathname)) - (let* ((directory (%pathname-directory pathname)) + (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname))) + (directory (%pathname-directory pathname)) (name (%pathname-name pathname)) (type (%pathname-type pathname)) (result (%device-string (%pathname-device pathname)))) @@ -355,10 +355,10 @@ (the simple-string type)))) result)) -(defun %ses-get-useful-name (pathname) +(defun namestring-without-device (pathname) "NAMESTRING of pathname ignoring the device slot." - (setq pathname (pathname pathname)) - (let* ((directory (%pathname-directory pathname)) + (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname))) + (directory (%pathname-directory pathname)) (name (%pathname-name pathname)) (type (%pathname-type pathname)) (result "")) @@ -379,8 +379,8 @@ ;;; (defun file-namestring (pathname) "Returns the name, type, and version of PATHNAME as a string." - (unless (pathnamep pathname) (setq pathname (pathname pathname))) - (let* ((name (%pathname-name pathname)) + (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname))) + (name (%pathname-name pathname)) (type (%pathname-type pathname)) (result (or name ""))) (declare (simple-string result)) @@ -390,8 +390,8 @@ (defun directory-namestring (pathname) "Returns the device & directory parts of PATHNAME as a string." - (setq pathname (pathname pathname)) - (let* ((directory (%pathname-directory pathname)) + (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname))) + (directory (%pathname-directory pathname)) (result (%device-string (%pathname-device pathname)))) (declare (simple-string result)) (when directory @@ -401,8 +401,41 @@ (defun host-namestring (pathname) "Returns the host part of PATHNAME as a string." - (setq pathname (pathname pathname)) - (%pathname-host pathname)) + (%pathname-host (if (pathnamep pathname) pathname (pathname pathname)))) + + +;;; Do-Search-List -- Internal +;;; +;;; Bind var in turn to each element of search list with the specifed +;;; name. +;;; +(defmacro do-search-list ((var name &optional exit-form) . body) + "Do-Search-List (Var Name [Exit-Form]) {Form}*" + `(dolist (,var (resolve-search-list ,name nil) ,exit-form) + (declare (simple-string ,var)) + ,@body)) + +(defun unix-namestring (pathname for-input) + "Convert PATHNAME into a string that can be used with UNIX system calls." + (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname))) + (device (%pathname-device pathname))) + (cond ((or (eq device :absolute) + (null device) + (string= device "Default")) + (namestring pathname)) + (for-input + (let ((remainder (namestring-without-device pathname)) + (first nil)) + (do-search-list (entry device first) + (let ((name (concatenate 'simple-string entry remainder))) + (unless first + (setf first name)) + (when (mach:unix-file-kind name) + (return name)))))) + (t + (concatenate 'simple-string + (car (resolve-search-list device t)) + (namestring-without-device pathname)))))) @@ -442,7 +475,7 @@ ;;; Truename -- Public ;;; -;;; Another silly file function trivially different from another function. +;;; Another silly file function trivially different from another function. ;;; (defun truename (pathname) "Return the pathname for the actual file described by the pathname @@ -452,100 +485,24 @@ (error "The file ~S does not exist." (namestring pathname))) result)) -;;; Do-Search-List -- Internal -;;; -;;; Bind var in turn to each element of search list with the specifed -;;; name. -;;; -(defmacro do-search-list ((var name &optional exit-form) . body) - "Do-Search-List (Var Name [Exit-Form]) {Form}*" - `(dolist (,var (resolve-search-list ,name nil) ,exit-form) - (declare (simple-string ,var)) - ,@body)) - - -;;; Sub-Probe-File -- Internal -;;; -;;; Does the work of Probe-File, returning an additional value which -;;; indicates whether the name is really a file. -;;; -(defun sub-probe-file (pathname) - (setq pathname (pathname pathname)) - (flet ((pathnamify (ns etype) - (declare (simple-string ns)) - (case etype - (:entry_remote - (values (parse-namestring (concatenate 'simple-string ns "/")) - :entry_directory)) - (t - (values (parse-namestring ns) etype))))) - (let ((log-name (or (%pathname-device pathname) "default"))) - (if (eq log-name :absolute) - (let ((namestring (namestring pathname))) - (multiple-value-bind (name etype) - (mach:unix-subtestname namestring) - (if (null name) NIL - (pathnamify name etype)))) - (if (null (%pathname-device pathname)) - (multiple-value-bind (name etype) - (mach:unix-subtestname - (%ses-get-useful-name pathname)) - (if (null name) NIL (pathnamify name etype))) - (let ((namestring (%ses-get-useful-name pathname))) - (do-search-list (entry log-name) - (let ((str (concatenate 'simple-string entry namestring))) - (declare (simple-string str)) - (multiple-value-bind (name etype) - (mach:unix-subtestname str) - (when name - (return (pathnamify name etype)))))))))))) - - ;;; Probe-File -- Public ;;; -;;; Just call Sub-Probe-File and return nil when it isn't a file. +;;; If PATHNAME exists, return it's truename, otherwise NIL. ;;; (defun probe-file (pathname) "Return a pathname which is the truename of the file if it exists, NIL otherwise. Returns NIL for directories and other non-file entries." - (multiple-value-bind (pn f) - (sub-probe-file pathname) - (if (eq f :entry_file) pn))) - + (let ((namestring (unix-namestring pathname t))) + (when (mach:unix-file-kind namestring) + (let ((truename (mach:unix-resolve-links + (mach:unix-maybe-prepend-current-directory + namestring)))) + (when truename + (pathname (mach:unix-simplify-pathname truename))))))) -;;; Predict-Name -- Internal -;;; -;;; Predict-Name is a function used by Open to get an absolute pathname -;;; for a file being opened. Returns the truename of the file and -;;; whether it really exists or not. -;;; -(defun predict-name (file-name for-input) - (let* ((pathname (pathname file-name)) - (device (%pathname-device pathname)) - (truename (probe-file pathname))) - (cond ((eq device :absolute) - (if truename - (values (namestring truename) t) - ;; Try again in case file-name is a directory. - (predict-name-with-subtest (namestring pathname)))) - ((and for-input truename) - (values (namestring truename) t)) - (t - (let ((expansion (resolve-search-list (or device "default") t))) - (let ((name (concatenate 'simple-string (car expansion) - (%ses-get-useful-name pathname)))) - (declare (simple-string name)) - (predict-name-with-subtest name))))))) - -(defun predict-name-with-subtest (name) - (let ((gr (mach:unix-subtestname name))) - (if gr - (values gr t) - (values (mach::simplify-file-name name) nil)))) - +;;;; Other random operations. - ;;; Rename-File -- Public ;;; ;;; If File is a File-Stream, then rename the associated file if it exists, @@ -556,25 +513,19 @@ "Rename File to have the specified New-Name. If file is a stream open to a file, then the associated file is renamed. If the file does not yet exist then the file is created with the New-Name when the stream is closed." - (if (streamp file) - (let* ((name (file-name file)) - (pn (parse-namestring name)) - (npn (merge-pathnames new-name pn)) - (new (predict-name npn nil))) - (when (mach:quick-subtestname name) - (multiple-value-bind (res err) (mach:Unix-rename name new) - (if (null res) (error "Failed to rename ~A to ~A, unix error: ~A." - name new (mach:get-unix-error-msg err))))) - (file-name file new) - (values npn pn (parse-namestring new))) - (let* ((pn (or (sub-probe-file file) - (error "File to rename does not exist: ~S" file))) - (npn (merge-pathnames new-name pn)) - (new (predict-name npn nil))) - (multiple-value-bind (res err) (mach:unix-rename (namestring pn) new) - (if res (values npn pn (parse-namestring new)) - (error "Failed to rename ~A to ~A, unix error: ~A." - (namestring pn) new (mach:get-unix-error-msg err))))))) + (let* ((original (truename file)) + (original-namestring (namestring original)) + (new-name (merge-pathnames new-name original)) + (new-namestring (unix-namestring new-name nil))) + (multiple-value-bind (res error) + (mach:unix-rename original-namestring + new-namestring) + (unless res + (error "Failed to rename ~A to ~A: ~A" + original new-name (mach:get-unix-error-msg error))) + (when (streamp file) + (file-name file new-namestring)) + (values new-name original (truename new-namestring))))) ;;; Delete-File -- Public ;;; @@ -582,18 +533,17 @@ ;;; (defun delete-file (file) "Delete the specified file." - (let ((tn (sub-probe-file file))) + (let ((namestring (unix-namestring file t))) (when (streamp file) (close file :abort t)) - (if tn - (let ((ns (namestring tn))) - (multiple-value-bind (res err) (mach:unix-unlink ns) - (if (null res) - (error "Failed to delete ~A, unix error: ~A." - ns (mach:get-unix-error-msg err))))) - (unless (streamp file) - (error "File to be deleted does not exist: ~S" file)))) + (when namestring + (multiple-value-bind (res err) (mach:unix-unlink namestring) + (unless res + (error "Could not delete ~A: ~A." + namestring + (mach:get-unix-error-msg err)))))) t) + ;;; User-Homedir-Pathname -- Public ;;; @@ -620,120 +570,171 @@ ;;; (defun file-write-date (file) "Return file's creation date, or NIL if it doesn't exist." - (let ((tn (sub-probe-file file))) - (when tn - (multiple-value-bind (res dev ino mode nlink uid gid - rdev size atime mtime) - (mach:unix-stat (namestring tn)) - (declare (ignore dev ino mode nlink uid gid rdev size atime)) - (if (null res) 0 - (+ unix-to-universal-time mtime)))))) + (multiple-value-bind (res dev ino mode nlink uid gid + rdev size atime mtime) + (mach:unix-stat (unix-namestring file t)) + (declare (ignore dev ino mode nlink uid gid rdev size atime)) + (when res + (+ unix-to-universal-time mtime)))) ;;; File-Author -- Public ;;; (defun file-author (file) "Returns the file author as a string, or nil if the author cannot be determined. Signals an error if file doesn't exist." - (let ((filename (truename file))) - (multiple-value-bind (winp dev ino mode nlink uid) - (mach:unix-stat (namestring filename)) - (declare (ignore dev ino mode nlink)) - (if winp (lookup-login-name uid))))) + (multiple-value-bind (winp dev ino mode nlink uid) + (mach:unix-stat (unix-namestring (pathname file) t)) + (declare (ignore dev ino mode nlink)) + (if winp (lookup-login-name uid)))) ;;;; DIRECTORY. -;;; DO-DIRECTORY searches a directory, binding the vars to the name and entry -;;; type. Pattern and All are used in MACH:UNIX-SEARCH-DIRECTORY. +;;; PARSE-PATTERN -- internal. +;;; +;;; Parse-pattern extracts the name portion of pathname and converts it into +;;; a pattern usable in match-pattern-p. +;;; +(defun parse-pattern (pathname) + (let ((string (file-namestring pathname)) + (pattern nil) + (last-regular-char nil) + (index 0)) + (flet ((flush-pending-regulars () + (when last-regular-char + (push (subseq string last-regular-char index) pattern)) + (setf last-regular-char nil))) + (loop + (when (>= index (length string)) + (return)) + (let ((char (schar string index))) + (cond ((char= char #\?) + (flush-pending-regulars) + (push :single-char-wild pattern) + (incf index)) + ((char= char #\*) + (flush-pending-regulars) + (push :multi-char-wild pattern) + (incf index)) + ((char= char #\[) + (flush-pending-regulars) + (let ((close-bracket (position #\] string :start index))) + (unless close-bracket + (error "``['' with no corresponding ``]'': ~S" string)) + (push :character-set pattern) + (push (subseq string (1+ index) close-bracket) + pattern) + (setf index (1+ close-bracket)))) + (t + (unless last-regular-char + (setf last-regular-char index)) + (incf index))))) + (flush-pending-regulars)) + (nreverse pattern))) + +;;; MATCH-PATTERN-P -- internal. ;;; -(defmacro do-directory ((name-var etype-var pattern &optional (all t) result) - . body) - "Do-Directory (Name Entry-Type Pattern [All] [Result]) {Form}*. - If All is non-nil (the default), then Unix dot files to be processed. - Unix dot and dot-dot are never processed." - (let ((file (gensym)) - (res (gensym)) - (type (gensym)) - (p (gensym))) - `(dolist (,file (mach:unix-search-directory ,pattern ,all) - ,result) - (declare (simple-string ,file)) - (let* ((,p (position #\/ ,file :from-end t)) - (,name-var - (if ,p - (subseq ,file (the fixnum (1+ (the fixnum ,p)))) - ,file))) - (declare (simple-string ,name-var)) - (unless (or (string= "." ,name-var) (string= ".." ,name-var)) - (let ((,etype-var (multiple-value-bind (,res ,type) - (mach:quick-subtestname ,file) - (declare (ignore ,res)) - ,type))) - ,@body)))))) - -(defun directory (pathname &key (all t)) +;;; Determine if string (starting at start) matches pattern. +;;; +(defun match-pattern-p (string pattern &optional (start 0)) + (cond ((null pattern) + (= start (length string))) + ((eq (car pattern) :single-char-wild) + (and (> (length string) start) + (match-pattern-p string (cdr pattern) (1+ start)))) + ((eq (car pattern) :character-set) + (and (> (length string) start) + (find (schar string start) (cadr pattern)) + (match-pattern-p string (cddr pattern) (1+ start)))) + ((eq (car pattern) :multi-char-wild) + (do ((new-start (length string) (1- new-start))) + ((< new-start start) nil) + (when (match-pattern-p string (cdr pattern) new-start) + (return t)))) + ((stringp (car pattern)) + (let* ((expected (car pattern)) + (len (length expected)) + (new-start (+ start len))) + (and (>= (length string) new-start) + (string= string expected :start1 start :end1 new-start) + (match-pattern-p string (cdr pattern) new-start)))) + (t + (error "Bogus thing in pattern: ~S" (car pattern))))) + +;;; MATCHING-FILES-IN-DIR -- internal +;;; +;;; Return a list of all the files in the directory dirname that match +;;; pattern. If all is nil, ignore files starting with a ``.''. +;;; +(defun matching-files-in-dir (dirname pattern all) + (let ((dir (mach:open-dir dirname))) + (if dir + (unwind-protect + (let ((results nil)) + (loop + (let ((name (mach:read-dir dir))) + (cond ((null name) + (return)) + ((or (string= name ".") + (string= name "..") + (and (not all) + (char= (schar name 0) #\.)))) + ((or (null pattern) + (match-pattern-p name pattern)) + (if (zerop (length dirname)) + (push name results) + (push (concatenate 'string dirname name) + results)))))) + (values results t)) + (mach:close-dir dir)) + (values nil nil)))) + +;;; DIRECTORY -- public. +;;; +(defun directory (pathname &key (all t) (check-for-subdirs t)) "Returns a list of pathnames, one for each file that matches the given pathname. Supplying :all as nil causes this to ignore Unix dot files. This never includes Unix dot and dot-dot in the result." - (setq pathname (pathname pathname)) - (multiple-value-bind (dir pattern) (find-directory pathname) - (let ((res ())) - (do-directory (name etype pattern all) - (if (eq etype :entry_file) - (let ((last-dot (position #\. name :from-end t))) - (push - (%make-pathname - "Mach" :absolute dir - (if last-dot (subseq name 0 last-dot) name) - (if last-dot (subseq name (1+ last-dot))) - nil) - res)) - (push - (%make-pathname - "Mach" :absolute - (concatenate 'simple-vector dir (vector name)) - nil nil nil) - res))) - (nreverse res)))) - -;;; FIND-DIRECTORY returns an absolute directory vector for pathname as a -;;; first argument and an absolute namestring. The namestring includes a -;;; trailing asterisk, wildcard, when the given pathname is immediately -;;; probe-able as a directory. -;;; -(defun find-directory (pathname) - (multiple-value-bind (pn type) - (sub-probe-file pathname) - (if pn - (let ((ns (namestring pn))) - (declare (simple-string ns)) - (case type - (:entry_directory - (when (char/= (schar ns (the fixnum (1- (length ns)))) #\/) - (setq ns (concatenate 'simple-string ns "/"))) - (values (%pathname-directory (pathname ns)) - (concatenate 'simple-string ns "*"))) - (t (values (%pathname-directory pn) ns)))) - (multiple-value-bind (pn type) - (sub-probe-file - (make-pathname - :directory (%pathname-directory pathname) - :device (%pathname-device pathname))) - (unless pn - (error "Directory does not exist: ~S" pathname)) - (let ((ns (namestring pn))) - (case type - (:entry_directory - (values - (%pathname-directory pn) - (concatenate 'simple-string ns (file-namestring pathname)))) - (t - (error "~S is not a directory." pathname)))))))) - + (let* ((pathname (if (pathnamep pathname) pathname (pathname pathname))) + (device (%pathname-device pathname)) + (pattern (parse-pattern pathname)) + (results nil) + (really-won nil)) + (if (or (eq device :absolute) + (null device) + (string= device "Default")) + (multiple-value-setq (results really-won) + (matching-files-in-dir (directory-namestring pathname) pattern all)) + (let ((remainder (namestring-without-device + (directory-namestring pathname)))) + (do-search-list (dir device) + (multiple-value-bind + (files won) + (matching-files-in-dir (concatenate 'simple-string + dir + remainder) + pattern + all) + (when won + (setf really-won t)) + (setf results (append results files)))))) + (unless really-won + (error "Could not find ~S." pathname)) + (setf results + (sort (delete-duplicates results :test #'string=) + #'string<)) + (mapcar #'(lambda (name) + (if (and check-for-subdirs + (eq (mach:unix-file-kind name) :directory)) + (pathname (concatenate 'string name "/")) + (pathname name))) + results))) -;;;; Printing directories and determining file owner names. +;;;; Printing directories. + +#| ;;; PRINT-DIRECTORY is exported from the EXTENSIONS package. ;;; @@ -864,6 +865,7 @@ (terpri)))) (when return-list (nreverse result)))) +|# ;;;; Translating uid's and gid's. @@ -939,93 +941,64 @@ :start2 id-start :end2 id-end)) (return (subseq entry 0 name-end)))))))))))) - -;;; Complete-One-File -- Internal -;;; -;;; Return as values a string and the greatest common prefix of all -;;; the files corresponding to pattern. -;;; -(defun complete-one-file (pattern default-type ignore-types) - (let ((first nil) - (length nil)) - (do-directory (name etype pattern nil) - (declare (ignore etype)) - (let* ((last-dot (position #\. name :from-end t)) - (type (if last-dot (subseq name (1+ last-dot))))) - (cond ((and (not (string= type default-type)) - (member type ignore-types :test #'string=))) - (first - (let ((msm (string-not-equal name first :end2 length))) - (when (and msm (< msm length)) - (setq length msm)))) - (t - (setq first name) - (setq length (length name)))))) - (values first length))) - - -;;; Complete-File -- Public -;;; -;;; If the pathname is absolute, just call Complete-One-File on and test -;;; whether the result is a file. If a relative pathname, do it on each -;;; directory, accumulating the result. +;;;; File completion. + +(defun complete-file (pathname &key (defaults *default-pathname-defaults*) + ignore-types) + ;; Find all possible pathnames. + (let ((files + (directory (concatenate 'string + (namestring (merge-pathnames pathname + defaults)) + "*") + :check-for-subdirs nil))) + (cond ((null files) + (values nil nil)) + ((null (cdr files)) + (values (merge-pathnames (file-namestring (car files)) + pathname) + t)) + (t + (let ((good-files + (delete-if #'(lambda (pathname) + (and (pathname-type pathname) + (member (pathname-type pathname) + ignore-types + :test #'string=))) + files))) + (cond ((null good-files)) + ((null (cdr good-files)) + (return-from complete-file + (values (merge-pathnames (file-namestring + (car good-files)) + pathname) + t))) + (t + (setf files good-files))) + (let ((common (file-namestring (car files)))) + (dolist (file (cdr files)) + (let ((name (file-namestring file))) + (dotimes (i (min (length common) (length name)) + (when (< (length name) (length common)) + (setf common name))) + (unless (char= (schar common i) (schar name i)) + (setf common (subseq common 0 i)) + (return))))) + (values (merge-pathnames common pathname) + nil))))))) + +;;; Ambiguous-Files -- Public ;;; -(defun complete-file (pathname &key defaults ignore-types) - "Attempt to complete Pathname as the name of a file. If the resulting - completion is unique, return T as the second value. If there is no - possible completion, return both values NIL." - (setq pathname (pathname pathname)) - (setq defaults (if defaults (pathname defaults) *default-pathname-defaults*)) - (flet ((pathnamify (res len ambiguous pathname) - (values - (make-pathname :device (%pathname-device pathname) - :directory (%pathname-directory pathname) - :defaults (parse-namestring (subseq res 0 len))) - (not ambiguous)))) - (let ((dev (or (%pathname-device pathname) "default")) - (default-type (%pathname-type defaults))) - (if (eq dev :absolute) - (multiple-value-bind - (res len) - (complete-one-file (concatenate 'simple-string - (namestring pathname) - "*") - default-type ignore-types) - (declare (fixnum len)) - (if res - (pathnamify res len - (/= (the fixnum (length res)) len) - pathname) - (values nil nil))) - (let ((namestring (%ses-get-useful-name pathname)) - (dirs (if (and (%pathname-directory defaults) - (string-equal dev "default")) - (list (directory-namestring defaults)) - ())) - (max most-positive-fixnum) - (max-str nil) - (ambiguous nil)) - (declare (simple-string namestring)) - (do-search-list (entry dev) - (pushnew entry dirs :test #'string-equal)) - (dolist (entry dirs) - (let ((str (concatenate 'simple-string entry namestring "*"))) - (declare (simple-string str)) - (multiple-value-bind - (res len) - (complete-one-file str default-type ignore-types) - (when res - (unless ambiguous - (setq ambiguous (or max-str (/= (length res) len)))) - (if max-str - (setq max (or (string-not-equal res max-str :end1 len - :end2 max) - max)) - (setq max len max-str res)))))) - (if max-str - (pathnamify max-str max ambiguous pathname) - (values nil nil))))))) +(defun ambiguous-files (pathname &optional defaults) + "Return a list of all files which are possible completions of Pathname. + We look in the directory specified by Defaults as well as looking down + the search list." + (directory (concatenate 'string + (namestring (merge-pathnames pathname defaults)) + "*") + :check-for-subdirs nil)) + ;;; File-writable -- exported from extensions. ;;; @@ -1035,11 +1008,11 @@ (defun file-writable (name) "File-writable accepts a pathname and returns T if the current process can write it, and NIL otherwise." - (multiple-value-bind (tn exists) (predict-name name nil) - (if exists - (values (mach:unix-access tn mach:w_ok)) - (values (mach:unix-access (directory-namestring tn) - (logior mach:w_ok mach:x_ok)))))) + (let ((truename (probe-file name))) + (values + (mach:unix-access + (unix-namestring (or truename (directory-namestring name)) t) + (if truename mach:w_ok (logior mach:w_ok mach:x_ok)))))) ;;; Pathname-Order -- Internal @@ -1057,34 +1030,6 @@ (t t))) xn))) -;;; Ambiguous-Files -- Public -;;; -;;; If the pathname is absolute, just do a directory. If it is relative, -;;; do a directory on each directory in the search-list and merge the results. -;;; -(defun ambiguous-files (pathname &optional defaults) - "Return a list of all files which are possible completions of Pathname. - We look in the directory specified by Defaults as well as looking down - the search list." - (setq pathname (pathname pathname) - defaults (if defaults (pathname defaults) *default-pathname-defaults*)) - (let ((dev (or (%pathname-device pathname) "default"))) - (if (eq dev :absolute) - (directory (concatenate 'simple-string (namestring pathname) "*")) - (let ((namestring (%ses-get-useful-name pathname)) - (dirs (if (and (%pathname-directory defaults) - (string-equal dev "default")) - (list (directory-namestring defaults)) - ())) - (res ())) - (declare (simple-string namestring)) - (do-search-list (entry dev) (pushnew entry dirs :test #'string-equal)) - (dolist (entry dirs) - (let ((str (concatenate 'simple-string entry namestring "*"))) - (declare (simple-string str)) - (setq res (merge 'list res (directory str) - #'pathname-order)))) - res)))) ;;; Default-Directory -- Public ;;; @@ -1112,7 +1057,7 @@ ;;; (defun %set-default-directory (new-val) (multiple-value-bind (gr error) - (mach:unix-chdir (predict-name new-val nil)) + (mach:unix-chdir (unix-namestring new-val t)) (if gr (car (setf (search-list "default:") (list (default-directory)))) -- GitLab