Shin The Gin This is my first attempt to save a running TclTk environment, to be sourced later.
Shin, you should be more careful about generating tcl code. For instance, this line of code is asking for trouble:
set ln "set $g \{$v\}"The first time you have a global variable with a space or special character, or a value with unbalanced braces, you're going to have a problem. Since tcl statements are lists of words, use list and all those problems will vanish in a puff of smoke:
set ln [list set $g $v]
Shin The Gin - Oops, I forgot the interpretive state while resourcing. Corrected.
catch {package require Tk}
# GLOBALS
#
proc codeForGlobals {} {
set result ""
foreach g [info globals] {
set isArray [array exists ::$g]
if {$isArray==1} {
set ln ""
set keys [array names ::$g]
foreach k $keys {
append ln "set $g"
append ln "("
append ln $k
append ln ") "
append ln "{[lindex [array get ::$g $k] 1]}"
append ln "\n"
}
} else {
upvar ::$g v
if {[string length "$v"]>0} {
set ln [list set $g $v]
}
}
append result "$ln\n"
}
return $result
}
# PROCEDURES
#
proc codeForProc {p} {
set args [info args $p]
set body [info body $p]
return "
proc $p {$args} {
$body
}
"
}
proc codeForAllProcs {} {
set result ""
foreach p [info proc] {
append result "[codeForProc $p]\n\n"
}
return $result
}
# WIDGETS
#
proc traverseWidgetTree {{win .}} {
set result "$win "
foreach w [winfo children $win] {
append result "[traverseWidgetTree $w] "
}
return $result
}
proc codeForWidget {{win .}} {
set class [winfo class $win]
set class [string replace $class 0 0 [string tolower [string index $class 0]]]
set cfg [$win configure]
set result ""
if {"$win"!="."} {
set result "$class $win\n"
}
foreach o {aspect attributes client colormapwindows focusmodel geometry iconbitmap iconmask iconname maxsize minsize overrideredirect positionfrom resizable sizefrom state title} {
if {[string length [wm $o $win]] > 0} {
if {"$o"=="title"} {
append result "wm $o $win \"[wm $o $win]\"\n"
} else {
append result "wm $o $win [wm $o $win]\n"
}
}
}
return $result
}
proc codeForWidgetTree {{win .}} {
set result ""
foreach w [traverseWidgetTree $win] {
append result [codeForWidget $w]
}
return $result
}
proc environmentCode {} {
set result "package require Tk\n\n"
append result [codeForGlobals]
append result [codeForAllProcs]
append result [codeForWidgetTree .]
return $result
}Calling
environmentCode gives You a string containing the loadable tcl code to be saved or evaluated in another
interp, which would clone the current environment.
Shin The Gin CodeForWidget was not functioning, because it didn't take care of the widget's managers. Here's the working version.
proc codeForWidget {{win .}} {
set class [winfo class $win]
set class [string replace $class 0 0 [string tolower [string index $class 0]]]
set cfg [$win configure]
set mgr [winfo manager $win]
if {"$mgr"!="wm"} {
if {"$mgr"!=""} {
set mgrinfo [$mgr info $win]
}
set result "$class $win "
foreach c $cfg {
set k [lindex $c 0]
set v [lindex $c end]
if {[llength $c] > 3} {
if {$v != {}} {
append result " $k {$v}"
}
}
}
if {"$mgr"!=""} {
append result "\n$mgr config $win $mgrinfo\n"
} else {
append result "\npack $win -in [winfo parent $win] -fill both -expand 1 \n"
}
} else {
set result ""
if {"$win"!="."} {
set result "$class $win\n"
}
foreach o {aspect attributes client colormapwindows focusmodel geometry iconbitmap iconmask iconname maxsize minsize overrideredirect positionfrom resizable sizefrom state title} {
if {[string length [wm $o $win]] > 0} {
if {"$o"=="title"} {
append result "wm $o $win \"[wm $o $win]\"\n"
} else {
append result "wm $o $win [wm $o $win]\n"
}
}
}
}
return $result
}In a next step, I'd try to regard namespaces so one could build an application interactively in a namespace and save it to a file of tcl code. A
[Namespace Browser
] would be nice here...
