summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--changes33
-rw-r--r--generic/tkInitScript.h10
-rw-r--r--library/tkfbox.tcl224
-rw-r--r--library/xmfbox.tcl70
4 files changed, 188 insertions, 149 deletions
diff --git a/changes b/changes
index f390f00..e3b41b7 100644
--- a/changes
+++ b/changes
@@ -4128,6 +4128,39 @@ Apple Universal Headers V. 3.0 so we can compile with CW Pro 2.0 (JI)
----------------- Released 8.0p2, 11/25/97 -----------------------
+11/25/97 (security bug fix + added feature) Tk Safe Init now asks
+the master's safe::TkInit for the 'argv' to use. This is transparently
+dealt with by the safe::loadTk API. New optional "-display displayName"
+argument to safe::loadTk, and the "-use" argument accepts both window
+Ids and Tk window names: see loadTk(n). Made the ":0.0" default display
+work on the Mac as it works on Windows and Unix. (DL)
+
+12/3/97 (bug fix/optimization) Removed unneeded and potentially dangerous
+instances of double evaluations if "if" and "expr" statements from
+the library files. It is recommended that unless you need a double
+evaluation you always use "expr {...}" instead of "expr ..." and
+"if {...} ..." instead of "if ... ...". It will also be faster
+thanks to the byte compiler. (DL)
+
+12/3/97 (new feature) Added support for browser/plugin style embedding,
+and made various other fixes to get the plugin working on the Mac. (JI)
+
+12/8/97 (bug fix) on Windows, using "winfo pathname" before "." was mapped
+was crashing. (DL)
+
+---- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ----
+
+12/97 (bug fix) more Macintosh embeding fixes needed for the plugin. (JI)
+
+Jan/9/98 (improvement) Allow applications to have custom init script
+without having to patch the Tk core: Tk_Init will use an existing
+"tkInit" proc if one exists in the interp where one tries to install Tk
+instead of defining it's own (tkInit is the transient proc defined in
+generic/tkInitScript.h that searches and sources tk.tcl and defines
+the 'correct' tk_library). (DL)
+
+---- Shipped as part of the plugin2.0 as 8.0p2Plugin2, Jan 15th 98 ----
+
6/3/98 (bug fix) Fixed bugs in the tk_getOpenFile under Unix.
1) If the -initialdir option was "." the result would be "././foo.tcl"
instead of an absolute path, like the Windows interface.
diff --git a/generic/tkInitScript.h b/generic/tkInitScript.h
index f46503a..c7ac6fe 100644
--- a/generic/tkInitScript.h
+++ b/generic/tkInitScript.h
@@ -22,10 +22,15 @@
* initialization.
* When called from a safe interpreter, it does not use file exists.
* we don't use pwd either because of safe interpreters.
+ *
+ * We leave the door open to the application by using an existing
+ * tkInit proc which if it exists is responsible for finding and sourcing
+ * tk.tcl themselves. With that, an application that wish to ignore
+ * the env(TK_LIBRARY) or have special initialization need can do it.
*/
-static char initScript[] =
-"proc tkInit {} {\n\
+static char initScript[] = "if {[info proc tkInit]==\"\"} {\n\
+ proc tkInit {} {\n\
global tk_library tk_version tk_patchLevel env errorInfo\n\
rename tkInit {}\n\
set errors \"\"\n\
@@ -71,6 +76,7 @@ static char initScript[] =
append msg \"$errors\n\n\"\n\
append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
error $msg\n\
+ }\n\
}\n\
tkInit";
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index 52a5fb8..74be14d 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -133,7 +133,7 @@ proc tkIconList_AutoScan {w} {
set x $tkPriv(x)
set y $tkPriv(y)
- if $data(noScroll) {
+ if {$data(noScroll)} {
return
}
if {$x >= [winfo width $data(canvas)]} {
@@ -188,8 +188,8 @@ proc tkIconList_Add {w image text} {
set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline ""]
set b [$data(canvas) bbox $iTag]
- set iW [expr [lindex $b 2]-[lindex $b 0]]
- set iH [expr [lindex $b 3]-[lindex $b 1]]
+ set iW [expr {[lindex $b 2]-[lindex $b 0]}]
+ set iH [expr {[lindex $b 3]-[lindex $b 1]}]
if {$data(maxIW) < $iW} {
set data(maxIW) $iW
}
@@ -198,8 +198,8 @@ proc tkIconList_Add {w image text} {
}
set b [$data(canvas) bbox $tTag]
- set tW [expr [lindex $b 2]-[lindex $b 0]]
- set tH [expr [lindex $b 3]-[lindex $b 1]]
+ set tW [expr {[lindex $b 2]-[lindex $b 0]}]
+ set tH [expr {[lindex $b 3]-[lindex $b 1]}]
if {$data(maxTW) < $tW} {
set data(maxTW) $tW
}
@@ -218,7 +218,7 @@ proc tkIconList_Add {w image text} {
proc tkIconList_Arrange {w} {
upvar #0 $w data
- if ![info exists data(list)] {
+ if {![info exists data(list)]} {
if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
set data(noScroll) 1
$data(sbar) config -command ""
@@ -228,26 +228,26 @@ proc tkIconList_Arrange {w} {
set W [winfo width $data(canvas)]
set H [winfo height $data(canvas)]
- set pad [expr [$data(canvas) cget -highlightthickness] + \
- [$data(canvas) cget -bd]]
+ set pad [expr {[$data(canvas) cget -highlightthickness] + \
+ [$data(canvas) cget -bd]}]
if {$pad < 2} {
set pad 2
}
- incr W -[expr $pad*2]
- incr H -[expr $pad*2]
+ incr W -[expr {$pad*2}]
+ incr H -[expr {$pad*2}]
- set dx [expr $data(maxIW) + $data(maxTW) + 8]
+ set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
if {$data(maxTH) > $data(maxIH)} {
set dy $data(maxTH)
} else {
set dy $data(maxIH)
}
incr dy 2
- set shift [expr $data(maxIW) + 4]
+ set shift [expr {$data(maxIW) + 4}]
- set x [expr $pad * 2]
- set y [expr $pad * 1]
+ set x [expr {$pad * 2}]
+ set y [expr {$pad * 1}] ; # Why * 1 ?
set usedColumn 0
foreach sublist $data(list) {
set usedColumn 1
@@ -259,24 +259,24 @@ proc tkIconList_Arrange {w} {
set tW [lindex $sublist 5]
set tH [lindex $sublist 6]
- set i_dy [expr ($dy - $iH)/2]
- set t_dy [expr ($dy - $tH)/2]
+ set i_dy [expr {($dy - $iH)/2}]
+ set t_dy [expr {($dy - $tH)/2}]
- $data(canvas) coords $iTag $x [expr $y + $i_dy]
- $data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
- $data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
- $data(canvas) coords $rTag $x $y [expr $x+$dx] [expr $y+$dy]
+ $data(canvas) coords $iTag $x [expr {$y + $i_dy}]
+ $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
+ $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
+ $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
incr y $dy
- if {[expr $y + $dy] > $H} {
- set y [expr $pad * 1]
+ if {($y + $dy) > $H} {
+ set y [expr {$pad * 1}] ; # *1 ?
incr x $dx
set usedColumn 0
}
}
if {$usedColumn} {
- set sW [expr $x + $dx]
+ set sW [expr {$x + $dx}]
} else {
set sW $x
}
@@ -292,7 +292,7 @@ proc tkIconList_Arrange {w} {
set data(noScroll) 0
}
- set data(itemsPerColumn) [expr ($H-$pad)/$dy]
+ set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
if {$data(itemsPerColumn) < 1} {
set data(itemsPerColumn) 1
}
@@ -321,47 +321,47 @@ proc tkIconList_See {w rTag} {
upvar #0 $w data
upvar #0 $w:itemList itemList
- if $data(noScroll) {
+ if {$data(noScroll)} {
return
}
set sRegion [$data(canvas) cget -scrollregion]
- if ![string compare $sRegion {}] {
+ if {![string compare $sRegion {}]} {
return
}
- if ![info exists itemList($rTag)] {
+ if {![info exists itemList($rTag)]} {
return
}
set bbox [$data(canvas) bbox $rTag]
- set pad [expr [$data(canvas) cget -highlightthickness] + \
- [$data(canvas) cget -bd]]
+ set pad [expr {[$data(canvas) cget -highlightthickness] + \
+ [$data(canvas) cget -bd]}]
set x1 [lindex $bbox 0]
set x2 [lindex $bbox 2]
- incr x1 -[expr $pad * 2]
- incr x2 -[expr $pad * 1]
+ incr x1 -[expr {$pad * 2}]
+ incr x2 -[expr {$pad * 1}] ; # *1 ?
- set cW [expr [winfo width $data(canvas)] - $pad*2]
+ set cW [expr {[winfo width $data(canvas)] - $pad*2}]
- set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]
- set dispX [expr int([lindex [$data(canvas) xview] 0]*$scrollW)]
+ set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
+ set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
set oldDispX $dispX
# check if out of the right edge
#
- if {[expr $x2 - $dispX] >= $cW} {
- set dispX [expr $x2 - $cW]
+ if {($x2 - $dispX) >= $cW} {
+ set dispX [expr {$x2 - $cW}]
}
# check if out of the left edge
#
- if {[expr $x1 - $dispX] < 0} {
+ if {($x1 - $dispX) < 0} {
set dispX $x1
}
if {$oldDispX != $dispX} {
- set fraction [expr double($dispX)/double($scrollW)]
+ set fraction [expr {double($dispX)/double($scrollW)}]
$data(canvas) xview moveto $fraction
}
}
@@ -377,7 +377,7 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
upvar #0 $w data
upvar #0 $w:itemList itemList
- if ![info exists itemList($rTag)] {
+ if {![info exists itemList($rTag)]} {
return
}
set iTag [lindex $itemList($rTag) 0]
@@ -385,7 +385,7 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
set text [lindex $itemList($rTag) 2]
set serial [lindex $itemList($rTag) 3]
- if ![info exists data(rect)] {
+ if {![info exists data(rect)]} {
set data(rect) [$data(canvas) create rect 0 0 0 0 \
-fill #a0a0ff -outline #a0a0ff]
}
@@ -397,7 +397,7 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
set data(selected) $text
if {$callBrowse} {
- if [string compare $data(-browsecmd) ""] {
+ if {[string compare $data(-browsecmd) ""]} {
eval $data(-browsecmd) [list $text]
}
}
@@ -406,11 +406,11 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
proc tkIconList_Unselect {w} {
upvar #0 $w data
- if [info exists data(rect)] {
+ if {[info exists data(rect)]} {
$data(canvas) delete $data(rect)
unset data(rect)
}
- if [info exists data(selected)] {
+ if {[info exists data(selected)]} {
unset data(selected)
}
set data(curItem) {}
@@ -421,7 +421,7 @@ proc tkIconList_Unselect {w} {
proc tkIconList_Get {w} {
upvar #0 $w data
- if [info exists data(selected)] {
+ if {[info exists data(selected)]} {
return $data(selected)
} else {
return ""
@@ -469,7 +469,7 @@ proc tkIconList_Leave1 {w x y} {
proc tkIconList_FocusIn {w} {
upvar #0 $w data
- if ![info exists data(list)] {
+ if {![info exists data(list)]} {
return
}
@@ -490,7 +490,7 @@ proc tkIconList_FocusIn {w} {
proc tkIconList_UpDown {w amount} {
upvar #0 $w data
- if ![info exists data(list)] {
+ if {![info exists data(list)]} {
return
}
@@ -498,13 +498,13 @@ proc tkIconList_UpDown {w amount} {
set rTag [lindex [lindex $data(list) 0] 2]
} else {
set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
- set rTag [lindex [lindex $data(list) [expr $data(curItem)+$amount]] 2]
- if ![string compare $rTag ""] {
+ set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
+ if {![string compare $rTag ""]} {
set rTag $oldRTag
}
}
- if [string compare $rTag ""] {
+ if {[string compare $rTag ""]} {
tkIconList_Select $w $rTag
tkIconList_See $w $rTag
}
@@ -521,21 +521,21 @@ proc tkIconList_UpDown {w amount} {
proc tkIconList_LeftRight {w amount} {
upvar #0 $w data
- if ![info exists data(list)] {
+ if {![info exists data(list)]} {
return
}
if {$data(curItem) == {}} {
set rTag [lindex [lindex $data(list) 0] 2]
} else {
set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
- set newItem [expr $data(curItem)+($amount*$data(itemsPerColumn))]
+ set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
set rTag [lindex [lindex $data(list) $newItem] 2]
- if ![string compare $rTag ""] {
+ if {![string compare $rTag ""]} {
set rTag $oldRTag
}
}
- if [string compare $rTag ""] {
+ if {[string compare $rTag ""]} {
tkIconList_Select $w $rTag
tkIconList_See $w $rTag
}
@@ -565,7 +565,7 @@ proc tkIconList_Goto {w text} {
upvar #0 $w:textList textList
global tkPriv
- if ![info exists data(list)] {
+ if {![info exists data(list)]} {
return
}
@@ -583,7 +583,7 @@ proc tkIconList_Goto {w text} {
set theIndex -1
set less 0
set len [string length $text]
- set len0 [expr $len-1]
+ set len0 [expr {$len-1}]
set i $start
# Search forward until we find a filename whose prefix is an exact match
@@ -632,7 +632,8 @@ proc tkFDialog {args} {
global tkPriv
set w __tk_filedialog
upvar #0 $w data
- if ![string compare [lindex [info level 0] 0] tk_getOpenFile] {
+
+ if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
set type open
} else {
set type save
@@ -694,10 +695,10 @@ proc tkFDialog {args} {
wm withdraw $w
update idletasks
- set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]]
- set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]]
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
wm deiconify $w
wm title $w $data(-title)
@@ -759,7 +760,7 @@ proc tkFDialog_Config {w type argList} {
# 2: default values depending on the type of the dialog
#
- if ![info exists data(selectPath)] {
+ if {![info exists data(selectPath)]} {
# first time the dialog has been popped up
set data(selectPath) [pwd]
set data(selectFile) ""
@@ -769,8 +770,8 @@ proc tkFDialog_Config {w type argList} {
#
tclParseConfigSpec $w $specs "" $argList
- if ![string compare $data(-title) ""] {
- if ![string compare $type "open"] {
+ if {![string compare $data(-title) ""]} {
+ if {![string compare $type "open"]} {
set data(-title) "Open"
} else {
set data(-title) "Save As"
@@ -780,9 +781,9 @@ proc tkFDialog_Config {w type argList} {
# 4: set the default directory and selection according to the -initial
# settings
#
- if [string compare $data(-initialdir) ""] {
+ if {[string compare $data(-initialdir) ""]} {
- if [file isdirectory $data(-initialdir)] {
+ if {[file isdirectory $data(-initialdir)]} {
set data(selectPath) [glob $data(-initialdir)]
} else {
set data(selectPath) [pwd]
@@ -801,7 +802,7 @@ proc tkFDialog_Config {w type argList} {
#
set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
- if ![winfo exists $data(-parent)] {
+ if {![winfo exists $data(-parent)]} {
error "bad window path name \"$data(-parent)\""
}
}
@@ -820,7 +821,7 @@ proc tkFDialog_Create {w} {
set data(dirMenuBtn) $f1.menu
set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
set data(upBtn) [button $f1.up]
- if ![info exists tkPriv(updirImage)] {
+ if {![info exists tkPriv(updirImage)]} {
set tkPriv(updirImage) [image create bitmap -data {
#define updir_width 28
#define updir_height 16
@@ -947,7 +948,7 @@ static char updir_bits[] = {
proc tkFDialog_UpdateWhenIdle {w} {
upvar #0 [winfo name $w] data
- if [info exists data(updateId)] {
+ if {[info exists data(updateId)]} {
return
} else {
set data(updateId) [after idle tkFDialog_Update $w]
@@ -974,7 +975,7 @@ proc tkFDialog_Update {w} {
catch {unset data(updateId)}
set TRANSPARENT_GIF_COLOR [$w cget -bg]
- if ![info exists tkPriv(folderImage)] {
+ if {![info exists tkPriv(folderImage)]} {
set tkPriv(folderImage) [image create photo -data {
R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
@@ -986,9 +987,9 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
set file $tkPriv(fileImage)
set appPWD [pwd]
- if [catch {
+ if {[catch {
cd $data(selectPath)
- }] {
+ }]} {
# We cannot change directory to $data(selectPath). $data(selectPath)
# should have been checked before tkFDialog_Update is called, so
# we normally won't come to here. Anyways, give an error and abort
@@ -1014,14 +1015,14 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
# Make the dir list
#
foreach f [lsort -dictionary [glob -nocomplain .* *]] {
- if ![string compare $f .] {
+ if {![string compare $f .]} {
continue
}
- if ![string compare $f ..] {
+ if {![string compare $f ..]} {
continue
}
- if [file isdir ./$f] {
- if ![info exists hasDoneDir($f)] {
+ if {[file isdir ./$f]} {
+ if {![info exists hasDoneDir($f)]} {
tkIconList_Add $data(icons) $folder $f
set hasDoneDir($f) 1
}
@@ -1029,7 +1030,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
# Make the file list
#
- if ![string compare $data(filter) *] {
+ if {![string compare $data(filter) *]} {
set files [lsort -dictionary \
[glob -nocomplain .* *]]
} else {
@@ -1039,8 +1040,8 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
set top 0
foreach f $files {
- if ![file isdir ./$f] {
- if ![info exists hasDoneFile($f)] {
+ if {![file isdir ./$f]} {
+ if {![info exists hasDoneFile($f)]} {
tkIconList_Add $data(icons) $file $f
set hasDoneFile($f) 1
}
@@ -1152,24 +1153,21 @@ proc tkFDialogResolveFile {context text defaultext} {
set path "$path$defaultext"
}
- if [catch {file exists $path}] {
- return [list ERROR $path ""]
- }
- if [catch {if [file exists $path] {}}] {
- # This "if" block can be safely removed if the following code returns
- # an error. It currently (7/22/97) doesn't
+ if {[catch {file exists $path}]} {
+ # This "if" block can be safely removed if the following code
+ # stop generating errors.
#
# file exists ~nonsuchuser
#
return [list ERROR $path ""]
}
- if [file exists $path] {
- if [file isdirectory $path] {
- if [catch {
+ if {[file exists $path]} {
+ if {[file isdirectory $path]} {
+ if {[catch {
cd $path
- }] {
+ }]} {
return [list CHDIR $path ""]
}
set directory [pwd]
@@ -1177,9 +1175,9 @@ proc tkFDialogResolveFile {context text defaultext} {
set flag OK
cd $appPWD
} else {
- if [catch {
+ if {[catch {
cd [file dirname $path]
- }] {
+ }]} {
return [list CHDIR [file dirname $path] ""]
}
set directory [pwd]
@@ -1189,15 +1187,15 @@ proc tkFDialogResolveFile {context text defaultext} {
}
} else {
set dirname [file dirname $path]
- if [file exists $dirname] {
- if [catch {
+ if {[file exists $dirname]} {
+ if {[catch {
cd $dirname
- }] {
+ }]} {
return [list CHDIR $dirname ""]
}
set directory [pwd]
set file [file tail $path]
- if [regexp {[*]|[?]} $file] {
+ if {[regexp {[*]|[?]} $file]} {
set flag PATTERN
} else {
set flag FILE
@@ -1221,7 +1219,7 @@ proc tkFDialogResolveFile {context text defaultext} {
proc tkFDialog_EntFocusIn {w} {
upvar #0 [winfo name $w] data
- if [string compare [$data(ent) get] ""] {
+ if {[string compare [$data(ent) get] ""]} {
$data(ent) selection from 0
$data(ent) selection to end
$data(ent) icursor end
@@ -1231,7 +1229,7 @@ proc tkFDialog_EntFocusIn {w} {
tkIconList_Unselect $data(icons)
- if ![string compare $data(type) open] {
+ if {![string compare $data(type) open]} {
$data(okBtn) config -text "Open"
} else {
$data(okBtn) config -text "Save"
@@ -1259,7 +1257,7 @@ proc tkFDialog_ActivateEnt {w} {
case $flag {
OK {
- if ![string compare $file ""] {
+ if {![string compare $file ""]} {
# user has entered an existing (sub)directory
set data(selectPath) $path
$data(ent) delete 0 end
@@ -1274,7 +1272,7 @@ proc tkFDialog_ActivateEnt {w} {
set data(filter) $file
}
FILE {
- if ![string compare $data(type) open] {
+ if {![string compare $data(type) open]} {
tk_messageBox -icon warning -type ok -parent $data(-parent) \
-message "File \"[file join $path $file]\" does not exist."
$data(ent) select from 0
@@ -1317,7 +1315,7 @@ proc tkFDialog_ActivateEnt {w} {
proc tkFDialog_InvokeBtn {w key} {
upvar #0 [winfo name $w] data
- if ![string compare [$data(okBtn) cget -text] $key] {
+ if {![string compare [$data(okBtn) cget -text] $key]} {
tkButtonInvoke $data(okBtn)
}
}
@@ -1327,7 +1325,7 @@ proc tkFDialog_InvokeBtn {w key} {
proc tkFDialog_UpDirCmd {w} {
upvar #0 [winfo name $w] data
- if [string compare $data(selectPath) "/"] {
+ if {[string compare $data(selectPath) "/"]} {
set data(selectPath) [file dirname $data(selectPath)]
}
}
@@ -1351,9 +1349,9 @@ proc tkFDialog_OkCmd {w} {
upvar #0 [winfo name $w] data
set text [tkIconList_Get $data(icons)]
- if [string compare $text ""] {
+ if {[string compare $text ""]} {
set file [tkFDialog_JoinFile $data(selectPath) $text]
- if [file isdirectory $file] {
+ if {[file isdirectory $file]} {
tkFDialog_ListInvoke $w $text
return
}
@@ -1382,11 +1380,11 @@ proc tkFDialog_ListBrowse {w text} {
}
set file [tkFDialog_JoinFile $data(selectPath) $text]
- if ![file isdirectory $file] {
+ if {![file isdirectory $file]} {
$data(ent) delete 0 end
$data(ent) insert 0 $text
- if ![string compare $data(type) open] {
+ if {![string compare $data(type) open]} {
$data(okBtn) config -text "Open"
} else {
$data(okBtn) config -text "Save"
@@ -1408,9 +1406,9 @@ proc tkFDialog_ListInvoke {w text} {
set file [tkFDialog_JoinFile $data(selectPath) $text]
- if [file isdirectory $file] {
+ if {[file isdirectory $file]} {
set appPWD [pwd]
- if [catch {cd $file}] {
+ if {[catch {cd $file}]} {
tk_messageBox -type ok -parent $data(-parent) -message \
"Cannot change to the directory \"$file\".\nPermission denied."\
-icon warning
@@ -1436,7 +1434,7 @@ proc tkFDialog_Done {w {selectFilePath ""}} {
upvar #0 [winfo name $w] data
global tkPriv
- if ![string compare $selectFilePath ""] {
+ if {![string compare $selectFilePath ""]} {
set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
$data(selectFile)]
set tkPriv(selectFile) $data(selectFile)
@@ -1445,11 +1443,13 @@ proc tkFDialog_Done {w {selectFilePath ""}} {
if {[file exists $selectFilePath] &&
![string compare $data(type) save]} {
- set reply [tk_messageBox -icon warning -type yesno -parent $data(-parent) \
- -message "File \"$selectFilePath\" already exists.\nDo you want to overwrite it?"]
- if ![string compare $reply "no"] {
- return
- }
+ set reply [tk_messageBox -icon warning -type yesno\
+ -parent $data(-parent) -message "File\
+ \"$selectFilePath\" already exists.\nDo\
+ you want to overwrite it?"]
+ if {![string compare $reply "no"]} {
+ return
+ }
}
}
set tkPriv(selectFilePath) $selectFilePath
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 39ef16d..e4d4aee 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -30,7 +30,7 @@ proc tkMotifFDialog {args} {
set w __tk_filedialog
upvar #0 $w data
- if ![string compare [lindex [info level 0] 0] tk_getOpenFile] {
+ if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
set type open
} else {
set type save
@@ -70,10 +70,10 @@ proc tkMotifFDialog {args} {
wm withdraw $w
update idletasks
- set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]]
- set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]]
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
wm geom $w +$x+$y
wm deiconify $w
wm title $w $data(-title)
@@ -128,7 +128,7 @@ proc tkMotifFDialog_Config {w type argList} {
# 2: default values depending on the type of the dialog
#
- if ![info exists data(selectPath)] {
+ if {![info exists data(selectPath)]} {
# first time the dialog has been popped up
set data(selectPath) [pwd]
set data(selectFile) ""
@@ -138,8 +138,8 @@ proc tkMotifFDialog_Config {w type argList} {
#
tclParseConfigSpec $w $specs "" $argList
- if ![string compare $data(-title) ""] {
- if ![string compare $type "open"] {
+ if {![string compare $data(-title) ""]} {
+ if {![string compare $type "open"]} {
set data(-title) "Open"
} else {
set data(-title) "Save As"
@@ -149,8 +149,8 @@ proc tkMotifFDialog_Config {w type argList} {
# 4: set the default directory and selection according to the -initial
# settings
#
- if [string compare $data(-initialdir) ""] {
- if [file isdirectory $data(-initialdir)] {
+ if {[string compare $data(-initialdir) ""]} {
+ if {[file isdirectory $data(-initialdir)]} {
set data(selectPath) [glob $data(-initialdir)]
} else {
set data(selectPath) [pwd]
@@ -171,10 +171,10 @@ proc tkMotifFDialog_Config {w type argList} {
#
set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
- if ![info exists data(filter)] {
+ if {![info exists data(filter)]} {
set data(filter) *
}
- if ![winfo exists $data(-parent)] {
+ if {![winfo exists $data(-parent)]} {
error "bad window path name \"$data(-parent)\""
}
}
@@ -301,11 +301,11 @@ proc tkMotifFDialog_BrowseDList {w} {
upvar #0 [winfo name $w] data
focus $data(dList)
- if ![string compare [$data(dList) curselection] ""] {
+ if {![string compare [$data(dList) curselection] ""]} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
- if ![string compare $subdir ""] {
+ if {![string compare $subdir ""]} {
return
}
@@ -334,11 +334,11 @@ proc tkMotifFDialog_BrowseDList {w} {
proc tkMotifFDialog_ActivateDList {w} {
upvar #0 [winfo name $w] data
- if ![string compare [$data(dList) curselection] ""] {
+ if {![string compare [$data(dList) curselection] ""]} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
- if ![string compare $subdir ""] {
+ if {![string compare $subdir ""]} {
return
}
@@ -359,7 +359,7 @@ proc tkMotifFDialog_ActivateDList {w} {
set data(selectPath) $newDir
tkMotifFDialog_Update $w
- if [string compare $subdir ..] {
+ if {[string compare $subdir ..]} {
$data(dList) selection set 0
$data(dList) activate 0
} else {
@@ -372,11 +372,11 @@ proc tkMotifFDialog_BrowseFList {w} {
upvar #0 [winfo name $w] data
focus $data(fList)
- if ![string compare [$data(fList) curselection] ""] {
+ if {![string compare [$data(fList) curselection] ""]} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
- if ![string compare $data(selectFile) ""] {
+ if {![string compare $data(selectFile) ""]} {
return
}
@@ -394,11 +394,11 @@ proc tkMotifFDialog_BrowseFList {w} {
proc tkMotifFDialog_ActivateFList {w} {
upvar #0 [winfo name $w] data
- if ![string compare [$data(fList) curselection] ""] {
+ if {![string compare [$data(fList) curselection] ""]} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
- if ![string compare $data(selectFile) ""] {
+ if {![string compare $data(selectFile) ""]} {
return
} else {
tkMotifFDialog_ActivateSEnt $w
@@ -421,7 +421,7 @@ proc tkMotifFDialog_InterpFilter {w} {
set text [string trim [$data(fEnt) get]]
# Perform tilde substitution
#
- if ![string compare [string index $text 0] ~] {
+ if {![string compare [string index $text 0] ~]} {
set list [file split $text]
set tilde [lindex $list 0]
catch {
@@ -432,7 +432,7 @@ proc tkMotifFDialog_InterpFilter {w} {
set resolved [file join [file dirname $text] [file tail $text]]
- if [file isdirectory $resolved] {
+ if {[file isdirectory $resolved]} {
set dir $resolved
set fil $data(filter)
} else {
@@ -465,32 +465,32 @@ proc tkMotifFDialog_ActivateSEnt {w} {
return
}
- if [string compare [file pathtype $selectFilePath] "absolute"] {
+ if {[string compare [file pathtype $selectFilePath] "absolute"]} {
tk_messageBox -icon warning -type ok \
-message "\"$selectFilePath\" must be an absolute pathname"
return
}
- if ![file exists $selectPath] {
+ if {![file exists $selectPath]} {
tk_messageBox -icon warning -type ok \
-message "Directory \"$selectPath\" does not exist."
return
}
- if ![file exists $selectFilePath] {
- if ![string compare $data(type) open] {
+ if {![file exists $selectFilePath]} {
+ if {![string compare $data(type) open]} {
tk_messageBox -icon warning -type ok \
-message "File \"$selectFilePath\" does not exist."
return
}
} else {
- if ![string compare $data(type) save] {
+ if {![string compare $data(type) save]} {
set message [format %s%s \
"File \"$selectFilePath\" already exists.\n\n" \
"Replace existing file?"]
set answer [tk_messageBox -icon warning -type yesno \
-message $message]
- if ![string compare $answer "no"] {
+ if {![string compare $answer "no"]} {
return
}
}
@@ -549,9 +549,9 @@ proc tkMotifFDialog_LoadFiles {w} {
$data(fList) delete 0 end
set appPWD [pwd]
- if [catch {
+ if {[catch {
cd $data(selectPath)
- }] {
+ }]} {
cd $appPWD
$data(dList) insert end ".."
@@ -561,13 +561,13 @@ proc tkMotifFDialog_LoadFiles {w} {
# Make the dir list
#
foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
- if [file isdir $f] {
+ if {[file isdirectory $f]} {
$data(dList) insert end $f
}
}
# Make the file list
#
- if ![string compare $data(filter) *] {
+ if {![string compare $data(filter) *]} {
set files [lsort -command tclSortNoCase [glob -nocomplain .* *]]
} else {
set files [lsort -command tclSortNoCase \
@@ -576,9 +576,9 @@ proc tkMotifFDialog_LoadFiles {w} {
set top 0
foreach f $files {
- if ![file isdir $f] {
+ if {![file isdir $f]} {
$data(fList) insert end $f
- if [string match .* $f] {
+ if {[string match .* $f]} {
incr top
}
}
generated by cgit v0.12 at 2024-07-07 19:03:18 (GMT)