diff options
author | welch <welch> | 1998-06-27 18:06:37 (GMT) |
---|---|---|
committer | welch <welch> | 1998-06-27 18:06:37 (GMT) |
commit | adcb060b5ab8d310f5aff8a1119d3b97baf86641 (patch) | |
tree | 759f8786c82028afeb67bd971309b7b328d81d7f /library | |
parent | d010dca55fd7a02e3fe6e50910359d8d4915f003 (diff) | |
download | tk-adcb060b5ab8d310f5aff8a1119d3b97baf86641.zip tk-adcb060b5ab8d310f5aff8a1119d3b97baf86641.tar.gz tk-adcb060b5ab8d310f5aff8a1119d3b97baf86641.tar.bz2 |
plugin updates
Diffstat (limited to 'library')
-rw-r--r-- | library/clrpick.tcl | 88 | ||||
-rw-r--r-- | library/comdlg.tcl | 36 | ||||
-rw-r--r-- | library/console.tcl | 32 | ||||
-rw-r--r-- | library/dialog.tcl | 8 | ||||
-rw-r--r-- | library/entry.tcl | 64 | ||||
-rw-r--r-- | library/focus.tcl | 6 | ||||
-rw-r--r-- | library/listbox.tcl | 14 | ||||
-rw-r--r-- | library/menu.tcl | 68 | ||||
-rw-r--r-- | library/msgbox.tcl | 26 | ||||
-rw-r--r-- | library/optMenu.tcl | 2 | ||||
-rw-r--r-- | library/palette.tcl | 46 | ||||
-rw-r--r-- | library/safetk.tcl | 104 | ||||
-rw-r--r-- | library/scale.tcl | 20 | ||||
-rw-r--r-- | library/scrlbar.tcl | 34 | ||||
-rw-r--r-- | library/tclIndex | 3 | ||||
-rw-r--r-- | library/tearoff.tcl | 2 | ||||
-rw-r--r-- | library/text.tcl | 94 | ||||
-rw-r--r-- | library/tk.tcl | 6 |
18 files changed, 356 insertions, 297 deletions
diff --git a/library/clrpick.tcl b/library/clrpick.tcl index af5f980..a06b2e2 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -59,7 +59,7 @@ proc tkColorDialog {args} { tkColorDialog_Config $w $args tkColorDialog_InitValues $w - if ![winfo exists $w] { + if {![winfo exists $w]} { toplevel $w -class tkColorDialog tkColorDialog_BuildDialog $w } @@ -72,10 +72,10 @@ proc tkColorDialog {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) @@ -120,19 +120,19 @@ proc tkColorDialog_InitValues {w} { # IntensityIncr is the difference in color intensity between a colorbar # and its neighbors. - set data(intensityIncr) [expr 256 / $data(NUM_COLORBARS)] + set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}] # ColorbarWidth is the width of each colorbar set data(colorbarWidth) \ - [expr $data(BARS_WIDTH) / $data(NUM_COLORBARS)] + [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}] # Indent is the width of the space at the left and right side of the # colorbar. It is always half the selector polygon width, because the # polygon extends into the space. - set data(indent) [expr $data(PLGN_WIDTH) / 2] + set data(indent) [expr {$data(PLGN_WIDTH) / 2}] set data(colorPad) 2 - set data(selPad) [expr $data(PLGN_WIDTH) / 2] + set data(selPad) [expr {$data(PLGN_WIDTH) / 2}] # # minX is the x coordinate of the first colorbar @@ -142,13 +142,13 @@ proc tkColorDialog_InitValues {w} { # # maxX is the x coordinate of the last colorbar # - set data(maxX) [expr $data(BARS_WIDTH) + $data(indent)-1] + set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}] # # canvasWidth is the width of the entire canvas, including the indents # - set data(canvasWidth) [expr $data(BARS_WIDTH) + \ - $data(PLGN_WIDTH)] + set data(canvasWidth) [expr {$data(BARS_WIDTH) + \ + $data(PLGN_WIDTH)}] # Set the initial color, specified by -initialcolor, or the # color chosen by the user the last time. @@ -156,9 +156,9 @@ proc tkColorDialog_InitValues {w} { set data(finalColor) $data(-initialcolor) set rgb [winfo rgb . $data(selection)] - set data(red,intensity) [expr [lindex $rgb 0]/0x100] - set data(green,intensity) [expr [lindex $rgb 1]/0x100] - set data(blue,intensity) [expr [lindex $rgb 2]/0x100] + set data(red,intensity) [expr {[lindex $rgb 0]/0x100}] + set data(green,intensity) [expr {[lindex $rgb 1]/0x100}] + set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}] } # tkColorDialog_Config -- @@ -181,10 +181,10 @@ proc tkColorDialog_Config {w argList} { # tclParseConfigSpec $w $specs "" $argList - if ![string compare $data(-title) ""] { + if {![string compare $data(-title) ""]} { set data(-title) " " } - if ![string compare $data(-initialcolor) ""] { + if {![string compare $data(-initialcolor) ""]} { if {[info exists tkPriv(selectColor)] && \ [string compare $tkPriv(selectColor) ""]} { set data(-initialcolor) $tkPriv(selectColor) @@ -192,12 +192,12 @@ proc tkColorDialog_Config {w argList} { set data(-initialcolor) [. cget -background] } } else { - if [catch {winfo rgb . $data(-initialcolor)} err] { + if {[catch {winfo rgb . $data(-initialcolor)} err]} { error $err } } - if ![winfo exists $data(-parent)] { + if {![winfo exists $data(-parent)]} { error "bad window path name \"$data(-parent)\"" } } @@ -233,8 +233,8 @@ proc tkColorDialog_BuildDialog {w} { pack $box -side left -fill both set height [expr \ - [winfo reqheight $box.entry] - \ - 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])] + {[winfo reqheight $box.entry] - \ + 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}] canvas $f.color -height $height\ -width $data(BARS_WIDTH) -relief sunken -bd 2 @@ -341,7 +341,7 @@ proc tkColorDialog_SetRGBValue {w color} { proc tkColorDialog_XToRgb {w x} { upvar #0 $w data - return [expr ($x * $data(intensityIncr))/ $data(colorbarWidth)] + return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] } # tkColorDialog_RgbToX @@ -351,7 +351,7 @@ proc tkColorDialog_XToRgb {w x} { proc tkColorDialog_RgbToX {w color} { upvar #0 $w data - return [expr ($color * $data(colorbarWidth)/ $data(intensityIncr))] + return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}] } @@ -370,7 +370,7 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { set sel $data($c,sel) # First handle the case that we are creating everything for the first time. - if $create { + if {$create} { # First remove all the lines that already exist. if { $data(lines,$c,last) > $data(lines,$c,start)} { for {set i $data(lines,$c,start)} \ @@ -379,7 +379,7 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { } } # Delete the selector if it exists - if [info exists data($c,index)] { + if {[info exists data($c,index)]} { $sel delete $data($c,index) } @@ -418,10 +418,10 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { # Draw the color bars. set highlightW [expr \ - [$col cget -highlightthickness] + [$col cget -bd]] + {[$col cget -highlightthickness] + [$col cget -bd]}] for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} { - set intensity [expr $i * $data(intensityIncr)] - set startx [expr $i * $data(colorbarWidth) + $highlightW] + set intensity [expr {$i * $data(intensityIncr)}] + set startx [expr {$i * $data(colorbarWidth) + $highlightW}] if { $c == "red" } { set color [format "#%02x%02x%02x" \ $intensity \ @@ -439,10 +439,10 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { $intensity] } - if $create { + if {$create} { set index [$col create rect $startx $highlightW \ - [expr $startx +$data(colorbarWidth)] \ - [expr [winfo height $col] + $highlightW]\ + [expr {$startx +$data(colorbarWidth)}] \ + [expr {[winfo height $col] + $highlightW}]\ -fill $color -outline $color] } else { $col itemconf $l -fill $color -outline $color @@ -451,9 +451,9 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} { } $sel raise $data($c,index) - if $create { + if {$create} { set data(lines,$c,last) $index - set data(lines,$c,start) [expr $index - $data(NUM_COLORBARS) + 1 ] + set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}] } tkColorDialog_RedrawFinalColor $w @@ -539,7 +539,7 @@ proc tkColorDialog_RedrawColorBars {w colorChanged} { proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} { upvar #0 $w data - if !$dontMove { + if {!$dontMove} { tkColorDialog_MoveSelector $w $sel $color $x $delta } } @@ -561,11 +561,11 @@ proc tkColorDialog_MoveSelector {w sel color x delta} { if { $x < 0 } { set x 0 } elseif { $x >= $data(BARS_WIDTH)} { - set x [expr $data(BARS_WIDTH) - 1] + set x [expr {$data(BARS_WIDTH) - 1}] } - set diff [expr $x - $data($color,x)] + set diff [expr {$x - $data($color,x)}] $sel move $data($color,index) $diff 0 - set data($color,x) [expr $data($color,x) + $diff] + set data($color,x) [expr {$data($color,x) + $diff}] # Return the x value that it was actually set at return $x @@ -617,14 +617,14 @@ proc tkColorDialog_HandleSelEntry {w} { set text [string trim $data(selection)] # Check to make sure that the color is valid - if [catch {set color [winfo rgb . $text]} ] { + if {[catch {set color [winfo rgb . $text]} ]} { set data(selection) $data(finalColor) return } - set R [expr [lindex $color 0]/0x100] - set G [expr [lindex $color 1]/0x100] - set B [expr [lindex $color 2]/0x100] + set R [expr {[lindex $color 0]/0x100}] + set G [expr {[lindex $color 1]/0x100}] + set B [expr {[lindex $color 2]/0x100}] tkColorDialog_SetRGBValue $w "$R $G $B" set data(selection) $text @@ -638,9 +638,9 @@ proc tkColorDialog_HandleRGBEntry {w} { upvar #0 $w data foreach c {red green blue} { - if [catch { - set data($c,intensity) [expr int($data($c,intensity))] - }] { + if {[catch { + set data($c,intensity) [expr {int($data($c,intensity))}] + }]} { set data($c,intensity) 0 } diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 4f00217..30e4c81 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -52,9 +52,9 @@ proc tclParseConfigSpec {w specs flags argList} { set verproc($cmdsw) [lindex $spec 4] } - if {[expr [llength $argList] %2] != 0} { + if {([llength $argList]%2) != 0} { foreach {cmdsw value} $argList { - if ![info exists cmd($cmdsw)] { + if {![info exists cmd($cmdsw)]} { error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]" } } @@ -70,7 +70,7 @@ proc tclParseConfigSpec {w specs flags argList} { # 3: parse the argument list # foreach {cmdsw value} $argList { - if ![info exists cmd($cmdsw)] { + if {![info exists cmd($cmdsw)]} { error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]" } set data($cmdsw) $value @@ -137,10 +137,10 @@ proc tclVerifyInteger {string} { # proc tkFocusGroup_Create {t} { global tkPriv - if [string compare [winfo toplevel $t] $t] { + if {[string compare [winfo toplevel $t] $t]} { error "$t is not a toplevel window" } - if ![info exists tkPriv(fg,$t)] { + if {![info exists tkPriv(fg,$t)]} { set tkPriv(fg,$t) 1 set tkPriv(focus,$t) "" bind $t <FocusIn> "tkFocusGroup_In $t %W %d" @@ -156,7 +156,7 @@ proc tkFocusGroup_Create {t} { # proc tkFocusGroup_BindIn {t w cmd} { global tkFocusIn tkPriv - if ![info exists tkPriv(fg,$t)] { + if {![info exists tkPriv(fg,$t)]} { error "focus group \"$t\" doesn't exist" } set tkFocusIn($t,$w) $cmd @@ -171,7 +171,7 @@ proc tkFocusGroup_BindIn {t w cmd} { # proc tkFocusGroup_BindOut {t w cmd} { global tkFocusOut tkPriv - if ![info exists tkPriv(fg,$t)] { + if {![info exists tkPriv(fg,$t)]} { error "focus group \"$t\" doesn't exist" } set tkFocusOut($t,$w) $cmd @@ -185,7 +185,7 @@ proc tkFocusGroup_BindOut {t w cmd} { proc tkFocusGroup_Destroy {t w} { global tkPriv tkFocusIn tkFocusOut - if ![string compare $t $w] { + if {![string compare $t $w]} { unset tkPriv(fg,$t) unset tkPriv(focus,$t) @@ -196,8 +196,8 @@ proc tkFocusGroup_Destroy {t w} { unset tkFocusOut($name) } } else { - if [info exists tkPriv(focus,$t)] { - if ![string compare $tkPriv(focus,$t) $w] { + if {[info exists tkPriv(focus,$t)]} { + if {![string compare $tkPriv(focus,$t) $w]} { set tkPriv(focus,$t) "" } } @@ -218,14 +218,14 @@ proc tkFocusGroup_Destroy {t w} { proc tkFocusGroup_In {t w detail} { global tkPriv tkFocusIn - if ![info exists tkFocusIn($t,$w)] { + if {![info exists tkFocusIn($t,$w)]} { set tkFocusIn($t,$w) "" return } - if ![info exists tkPriv(focus,$t)] { + if {![info exists tkPriv(focus,$t)]} { return } - if ![string compare $tkPriv(focus,$t) $w] { + if {![string compare $tkPriv(focus,$t) $w]} { # This is already in focus # return @@ -250,10 +250,10 @@ proc tkFocusGroup_Out {t w detail} { # This is caused by mouse moving out of the window return } - if ![info exists tkPriv(focus,$t)] { + if {![info exists tkPriv(focus,$t)]} { return } - if ![info exists tkFocusOut($t,$w)] { + if {![info exists tkFocusOut($t,$w)]} { return } else { eval $tkFocusOut($t,$w) @@ -280,18 +280,18 @@ proc tkFDGetFileTypes {string} { set label [lindex $t 0] set exts {} - if [info exists hasDoneType($label)] { + if {[info exists hasDoneType($label)]} { continue } set name "$label (" set sep "" foreach ext $fileTypes($label) { - if ![string compare $ext ""] { + if {![string compare $ext ""]} { continue } regsub {^[.]} $ext "*." ext - if ![info exists hasGotExt($label,$ext)] { + if {![info exists hasGotExt($label,$ext)]} { append name $sep$ext lappend exts $ext set hasGotExt($label,$ext) 1 diff --git a/library/console.tcl b/library/console.tcl index d2c28b2..673d842 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -108,7 +108,7 @@ proc tkConsoleSource {} { -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}] if {"$filename" != ""} { set cmd [list source $filename] - if [catch {consoleinterp eval $cmd} result] { + if {[catch {consoleinterp eval $cmd} result]} { tkConsoleOutput stderr "$result\n" } } @@ -136,7 +136,7 @@ proc tkConsoleInvoke {args} { } if {$cmd == ""} { tkConsolePrompt - } elseif [info complete $cmd] { + } elseif {[info complete $cmd]} { .console mark set output end .console tag delete input set result [consoleinterp record $cmd] @@ -168,7 +168,7 @@ proc tkConsoleHistory {cmd} { prev { incr histNum -1 if {$histNum == 0} { - set cmd {history event [expr [history nextid] -1]} + set cmd {history event [expr {[history nextid] -1}]} } else { set cmd "history event $histNum" } @@ -182,7 +182,7 @@ proc tkConsoleHistory {cmd} { next { incr histNum if {$histNum == 0} { - set cmd {history event [expr [history nextid] -1]} + set cmd {history event [expr {[history nextid] -1}]} } elseif {$histNum > 0} { set cmd "" set histNum 1 @@ -213,7 +213,7 @@ proc tkConsolePrompt {{partial normal}} { if {$partial == "normal"} { set temp [.console index "end - 1 char"] .console mark set output end - if [consoleinterp eval "info exists tcl_prompt1"] { + if {[consoleinterp eval "info exists tcl_prompt1"]} { consoleinterp eval "eval \[set tcl_prompt1\]" } else { puts -nonewline "% " @@ -221,7 +221,7 @@ proc tkConsolePrompt {{partial normal}} { } else { set temp [.console index output] .console mark set output end - if [consoleinterp eval "info exists tcl_prompt2"] { + if {[consoleinterp eval "info exists tcl_prompt2"]} { consoleinterp eval "eval \[set tcl_prompt2\]" } else { puts -nonewline "> " @@ -271,7 +271,7 @@ proc tkConsoleBind {win} { if {[%W tag nextrange sel 1.0 end] != ""} { %W tag remove sel sel.first promptEnd } else { - if [%W compare insert < promptEnd] { + if {[%W compare insert < promptEnd]} { break } } @@ -280,14 +280,14 @@ proc tkConsoleBind {win} { if {[%W tag nextrange sel 1.0 end] != ""} { %W tag remove sel sel.first promptEnd } else { - if [%W compare insert <= promptEnd] { + if {[%W compare insert <= promptEnd]} { break } } } foreach left {Control-a Home} { bind $win <$left> { - if [%W compare insert < promptEnd] { + if {[%W compare insert < promptEnd]} { tkTextSetCursor %W {insert linestart} } else { tkTextSetCursor %W promptEnd @@ -302,32 +302,32 @@ proc tkConsoleBind {win} { } } bind $win <Control-d> { - if [%W compare insert < promptEnd] { + if {[%W compare insert < promptEnd]} { break } } bind $win <Control-k> { - if [%W compare insert < promptEnd] { + if {[%W compare insert < promptEnd]} { %W mark set insert promptEnd } } bind $win <Control-t> { - if [%W compare insert < promptEnd] { + if {[%W compare insert < promptEnd]} { break } } bind $win <Meta-d> { - if [%W compare insert < promptEnd] { + if {[%W compare insert < promptEnd]} { break } } bind $win <Meta-BackSpace> { - if [%W compare insert <= promptEnd] { + if {[%W compare insert <= promptEnd]} { break } } bind $win <Control-h> { - if [%W compare insert <= promptEnd] { + if {[%W compare insert <= promptEnd]} { break } } @@ -353,7 +353,7 @@ proc tkConsoleBind {win} { } foreach left {Control-b Left} { bind $win <$left> { - if [%W compare insert == promptEnd] { + if {[%W compare insert == promptEnd]} { break } tkTextSetCursor %W insert-1c diff --git a/library/dialog.tcl b/library/dialog.tcl index a9fcfa5..8be30ea 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -126,10 +126,10 @@ proc tk_dialog {w title text bitmap default 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 diff --git a/library/entry.tcl b/library/entry.tcl index 4a0b764..3a86498 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -34,7 +34,7 @@ bind Entry <<Cut>> { if {![catch {set data [string range [%W get] [%W index sel.first]\ - [expr [%W index sel.last] - 1]]}]} { + [expr {[%W index sel.last] - 1}]]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data %W delete sel.first sel.last @@ -42,7 +42,7 @@ bind Entry <<Cut>> { } bind Entry <<Copy>> { if {![catch {set data [string range [%W get] [%W index sel.first]\ - [expr [%W index sel.last] - 1]]}]} { + [expr {[%W index sel.last] - 1}]]}]} { clipboard clear -displayof %W clipboard append -displayof %W $data } @@ -115,17 +115,17 @@ bind Entry <ButtonRelease-2> { } bind Entry <Left> { - tkEntrySetCursor %W [expr [%W index insert] - 1] + tkEntrySetCursor %W [expr {[%W index insert] - 1}] } bind Entry <Right> { - tkEntrySetCursor %W [expr [%W index insert] + 1] + tkEntrySetCursor %W [expr {[%W index insert] + 1}] } bind Entry <Shift-Left> { - tkEntryKeySelect %W [expr [%W index insert] - 1] + tkEntryKeySelect %W [expr {[%W index insert] - 1}] tkEntrySeeInsert %W } bind Entry <Shift-Right> { - tkEntryKeySelect %W [expr [%W index insert] + 1] + tkEntryKeySelect %W [expr {[%W index insert] + 1}] tkEntrySeeInsert %W } bind Entry <Control-Left> { @@ -158,7 +158,7 @@ bind Entry <Shift-End> { } bind Entry <Delete> { - if [%W selection present] { + if {[%W selection present]} { %W delete sel.first sel.last } else { %W delete insert @@ -213,67 +213,67 @@ bind Entry <Insert> { # Additional emacs-like bindings: bind Entry <Control-a> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkEntrySetCursor %W 0 } } bind Entry <Control-b> { - if !$tk_strictMotif { - tkEntrySetCursor %W [expr [%W index insert] - 1] + if {!$tk_strictMotif} { + tkEntrySetCursor %W [expr {[%W index insert] - 1}] } } bind Entry <Control-d> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete insert } } bind Entry <Control-e> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkEntrySetCursor %W end } } bind Entry <Control-f> { - if !$tk_strictMotif { - tkEntrySetCursor %W [expr [%W index insert] + 1] + if {!$tk_strictMotif} { + tkEntrySetCursor %W [expr {[%W index insert] + 1}] } } bind Entry <Control-h> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkEntryBackspace %W } } bind Entry <Control-k> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete insert end } } bind Entry <Control-t> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkEntryTranspose %W } } bind Entry <Meta-b> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkEntrySetCursor %W [tkEntryPreviousWord %W insert] } } bind Entry <Meta-d> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete insert [tkEntryNextWord %W insert] } } bind Entry <Meta-f> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkEntrySetCursor %W [tkEntryNextWord %W insert] } } bind Entry <Meta-BackSpace> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete [tkEntryPreviousWord %W insert] insert } } bind Entry <Meta-Delete> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete [tkEntryPreviousWord %W insert] insert } } @@ -281,7 +281,7 @@ bind Entry <Meta-Delete> { # A few additional bindings of my own. bind Entry <2> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W scan mark %x set tkPriv(x) %x set tkPriv(y) %y @@ -289,7 +289,7 @@ bind Entry <2> { } } bind Entry <B2-Motion> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { if {abs(%x-$tkPriv(x)) > 2} { set tkPriv(mouseMoved) 1 } @@ -356,7 +356,7 @@ proc tkEntryMouseSelect {w x} { } switch $tkPriv(selectMode) { char { - if $tkPriv(mouseMoved) { + if {$tkPriv(mouseMoved)} { if {$cur < $anchor} { $w selection range $cur $anchor } elseif {$cur > $anchor} { @@ -369,10 +369,10 @@ proc tkEntryMouseSelect {w x} { word { if {$cur < [$w index anchor]} { set before [tcl_wordBreakBefore [$w get] $cur] - set after [tcl_wordBreakAfter [$w get] [expr $anchor-1]] + set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]] } else { set before [tcl_wordBreakBefore [$w get] $anchor] - set after [tcl_wordBreakAfter [$w get] [expr $cur - 1]] + set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]] } if {$before < 0} { set before 0 @@ -440,7 +440,7 @@ proc tkEntryAutoScan {w} { # actually been moved to this position yet). proc tkEntryKeySelect {w new} { - if ![$w selection present] { + if {![$w selection present]} { $w selection from insert $w selection to $new } else { @@ -482,7 +482,7 @@ proc tkEntryInsert {w s} { # w - The entry window in which to backspace. proc tkEntryBackspace w { - if [$w selection present] { + if {[$w selection present]} { $w delete sel.first sel.last } else { set x [expr {[$w index insert] - 1}] @@ -491,7 +491,7 @@ proc tkEntryBackspace w { set range [$w xview] set left [lindex $range 0] set right [lindex $range 1] - $w xview moveto [expr $left - ($right - $left)/2.0] + $w xview moveto [expr {$left - ($right - $left)/2.0}] } } } @@ -547,11 +547,11 @@ proc tkEntryTranspose w { if {$i < [$w index end]} { incr i } - set first [expr $i-2] + set first [expr {$i-2}] if {$first < 0} { return } - set new [string index [$w get] [expr $i-1]][string index [$w get] $first] + set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first] $w delete $first $i $w insert insert $new tkEntrySeeInsert $w diff --git a/library/focus.tcl b/library/focus.tcl index bf0476d..b4ff997 100644 --- a/library/focus.tcl +++ b/library/focus.tcl @@ -167,9 +167,9 @@ proc tk_focusFollowsMouse {} { set script { if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear") || ("%d" == "NotifyInferior")} { - if [tkFocusOK %W] { - focus %W - } + if {[tkFocusOK %W]} { + focus %W + } } } if {$old != ""} { diff --git a/library/listbox.tcl b/library/listbox.tcl index 4e84b3a..ddaafa7 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -33,7 +33,7 @@ # makes that unnecessary. bind Listbox <1> { - if [winfo exists %W] { + if {[winfo exists %W]} { tkListboxBeginSelect %W [%W index @%x,%y] } } @@ -186,7 +186,7 @@ bind Listbox <B2-Motion> { proc tkListboxBeginSelect {w el} { global tkPriv if {[$w cget -selectmode] == "multiple"} { - if [$w selection includes $el] { + if {[$w selection includes $el]} { $w selection clear $el } else { $w selection set $el @@ -224,7 +224,7 @@ proc tkListboxMotion {w el} { } extended { set i $tkPriv(listboxPrev) - if [$w selection includes anchor] { + if {[$w selection includes anchor]} { $w selection clear $i $el $w selection set anchor $el } else { @@ -290,7 +290,7 @@ proc tkListboxBeginToggle {w el} { set tkPriv(listboxSelection) [$w curselection] set tkPriv(listboxPrev) $el $w selection anchor $el - if [$w selection includes $el] { + if {[$w selection includes $el]} { $w selection clear $el } else { $w selection set $el @@ -340,7 +340,7 @@ proc tkListboxAutoScan {w} { proc tkListboxUpDown {w amount} { global tkPriv - $w activate [expr [$w index active] + $amount] + $w activate [expr {[$w index active] + $amount}] $w see active switch [$w cget -selectmode] { browse { @@ -371,7 +371,7 @@ proc tkListboxExtendUpDown {w amount} { if {[$w cget -selectmode] != "extended"} { return } - $w activate [expr [$w index active] + $amount] + $w activate [expr {[$w index active] + $amount}] $w see active tkListboxMotion $w [$w index active] } @@ -392,7 +392,7 @@ proc tkListboxDataExtend {w el} { if {$mode == "extended"} { $w activate $el $w see $el - if [$w selection includes anchor] { + if {[$w selection includes anchor]} { tkListboxMotion $w $el } } elseif {$mode == "multiple"} { diff --git a/library/menu.tcl b/library/menu.tcl index 21b69d9..b0fa2cc 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -218,7 +218,7 @@ proc tkMbLeave w { global tkPriv set tkPriv(inMenubutton) {} - if ![winfo exists $w] { + if {![winfo exists $w]} { return } if {[$w cget -state] == "active"} { @@ -273,29 +273,29 @@ proc tkMbPost {w {x {}} {y {}}} { # the menu just below the menubutton, as for a pull-down. update idletasks - if [catch { + if {[catch { switch [$w cget -direction] { above { set x [winfo rootx $w] - set y [expr [winfo rooty $w] - [winfo reqheight $menu]] + set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}] $menu post $x $y } below { set x [winfo rootx $w] - set y [expr [winfo rooty $w] + [winfo height $w]] + set y [expr {[winfo rooty $w] + [winfo height $w]}] $menu post $x $y } left { - set x [expr [winfo rootx $w] - [winfo reqwidth $menu]] - set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2] + set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] + set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] set entry [tkMenuFindName $menu [$w cget -text]] - if [$w cget -indicatoron] { + if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { - incr y [expr -([$menu yposition $entry] \ - + [winfo reqheight $menu])/2] + incr y [expr {-([$menu yposition $entry] \ + + [winfo reqheight $menu])/2}] } else { - incr y [expr -([$menu yposition $entry] \ - + [$menu yposition [expr $entry+1]])/2] + incr y [expr {-([$menu yposition $entry] \ + + [$menu yposition [expr {$entry+1}]])/2}] } } $menu post $x $y @@ -305,16 +305,16 @@ proc tkMbPost {w {x {}} {y {}}} { } } right { - set x [expr [winfo rootx $w] + [winfo width $w]] - set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2] + set x [expr {[winfo rootx $w] + [winfo width $w]}] + set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] set entry [tkMenuFindName $menu [$w cget -text]] - if [$w cget -indicatoron] { + if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { - incr y [expr -([$menu yposition $entry] \ - + [winfo reqheight $menu])/2] + incr y [expr {-([$menu yposition $entry] \ + + [winfo reqheight $menu])/2}] } else { - incr y [expr -([$menu yposition $entry] \ - + [$menu yposition [expr $entry+1]])/2] + incr y [expr {-([$menu yposition $entry] \ + + [$menu yposition [expr {$entry+1}]])/2}] } } $menu post $x $y @@ -324,18 +324,18 @@ proc tkMbPost {w {x {}} {y {}}} { } } default { - if [$w cget -indicatoron] { + if {[$w cget -indicatoron]} { if {$y == ""} { - set x [expr [winfo rootx $w] + [winfo width $w]/2] - set y [expr [winfo rooty $w] + [winfo height $w]/2] + set x [expr {[winfo rootx $w] + [winfo width $w]/2}] + set y [expr {[winfo rooty $w] + [winfo height $w]/2}] } tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]] } else { - $menu post [winfo rootx $w] [expr [winfo rooty $w]+[winfo height $w]] + $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}] } } } - } msg] { + } msg]} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. @@ -781,7 +781,7 @@ proc tkMenuNextMenu {menu direction} { } set buttons [winfo children [winfo parent $w]] set length [llength $buttons] - set i [expr [lsearch -exact $buttons $w] + $count] + set i [expr {[lsearch -exact $buttons $w] + $count}] while 1 { while {$i < 0} { incr i $length @@ -820,13 +820,13 @@ proc tkMenuNextEntry {menu count} { if {[$menu index last] == "none"} { return } - set length [expr [$menu index last]+1] + set length [expr {[$menu index last]+1}] set quitAfter $length set active [$menu index active] if {$active == "none"} { set i 0 } else { - set i [expr $active + $count] + set i [expr {$active + $count}] } while 1 { if {$quitAfter <= 0} { @@ -1020,9 +1020,9 @@ proc tkTraverseWithinMenu {w char} { return } for {set i 0} {$i <= $last} {incr i} { - if [catch {set char2 [string index \ + if {[catch {set char2 [string index \ [$w entrycget $i -label] \ - [$w entrycget $i -underline]]}] { + [$w entrycget $i -underline]]}]} { continue } if {[string compare $char [string tolower $char2]] == 0} { @@ -1105,7 +1105,7 @@ proc tkMenuFindName {menu s} { return } for {set i 0} {$i <= $last} {incr i} { - if ![catch {$menu entrycget $i -label} label] { + if {![catch {$menu entrycget $i -label} label]} { if {$label == $s} { return $i } @@ -1131,13 +1131,13 @@ proc tkPostOverPoint {menu x y {entry {}}} { if {$entry != {}} { if {$entry == [$menu index last]} { - incr y [expr -([$menu yposition $entry] \ - + [winfo reqheight $menu])/2] + incr y [expr {-([$menu yposition $entry] \ + + [winfo reqheight $menu])/2}] } else { - incr y [expr -([$menu yposition $entry] \ - + [$menu yposition [expr $entry+1]])/2] + incr y [expr {-([$menu yposition $entry] \ + + [$menu yposition [expr {$entry+1}]])/2}] } - incr x [expr -[winfo reqwidth $menu]/2] + incr x [expr {-[winfo reqwidth $menu]/2}] } $menu post $x $y if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} { diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 07df82b..61fe65f 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -61,7 +61,7 @@ proc tkMessageBox {args} { } } - if ![winfo exists $data(-parent)] { + if {![winfo exists $data(-parent)]} { error "bad window path name \"$data(-parent)\"" } @@ -111,15 +111,15 @@ proc tkMessageBox {args} { } } - if [string compare $data(-default) ""] { + if {[string compare $data(-default) ""]} { set valid 0 foreach btn $buttons { - if ![string compare [lindex $btn 0] $data(-default)] { + if {![string compare [lindex $btn 0] $data(-default)]} { set valid 1 break } } - if !$valid { + if {!$valid} { error "invalid default button \"$data(-default)\"" } } @@ -127,7 +127,7 @@ proc tkMessageBox {args} { # 2. Set the dialog to be a child window of $parent # # - if [string compare $data(-parent) .] { + if {[string compare $data(-parent) .]} { set w $data(-parent).__tk__messagebox } else { set w .__tk__messagebox @@ -176,7 +176,7 @@ proc tkMessageBox {args} { foreach but $buttons { set name [lindex $but 0] set opts [lrange $but 1 end] - if ![string compare $opts {}] { + if {![string compare $opts {}]} { # Capitalize the first letter of $name set capName \ [string toupper \ @@ -186,7 +186,7 @@ proc tkMessageBox {args} { eval button $w.$name $opts -command [list "set tkPriv(button) $name"] - if ![string compare $name $data(-default)] { + if {![string compare $name $data(-default)]} { $w.$name configure -default active } pack $w.$name -in $w.bot -side left -expand 1 \ @@ -206,7 +206,7 @@ proc tkMessageBox {args} { # 6. Create a binding for <Return> on the dialog if there is a # default button. - if [string compare $data(-default) ""] { + if {[string compare $data(-default) ""]} { bind $w <Return> "tkButtonInvoke $w.$data(-default)" } @@ -216,10 +216,10 @@ proc tkMessageBox {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 @@ -231,7 +231,7 @@ proc tkMessageBox {args} { set grabStatus [grab status $oldGrab] } grab $w - if [string compare $data(-default) ""] { + if {[string compare $data(-default) ""]} { focus $w.$data(-default) } else { focus $w diff --git a/library/optMenu.tcl b/library/optMenu.tcl index 32ca096c..bf9768c 100644 --- a/library/optMenu.tcl +++ b/library/optMenu.tcl @@ -30,7 +30,7 @@ proc tk_optionMenu {w varName firstValue args} { upvar #0 $varName var - if ![info exists var] { + if {![info exists var]} { set var $firstValue } menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \ diff --git a/library/palette.tcl b/library/palette.tcl index 5d5318e..227a241 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -34,41 +34,41 @@ proc tk_setPalette {args} { } else { array set new $args } - if ![info exists new(background)] { + if {![info exists new(background)]} { error "must specify a background color" } - if ![info exists new(foreground)] { + if {![info exists new(foreground)]} { set new(foreground) black } set bg [winfo rgb . $new(background)] set fg [winfo rgb . $new(foreground)] - set darkerBg [format #%02x%02x%02x [expr (9*[lindex $bg 0])/2560] \ - [expr (9*[lindex $bg 1])/2560] [expr (9*[lindex $bg 2])/2560]] + set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \ + [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]] foreach i {activeForeground insertBackground selectForeground \ highlightColor} { - if ![info exists new($i)] { + if {![info exists new($i)]} { set new($i) $new(foreground) } } - if ![info exists new(disabledForeground)] { + if {![info exists new(disabledForeground)]} { set new(disabledForeground) [format #%02x%02x%02x \ - [expr (3*[lindex $bg 0] + [lindex $fg 0])/1024] \ - [expr (3*[lindex $bg 1] + [lindex $fg 1])/1024] \ - [expr (3*[lindex $bg 2] + [lindex $fg 2])/1024]] + [expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \ + [expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \ + [expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]] } - if ![info exists new(highlightBackground)] { + if {![info exists new(highlightBackground)]} { set new(highlightBackground) $new(background) } - if ![info exists new(activeBackground)] { + if {![info exists new(activeBackground)]} { # Pick a default active background that islighter than the # normal background. To do this, round each color component # up by 15% or 1/3 of the way to full white, whichever is # greater. foreach i {0 1 2} { - set light($i) [expr [lindex $bg $i]/256] - set inc1 [expr ($light($i)*15)/100] - set inc2 [expr (255-$light($i))/3] + set light($i) [expr {[lindex $bg $i]/256}] + set inc1 [expr {($light($i)*15)/100}] + set inc2 [expr {(255-$light($i))/3}] if {$inc1 > $inc2} { incr light($i) $inc1 } else { @@ -81,13 +81,13 @@ proc tk_setPalette {args} { set new(activeBackground) [format #%02x%02x%02x $light(0) \ $light(1) $light(2)] } - if ![info exists new(selectBackground)] { + if {![info exists new(selectBackground)]} { set new(selectBackground) $darkerBg } - if ![info exists new(troughColor)] { + if {![info exists new(troughColor)]} { set new(troughColor) $darkerBg } - if ![info exists new(selectColor)] { + if {![info exists new(selectColor)]} { set new(selectColor) #b03060 } @@ -188,18 +188,18 @@ proc tkRecolorTree {w colors} { proc tkDarken {color percent} { set l [winfo rgb . $color] - set red [expr [lindex $l 0]/256] - set green [expr [lindex $l 1]/256] - set blue [expr [lindex $l 2]/256] - set red [expr ($red*$percent)/100] + set red [expr {[lindex $l 0]/256}] + set green [expr {[lindex $l 1]/256}] + set blue [expr {[lindex $l 2]/256}] + set red [expr {($red*$percent)/100}] if {$red > 255} { set red 255 } - set green [expr ($green*$percent)/100] + set green [expr {($green*$percent)/100}] if {$green > 255} { set green 255 } - set blue [expr ($blue*$percent)/100] + set blue [expr {($blue*$percent)/100}] if {$blue > 255} { set blue 255 } diff --git a/library/safetk.tcl b/library/safetk.tcl index 1cabcd5..40482ec 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -13,16 +13,12 @@ # # -# Note: It is UNSAFE to let any untrusted code being executed +# Note: It is now ok to let untrusted code being executed # between the creation of the interp and the actual loading -# of Tk in that interp. -# You should "loadTk $slave" right after safe::tkInterpCreate -# Otherwise, if you are using an application with Tk -# and don't want safe slaves to have access to Tk, potentially -# in a malevolent way, you should use -# ::safe::interpCreate -nostatics -accesspath {directories...} -# where the directory list does NOT contain any Tk dynamically -# loadable library +# of Tk in that interp because the C side Tk_Init will +# now look up the master interp and ask its safe::TkInit +# for the actual parameters to use for it's initialization (if allowed), +# not relying on the slave state. # # We use opt (optional arguments parsing) @@ -35,20 +31,22 @@ namespace eval ::safe { # # tkInterpInit : prepare the slave interpreter for tk loading - # + # most of the real job is done by loadTk # returns the slave name (tkInterpInit does) # - proc ::safe::tkInterpInit {slave} { + proc ::safe::tkInterpInit {slave argv} { global env tk_library - if {[info exists env(DISPLAY)]} { - $slave eval [list set env(DISPLAY) $env(DISPLAY)]; - } + + # Clear Tk's access for that interp (path). + allowTk $slave $argv + # there seems to be an obscure case where the tk_library # variable value is changed to point to a sym link destination # dir instead of the sym link itself, and thus where the $tk_library # would then not be anymore one of the auto_path dir, so we use # the addToAccessPath which adds if it's not already in instead - # of the more conventional findInAccessPath + # of the more conventional findInAccessPath. + # Might be usefull for masters without Tk really loaded too. ::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]] return $slave; } @@ -67,23 +65,81 @@ proc ::safe::loadTk {} {} ::tcl::OptProc loadTk { {slave -interp "name of the slave interpreter"} {-use -windowId {} "window Id to use (new toplevel otherwise)"} + {-display -displayName {} "display name to use (current one otherwise)"} } { + set displayGiven [::tcl::OptProcArgGiven "-display"] + if {!$displayGiven} { + # Try to get the current display from "." + # (which might not exist if the master is tk-less) + if {[catch {set display [winfo screen .]}]} { + if {[info exists ::env(DISPLAY)]} { + set display $::env(DISPLAY) + } else { + Log $slave "no winfo screen . nor env(DISPLAY)" WARNING + set display ":0.0" + } + } + } if {![::tcl::OptProcArgGiven "-use"]} { # create a decorated toplevel - ::tcl::Lassign [tkTopLevel $slave] w use; + ::tcl::Lassign [tkTopLevel $slave $display] w use; # set our delete hook (slave arg is added by interpDelete) Set [DeleteHookName $slave] [list tkDelete {} $w]; + } else { + # Let's be nice and also accept tk window names instead of ids + if {[string match ".*" $use]} { + set windowName $use + set use [winfo id $windowName] + set nDisplay [winfo screen $windowName] + } else { + # Check for a better -display value + # (works only for multi screens on single host, but not + # cross hosts, for that a tk window name would be better + # but embeding is also usefull for non tk names) + if {![catch {winfo pathname $use} name]} { + set nDisplay [winfo screen $name] + } else { + # Can't have a better one + set nDisplay $display + } + } + if {[string compare $nDisplay $display]} { + if {$displayGiven} { + error "conflicting -display $display and -use\ + $use -> $nDisplay" + } else { + set display $nDisplay + } + } } - tkInterpInit $slave; - ::interp eval $slave [list set argv [list "-use" $use]]; - ::interp eval $slave [list set argc 2]; + + # Prepares the slave for tk with those parameters + + tkInterpInit $slave [list "-use" $use "-display" $display] + load {} Tk $slave - # Remove env(DISPLAY) if it's in there (if it has been set by - # tkInterpInit) - ::interp eval $slave {catch {unset env(DISPLAY)}} + return $slave } +proc ::safe::TkInit {interpPath} { + variable tkInit + if {[info exists tkInit($interpPath)]} { + set value $tkInit($interpPath) + Log $interpPath "TkInit called, returning \"$value\"" NOTICE + return $value + } else { + Log $interpPath "TkInit called for interp with clearance:\ + preventing Tk init" ERROR + error "not allowed" + } +} + +proc ::safe::allowTk {interpPath argv} { + variable tkInit + set tkInit($interpPath) $argv +} + proc ::safe::tkDelete {W window slave} { # we are going to be called for each widget... skip untill it's # top level @@ -99,11 +155,11 @@ proc ::safe::loadTk {} {} } } -proc ::safe::tkTopLevel {slave} { +proc ::safe::tkTopLevel {slave display} { variable tkSafeId; incr tkSafeId; set w ".safe$tkSafeId"; - if {[catch {toplevel $w -class SafeTk} msg]} { + if {[catch {toplevel $w -screen $display -class SafeTk} msg]} { return -code error "Unable to create toplevel for\ safe slave \"$slave\" ($msg)"; } diff --git a/library/scale.tcl b/library/scale.tcl index 8e96176..f6bb4d3 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -19,7 +19,7 @@ # Standard Motif bindings: bind Scale <Enter> { - if $tk_strictMotif { + if {$tk_strictMotif} { set tkPriv(activeBg) [%W cget -activebackground] %W config -activebackground [%W cget -background] } @@ -29,7 +29,7 @@ bind Scale <Motion> { tkScaleActivate %W %x %y } bind Scale <Leave> { - if $tk_strictMotif { + if {$tk_strictMotif} { %W config -activebackground $tkPriv(activeBg) } if {[%W cget -state] == "active"} { @@ -137,8 +137,8 @@ proc tkScaleButtonDown {w x y} { set tkPriv(dragging) 1 set tkPriv(initValue) [$w get] set coords [$w coords] - set tkPriv(deltaX) [expr $x - [lindex $coords 0]] - set tkPriv(deltaY) [expr $y - [lindex $coords 1]] + set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}] + set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}] $w configure -sliderrelief sunken } } @@ -155,11 +155,11 @@ proc tkScaleButtonDown {w x y} { proc tkScaleDrag {w x y} { global tkPriv - if !$tkPriv(dragging) { + if {!$tkPriv(dragging)} { return } - $w set [$w get [expr $x - $tkPriv(deltaX)] \ - [expr $y - $tkPriv(deltaY)]] + $w set [$w get [expr {$x - $tkPriv(deltaX)}] \ + [expr {$y - $tkPriv(deltaY)}]] } # tkScaleEndDrag -- @@ -197,7 +197,7 @@ proc tkScaleIncrement {w dir big repeat} { if {$big == "big"} { set inc [$w cget -bigincrement] if {$inc == 0} { - set inc [expr abs([$w cget -to] - [$w cget -from])/10.0] + set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}] } if {$inc < [$w cget -resolution]} { set inc [$w cget -resolution] @@ -206,9 +206,9 @@ proc tkScaleIncrement {w dir big repeat} { set inc [$w cget -resolution] } if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} { - set inc [expr -$inc] + set inc [expr {-$inc}] } - $w set [expr [$w get] + $inc] + $w set [expr {[$w get] + $inc}] if {$repeat == "again"} { set tkPriv(afterId) [after [$w cget -repeatinterval] \ diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index e2b04b7..6073e74 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -20,7 +20,7 @@ if {($tcl_platform(platform) != "windows") && ($tcl_platform(platform) != "macintosh")} { bind Scrollbar <Enter> { - if $tk_strictMotif { + if {$tk_strictMotif} { set tkPriv(activeBg) [%W cget -activebackground] %W config -activebackground [%W cget -background] } @@ -231,8 +231,8 @@ proc tkScrollStartDrag {w x y} { if {$iv0 == 0} { set tkPriv(initPos) 0.0 } else { - set tkPriv(initPos) [expr (double([lindex $tkPriv(initValues) 2])) \ - / [lindex $tkPriv(initValues) 0]] + set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \ + / [lindex $tkPriv(initValues) 0]}] } } } @@ -253,19 +253,19 @@ proc tkScrollDrag {w x y} { if {$tkPriv(initPos) == ""} { return } - set delta [$w delta [expr $x - $tkPriv(pressX)] [expr $y - $tkPriv(pressY)]] - if [$w cget -jump] { + set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]] + if {[$w cget -jump]} { if {[llength $tkPriv(initValues)] == 2} { - $w set [expr [lindex $tkPriv(initValues) 0] + $delta] \ - [expr [lindex $tkPriv(initValues) 1] + $delta] + $w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \ + [expr {[lindex $tkPriv(initValues) 1] + $delta}] } else { - set delta [expr round($delta * [lindex $tkPriv(initValues) 0])] + set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}] eval $w set [lreplace $tkPriv(initValues) 2 3 \ - [expr [lindex $tkPriv(initValues) 2] + $delta] \ - [expr [lindex $tkPriv(initValues) 3] + $delta]] + [expr {[lindex $tkPriv(initValues) 2] + $delta}] \ + [expr {[lindex $tkPriv(initValues) 3] + $delta}]] } } else { - tkScrollToPos $w [expr $tkPriv(initPos) + $delta] + tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}] } } @@ -283,10 +283,10 @@ proc tkScrollEndDrag {w x y} { if {$tkPriv(initPos) == ""} { return } - if [$w cget -jump] { - set delta [$w delta [expr $x - $tkPriv(pressX)] \ - [expr $y - $tkPriv(pressY)]] - tkScrollToPos $w [expr $tkPriv(initPos) + $delta] + if {[$w cget -jump]} { + set delta [$w delta [expr {$x - $tkPriv(pressX)}] \ + [expr {$y - $tkPriv(pressY)}]] + tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}] } set tkPriv(initPos) "" } @@ -375,9 +375,9 @@ proc tkScrollToPos {w pos} { proc tkScrollTopBottom {w x y} { global tkPriv set element [$w identify $x $y] - if [string match *1 $element] { + if {[string match *1 $element]} { tkScrollToPos $w 0 - } elseif [string match *2 $element] { + } elseif {[string match *2 $element]} { tkScrollToPos $w 1 } diff --git a/library/tclIndex b/library/tclIndex index e65708e..e2cf7f1 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -72,6 +72,7 @@ set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]] set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]] set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]] set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]] +set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]] set auto_index(tk_popup) [list source [file join $dir menu.tcl]] set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]] set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]] @@ -172,6 +173,8 @@ set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]] set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]] set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]] set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]] +set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]] +set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]] set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]] set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]] set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]] diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 7cbe8e7..91b4ff2 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -49,7 +49,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { } for {set i 1} 1 {incr i} { set menu $parent.tearoff$i - if ![winfo exists $menu] { + if {![winfo exists $menu]} { break } } diff --git a/library/text.tcl b/library/text.tcl index 891a9ed..9191a03 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -216,7 +216,7 @@ bind Text <Delete> { bind Text <BackSpace> { if {[%W tag nextrange sel 1.0 end] != ""} { %W delete sel.first sel.last - } elseif [%W compare insert != 1.0] { + } elseif {[%W compare insert != 1.0]} { %W delete insert-1c %W see insert } @@ -278,33 +278,33 @@ if {$tcl_platform(platform) == "macintosh"} { # Additional emacs-like bindings: bind Text <Control-a> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W {insert linestart} } } bind Text <Control-b> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W insert-1c } } bind Text <Control-d> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete insert } } bind Text <Control-e> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W {insert lineend} } } bind Text <Control-f> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W insert+1c } } bind Text <Control-k> { - if !$tk_strictMotif { - if [%W compare insert == {insert lineend}] { + if {!$tk_strictMotif} { + if {[%W compare insert == {insert lineend}]} { %W delete insert } else { %W delete insert {insert lineend} @@ -312,67 +312,67 @@ bind Text <Control-k> { } } bind Text <Control-n> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W [tkTextUpDownLine %W 1] } } bind Text <Control-o> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W insert insert \n %W mark set insert insert-1c } } bind Text <Control-p> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W [tkTextUpDownLine %W -1] } } bind Text <Control-t> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextTranspose %W } } if {$tcl_platform(platform) != "windows"} { bind Text <Control-v> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextScrollPages %W 1 } } } bind Text <Meta-b> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord] } } bind Text <Meta-d> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete insert [tkTextNextWord %W insert] } } bind Text <Meta-f> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W [tkTextNextWord %W insert] } } bind Text <Meta-less> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W 1.0 } } bind Text <Meta-greater> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { tkTextSetCursor %W end-1c } } bind Text <Meta-BackSpace> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert } } bind Text <Meta-Delete> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert } } @@ -420,15 +420,15 @@ bind Text <Shift-Option-Down> { # A few additional bindings of my own. bind Text <Control-h> { - if !$tk_strictMotif { - if [%W compare insert != 1.0] { + if {!$tk_strictMotif} { + if {[%W compare insert != 1.0]} { %W delete insert-1c %W see insert } } } bind Text <2> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { %W scan mark %x %y set tkPriv(x) %x set tkPriv(y) %y @@ -436,11 +436,11 @@ bind Text <2> { } } bind Text <B2-Motion> { - if !$tk_strictMotif { + if {!$tk_strictMotif} { if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} { set tkPriv(mouseMoved) 1 } - if $tkPriv(mouseMoved) { + if {$tkPriv(mouseMoved)} { %W scan dragto %x %y } } @@ -460,7 +460,7 @@ set tkPriv(prevPos) {} proc tkTextClosestGap {w x y} { set pos [$w index @$x,$y] set bbox [$w bbox $pos] - if ![string compare $bbox ""] { + if {![string compare $bbox ""]} { return $pos } if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { @@ -506,7 +506,7 @@ proc tkTextSelectTo {w x y} { global tkPriv tcl_platform set cur [tkTextClosestGap $w $x $y] - if [catch {$w index anchor}] { + if {[catch {$w index anchor}]} { $w mark set anchor $cur } set anchor [$w index anchor] @@ -515,7 +515,7 @@ proc tkTextSelectTo {w x y} { } switch $tkPriv(selectMode) { char { - if [$w compare $cur < anchor] { + if {[$w compare $cur < anchor]} { set first $cur set last anchor } else { @@ -524,7 +524,7 @@ proc tkTextSelectTo {w x y} { } } word { - if [$w compare $cur < anchor] { + if {[$w compare $cur < anchor]} { set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore] set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter] } else { @@ -533,7 +533,7 @@ proc tkTextSelectTo {w x y} { } } line { - if [$w compare $cur < anchor] { + if {[$w compare $cur < anchor]} { set first [$w index "$cur linestart"] set last [$w index "anchor - 1c lineend + 1c"] } else { @@ -568,11 +568,11 @@ proc tkTextKeyExtend {w index} { global tkPriv set cur [$w index $index] - if [catch {$w index anchor}] { + if {[catch {$w index anchor}]} { $w mark set anchor $cur } set anchor [$w index anchor] - if [$w compare $cur < anchor] { + if {[$w compare $cur < anchor]} { set first $cur set last anchor } else { @@ -640,7 +640,7 @@ proc tkTextAutoScan {w} { proc tkTextSetCursor {w pos} { global tkPriv - if [$w compare $pos == end] { + if {[$w compare $pos == end]} { set pos {end - 1 chars} } $w mark set insert $pos @@ -662,14 +662,14 @@ proc tkTextKeySelect {w new} { global tkPriv if {[$w tag nextrange sel 1.0 end] == ""} { - if [$w compare $new < insert] { + if {[$w compare $new < insert]} { $w tag add sel $new insert } else { $w tag add sel insert $new } $w mark set anchor insert } else { - if [$w compare $new < anchor] { + if {[$w compare $new < anchor]} { set first $new set last anchor } else { @@ -709,11 +709,11 @@ proc tkTextResetAnchor {w index} { set a [$w index $index] set b [$w index sel.first] set c [$w index sel.last] - if [$w compare $a < $b] { + if {[$w compare $a < $b]} { $w mark set anchor sel.last return } - if [$w compare $a > $c] { + if {[$w compare $a > $c]} { $w mark set anchor sel.first return } @@ -783,7 +783,7 @@ proc tkTextUpDownLine {w n} { if {[string compare $tkPriv(prevPos) $i] != 0} { set tkPriv(char) $char } - set new [$w index [expr $line + $n].$tkPriv(char)] + set new [$w index [expr {$line + $n}].$tkPriv(char)] if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} { set new $i } @@ -805,8 +805,8 @@ proc tkTextPrevPara {w pos} { while 1 { if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n")) || ($pos == "1.0")} { - if [regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ - dummy index] { + if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ + dummy index]} { set pos [$w index "$pos + [lindex $index 0] chars"] } if {[$w compare $pos != insert] || ($pos == "1.0")} { @@ -829,19 +829,19 @@ proc tkTextPrevPara {w pos} { proc tkTextNextPara {w start} { set pos [$w index "$start linestart + 1 line"] while {[$w get $pos] != "\n"} { - if [$w compare $pos == end] { + if {[$w compare $pos == end]} { return [$w index "end - 1c"] } set pos [$w index "$pos + 1 line"] } while {[$w get $pos] == "\n"} { set pos [$w index "$pos + 1 line"] - if [$w compare $pos == end] { + if {[$w compare $pos == end]} { return [$w index "end - 1c"] } } - if [regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ - dummy index] { + if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ + dummy index]} { return [$w index "$pos + [lindex $index 0] chars"] } return $pos @@ -863,7 +863,7 @@ proc tkTextScrollPages {w count} { set bbox [$w bbox insert] $w yview scroll $count pages if {$bbox == ""} { - return [$w index @[expr [winfo height $w]/2],0] + return [$w index @[expr {[winfo height $w]/2}],0] } return [$w index @[lindex $bbox 0],[lindex $bbox 1]] } @@ -880,11 +880,11 @@ proc tkTextScrollPages {w count} { proc tkTextTranspose w { set pos insert - if [$w compare $pos != "$pos lineend"] { + if {[$w compare $pos != "$pos lineend"]} { set pos [$w index "$pos + 1 char"] } set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"] - if [$w compare "$pos - 1 char" == 1.0] { + if {[$w compare "$pos - 1 char" == 1.0]} { return } $w delete "$pos - 2 char" $pos diff --git a/library/tk.tcl b/library/tk.tcl index 4ecbeaf..1f88efb 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -42,7 +42,7 @@ set tk_strictMotif 0 proc tkScreenChanged screen { set x [string last . $screen] if {$x > 0} { - set disp [string range $screen 0 [expr $x - 1]] + set disp [string range $screen 0 [expr {$x - 1}]] } else { set disp $screen } @@ -51,7 +51,7 @@ proc tkScreenChanged screen { global tkPriv global tcl_platform - if [info exists tkPriv] { + if {[info exists tkPriv]} { set tkPriv(screen) $screen return } @@ -101,7 +101,7 @@ tkScreenChanged [winfo screen .] proc tkEventMotifBindings {n1 dummy dummy} { upvar $n1 name - if $name { + if {$name} { set op delete } else { set op add |