From nsiivola at common-lisp.net Sat May 1 14:10:26 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 May 2004 10:10:26 -0400 Subject: [Linedit-cvs] CVS update: src/complete.lisp Message-ID: 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)