diff options
| -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 | ||||
| -rw-r--r-- | mac/tkMac.h | 37 | ||||
| -rw-r--r-- | mac/tkMacCursor.c | 34 | ||||
| -rw-r--r-- | mac/tkMacEmbed.c | 180 | ||||
| -rw-r--r-- | mac/tkMacInt.h | 18 | ||||
| -rw-r--r-- | mac/tkMacMenu.c | 37 | ||||
| -rw-r--r-- | mac/tkMacSubwindows.c | 114 | ||||
| -rw-r--r-- | mac/tkMacWindowMgr.c | 61 | ||||
| -rw-r--r-- | mac/tkMacWm.c | 34 | ||||
| -rw-r--r-- | mac/tkMacXStubs.c | 2 | ||||
| -rw-r--r-- | tests/safe.test | 47 | ||||
| -rw-r--r-- | win/tkWinWindow.c | 7 |
29 files changed, 802 insertions, 422 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 diff --git a/mac/tkMac.h b/mac/tkMac.h index ce41c81..e124903 100644 --- a/mac/tkMac.h +++ b/mac/tkMac.h @@ -15,6 +15,8 @@ #define _TKMAC #include <Windows.h> +#include <QDOffscreen.h> +#include "tkInt.h" /* * "export" is a MetroWerks specific pragma. It flags the linker that @@ -32,21 +34,46 @@ EXTERN QDGlobalsPtr tcl_macQdPtr; +/* + * Structures and function types for handling Netscape-type in process + * embedding where Tk does not control the top-level + */ +typedef int (Tk_MacEmbedRegisterWinProc) (int winID, Tk_Window window); +typedef GWorldPtr (Tk_MacEmbedGetGrafPortProc) (Tk_Window window); +typedef int (Tk_MacEmbedMakeContainerExistProc) (Tk_Window window); +typedef void (Tk_MacEmbedGetClipProc) (Tk_Window window, RgnHandle rgn); +typedef void (Tk_MacEmbedGetOffsetInParentProc) (Tk_Window window, Point *ulCorner); + /* - * The following functions are needed to create a shell, and so they must be exported - * from the Tk library. However, these are not the final form of these interfaces, so - * they are not currently supported as public interfaces. + * Mac Specific functions that are available to extension writers. */ + +EXTERN void Tk_MacSetEmbedHandler _ANSI_ARGS_(( + Tk_MacEmbedRegisterWinProc *registerWinProcPtr, + Tk_MacEmbedGetGrafPortProc *getPortProcPtr, + Tk_MacEmbedMakeContainerExistProc *containerExistProcPtr, + Tk_MacEmbedGetClipProc *getClipProc, + Tk_MacEmbedGetOffsetInParentProc *getOffsetProc)); + +EXTERN void Tk_MacTurnOffMenus _ANSI_ARGS_ (()); +EXTERN void Tk_MacTkOwnsCursor _ANSI_ARGS_ ((int tkOwnsIt)); + /* * These functions are currently in tkMacInt.h. They are just copied over here * so they can be exported. */ EXTERN void TkMacInitMenus _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN void TkMacInitAppleEvents _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN void TkMacInitAppleEvents _ANSI_ARGS_((Tcl_Interp *interp)); + +EXTERN int TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr)); +EXTERN int TkMacConvertTkEvent _ANSI_ARGS_((EventRecord *eventPtr, + Window window)); +EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin, + int x, int y, int width, int height, int flags)); +EXTERN void TkMacInvalClipRgns _ANSI_ARGS_((TkWindow *winPtr)); -EXTERN int TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr)); #pragma export reset diff --git a/mac/tkMacCursor.c b/mac/tkMacCursor.c index f221189..805dac3 100644 --- a/mac/tkMacCursor.c +++ b/mac/tkMacCursor.c @@ -64,9 +64,16 @@ static struct CursorName { static TkMacCursor * gCurrentCursor = NULL; /* A pointer to the current * cursor. */ -static int gResizeOverride = false; /* A boolean indicating wether +static int gResizeOverride = false; /* A boolean indicating whether * we should use the resize * cursor during installations. */ +static int gTkOwnsCursor = true; /* A boolean indicating whether + Tk owns the cursor. If not (for + instance, in the case where a Tk + window is embedded in another app's + window, and the cursor is out of + the tk window, we will not attempt + to adjust the cursor */ /* * Declarations of procedures local to this file @@ -348,6 +355,9 @@ void TkpSetCursor( TkpCursor cursor) { + if (!gTkOwnsCursor) { + return; + } if (cursor == None) { gCurrentCursor = NULL; } else { @@ -358,3 +368,25 @@ TkpSetCursor( TkMacInstallCursor(gResizeOverride); } } + +/* + *---------------------------------------------------------------------- + * + * Tk_MacTkOwnsCursor -- + * + * Sets whether Tk has the right to adjust the cursor. + * + * Results: + * None. + * + * Side effects: + * May keep Tk from changing the cursor. + * + *---------------------------------------------------------------------- + */ + +void Tk_MacTkOwnsCursor( + int tkOwnsIt) +{ + gTkOwnsCursor = tkOwnsIt; +} diff --git a/mac/tkMacEmbed.c b/mac/tkMacEmbed.c index 7a73b54..91f06d6 100644 --- a/mac/tkMacEmbed.c +++ b/mac/tkMacEmbed.c @@ -53,6 +53,11 @@ typedef struct Container { static Container *firstContainerPtr = NULL; /* First in list of all containers * managed by this process. */ +/* + * Globals defined in this file + */ + +TkMacEmbedHandler *gMacEmbedHandler = NULL; /* * Prototypes for static procedures defined in this file: @@ -74,9 +79,41 @@ static void EmbedStructureProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); static void EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr)); -/* WARNING - HACK */ -static void GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr, - TkWindow *destPtr)); + +/* + *---------------------------------------------------------------------- + * + * Tk_MacSetEmbedHandler -- + * + * Registers a handler for an in process form of embedding, like + * Netscape plugins, where Tk is loaded into the process, but does + * not control the main window + * + * Results: + * None + * + * Side effects: + * The embed handler is set. + * + *---------------------------------------------------------------------- + */ +void +Tk_MacSetEmbedHandler( + Tk_MacEmbedRegisterWinProc *registerWinProc, + Tk_MacEmbedGetGrafPortProc *getPortProc, + Tk_MacEmbedMakeContainerExistProc *containerExistProc, + Tk_MacEmbedGetClipProc *getClipProc, + Tk_MacEmbedGetOffsetInParentProc *getOffsetProc) +{ + if (gMacEmbedHandler == NULL) { + gMacEmbedHandler = (TkMacEmbedHandler *) ckalloc(sizeof(TkMacEmbedHandler)); + } + gMacEmbedHandler->registerWinProc = registerWinProc; + gMacEmbedHandler->getPortProc = getPortProc; + gMacEmbedHandler->containerExistProc = containerExistProc; + gMacEmbedHandler->getClipProc = getClipProc; + gMacEmbedHandler->getOffsetProc = getOffsetProc; +} /* @@ -240,18 +277,6 @@ TkpUseWindow( } } - /* - * We should not get to this code until we start to allow - * embedding in other applications. - */ - - if (containerPtr == NULL) { - Tcl_AppendResult(interp, "The window ID ", string, - " does not correspond to a valid Tk Window.", - (char *) NULL); - return TCL_ERROR; - } - /* * Make the embedded window. */ @@ -264,13 +289,27 @@ TkpUseWindow( macWin->winPtr = winPtr; winPtr->privatePtr = macWin; + + /* + * The portPtr will be NULL for a Tk in Tk embedded window. + * It is none of our business what it is for a Tk not in Tk embedded window, + * but we will initialize it to NULL, and let the registerWinProc + * set it. In any case, you must always use TkMacGetDrawablePort + * to get the portPtr. It will correctly find the container's port. + */ + + macWin->portPtr = (GWorldPtr) NULL; + macWin->clipRgn = NewRgn(); macWin->aboveClipRgn = NewRgn(); macWin->referenceCount = 0; macWin->flags = TK_CLIP_INVALID; - + macWin->toplevel = macWin; + macWin->toplevel->referenceCount++; + winPtr->flags |= TK_EMBEDDED; + /* * Make a copy of the TK_EMBEDDED flag, since sometimes * we need this to get the port after the TkWindow structure @@ -279,33 +318,67 @@ TkpUseWindow( macWin->flags |= TK_EMBEDDED; - /* - * The portPtr will be NULL for an embedded window. - * Always use TkMacGetDrawablePort to get the portPtr. - * It will correctly find the container's port. + /* + * Now check whether it is embedded in another Tk widget. If not (the first + * case below) we see if there is an in-process embedding handler registered, + * and if so, let that fill in the rest of the macWin. */ - - macWin->portPtr = (GWorldPtr) NULL; - - macWin->toplevel = macWin; - macWin->xOff = parent->winPtr->privatePtr->xOff + - parent->winPtr->changes.border_width + - winPtr->changes.x; - macWin->yOff = parent->winPtr->privatePtr->yOff + - parent->winPtr->changes.border_width + - winPtr->changes.y; - macWin->toplevel->referenceCount++; + if (containerPtr == NULL) { + /* + * If someone has registered an in process embedding handler, then + * see if it can handle this window... + */ + + if (gMacEmbedHandler == NULL || + gMacEmbedHandler->registerWinProc(result, (Tk_Window) winPtr) != TCL_OK) { + Tcl_AppendResult(interp, "The window ID ", string, + " does not correspond to a valid Tk Window.", + (char *) NULL); + return TCL_ERROR; + } else { + containerPtr = (Container *) ckalloc(sizeof(Container)); + + containerPtr->parentPtr = NULL; + containerPtr->embedded = (Window) macWin; + containerPtr->embeddedPtr = macWin->winPtr; + containerPtr->nextPtr = firstContainerPtr; + firstContainerPtr = containerPtr; + + } + } else { + + /* + * The window is embedded in another Tk window. + */ + + macWin->xOff = parent->winPtr->privatePtr->xOff + + parent->winPtr->changes.border_width + + winPtr->changes.x; + macWin->yOff = parent->winPtr->privatePtr->yOff + + parent->winPtr->changes.border_width + + winPtr->changes.y; - /* - * Finish filling up the container structure with the embedded window's - * information. - */ + + /* + * Finish filling up the container structure with the embedded window's + * information. + */ - containerPtr->embedded = (Window) macWin; - containerPtr->embeddedPtr = macWin->winPtr; + containerPtr->embedded = (Window) macWin; + containerPtr->embeddedPtr = macWin->winPtr; - /* + /* + * Create an event handler to clean up the Container structure when + * tkwin is eventually deleted. + */ + + Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc, + (ClientData) winPtr); + + } + + /* * TODO: need general solution for visibility events. */ @@ -318,15 +391,19 @@ TkpUseWindow( event.xvisibility.state = VisibilityUnobscured; Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); - /* - * Create an event handler to clean up the Container structure when - * tkwin is eventually deleted. + + /* + * TODO: need general solution for visibility events. */ - - Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc, - (ClientData) winPtr); - + event.xany.serial = Tk_Display(winPtr)->request; + event.xany.send_event = False; + event.xany.display = Tk_Display(winPtr); + + event.xvisibility.type = VisibilityNotify; + event.xvisibility.window = (Window) macWin;; + event.xvisibility.state = VisibilityUnobscured; + Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); return TCL_OK; } @@ -884,11 +961,10 @@ EmbedActivateProc(clientData, eventPtr) Container *containerPtr = (Container *) clientData; if (containerPtr->embeddedPtr != NULL) { - - if (eventPtr->type == ActivateNotify) { - TkGenerateActivateEvents(containerPtr->embeddedPtr, 1); + if (eventPtr->type == ActivateNotify) { + TkGenerateActivateEvents(containerPtr->embeddedPtr,1); } else if (eventPtr->type == DeactivateNotify) { - TkGenerateActivateEvents(containerPtr->embeddedPtr, 0); + TkGenerateActivateEvents(containerPtr->embeddedPtr,0); } } } @@ -923,14 +999,14 @@ EmbedFocusProc(clientData, eventPtr) XEvent event; if (containerPtr->embeddedPtr != NULL) { - display = Tk_Display(containerPtr->parentPtr); + display = Tk_Display(containerPtr->parentPtr); event.xfocus.serial = LastKnownRequestProcessed(display); event.xfocus.send_event = false; event.xfocus.display = display; event.xfocus.mode = NotifyNormal; event.xfocus.window = containerPtr->embedded; - if (eventPtr->type == FocusIn) { + if (eventPtr->type == FocusIn) { /* * The focus just arrived at the container. Change the X focus * to move it to the embedded application, if there is one. @@ -951,7 +1027,7 @@ EmbedFocusProc(clientData, eventPtr) } Tk_QueueWindowEvent(&event, TCL_QUEUE_MARK); - } + } } /* diff --git a/mac/tkMacInt.h b/mac/tkMacInt.h index fcb8174..d4a34f0 100644 --- a/mac/tkMacInt.h +++ b/mac/tkMacInt.h @@ -73,6 +73,24 @@ typedef struct TkMacWindowList { */ /* + * This structure is for handling Netscape-type in process + * embedding where Tk does not control the top-level. It contains + * various functions that are needed by Mac specific routines, like + * TkMacGetDrawablePort. The definitions of the function types + * are in tclMac.h. + */ + +typedef struct { + Tk_MacEmbedRegisterWinProc *registerWinProc; + Tk_MacEmbedGetGrafPortProc *getPortProc; + Tk_MacEmbedMakeContainerExistProc *containerExistProc; + Tk_MacEmbedGetClipProc *getClipProc; + Tk_MacEmbedGetOffsetInParentProc *getOffsetProc; +} TkMacEmbedHandler; + +extern TkMacEmbedHandler *gMacEmbedHandler; + +/* * Defines used for TkMacInvalidateWindow */ diff --git a/mac/tkMacMenu.c b/mac/tkMacMenu.c index 33bb82b..3d58597 100644 --- a/mac/tkMacMenu.c +++ b/mac/tkMacMenu.c @@ -139,6 +139,8 @@ typedef struct TopLevelMenubarList { #define MENUBAR_REDRAW_PENDING 1 +static int gNoTkMenus = 0; /* This is used by Tk_MacTurnOffMenus as the + * flag that Tk is not to draw any menus. */ RgnHandle tkMenuCascadeRgn = NULL; /* The region to clip drawing to when the * MDEF is up. */ @@ -1396,6 +1398,31 @@ TkpMenuNewEntry( *---------------------------------------------------------------------- * * + * Tk_MacTurnOffMenus -- + * + * Turns off all the menu drawing code. This is more than just disabling + * the "menu" command, this means that Tk will NEVER touch the menubar. + * It is needed in the Plugin, where Tk does not own the menubar. + * + * Results: + * None. + * + * Side effects: + * A flag is set which will disable all menu drawing. + * + *---------------------------------------------------------------------- + */ + +EXTERN void +Tk_MacTurnOffMenus() +{ + gNoTkMenus = 1; +} + +/* + *---------------------------------------------------------------------- + * + * * DrawMenuBarWhenIdle -- * * Update the menu bar next time there is an idle event. @@ -1419,6 +1446,14 @@ DrawMenuBarWhenIdle( Tcl_HashEntry *hashEntryPtr; /* + * If we have been turned off, exit. + */ + + if (gNoTkMenus) { + return; + } + + /* * We need to clear the apple and help menus of any extra items. */ @@ -3991,4 +4026,6 @@ TkpMenuInit(void) currentMenuBarInterp = NULL; currentMenuBarName = NULL; windowListPtr = NULL; + FixMDEF(); + } diff --git a/mac/tkMacSubwindows.c b/mac/tkMacSubwindows.c index 65c1a7e..63c5e09 100644 --- a/mac/tkMacSubwindows.c +++ b/mac/tkMacSubwindows.c @@ -288,67 +288,76 @@ XResizeWindow( display->request++; SetPort((GrafPtr) destPort); - if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) { - /* - * NOTE: we are not adding the new space to the update - * region. It is currently assumed that Tk will need - * to completely redraw anway. - */ - SizeWindow((WindowRef) destPort, - (short) width, (short) height, false); - TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY); - TkMacInvalClipRgns(macWin->winPtr); - } else { - /* TODO: update all xOff & yOffs */ - int deltaX, deltaY, parentBorderwidth; - MacDrawable *macParent = macWin->winPtr->parentPtr->privatePtr; - - /* - * Find the Parent window - - * For an embedded window this will be its container. - */ - - if (Tk_IsEmbedded(macWin->winPtr)) { + if (Tk_IsTopLevel(macWin->winPtr)) { + if (!Tk_IsEmbedded(macWin->winPtr)) { + /* + * NOTE: we are not adding the new space to the update + * region. It is currently assumed that Tk will need + * to completely redraw anway. + */ + SizeWindow((WindowRef) destPort, + (short) width, (short) height, false); + TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY); + TkMacInvalClipRgns(macWin->winPtr); + } else { + int deltaX, deltaY; + + /* + * Find the Parent window - + * For an embedded window this will be its container. + */ TkWindow *contWinPtr; contWinPtr = TkpGetOtherWindow(macWin->winPtr); - if (contWinPtr == NULL) { - panic("XMoveResizeWindow could not find container"); - } - macParent = contWinPtr->privatePtr; - /* - * NOTE: Here we should handle out of process embedding. - */ - - } else { - macParent = macWin->winPtr->parentPtr->privatePtr; - if (macParent == NULL) { - return; /* TODO: Probably should be a panic */ + if (contWinPtr != NULL) { + MacDrawable *macParent = contWinPtr->privatePtr; + + TkMacInvalClipRgns(macParent->winPtr); + TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW); + + deltaX = macParent->xOff + + macWin->winPtr->changes.x - macWin->xOff; + deltaY = macParent->yOff + + macWin->winPtr->changes.y - macWin->yOff; + + UpdateOffsets(macWin->winPtr, deltaX, deltaY); + } else { + /* + * This is the case where we are embedded in + * another app. At this point, we are assuming that + * the changes.x,y is not maintained, if you need + * the info get it from Tk_GetRootCoords, + * and that the toplevel sits at 0,0 when it is drawn. + */ + + TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW); + UpdateOffsets(macWin->winPtr, 0, 0); } + + } + } else { + /* TODO: update all xOff & yOffs */ + int deltaX, deltaY, parentBorderwidth; + MacDrawable *macParent = macWin->winPtr->parentPtr->privatePtr; + + if (macParent == NULL) { + return; /* TODO: Probably should be a panic */ } - TkMacInvalClipRgns(macParent->winPtr); + TkMacInvalClipRgns(macParent->winPtr); TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW); deltaX = - macWin->xOff; deltaY = - macWin->yOff; - /* - * If macWin->winPtr is an embedded window, don't offset by its - * parent's borderwidth... - */ - - if (!Tk_IsEmbedded(macWin->winPtr)) { - parentBorderwidth = macWin->winPtr->parentPtr->changes.border_width; - } else { - parentBorderwidth = 0; - } + parentBorderwidth = macWin->winPtr->parentPtr->changes.border_width; + deltaX += macParent->xOff + parentBorderwidth + macWin->winPtr->changes.x; deltaY += macParent->yOff + parentBorderwidth + macWin->winPtr->changes.y; - + UpdateOffsets(macWin->winPtr, deltaX, deltaY); } } @@ -744,6 +753,9 @@ TkMacUpdateClipRgn( TkMacUpdateClipRgn(contWinPtr); SectRgn(rgn, contWinPtr->privatePtr->aboveClipRgn, rgn); + } else if (gMacEmbedHandler != NULL) { + gMacEmbedHandler->getClipProc((Tk_Window) winPtr, tmpRgn); + SectRgn(rgn, tmpRgn, rgn); } /* @@ -883,6 +895,7 @@ TkMacGetDrawablePort( Drawable drawable) { MacDrawable *macWin = (MacDrawable *) drawable; + GWorldPtr resultPort = NULL; if (macWin == NULL) { return NULL; @@ -917,8 +930,13 @@ TkMacGetDrawablePort( contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr); if (contWinPtr != NULL) { - return TkMacGetDrawablePort((Drawable) contWinPtr->privatePtr); - } else { + resultPort = TkMacGetDrawablePort((Drawable) contWinPtr->privatePtr); + } else if (gMacEmbedHandler != NULL) { + resultPort = gMacEmbedHandler->getPortProc( + (Tk_Window) macWin->winPtr); + } + + if (resultPort == NULL) { panic("TkMacGetDrawablePort couldn't find container"); return NULL; } @@ -928,7 +946,7 @@ TkMacGetDrawablePort( */ } - + return resultPort; } /* diff --git a/mac/tkMacWindowMgr.c b/mac/tkMacWindowMgr.c index 7c8206c..6ffaa2e 100644 --- a/mac/tkMacWindowMgr.c +++ b/mac/tkMacWindowMgr.c @@ -69,7 +69,8 @@ static int GenerateUpdateEvent _ANSI_ARGS_((EventRecord *eventPtr, static void GenerateUpdates _ANSI_ARGS_((RgnHandle updateRgn, TkWindow *winPtr)); static int GeneratePollingEvents _ANSI_ARGS_((void)); -static int GeneratePollingEvents2 _ANSI_ARGS_((Window window)); +static int GeneratePollingEvents2 _ANSI_ARGS_((Window window, + int adjustCursor)); static OSErr TellWindowDefProcToCalcRegions _ANSI_ARGS_((WindowRef wRef)); static int WindowManagerMouse _ANSI_ARGS_((EventRecord *theEvent, Window window)); @@ -810,7 +811,7 @@ GeneratePollingEvents() } Tk_UpdatePointer(tkwin, whereGlobal.h, whereGlobal.v, TkMacButtonKeyState()); - + /* * Finally, we make sure the proper cursor is installed. The installation * is polled to 1) make our resize hack work, and 2) make sure we have the @@ -849,7 +850,8 @@ GeneratePollingEvents() static int GeneratePollingEvents2( - Window window) + Window window, + int adjustCursor) { Tk_Window tkwin, rootwin; WindowRef whichwindow, frontWin; @@ -889,6 +891,7 @@ GeneratePollingEvents2( } } + /* * The following call will generate the appropiate X events and * adjust any state that Tk must remember. @@ -899,15 +902,17 @@ GeneratePollingEvents2( } Tk_UpdatePointer(tkwin, whereGlobal.h, whereGlobal.v, TkMacButtonKeyState()); - + /* * Finally, we make sure the proper cursor is installed. The installation * is polled to 1) make our resize hack work, and 2) make sure we have the * proper cursor even if someone else changed the cursor out from under * us. */ - TkMacInstallCursor(0); - + + if (adjustCursor) { + TkMacInstallCursor(0); + } return true; } @@ -1214,7 +1219,7 @@ TkMacConvertEvent( * TkMacConvertTkEvent -- * * This function converts a Macintosh event into zero or more - * Tcl events. + * Tcl events. It is intended for use in Netscape-style embedding. * * Results: * Returns 1 if event added to Tcl queue, 0 otherwse. @@ -1233,14 +1238,34 @@ TkMacConvertTkEvent( int eventFound = false; Point where; + /* + * By default, assume it is legal for us to set the cursor + */ + + Tk_MacTkOwnsCursor(1); + switch (eventPtr->what) { case nullEvent: + /* + * We get NULL events only when the cursor is NOT over + * the plugin. Otherwise we get updateCursor events. + * We will not generate polling events or move the cursor + * in this case. + */ + + eventFound = false; + break; case adjustCursorEvent: - if (GeneratePollingEvents2(window)) { + if (GeneratePollingEvents2(window, 1)) { eventFound = true; } break; case updateEvt: + /* + * It is possibly not legal for us to set the cursor + */ + + Tk_MacTkOwnsCursor(0); if (GenerateUpdateEvent(eventPtr, window)) { eventFound = true; } @@ -1271,6 +1296,13 @@ TkMacConvertTkEvent( eventFound |= GenerateKeyEvent(eventPtr, window); break; case activateEvt: + /* + * It is probably not legal for us to set the cursor + * here, since we don't know where the mouse is in the + * window that is being activated. + */ + + Tk_MacTkOwnsCursor(0); eventFound |= GenerateActivateEvents(eventPtr, window); eventFound |= GenerateFocusEvent(eventPtr, window); break; @@ -1291,10 +1323,18 @@ TkMacConvertTkEvent( * Do clipboard conversion. */ switch ((eventPtr->message & osEvtMessageMask) >> 24) { + /* + * It is possibly not legal for us to set the cursor. + * Netscape sends us these events all the time... + */ + + Tk_MacTkOwnsCursor(0); + case mouseMovedMessage: - if (GeneratePollingEvents2(window)) { + /* if (GeneratePollingEvents2(window, 0)) { eventFound = true; - } + } NEXT LINE IS TEMPORARY */ + eventFound = false; break; case suspendResumeMessage: if (!(eventPtr->message & resumeFlag)) { @@ -1516,7 +1556,6 @@ TellWindowDefProcToCalcRegions( * Assuming there are no errors we now call the window definition * procedure to tell it to calculate the regions for the window. */ - if (err == noErr) { (void) CallWindowDefProc((UniversalProcPtr) *wdef, GetWVariant(wRef), wRef, wCalcRgns, 0); diff --git a/mac/tkMacWm.c b/mac/tkMacWm.c index 56c4b8a..a8959f3 100644 --- a/mac/tkMacWm.c +++ b/mac/tkMacWm.c @@ -19,6 +19,7 @@ #include <Windows.h> #include <ToolUtils.h> +#include <tclMac.h> #include "tkPort.h" #include "tkInt.h" #include "tkMacInt.h" @@ -532,7 +533,7 @@ TkWmMapWindow( */ XMapWindow(winPtr->display, winPtr->window); - + /* * Now that the window is visable we can determine the offset * from the window's content orgin to the window's decorative @@ -2333,12 +2334,26 @@ Tk_GetRootCoords( y += winPtr->changes.y + winPtr->changes.border_width; } else { + Point theOffset; - /* - * NOTE: Here we should handle - * out of process embedding. - */ - + if (gMacEmbedHandler->getOffsetProc != NULL) { + /* + * We do not require that the changes.x & changes.y for + * a non-Tk master window be kept up to date. So we + * first subtract off the possibly bogus values that have + * been added on at the top of this pass through the loop, + * and then call out to the getOffsetProc to give us + * the correct offset. + */ + + x -= winPtr->changes.x + winPtr->changes.border_width; + y -= winPtr->changes.y + winPtr->changes.border_width; + + gMacEmbedHandler->getOffsetProc((Tk_Window) winPtr, &theOffset); + + x += theOffset.h; + y += theOffset.v; + } break; } } @@ -3861,6 +3876,13 @@ TkMacMakeRealWindowExist( TkMacMakeRealWindowExist(contWinPtr->privatePtr->toplevel->winPtr); macWin->flags |= TK_HOST_EXISTS; return; + } else if (gMacEmbedHandler != NULL) { + if (gMacEmbedHandler->containerExistProc != NULL) { + if (gMacEmbedHandler->containerExistProc((Tk_Window) winPtr) != TCL_OK) { + panic("ContainerExistProc could not make container"); + } + } + return; } else { panic("TkMacMakeRealWindowExist could not find container"); } diff --git a/mac/tkMacXStubs.c b/mac/tkMacXStubs.c index f1042c2..a109353 100644 --- a/mac/tkMacXStubs.c +++ b/mac/tkMacXStubs.c @@ -46,7 +46,7 @@ */ static TkDisplay *gMacDisplay = NULL; /* Macintosh display. */ -static char *macScreenName = "Macintosh:0"; +static char *macScreenName = ":0"; /* Default name of macintosh display. */ /* diff --git a/tests/safe.test b/tests/safe.test index 65aed36..3eaf504 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -119,4 +119,51 @@ test safe-4.2 {testing loadTk -use} { destroy $w } {} +test safe-5.1 {loading Tk in safe interps without master's clearance} { + set i [safe::interpCreate] + catch {interp eval $i {load {} Tk}} msg + safe::interpDelete $i + set msg +} {not allowed to start Tk by master's safe::TkInit} + +test safe-5.2 {multi-level Tk loading with clearance} { + # No error shall occur in that test and no window + # shall remain at the end. + set i [safe::interpCreate] + set j [list $i x] + set j [safe::interpCreate $j] + safe::loadTk $j + interp eval $j { + button .b -text Ok -command {destroy .} + pack .b +# tkwait window . ; # for interactive testing/debugging + } + safe::interpDelete $j + safe::interpDelete $i +} {} + +test safe-6.1 {loadTk -use windowPath} { + set w .safeTkFrame + catch {destroy $w} + frame $w -container 1; + pack .safeTkFrame + set i [safe::loadTk [safe::interpCreate] -use $w] + interp eval $i {button .b -text "hello world!"; pack .b} + safe::interpDelete $i + destroy $w +} {} + +test safe-6.2 {loadTk -use windowPath, conflicting -display} { + set w .safeTkFrame + catch {destroy $w} + frame $w -container 1; + pack .safeTkFrame + set i [safe::interpCreate] + catch {safe::loadTk $i -use $w -display :23.56} msg + safe::interpDelete $i + destroy $w + string range $msg 0 36 +} {conflicting -display :23.56 and -use } + + unset hidden_cmds diff --git a/win/tkWinWindow.c b/win/tkWinWindow.c index 2b8eb41..dbac589 100644 --- a/win/tkWinWindow.c +++ b/win/tkWinWindow.c @@ -114,7 +114,12 @@ Tk_Window Tk_HWNDToWindow(hwnd) HWND hwnd; { - Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd); + Tcl_HashEntry *entryPtr; + if (!initialized) { + Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS); + initialized = 1; + } + entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd); if (entryPtr != NULL) { return (Tk_Window) Tcl_GetHashValue(entryPtr); } |