summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorwelch <welch>1998-06-27 18:06:37 (GMT)
committerwelch <welch>1998-06-27 18:06:37 (GMT)
commitadcb060b5ab8d310f5aff8a1119d3b97baf86641 (patch)
tree759f8786c82028afeb67bd971309b7b328d81d7f
parentd010dca55fd7a02e3fe6e50910359d8d4915f003 (diff)
downloadtk-adcb060b5ab8d310f5aff8a1119d3b97baf86641.zip
tk-adcb060b5ab8d310f5aff8a1119d3b97baf86641.tar.gz
tk-adcb060b5ab8d310f5aff8a1119d3b97baf86641.tar.bz2
plugin updates
-rw-r--r--library/clrpick.tcl88
-rw-r--r--library/comdlg.tcl36
-rw-r--r--library/console.tcl32
-rw-r--r--library/dialog.tcl8
-rw-r--r--library/entry.tcl64
-rw-r--r--library/focus.tcl6
-rw-r--r--library/listbox.tcl14
-rw-r--r--library/menu.tcl68
-rw-r--r--library/msgbox.tcl26
-rw-r--r--library/optMenu.tcl2
-rw-r--r--library/palette.tcl46
-rw-r--r--library/safetk.tcl104
-rw-r--r--library/scale.tcl20
-rw-r--r--library/scrlbar.tcl34
-rw-r--r--library/tclIndex3
-rw-r--r--library/tearoff.tcl2
-rw-r--r--library/text.tcl94
-rw-r--r--library/tk.tcl6
-rw-r--r--mac/tkMac.h37
-rw-r--r--mac/tkMacCursor.c34
-rw-r--r--mac/tkMacEmbed.c180
-rw-r--r--mac/tkMacInt.h18
-rw-r--r--mac/tkMacMenu.c37
-rw-r--r--mac/tkMacSubwindows.c114
-rw-r--r--mac/tkMacWindowMgr.c61
-rw-r--r--mac/tkMacWm.c34
-rw-r--r--mac/tkMacXStubs.c2
-rw-r--r--tests/safe.test47
-rw-r--r--win/tkWinWindow.c7
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);
}