Skip to content
Snippets Groups Projects
Commit dfc94f8a authored by wlott's avatar wlott
Browse files

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.
parent a0e0dcfd
No related branches found
No related tags found
No related merge requests found
......@@ -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))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment