From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Wed, 23 Jan 2002 03:32:48 +0000 (+0000)
Subject: 	* tkcon.tcl (ExpandPathname): use a safer regsub to first unescape
X-Git-Tag: tkcon-2-4~32
X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=c33abe1d6c8a59b0d1d4fd00eeed9e31cb975178;p=tkcon

	* tkcon.tcl (ExpandPathname): use a safer regsub to first unescape
	the str, then to protect it in the glob.
	(dir): Use -directory arg in 8.3+ for better results.
---

diff --git a/ChangeLog b/ChangeLog
index 25aa6e4..305430c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2002-01-22  Jeff Hobbs  <jeffh@ActiveState.com>
 
+	* tkcon.tcl (ExpandPathname): use a safer regsub to first unescape
+	the str, then to protect it in the glob.
+	(dir): Use -directory arg in 8.3+ for better results.
+
 	* docs/idebug.html: added note about ? help at debug prompt.
 
 	* tkcon.tcl (dir): prevented possible 'divide by zero' error.
diff --git a/tkcon.tcl b/tkcon.tcl
index ab3dff9..9b014f4 100755
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -3736,17 +3736,37 @@ proc dir {args} {
     }
     set sep [string trim [file join . .] .]
     if {![llength $args]} { set args . }
-    foreach arg $args {
-	if {[file isdir $arg]} {
-	    set arg [string trimright $arg $sep]$sep
-	    if {$s(all)} {
-		lappend out [list $arg [lsort [glob -nocomplain -- $arg.* $arg*]]]
+    if {$::tcl_version >= 8.3} {
+	# Newer glob args allow safer dir processing.  The user may still
+	# want glob chars, but really only for file matching.
+	foreach arg $args {
+	    if {[file isdirectory $arg]} {
+		if {$s(all)} {
+		    lappend out [list $arg [lsort \
+			    [glob -nocomplain -directory $arg .* *]]]
+		} else {
+		    lappend out [list $arg [lsort \
+			    [glob -nocomplain -directory $arg *]]]
+		}
 	    } else {
-		lappend out [list $arg [lsort [glob -nocomplain -- $arg*]]]
+		set dir [file dirname $arg]
+		lappend out [list $dir$sep [lsort \
+			[glob -nocomplain -directory $dir [file tail $arg]]]]
+	    }
+	}
+    } else {
+	foreach arg $args {
+	    if {[file isdirectory $arg]} {
+		set arg [string trimright $arg $sep]$sep
+		if {$s(all)} {
+		    lappend out [list $arg [lsort [glob -nocomplain -- $arg.* $arg*]]]
+		} else {
+		    lappend out [list $arg [lsort [glob -nocomplain -- $arg*]]]
+		}
+	    } else {
+		lappend out [list [file dirname $arg]$sep \
+			[lsort [glob -nocomplain -- $arg]]]
 	    }
-	} else {
-	    lappend out [list [file dirname $arg]$sep \
-		    [lsort [glob -nocomplain -- $arg]]]
 	}
     }
     if {$s(long)} {
@@ -4700,7 +4720,7 @@ proc ::tkcon::Expand {w {type ""}} {
 proc ::tkcon::ExpandPathname str {
     set pwd [EvalAttached pwd]
     # Cause a string like {C:/Program\ Files/} to become "C:/Program Files/"
-    set str [subst $str]
+    regsub -all {\\([][ ])} $str {\1} str
     if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
 	return -code error $err
     }
@@ -4708,7 +4728,9 @@ proc ::tkcon::ExpandPathname str {
     ## Check to see if it was known to be a directory and keep the trailing
     ## slash if so (file tail cuts it off)
     if {[string match */ $str]} { append dir / }
-    if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
+    # Create a safely glob-able name
+    regsub -all {([][])} $dir {\\\1} safedir
+    if {[catch {lsort [EvalAttached [list glob $safedir*]]} m]} {
 	set match {}
     } else {
 	if {[llength $m] > 1} {
@@ -4727,16 +4749,16 @@ proc ::tkcon::ExpandPathname str {
 	    if {[string match */* $str]} {
 		set tmp [string trimright [file dirname $str] /]/$tmp
 	    }
-	    regsub -all {([^\\]) } $tmp {\1\\ } tmp
+	    regsub -all {([^\\])([][ ])} $tmp {\1\\\2} tmp
 	    set match [linsert $m 0 $tmp]
 	} else {
 	    ## This may look goofy, but it handles spaces in path names
 	    eval append match $m
-	    if {[file isdir $match]} {append match /}
+	    if {[file isdirectory $match]} {append match /}
 	    if {[string match */* $str]} {
 		set match [string trimright [file dirname $str] /]/$match
 	    }
-	    regsub -all {([^\\]) } $match {\1\\ } match
+	    regsub -all {([^\\])([][ ])} $match {\1\\\2} match
 	    ## Why is this one needed and the ones below aren't!!
 	    set match [list $match]
 	}