Newer
Older
;;; 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))))))
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
;;; 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))