(unparse #'unparse-unix-namestring)
(unparse-native #'unparse-native-unix-namestring)
(unparse-host #'unparse-unix-host)
- (unparse-directory #'unparse-unix-directory)
+ (unparse-directory #'unparse-physical-directory)
(unparse-file #'unparse-unix-file)
(unparse-enough #'unparse-unix-enough)
(unparse-directory-separator "/")
(unparse #'unparse-win32-namestring)
(unparse-native #'unparse-native-win32-namestring)
(unparse-host #'unparse-win32-host)
- (unparse-directory #'unparse-win32-directory)
+ (unparse-directory #'unparse-physical-directory)
(unparse-file #'unparse-win32-file)
(unparse-enough #'unparse-win32-enough)
(unparse-directory-separator "\\")
((member :unspecific) '(:relative))
(list
(collect ((results))
- (results (pop directory))
- (dolist (piece directory)
- (cond ((member piece '(:wild :wild-inferiors :up :back))
- (results piece))
- ((or (simple-string-p piece) (pattern-p piece))
- (results (maybe-diddle-case piece diddle-case)))
- ((stringp piece)
- (results (maybe-diddle-case (coerce piece 'simple-string)
- diddle-case)))
- (t
- (error "~S is not allowed as a directory component." piece))))
+ (let ((root (pop directory)))
+ (if (member root '(:relative :absolute))
+ (results root)
+ (error "List of directory components must start with ~S or ~S."
+ :absolute :relative)))
+ (when directory
+ (let ((next (pop directory)))
+ (if (or (eq :home next)
+ (typep next '(cons (eql :home) (cons string null))))
+ (results next)
+ (push next directory)))
+ (dolist (piece directory)
+ (cond ((member piece '(:wild :wild-inferiors :up :back))
+ (results piece))
+ ((or (simple-string-p piece) (pattern-p piece))
+ (results (maybe-diddle-case piece diddle-case)))
+ ((stringp piece)
+ (results (maybe-diddle-case (coerce piece 'simple-string)
+ diddle-case)))
+ (t
+ (error "~S is not allowed as a directory component." piece)))))
(results)))
(simple-string
`(:absolute ,(maybe-diddle-case directory diddle-case)))
;;; a new one if necessary.
(defun intern-logical-host (thing)
(declare (values logical-host))
- (with-locked-hash-table (*logical-hosts*)
+ (with-locked-system-table (*logical-hosts*)
(or (find-logical-host thing nil)
(let* ((name (logical-word-or-lose thing))
(new (make-logical-host :name name)))