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 tagsUsage 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 TrzewikThe procedure above does not works reliable by geometry manager serialization. Following things do not work
- can not handle for example pack .win.b -in .win.c ( -in option are ignored)
- by searching for geometry manager geometry manager of first child will be asked. It does not work if first child is menu because the geometry manager is wm in this case. Better way is ask gemetry manager for each widget.
- have problems with toplevel -menu option. Because the menu window can be defined only after define the toplevel.
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
}
