;;; Call FUNCTION on matches.
(defun %enumerate-matches (pathname verify-existence follow-links function)
- (/show0 "entering %ENUMERATE-MATCHES")
+ (/noshow0 "entering %ENUMERATE-MATCHES")
(when (pathname-type pathname)
(unless (pathname-name pathname)
(error "cannot supply a type without a name:~% ~S" pathname)))
(member (pathname-type pathname) '(nil :unspecific)))
(error "cannot supply a version without a type:~% ~S" pathname))
(let ((directory (pathname-directory pathname)))
- (/show0 "computed DIRECTORY")
+ (/noshow0 "computed DIRECTORY")
(if directory
(ecase (car directory)
(:absolute
- (/show0 "absolute directory")
+ (/noshow0 "absolute directory")
(%enumerate-directories "/" (cdr directory) pathname
verify-existence follow-links
nil function))
(:relative
- (/show0 "relative directory")
+ (/noshow0 "relative directory")
(%enumerate-directories "" (cdr directory) pathname
verify-existence follow-links
nil function)))
;;; Call FUNCTION on files.
(defun %enumerate-files (directory pathname verify-existence function)
(declare (simple-string directory))
- (/show0 "entering %ENUMERATE-FILES")
+ (/noshow0 "entering %ENUMERATE-FILES")
(let ((name (%pathname-name pathname))
(type (%pathname-type pathname))
(version (%pathname-version pathname)))
- (/show0 "computed NAME, TYPE, and VERSION")
+ (/noshow0 "computed NAME, TYPE, and VERSION")
(cond ((member name '(nil :unspecific))
- (/show0 "UNSPECIFIC, more or less")
+ (/noshow0 "UNSPECIFIC, more or less")
(when (or (not verify-existence)
(sb!unix:unix-file-kind directory))
(funcall function directory)))
(pattern-p type)
(eq name :wild)
(eq type :wild))
- (/show0 "WILD, more or less")
+ (/noshow0 "WILD, more or less")
;; I IGNORE-ERRORS here just because the original CMU CL
;; code did. I think the intent is that it's not an error
;; to request matches to a wild pattern when no matches
directory
complete-filename))))))
(t
- (/show0 "default case")
+ (/noshow0 "default case")
(let ((file (concatenate 'string directory name)))
- (/show0 "computed basic FILE=..")
+ (/noshow0 "computed basic FILE=..")
(/primitive-print file)
(unless (or (null type) (eq type :unspecific))
- (/show0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
+ (/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
(setf file (concatenate 'string file "." type)))
(unless (member version '(nil :newest :wild))
- (/show0 "tweaking FILE for more-or-less-:WILD case")
+ (/noshow0 "tweaking FILE for more-or-less-:WILD case")
(setf file (concatenate 'string file "."
(quick-integer-to-string version))))
- (/show0 "finished possibly tweaking FILE=..")
+ (/noshow0 "finished possibly tweaking FILE=..")
(/primitive-print file)
(when (or (not verify-existence)
(sb!unix:unix-file-kind file t))
- (/show0 "calling FUNCTION on FILE")
+ (/noshow0 "calling FUNCTION on FILE")
(funcall function file)))))))
-(/show0 "filesys.lisp 603")
+(/noshow0 "filesys.lisp 603")
;;; FIXME: Why do we need this?
(defun quick-integer-to-string (n)
\f
;;;; UNIX-NAMESTRING
-(defun unix-namestring (pathname &optional (for-input t) executable-only)
- #!+sb-doc
- "Convert PATHNAME into a string that can be used with UNIX system calls.
- Search-lists and wild-cards are expanded."
- ;; toy@rtp.ericsson.se: Let unix-namestring also handle logical
- ;; pathnames too.
- ;; FIXME: What does this ^ mean? A bug? A remark on a change already made?
- (let ((path (let ((lpn (pathname pathname)))
- (if (typep lpn 'logical-pathname)
- (namestring (translate-logical-pathname lpn))
- pathname))))
- (enumerate-search-list
- (pathname path)
- (collect ((names))
- (enumerate-matches (name pathname nil :verify-existence for-input)
- (when (or (not executable-only)
- (and (eq (sb!unix:unix-file-kind name)
- :file)
- (sb!unix:unix-access name
- sb!unix:x_ok)))
- (names name)))
- (let ((names (names)))
- (when names
- (when (cdr names)
- (error 'simple-file-error
- :format-control "~S is ambiguous:~{~% ~A~}"
- :format-arguments (list pathname names)))
- (return (car names))))))))
+(defun empty-relative-pathname-spec-p (x)
+ (or (equal x "")
+ (and (pathnamep x)
+ (or (equal (pathname-directory x) '(:relative))
+ ;; KLUDGE: I'm not sure this second check should really
+ ;; have to be here. But on sbcl-0.6.12.7,
+ ;; (PATHNAME-DIRECTORY (PATHNAME "")) is NIL, and
+ ;; (PATHNAME "") seems to act like an empty relative
+ ;; pathname, so in order to work with that, I test
+ ;; for NIL here. -- WHN 2001-05-18
+ (null (pathname-directory x)))
+ (null (pathname-name x))
+ (null (pathname-type x)))
+ ;; (The ANSI definition of "pathname specifier" has
+ ;; other cases, but none of them seem to admit the possibility
+ ;; of being empty and relative.)
+ ))
+
+;;; Convert PATHNAME into a string that can be used with UNIX system
+;;; calls, or return NIL if no match is found. Search-lists and
+;;; wild-cards are expanded.
+(defun unix-namestring (pathname-spec &optional (for-input t))
+ ;; The ordinary rules of converting Lispy paths to Unix paths break
+ ;; down for the current working directory, which Lisp thinks of as
+ ;; "" (more or less, and modulo ANSI's *DEFAULT-PATHNAME-DEFAULTS*,
+ ;; which unfortunately SBCL, as of sbcl-0.6.12.8, basically ignores)
+ ;; and Unix thinks of as ".". Since we're at the interface between
+ ;; Unix system calls and things like ENSURE-DIRECTORIES-EXIST which
+ ;; think the Lisp way, we perform the conversion.
+ ;;
+ ;; (FIXME: The *right* way to deal with this special case is to
+ ;; merge PATHNAME-SPEC with *DEFAULT-PATHNAME-DEFAULTS* here, after
+ ;; which it's not a relative pathname any more so the special case
+ ;; is no longer an issue. But until *DEFAULT-PATHNAME-DEFAULTS*
+ ;; works, we use this hack.)
+ (if (empty-relative-pathname-spec-p pathname-spec)
+ "."
+ ;; Otherwise, the ordinary rules apply.
+ (let* ((namestring (physicalize-pathname (pathname pathname-spec)))
+ (matches nil)) ; an accumulator for actual matches
+ (enumerate-matches (match namestring nil :verify-existence for-input)
+ (push match matches))
+ (case (length matches)
+ (0 nil)
+ (1 (first matches))
+ (t (error 'simple-file-error
+ :format-control "~S is ambiguous:~{~% ~A~}"
+ :format-arguments (list pathname-spec matches)))))))
\f
;;;; TRUENAME and PROBE-FILE
-;;; Another silly file function trivially different from another function.
+;;; This is only trivially different from PROBE-FILE, which is silly
+;;; but ANSI.
(defun truename (pathname)
#!+sb-doc
- "Return the pathname for the actual file described by the pathname
- An error of type file-error is signalled if no such file exists,
- or the pathname is wild."
+ "Return the pathname for the actual file described by PATHNAME.
+ An error of type FILE-ERROR is signalled if no such file exists,
+ or the pathname is wild.
+
+ Under Unix, the TRUENAME of a broken symlink is considered to be
+ the name of the broken symlink itself."
(if (wild-pathname-p pathname)
(error 'simple-file-error
- :format-control "bad place for a wild pathname"
+ :format-control "can't use a wild pathname here"
:pathname pathname)
(let ((result (probe-file pathname)))
(unless result
;;; If PATHNAME exists, return its truename, otherwise NIL.
(defun probe-file (pathname)
#!+sb-doc
- "Return a pathname which is the truename of the file if it exists, NIL
+ "Return a pathname which is the truename of the file if it exists, or NIL
otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
- (if (wild-pathname-p pathname)
- (error 'simple-file-error
- :pathname pathname
- :format-control "bad place for a wild pathname")
- (let ((namestring (unix-namestring pathname t)))
- (when (and namestring (sb!unix:unix-file-kind namestring))
- (let ((truename (sb!unix:unix-resolve-links
- (sb!unix:unix-maybe-prepend-current-directory
- namestring))))
- (when truename
- (let ((*ignore-wildcards* t))
- (pathname (sb!unix:unix-simplify-pathname truename)))))))))
+ (when (wild-pathname-p pathname)
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "can't use a wild pathname here"))
+ (let* ((defaulted-pathname (merge-pathnames
+ pathname
+ (sane-default-pathname-defaults)))
+ (namestring (unix-namestring defaulted-pathname t)))
+ (when (and namestring (sb!unix:unix-file-kind namestring t))
+ (let ((trueishname (sb!unix:unix-resolve-links namestring)))
+ (when trueishname
+ (let ((*ignore-wildcards* t))
+ (pathname (sb!unix:unix-simplify-pathname trueishname))))))))
\f
;;;; miscellaneous other operations
(defun file-author (file)
#!+sb-doc
- "Returns the file author as a string, or nil if the author cannot be
- determined. Signals an error of type file-error if file doesn't exist,
- or file is a wild pathname."
+ "Return the file author as a string, or nil if the author cannot be
+ determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
+ or FILE is a wild pathname."
(if (wild-pathname-p file)
(error 'simple-file-error
:pathname file
(/show0 "filesys.lisp 800")
-(defun directory (pathname &key (all t) (check-for-subdirs t)
- (follow-links t))
+(defun directory (pathname &key)
#!+sb-doc
- "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. If :FOLLOW-LINKS is NIL,
- then symbolic links in the result are not expanded. This is not the
- default because TRUENAME does follow links, and the result pathnames are
- defined to be the TRUENAME of the pathname (the truename of a link may well
- be in another directory.)"
- (let ((results nil))
+ "Return a list of PATHNAMEs, each the TRUENAME of a file that matched the
+ given pathname. Note that the interaction between this ANSI-specified
+ TRUENAMEing and the semantics of the Unix filesystem (symbolic links..)
+ means this function can sometimes return files which don't have the same
+ directory as PATHNAME."
+ (let ((truenames nil))
(enumerate-search-list
(pathname (merge-pathnames pathname
(make-pathname :name :wild
:type :wild
:version :wild)))
- (enumerate-matches (name pathname)
- (when (or all
- (let ((slash (position #\/ name :from-end t)))
- (or (null slash)
- (= (1+ slash) (length name))
- (char/= (schar name (1+ slash)) #\.))))
- (push name results))))
- (let ((*ignore-wildcards* t))
- (mapcar (lambda (name)
- (let ((name (if (and check-for-subdirs
- (eq (sb!unix:unix-file-kind name)
- :directory))
- (concatenate 'string name "/")
- name)))
- (if follow-links (truename name) (pathname name))))
- (sort (delete-duplicates results :test #'string=) #'string<)))))
+ (enumerate-matches (match pathname)
+ (let ((*ignore-wildcards* t))
+ (push (truename (if (eq (sb!unix:unix-file-kind match) :directory)
+ (concatenate 'string match "/")
+ match))
+ truenames))))
+ ;; FIXME: The DELETE-DUPLICATES here requires quadratic time,
+ ;; which is unnecessarily slow. That might not be an issue,
+ ;; though, since the time constant for doing TRUENAME on every
+ ;; directory entry is likely to be (much) larger, and the cost of
+ ;; all those TRUENAMEs on a huge directory might even be quadratic
+ ;; in the directory size. Someone who cares about enormous
+ ;; directories might want to check this. -- WHN 2001-06-19
+ (sort (delete-duplicates truenames :test #'string= :key #'pathname-name)
+ #'string< :key #'pathname-name)))
\f
;;;; translating Unix uid's
;;;;
(t t)))
xn)))
\f
-;;;; DEFAULT-DIRECTORY stuff
-;;;;
-;;;; FIXME: *DEFAULT-DIRECTORY-DEFAULTS* seems to be the ANSI way to
-;;;; deal with this, so we should beef up *DEFAULT-DIRECTORY-DEFAULTS*
-;;;; and make all the old DEFAULT-DIRECTORY stuff go away. (At that
-;;;; time the need for UNIX-CHDIR will go away too, I think.)
-
-(defun default-directory ()
- #!+sb-doc
- "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) (sb!unix:unix-current-directory)
- (if gr
- (let ((*ignore-wildcards* t))
- (pathname (concatenate 'simple-string dir-or-error "/")))
- (error dir-or-error))))
-
-(defun %set-default-directory (new-val)
- (let ((namestring (unix-namestring new-val t)))
- (unless namestring
- (error "~S doesn't exist." new-val))
- (multiple-value-bind (gr error) (sb!unix:unix-chdir namestring)
- (if gr
- (setf (search-list "default:") (default-directory))
- (simple-file-perror "couldn't set default directory to ~S"
- new-val
- error)))
- new-val))
-
-(/show0 "filesys.lisp 934")
-
-(/show0 "entering what used to be !FILESYS-COLD-INIT")
-(defvar *default-pathname-defaults*
- (%make-pathname *unix-host* nil nil nil nil :newest))
-(setf (search-list "default:") (default-directory))
-(/show0 "leaving what used to be !FILESYS-COLD-INIT")
-\f
(defun ensure-directories-exist (pathspec &key verbose (mode #o777))
#!+sb-doc
- "Tests whether the directories containing the specified file
- actually exist, and attempts to create them if they do not.
- Portable programs should avoid using the :MODE argument."
- (let* ((pathname (pathname pathspec))
- (pathname (if (typep pathname 'logical-pathname)
- (translate-logical-pathname pathname)
- pathname))
- (created-p nil))
+ "Test whether the directories containing the specified file
+ actually exist, and attempt to create them if they do not.
+ The MODE argument is a CMUCL/SBCL-specific extension to control
+ the Unix permission bits."
+ (let ((pathname (physicalize-pathname (pathname pathspec)))
+ (created-p nil))
(when (wild-pathname-p pathname)
(error 'simple-file-error
:format-control "bad place for a wild pathname"