[Linedit-cvs] CVS update: src/complete.lisp

[Nikodemus Siivola]

Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv30015

Modified Files:
	complete.lisp 
Log Message:

* Fix tilde-expansion for logical pathnames, which may be returned
  by (user-homedir-pathname). Reported and fix suggested by
  Peter Denno.

Date: Sat May  1 10:10:25 2004
Author: nsiivola

Index: src/complete.lisp
diff -u src/complete.lisp:1.11 src/complete.lisp:1.12
--- src/complete.lisp:1.11	Sun Apr 25 11:03:26 2004
+++ src/complete.lisp	Sat May  1 10:10:25 2004
@@ -87,14 +87,19 @@
 to the appropriate home directory."
   (if (and (> (length string) 0)
 	   (eql (schar string 0) #\~))
-      (flet ((chop (s) (subseq s 0 (1- (length s)))))
-	(let* ((slash-idx (loop for i below (length string)
-				when (eql (schar string i) #\/) return i))
-	       (suffix (and slash-idx (subseq string slash-idx)))
-	       (uname (subseq string 1 slash-idx))
+      (flet ((chop (s) 
+	       (subseq s 0 (1- (length s)))))
+	(let* ((slash-index (loop for i below (length string)
+				  when (eql (schar string i) #\/) 
+				  return i))
+	       (suffix (and slash-index (subseq string slash-index)))
+	       (uname (subseq string 1 slash-index))
 	       (homedir (or (cdr (assoc :home (user-info uname)))
-			    (chop (namestring (user-homedir-pathname))))))
-	(concatenate 'string homedir (or suffix ""))))
+			    (chop (namestring 
+				   (or (probe-file (user-homedir-pathname))
+				       (return-from tilde-expand-string 
+					 string)))))))
+	  (concatenate 'string homedir (or suffix ""))))
       string))
 
 (defun directory-complete (string)