Changeset 6638

Timestamp:

May 31, 2007, 5:43:37 PM (17 years ago)

Author:

Gary Byers

Message:

Do ~-expansion in more places. Hopefully caught most places.

File:

• trunk/ccl/level-1/l1-files.lisp (modified) (3 diffs)

trunk/ccl/level-1/l1-files.lisp

@@ -432 +432 @@
   (require-type reference-host '(or null string))
   (multiple-value-bind (sstr start end) (get-sstring string start end)
+    (if (and (> end start)
+             (eql (schar sstr start) #\~))
+      (setq sstr (tilde-expand (subseq sstr start end))
+            start 0
+            end (length sstr)))
     (let (directory name type host version (start-pos start) (end-pos end) has-slashes)
       (multiple-value-setq (host start-pos has-slashes) (pathname-host-sstr sstr start-pos end-pos))
@@ -689 +694 @@
                   (string
                    (multiple-value-bind (sstr start end) (get-sstring path)
+                     (if (and (> end start)
+                              (eql (schar sstr start) #\~))
+                       (setq sstr (tilde-expand (subseq sstr start end))
+                             start 0
+                             end (length sstr)))
                      (multiple-value-bind (host pos2) (pathname-host-sstr sstr start end)
                        (unless (eq host :unspecific) (setq logical-p t))
@@ -701 +711 @@
 ;; Must match pathname-directory-end below
 (defun pathname-directory-sstr (sstr start end host)
+  (if (and (eq host :unspecific)
+           (> end start)
+           (eql (schar sstr start) #\~))
+    (setq sstr (tilde-expand (subseq sstr start end))
+          start 0
+          end (length sstr)))
   (let ((pos (%path-mem-last (if (eq host :unspecific) "/" ";") sstr start end)))
     (if pos