This can be used to save a widget with its children for later recreation, or for reparenting it from one frame to another (might be a toplevel). - RS
Limitations:
text images and windows are not saved. nothing in a canvas is saved. a toplevels wm attributes (resizable, toolwindow, aspect, etc) are not saved. listbox item configurations, text tags and marks can get quite slow if you have large listboxes or many tags
Usage example:
set state [serialize .frame] destroy .frame toplevel .frame eval [join $state \;]
--AF 23-06-03
proc serialize {w} {
upvar state state
foreach c [winfo children $w] {
if {[string match .#* $c]} {continue}
set new $c
if {[catch {$c configure -class} widget]} {set widget "{} {} {} [winfo class $c]"}
set widget [string tolower [lindex $widget 3]]
lappend state "$widget $new [getconfig $c]"
if {$widget == "listbox"} {
lappend state "$new insert 0 [$c get 0 end]"
set len [$c index end]
for {set x 0} {$x < $len} {incr x} {
if {[set config [getconfig $c "itemconfigure $x"]] != " "} {
lappend state "$new itemconfigure $x $config"
}
}
} elseif {$widget == "entry"} {
lappend state "$new configure -state normal"
lappend state "$new insert 0 [list [$c get]]"
lappend state "$new configure -state [$c cget -state]"
} elseif {$widget == "text"} {
lappend state "$new configure -state normal"
lappend state "$new insert 1.0 [list [$c get 1.0 end-1c]]"
lappend state "$new delete end end-1l"
lappend state "addtags $new [list [$c dump -tag 1.0 end]]"
foreach x [$c tag names] {
lappend state "$new tag configure $x [getconfig $c "tag configure $x"]"
if {[set bindings [$c tag bind $x]] != ""} {
foreach b $bindings {lappend state "$new tag bind $x $b [list [$c tag bind $x $b]]"}
}
}
lappend state [string map "mark \"\;$new mark set\"" [$c dump -mark 1.0 end]]
lappend state "$new configure -state [$c cget -state]"
} elseif {$widget == "menu"} {
set end [$c index end]
for {set x 0} {$x <= $end} {incr x} {
lappend state "$new add [$c type $x] [getconfig $c "entryconfigure $x"]"
}
}
lappend state "bindtags $new [list [bindtags $c]]"
if {[set bindings [bind $c]] != ""} {
foreach x $bindings {lappend state "bind $new $x [list [bind $c $x]]"}
}
if {[winfo children $c] != ""} {serialize $c}
}
set manager {}
foreach x [winfo children $w] {
if {[set manager [winfo manager $x]] != ""} {break}
}
if {$manager == "grid" || $manager == "pack" || $manager == "place"} {
foreach x [$manager slaves $w] {lappend state "$manager $x [lrange [$manager info $x] 2 end]"}
} elseif {$manager == "panedwindow"} {
foreach x [$w panes] {lappend state "$w add $x [getconfig $w "paneconfigure $x"]"}
}
set grid [grid size $w]
if {[set cols [lindex $grid 0]] > 0} {
for {incr cols -1} {$cols > -1} {incr cols -1} {
lappend state "grid columnconfigure $w $cols [grid columnconfigure $w $cols]"
}
}
if {[set rows [lindex $grid 1]] > 0} {
for {incr rows -1} {$rows > -1} {incr rows -1} {
lappend state "grid rowconfigure $w $rows [grid rowconfigure $w $rows]"
}
}
return $state
}
proc getconfig {w {cmd configure}} {
set args {}
foreach x [eval $w $cmd] {
if {[set opt [lindex $x 4]] != [lindex $x 3]} {lappend args [list [lindex $x 0] $opt]}
}
return [join $args]
}
proc addtags {w tags} {
foreach {d tag pos} $tags {
if {$d == "tagon"} {
set t($tag) $pos
} elseif {$d == "tagoff" && [info exists t($tag)] && $t($tag) != ""} {
$w tag add $tag $t($tag) $pos
unset t($tag)
}
}
}This might be another good candidate for tklib.
04.01.2004 Artur Trzewik
The procedure above does not works reliable by geometry manager serialization. Following things do not work
The procedure does not serialize root window. It can be not used to serialize sub windows. Unfortunately the recursive proc "serialize" serialize only children windows in the loop.
This implementation first task is to reap another GUI to source-form that can be used as programm-sniplet. Therefore instead of root-window variable $win will be used. Intenal state of listboxes, texts and entry will be not serialized. It works also for serialization of subwidgets. I hope it works in more cases. Usage:
set state [serializeWidgetAction .toplevel]
This code below will be included in XOTclIDE Tk Inspector.
proc serializeWidget {w root} {
append state "# serialize $w\n"
set new \$win[string range $w [string length $root] end]
if {[catch {$w configure -class} widget]} {set widget "{} {} {} [winfo class $w]"}
set widget [string tolower [lindex $widget 3]]
append state "$widget $new [widgetConfigurationString $w $root]" \n
if {$widget == "menu"} {
append state [serializeMenu $w $root] \n
}
#append state "bindtags $new [list [bindtags $c]]\n"
if {[set bindings [bind $w]] != ""} {
foreach x $bindings {
append state "bind $new $x [list [bind $w $x]]\n"
}
}
foreach c [winfo children $w] {
if {[string match *.#* $c]} {continue}
append state [serializeWidget $c $root]
}
# Search again after pannedwindow
foreach c [winfo children $w] {
if {[winfo class $c]!="Panedwindow"} {continue}
set newc \$win[string range $c [string length $root] end]
foreach x [$c panes] {
set news \$win[string range $x [string length $root] end]
append state "$newc add $news [getconfig $c [list paneconfigure $x]]\n"
}
}
if {$widget=="panedwindow" && $w==$root} {
foreach x [$w panes] {
set news \$win[string range $x [string length $root] end]
append state "$new add $news [getconfig $w [list paneconfigure $x]]\n"
}
}
if {$widget=="toplevel" && [$w cget -menu]!=""} {
regsub -all -- $root [$w cget -menu] \$win menu
append state "$new configure -menu $menu"
}
set manager [set manager [winfo manager $w]]
if {$manager == "grid" || $manager == "pack" || $manager == "place"} {
append state "$manager $new [packerConfigurationString $w $manager $root]\n"
}
set grid [grid size $w]
if {[set cols [lindex $grid 0]] > 0} {
for {incr cols -1} {$cols > -1} {incr cols -1} {
append state "grid columnconfigure $new $cols [grid columnconfigure $w $cols]\n"
}
}
if {[set rows [lindex $grid 1]] > 0} {
for {incr rows -1} {$rows > -1} {incr rows -1} {
append state "grid rowconfigure $new $rows [grid rowconfigure $w $rows]\n"
}
}
return $state
}
proc packerConfigurationString {win manager root} {
set text ""
array set defarr {
-anchor center
-expand 0
-fill none
-ipadx 0
-ipady 0
-padx 0
-pady 0
-side top
-columnspan 0
-rowspan 0
-sticky {}
-bordermode inside
}
if {$manager=="place"} {
set defarr(-anchor) nw
}
foreach {opt value} [$manager info $win] {
if {[info exists defarr($opt)] && $defarr($opt)==$value} continue
if {$opt=="-in"} {
if {$value!=[winfo parent $win]} {
if {![regsub -all -- $root $value \$win value]} {
return "### gemetry window $value not child of $root"
}
append text " $opt $value"
}
} else {
append text " $opt $value"
}
}
return $text
}
proc serializeMenu {c root} {
set end [$c index end]
set text ""
for {set x 0} {$x <= $end} {incr x} {
set state "$c add [$c type $x] [getconfig $c [list entryconfigure $x]]\n"
regsub -all -- $root $state \$win state
append text $state
}
return $text
}
proc getconfig {w {cmd configure}} {
set args {}
foreach x [eval $w $cmd] {
if {[set opt [lindex $x 4]] != [lindex $x 3]} {lappend args [list [lindex $x 0] $opt]}
}
return [join $args]
}
proc widgetConfigurationString {w root} {
set text ""
foreach conf [$w configure] {
if {[lindex $conf 3]==[lindex $conf 4]} continue
set cname [lindex $conf 0]
if {[winfo class $w]=="Toplevel" && $cname=="-menu"} continue
if {[lsearch [list -command -yscrollcommand -xscrollcommand] $cname]>=0} {
regsub -all -- $root [lindex $conf 4] \$win erg
append text " $cname \[list $erg\]"
} else {
append text " $cname [list [lindex $conf 4]]"
}
}
return $text
}
proc serializeWidgetAction w {
if {[winfo class $w]=="Toplevel"} {
append text "set win .test\n\n"
} else {
append text "set win .test.w\ntoplevel .test\n\n"
}
append text [serializeWidget $w $w]
if {[winfo class $w]!="Toplevel"} {
append text "pack .test.w"
}
return $text
}