- (if (and (>= end (+ start 2))
- (alpha-char-p (char namestr start))
- (eql (char namestr (1+ start)) #\:))
- (values (string (char namestr start)) (+ start 2))
+ (if (>= end (+ start 2))
+ (let ((c0 (char namestr start))
+ (c1 (char namestr (1+ start))))
+ (cond ((and (eql c1 #\:) (alpha-char-p c0))
+ ;; "X:" style, saved as X
+ (values (string (char namestr start)) (+ start 2)))
+ ((and (member c0 '(#\/ #\\)) (eql c0 c1))
+ ;; "//UNC" style, saved as UNC
+ ;; FIXME: at unparsing time we tell these apart by length,
+ ;; which seems a bit lossy -- presumably one-letter UNC
+ ;; hosts can exist as well. That seems a less troublesome
+ ;; restriction than disallowing UNC hosts whose names match
+ ;; logical pathname hosts... Time will tell -- both LispWorks
+ ;; and ACL use the host component for UNC hosts, so maybe
+ ;; we will end up there as well.
+ (let ((p (or (position c0 namestr :start (+ start 3) :end end)
+ end)))
+ (values (subseq namestr (+ start 2) p) p)))
+ (t
+ (values nil start))))