Newer
Older
:directory (concatenate 'simple-vector
(pathname-directory defaults)
(pathname-directory pathname))
:name (or (pathname-name pathname) (pathname-name defaults))
:type (or (pathname-type pathname)
(pathname-type defaults))))
(t
;; This branch should never fire, but just in case ...
(merge-pathnames pathname defaults))))
"*")))
;;; Ambiguous-Files -- Public
(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
(make-pathname :defaults defaults
:name nil
:type nil)))
"*")))
;;; File-writable -- exported from extensions.
;;;
;;; Determines whether the single argument (which should be a pathname)
;;; can be written by the the current task.
(defun file-writable (name)
"File-writable accepts a pathname and returns T if the current
process can write it, and NIL otherwise."
(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))))))
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
;;; Pathname-Order -- Internal
;;;
;;; Predicate to order pathnames by. Goes by name.
;;;
(defun pathname-order (x y)
(let ((xn (%pathname-name x))
(yn (%pathname-name y)))
(if (and xn yn)
(let ((res (string-lessp xn yn)))
(cond ((not res) nil)
((= res (length (the simple-string xn))) t)
((= res (length (the simple-string yn))) nil)
(t t)))
xn)))
;;; Default-Directory -- Public
;;;
;;; This fills in a hole in Common Lisp. We return the first thing we
;;; find by doing a ResolveSearchList on Default.
;;;
(defun default-directory ()
"Returns the pathname for the default directory. This is the place where
a file will be written if no directory is specified. This may be changed
with setf."
(multiple-value-bind (gr dir-or-error)
(mach:unix-current-directory)
(if gr
(pathname (concatenate 'simple-string dir-or-error "/"))
(error dir-or-error))))
;;;
;;; Maybe this shouldn't go here...
(defsetf default-directory %set-default-directory)
;;; %Set-Default-Directory -- Internal
;;;
;;; The setf method for Default-Directory. We actually set the environment
;;; variable Current which is by convention the head of the search list.
;;;
(defun %set-default-directory (new-val)
(multiple-value-bind (gr error)
(mach:unix-chdir (unix-namestring new-val t))