summaryrefslogtreecommitdiffstats
path: root/library/tkfbox.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-08-11 21:24:25 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-08-11 21:24:25 (GMT)
commit35a62312c2abb7fe1b09f1ccf4f04599f13bed0f (patch)
tree5bc1e4d8ab829d16aa4f1b3114e62eab33c662f2 /library/tkfbox.tcl
parent2755967cfd01a2ddb9efa3be42533a6dbaba86a6 (diff)
downloadtk-35a62312c2abb7fe1b09f1ccf4f04599f13bed0f.zip
tk-35a62312c2abb7fe1b09f1ccf4f04599f13bed0f.tar.gz
tk-35a62312c2abb7fe1b09f1ccf4f04599f13bed0f.tar.bz2
More fixing of [Bug 987169] and simple support for [FRQ 979101]
Diffstat (limited to 'library/tkfbox.tcl')
-rw-r--r--library/tkfbox.tcl27
1 files changed, 21 insertions, 6 deletions
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index fff9cb3..de4b618 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.44 2004/07/22 22:22:39 hobbs Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.45 2004/08/11 21:24:25 dkf Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -1384,11 +1384,14 @@ proc ::tk::dialog::file::SetFilter {w type} {
# (2) resolve all instances of . and ..
# (3) check for non-existent files/directories
# (4) check for chdir permissions
+# (5) conversion of environment variable references to their
+# contents (once only)
#
# Arguments:
# context: the current directory you are in
# text: the text entered by the user
# defaultext: the default extension to add to files with no extension
+# expandEnv: whether to expand environment variables (yes by default)
#
# Return vaue:
# [list $flag $directory $file]
@@ -1407,8 +1410,7 @@ proc ::tk::dialog::file::SetFilter {w type} {
# directory may not be the same as context, because text may contain
# a subdirectory name
#
-proc ::tk::dialog::file::ResolveFile {context text defaultext} {
-
+proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
set appPWD [pwd]
set path [::tk::dialog::file::JoinFile $context $text]
@@ -1420,7 +1422,6 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext} {
set path "$path$defaultext"
}
-
if {[catch {file exists $path}]} {
# This "if" block can be safely removed if the following code
# stop generating errors.
@@ -1455,17 +1456,31 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext} {
return [list CHDIR $dirname ""]
}
set directory [pwd]
+ cd $appPWD
set file [file tail $path]
- if {[regexp {[*]|[?]} $file]} {
+ # It's nothing else, so check to see if it is an env-reference
+ if {$expandEnv && [string match {$*} $file]} {
+ set var [string range $file 1 end]
+ if {[info exist ::env($var)]} {
+ return [ResolveFile $context $::env($var) $defaultext 0]
+ }
+ }
+ if {[regexp {[*?]} $file]} {
set flag PATTERN
} else {
set flag FILE
}
- cd $appPWD
} else {
set directory $dirname
set file [file tail $path]
set flag PATH
+ # It's nothing else, so check to see if it is an env-reference
+ if {$expandEnv && [string match {$*} $file]} {
+ set var [string range $file 1 end]
+ if {[info exist ::env($var)]} {
+ return [ResolveFile $context $::env($var) $defaultext 0]
+ }
+ }
}
}