Changeset 9818


Ignore:
Timestamp:
Jun 21, 2008, 10:00:18 PM (11 years ago)
Author:
gb
Message:

Some support for pathname devices (e.g., drive letters) for Windows.
In current scheme, #\: is overloaded, both to separate a host from
the rest of the namestring in a logical pathname and to separate
the device from the rest of the namestring in a physical pathname,
so there's ambiguity there:

"x:foo" is a legal Windows namestring (the file foo in the current
directory on device x"), but is probably still parsed as a reference
to the non-extant logical host x.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/win64/level-1/l1-pathnames.lisp

    r9276 r9818  
    320320   unspecified elements into a completed to-pathname based on the to-wildname."
    321321  (when (not (pathnamep source)) (setq source (pathname source)))
    322   (flet ((foo-error (source from)
    323            (error "Source ~S and from-wildname ~S do not match" source from)))
    324     (let (r-host r-device r-directory r-name r-type r-version s-host f-host t-host)
     322  (flet ((translate-pathname-component-mismatch (component-name source from)
     323           (error "~S components of source ~S and from-wildname ~S do not match" component-name source from)))
     324    (let (r-host  r-directory r-name r-type r-version s-host f-host t-host t-device)
    325325      (setq s-host (pathname-host source))
    326326      (setq f-host (pathname-host from-wildname))
    327327      (setq t-host (pathname-host to-wildname))
    328       (if (not (%host-component-match-p s-host f-host)) (foo-error source from-wildname))
     328      (setq t-device (pathname-device to-wildname))
     329      (if (not (%host-component-match-p s-host f-host)) (translate-pathname-component-mismatch 'pathname-host source from-wildname))
    329330      (setq r-host (translate-component s-host f-host t-host reversible))
    330331      (let ((s-dir (%std-directory-component (pathname-directory source) s-host))
     
    332333            (t-dir (%std-directory-component (pathname-directory to-wildname) t-host)))
    333334        (let ((match (%pathname-match-directory s-dir f-dir)))
    334           (if (not match)(foo-error source from-wildname))
     335          (if (not match)(translate-pathname-component-mismatch 'pathname-directory source from-wildname))
    335336          (setq r-directory  (translate-directory s-dir f-dir t-dir reversible t-host))))
    336337      (let ((s-name (pathname-name source))
    337338            (f-name (pathname-name from-wildname))
    338339            (t-name (pathname-name to-wildname)))
    339         (if (not (%component-match-p s-name f-name))(foo-error source from-wildname))       
     340        (if (not (%component-match-p s-name f-name))(translate-pathname-component-mismatch 'pathname-name source from-wildname))       
    340341        (setq r-name (translate-component s-name f-name t-name reversible)))
    341342      (let ((s-type (pathname-type source))
    342343            (f-type (pathname-type from-wildname))
    343344            (t-type (pathname-type to-wildname)))
    344         (if (not (%component-match-p s-type f-type))(foo-error source from-wildname))
     345        (if (not (%component-match-p s-type f-type))(translate-pathname-component-mismatch 'pathname-component source from-wildname))
    345346        (setq r-type (translate-component s-type f-type t-type reversible)))
    346347      (let ((s-version (pathname-version source))
    347348            (f-version (pathname-version from-wildname))
    348349            (t-version (pathname-version to-wildname)))
    349         (if (not (%component-match-p s-version f-version))(foo-error source from-wildname))
     350        (if (not (%component-match-p s-version f-version))(translate-pathname-component-mismatch 'pathname-version source from-wildname))
    350351        (setq r-version (translate-component s-version f-version t-version reversible))
    351352        ;(if (eq r-version :unspecific)(setq r-version nil))
    352353        )
    353       (make-pathname :device r-device :host r-host :directory r-directory
     354      (make-pathname :device t-device :host r-host :directory r-directory
    354355                     :name r-name :type r-type :version r-version :defaults nil)
    355356      )))
     
    397398    (and
    398399     (%host-component-match-p path-host wild-host)
    399      (%component-match-p (pathname-device pathname)(pathname-device wildname))
     400     ;(%component-match-p (pathname-device pathname)(pathname-device wildname))
    400401     (%pathname-match-directory
    401402      (%std-directory-component (pathname-directory pathname) path-host)
     
    403404     (%component-match-p (pathname-name pathname)(pathname-name wildname))
    404405     (%component-match-p (pathname-type pathname)(pathname-type wildname))
     406     #+nil
    405407     (%component-match-p (pathname-version pathname)(pathname-version wildname)))))
    406408
     
    663665          ((null host) (%cons-pathname (pathname-directory pathname)
    664666                                       (pathname-name pathname)
    665                                        (pathname-type pathname)))
     667                                       (pathname-type pathname)
     668                                       (pathname-version pathname)
     669                                       (pathname-device pathname)))
    666670          (t
    667671           (let ((rule (assoc pathname (logical-pathname-translations host)
Note: See TracChangeset for help on using the changeset viewer.