From: Jeff Hobbs 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: https://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 + * 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] }