Posted to tcl by patthoyts at Mon Oct 27 21:47:17 GMT 2008view raw
- package require Tk
- proc Main {args} {
- array set opts [linsert $args 0 -safe 1 -frame 0]
- wm withdraw .
- set container 1
- if {$opts(-frame)} { set container 0 }
- set dlg [toplevel .test -container $container]
- #wm withdraw $dlg
- if {$opts(-frame)} {
- wm title $dlg "Embedding Safe-Tk in Frame"
- pack [frame $dlg.f -container 1] -fill both -expand 1
- set slave [::safe::interpCreate slave]
- bind $dlg <Destroy> [list interp delete $slave]
- ::safe::loadTk $slave -use $dlg.f
- $slave eval {
- pack [text .t] -fill both -expand 1
- .t insert end "Tcl $tcl_patchLevel Tk $tk_patchLevel\n" {}
- update
- }
- } elseif {$opts(-safe)} {
- wm title $dlg "Embedding Safe-Tk"
- set slave [::safe::interpCreate slave]
- bind $dlg <Destroy> [list interp delete $slave]
- ::safe::loadTk $slave -use $dlg
- $slave eval {
- pack [text .t] -fill both -expand 1
- .t insert end "Tcl $tcl_patchLevel Tk $tk_patchLevel\n" {}
- update
- }
- } else {
- wm title $dlg "Embedding Tk"
- set slave [interp create slave]
- bind $dlg <Destroy> [list interp delete $slave]
- $slave eval [string map [list %W [winfo id $dlg]] {
- set argv [list -use %W]
- load {} Tk
- pack [text .t] -fill both -expand 1
- .t insert end "Tcl $tcl_patchLevel Tk $tk_patchLevel\n" {}
- update
- }]
- }
- bind $dlg <Control-F2> {console show}
- #wm deiconify $dlg
- tkwait window $dlg
- }
- if {!$tcl_interactive} {
- set r [catch [linsert $argv 0 Main] err]
- if {$r} {
- tk_messageBox -icon error -title "Script error" \
- -message $err -detail $errorInfo
- }
- exit
- }