(defun pathname-host (pathname &key (case :local))
#!+sb-doc
- "Accessor for the pathname's host."
+ "Return PATHNAME's host."
(declare (type pathname-designator pathname)
(type (member :local :common) case)
(values host)
(defun pathname-device (pathname &key (case :local))
#!+sb-doc
- "Accessor for pathname's device."
+ "Return PATHNAME's device."
(declare (type pathname-designator pathname)
(type (member :local :common) case))
(with-pathname (pathname pathname)
(defun pathname-directory (pathname &key (case :local))
#!+sb-doc
- "Accessor for the pathname's directory list."
+ "Return PATHNAME's directory."
(declare (type pathname-designator pathname)
(type (member :local :common) case))
(with-pathname (pathname pathname)
:lower)))))
(defun pathname-name (pathname &key (case :local))
#!+sb-doc
- "Accessor for the pathname's name."
+ "Return PATHNAME's name."
(declare (type pathname-designator pathname)
(type (member :local :common) case))
(with-pathname (pathname pathname)
(defun pathname-type (pathname &key (case :local))
#!+sb-doc
- "Accessor for the pathname's name."
+ "Return PATHNAME's type."
(declare (type pathname-designator pathname)
(type (member :local :common) case))
(with-pathname (pathname pathname)
(defun pathname-version (pathname)
#!+sb-doc
- "Accessor for the pathname's version."
+ "Return PATHNAME's version."
(declare (type pathname-designator pathname))
(with-pathname (pathname pathname)
(%pathname-version pathname)))
(defun substitute-into (pattern subs diddle-case)
(declare (type pattern pattern)
(type list subs)
- (values (or simple-base-string pattern)))
+ (values (or simple-base-string pattern) list))
(let ((in-wildcard nil)
(pieces nil)
(strings nil))
values)
(defun %enumerate-search-list (pathname function)
- (/show0 "entering %ENUMERATE-SEARCH-LIST")
(let* ((pathname (if (typep pathname 'logical-pathname)
(translate-logical-pathname pathname)
pathname))
(search-list (extract-search-list pathname nil)))
- (/show0 "PATHNAME and SEARCH-LIST computed")
(cond
((not search-list)
- (/show0 "no search list")
(funcall function pathname))
((not (search-list-defined search-list))
- (/show0 "undefined search list")
(error "undefined search list: ~A"
(search-list-name search-list)))
(t
- (/show0 "general case")
(let ((tail (cddr (pathname-directory pathname))))
- (/show0 "TAIL computed")
(dolist (expansion
(search-list-expansions search-list))
- (/show0 "tail recursing in %ENUMERATE-SEARCH-LIST")
(%enumerate-search-list (make-pathname :defaults pathname
:directory
(cons :absolute
;;; Unparse a logical pathname string.
(defun unparse-enough-namestring (pathname defaults)
- (let* ((path-dir (pathname-directory pathname))
- (def-dir (pathname-directory defaults))
- (enough-dir
+ (let* ((path-directory (pathname-directory pathname))
+ (def-directory (pathname-directory defaults))
+ (enough-directory
;; Go down the directory lists to see what matches. What's
;; left is what we want, more or less.
- (cond ((and (eq (first path-dir) (first def-dir))
- (eq (first path-dir) :absolute))
+ (cond ((and (eq (first path-directory) (first def-directory))
+ (eq (first path-directory) :absolute))
;; Both paths are :ABSOLUTE, so find where the
;; common parts end and return what's left
- (do* ((p (rest path-dir) (rest p))
- (d (rest def-dir) (rest d)))
+ (do* ((p (rest path-directory) (rest p))
+ (d (rest def-directory) (rest d)))
((or (endp p) (endp d)
(not (equal (first p) (first d))))
`(:relative ,@p))))
(t
;; At least one path is :RELATIVE, so just return the
;; original path. If the original path is :RELATIVE,
- ;; then that's the right one. If PATH-DIR is
+ ;; then that's the right one. If PATH-DIRECTORY is
;; :ABSOLUTE, we want to return that except when
- ;; DEF-DIR is :ABSOLUTE, as handled above. so return
+ ;; DEF-DIRECTORY is :ABSOLUTE, as handled above. so return
;; the original directory.
- path-dir))))
+ path-directory))))
(make-pathname :host (pathname-host pathname)
- :directory enough-dir
+ :directory enough-directory
:name (pathname-name pathname)
:type (pathname-type pathname)
:version (pathname-version pathname))))