From 18a9126e35c5951c3346db2071c52bae84b71767 Mon Sep 17 00:00:00 2001
From: Stelian Ionescu <sionescu@common-lisp.net>
Date: Wed, 21 Jan 2009 14:28:25 +0100
Subject: [PATCH] Add function EXPAND-USER-DIRECTORY.

---
 pathnames/file-path-unix.lisp | 20 ++++++++++++++++----
 pathnames/file-path.lisp      |  4 +++-
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/pathnames/file-path-unix.lisp b/pathnames/file-path-unix.lisp
index 9808cfb..0050389 100644
--- a/pathnames/file-path-unix.lisp
+++ b/pathnames/file-path-unix.lisp
@@ -89,7 +89,7 @@
                                  &key (start 0) end
                                  as-directory expand-user)
   (let* ((expansion (if expand-user
-                        (expand-userdir (subseq namestring start end))
+                        (%expand-user-directory (subseq namestring start end))
                         (subseq namestring start end)))
          (components (remove "." (split-directory-namestring expansion)
                              :test #'string=))
@@ -101,7 +101,7 @@
     (make-instance type :directory (cons directory-type dirname)
                    :name (if (string= "" basename) nil basename))))
 
-(defmethod expand-userdir ((dirname string))
+(defmethod %expand-user-directory ((pathspec string))
   (flet ((user-homedir (user)
            (nth-value 5 (nix:getpwnam user)))
          (uid-homedir (uid)
@@ -109,7 +109,7 @@
          (concat-homedir (dir rest)
            (join +directory-delimiter+ dir rest)))
     (destructuring-bind (first &optional rest)
-        (split-directory-namestring dirname 2)
+        (split-directory-namestring pathspec 2)
       (cond
         ((string= "~" first)
          (let ((homedir
@@ -127,7 +127,19 @@
                      first)))
            (return* (concat-homedir homedir rest))))
         (t
-         dirname)))))
+         pathspec)))))
+
+(defmethod expand-user-directory ((path unix-path))
+  (with-slots (directory)
+      path
+    (assert (and (consp directory)
+                 (eql :relative (first directory))
+                 (stringp (second directory))))
+    (let ((dirs (split-directory-namestring
+                 (%expand-user-directory (second directory)))))
+      (setf directory
+            (append (list :absolute) dirs (cddr directory)))))
+  (values path))
 
 
 ;;;-------------------------------------------------------------------------
diff --git a/pathnames/file-path.lisp b/pathnames/file-path.lisp
index a1afecf..e2d3cb7 100644
--- a/pathnames/file-path.lisp
+++ b/pathnames/file-path.lisp
@@ -89,11 +89,13 @@
 
 (defgeneric file-path (pathspec))
 
+(defgeneric expand-user-directory (path))
+
 ;;; Internal functions
 
 (defgeneric %file-path-directory-namestring (path &key trailing-delimiter))
 
-(defgeneric expand-userdir (dirname))
+(defgeneric %expand-user-directory (pathspec))
 
 
 ;;;-------------------------------------------------------------------------
-- 
2.11.4.GIT