#!+sb-doc
"Remove any occurrences of #\\ from the string because we've already
checked for whatever they may have protected."
- (declare (type simple-base-string namestr)
+ (declare (type simple-string namestr)
(type index start end))
- (let* ((result (make-string (- end start) :element-type 'base-char))
+ (let* ((result (make-string (- end start) :element-type 'character))
(dst 0)
(quoted nil))
(do ((src start (1+ src)))
(/show0 "filesys.lisp 86")
(defun maybe-make-pattern (namestr start end)
- (declare (type simple-base-string namestr)
+ (declare (type simple-string namestr)
(type index start end))
(if *ignore-wildcards*
(subseq namestr start end)
(/show0 "filesys.lisp 160")
(defun extract-name-type-and-version (namestr start end)
- (declare (type simple-base-string namestr)
+ (declare (type simple-string namestr)
(type index start end))
(let* ((last-dot (position #\. namestr :start (1+ start) :end end
:from-end t)))
(:relative ""))
""))
(devstring (if (and device (not (eq device :unspecific)))
- (concatenate 'simple-base-string (string device) (string #\:))
+ (concatenate 'simple-string (string device) (string #\:))
""))
- (headstring (concatenate 'simple-base-string devstring dirstring)))
+ (headstring (concatenate 'simple-string devstring dirstring)))
(if directory
(%enumerate-directories headstring (rest directory) pathname
verify-existence follow-links nil function)
follow-links nodes function
&aux (host (pathname-host pathname)))
(declare (simple-string head))
+ #!+win32
+ (setf follow-links nil)
(macrolet ((unix-xstat (name)
`(if follow-links
(sb!unix:unix-stat ,name)
(let ((piece (car tail)))
(etypecase piece
(simple-string
- (let ((head (concatenate 'base-string head piece)))
+ (let ((head (concatenate 'string head piece)))
(with-directory-node-noted (head)
(%enumerate-directories
- (concatenate 'base-string head
+ (concatenate 'string head
(host-unparse-directory-separator host))
(cdr tail) pathname
verify-existence follow-links
(%enumerate-directories head (rest tail) pathname
verify-existence follow-links
nodes function)
- (dolist (name (ignore-errors (directory-lispy-filenames head)))
- (let ((subdir (concatenate 'base-string head name)))
+ (dolist (name (directory-lispy-filenames head))
+ (let ((subdir (concatenate 'string head name)))
(multiple-value-bind (res dev ino mode)
(unix-xstat subdir)
(declare (type (or fixnum null) mode))
sb!unix:s-ifdir))
(unless (dolist (dir nodes nil)
(when (and (eql (car dir) dev)
+ #!+win32 ;; KLUDGE
+ (not (zerop ino))
(eql (cdr dir) ino))
(return t)))
(let ((nodes (cons (cons dev ino) nodes))
- (subdir (concatenate 'base-string subdir (host-unparse-directory-separator host))))
+ (subdir (concatenate 'string subdir (host-unparse-directory-separator host))))
(%enumerate-directories subdir tail pathname
verify-existence follow-links
nodes function))))))))
((or pattern (member :wild))
(dolist (name (directory-lispy-filenames head))
(when (or (eq piece :wild) (pattern-matches piece name))
- (let ((subdir (concatenate 'base-string head name)))
+ (let ((subdir (concatenate 'string head name)))
(multiple-value-bind (res dev ino mode)
(unix-xstat subdir)
(declare (type (or fixnum null) mode))
(eql (logand mode sb!unix:s-ifmt)
sb!unix:s-ifdir))
(let ((nodes (cons (cons dev ino) nodes))
- (subdir (concatenate 'base-string subdir (host-unparse-directory-separator host))))
+ (subdir (concatenate 'string subdir (host-unparse-directory-separator host))))
(%enumerate-directories subdir (rest tail) pathname
verify-existence follow-links
nodes function))))))))
:pathname pathname
:format-control "~@<invalid use of :UP after :ABSOLUTE.~@:>"))
(with-directory-node-removed (head)
- (let ((head (concatenate 'base-string head "..")))
+ (let ((head (concatenate 'string head "..")))
(with-directory-node-noted (head)
- (%enumerate-directories (concatenate 'base-string head (host-unparse-directory-separator host))
+ (%enumerate-directories (concatenate 'string head (host-unparse-directory-separator host))
(rest tail) pathname
verify-existence follow-links
nodes function)))))
(/noshow0 "computed NAME, TYPE, and VERSION")
(cond ((member name '(nil :unspecific))
(/noshow0 "UNSPECIFIC, more or less")
- (let ((directory (coerce directory 'base-string)))
+ (let ((directory (coerce directory 'string)))
(when (or (not verify-existence)
(sb!unix:unix-file-kind directory))
(funcall function directory))))
(components-match file-type type)
(components-match file-version version))
(funcall function
- (concatenate 'base-string
+ (concatenate 'string
directory
complete-filename))))))
(t
(/noshow0 "default case")
- (let ((file (concatenate 'base-string directory name)))
+ (let ((file (concatenate 'string directory name)))
(/noshow "computed basic FILE")
(unless (or (null type) (eq type :unspecific))
(/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
- (setf file (concatenate 'base-string file "." type)))
+ (setf file (concatenate 'string file "." type)))
(unless (member version '(nil :newest :wild :unspecific))
(/noshow0 "tweaking FILE for more-or-less-:WILD case")
- (setf file (concatenate 'base-string file "."
+ (setf file (concatenate 'string file "."
(quick-integer-to-string version))))
(/noshow0 "finished possibly tweaking FILE")
(when (or (not verify-existence)
(defun truename (pathname)
#!+sb-doc
"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.
+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."
+Under Unix, the TRUENAME of a broken symlink is considered to be the name of
+the broken symlink itself."
(let ((result (probe-file pathname)))
(unless result
(error 'simple-file-error
(defun probe-file (pathname)
#!+sb-doc
"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."
+otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
(let* ((defaulted-pathname (merge-pathnames
pathname
(sane-default-pathname-defaults)))
(let ((trueishname (sb!unix:unix-resolve-links namestring)))
(when trueishname
(let* ((*ignore-wildcards* t)
- (name (sb!unix:unix-simplify-pathname trueishname)))
+ (name (simplify-namestring
+ trueishname
+ (pathname-host defaulted-pathname))))
(if (eq (sb!unix:unix-file-kind name) :directory)
;; FIXME: this might work, but it's ugly.
(pathname (concatenate 'string name "/"))
;;; (This is an ANSI Common Lisp function.)
(defun user-homedir-pathname (&optional host)
+ #!+sb-doc
"Return the home directory of the user as a pathname. If the HOME
environment variable has been specified, the directory it designates
is returned; otherwise obtains the home directory from the operating
system."
(declare (ignore host))
- (parse-native-namestring
- (ensure-trailing-slash
- (if (posix-getenv "HOME")
- (posix-getenv "HOME")
- #!-win32
- (sb!unix:uid-homedir (sb!unix:unix-getuid))
- #!+win32
- ;; Needs to bypass PARSE-NATIVE-NAMESTRING & ENSURE-TRAILING-SLASH
- (return-from user-homedir-pathname
- (sb!win32::get-folder-pathname sb!win32::csidl_profile))))))
+ (let ((env-home (posix-getenv "HOME")))
+ (parse-native-namestring
+ (ensure-trailing-slash
+ (if (and env-home
+ (not (equal env-home "")))
+ env-home
+ #!-win32
+ (sb!unix:uid-homedir (sb!unix:unix-getuid))
+ #!+win32
+ ;; Needs to bypass PARSE-NATIVE-NAMESTRING & ENSURE-TRAILING-SLASH
+ (return-from user-homedir-pathname
+ (sb!win32::get-folder-pathname sb!win32::csidl_profile)))))))
(defun file-write-date (file)
#!+sb-doc
;; grounds that the implementation should have repeatable
;; behavior when possible.
(sort (loop for name being each hash-key in truenames
- using (hash-value truename)
- collect (cons name truename))
+ using (hash-value truename)
+ collect (cons name truename))
#'string<
:key #'car))))
\f
:device (pathname-device pathname)
:directory (subseq dir 0 i))))
(unless (probe-file newpath)
- (let ((namestring (coerce (namestring newpath) 'base-string)))
+ (let ((namestring (coerce (namestring newpath) 'string)))
(when verbose
(format *standard-output*
"~&creating directory: ~A~%"
projects / sbcl.git / blobdiff