From a058a46a309a143a549befed911bec8212d12b16 Mon Sep 17 00:00:00 2001 From: welch Date: Sat, 27 Jun 1998 18:16:23 +0000 Subject: Merged changes between child workspace "/home/welch/ws/tk8.0.3" and parent workspace "/ws/tk8.0". --- changes | 33 ++++++++ generic/tkInitScript.h | 10 ++- library/tkfbox.tcl | 224 ++++++++++++++++++++++++------------------------- library/xmfbox.tcl | 70 ++++++++-------- 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 } } -- cgit v0.12