#############################################################################
# $Id: widget.tcl,v 1.78 2005/12/02 21:48:28 kenparkerjr Exp $
#
# widget.tcl - procedures for manipulating widget information
#
# Copyright (C) 1996-1998 Stewart Allen
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

##############################################################################
#

###
## A workaround for the winfo toplevel problem. Menus are placed with wm
## and winfo toplevel doesn't return the correct widget.
proc vTcl:get_toplevel {target} {
    set c [vTcl:get_class $target]
    if {$c == "Menu"} {
        # go up until we find the parent toplevel
        return [vTcl:get_toplevel [winfo parent $target]]
    } else {
        return [winfo toplevel $target]
    }
}

#
# Given a full widget path, returns a name with "$base" replacing
# the first widget element.
#
proc vTcl:base_name {target} {

    ## don't change anything if the widget doesn't start with a
    ## period (.) because it could be an alias
    if {[string range $target 0 0] != "."} {
        return $target
    }

    ## let's see if there is a basename to replace
    global basenames
    if {[info exists basenames($target)]} {
        return $basenames($target)
    } else {
        ## let's see if we have a partial match
        foreach name [lsort -decreasing [array names basenames]] {
            if {[string match $name* $target]} {
                set length [string length $name]
                set result [string replace $target 0 [expr $length - 1] \
                    $basenames($name)]
                return $result
            }
        }
    }

    ## otherwise, just replace the toplevel by $top
    set l [split $target .]
    set name "\$top"
    foreach i [lrange $l 2 end] {
        append name ".$i"
    }
    return $name
}

#
# Given two compatible widgets, sets up a scrollbar
# link (i.e. textfield and scrollbar)
#
proc vTcl:bind_scrollbar {t1 t2} {
    global vTcl
    set c1 [winfo class $t1]
    set c2 [winfo class $t2]
    if { $c1 == "Scrollbar" } {
        set t3 $t1; set t1 $t2; set t2 $t3
        set c3 $c1; set c1 $c2; set c2 $c3
    } elseif { $c2 == "Scrollbar" } {
    } else {
        return
    }
    switch [lindex [$t2 conf -orient] 4] {
        vert -
        vertical { set scr_cmd -yscrollcommand; set v_cmd yview }
        default  { set scr_cmd -xscrollcommand; set v_cmd xview }
    }
    switch $c1 {
        Mclistbox -
        Listbox -
        Canvas  -
        Table   -
        Text {
            $t1 conf $scr_cmd "$t2 set"
            $t2 conf -command "$t1 $v_cmd"
        }
        Entry {
            if {$v_cmd == "xview"} {
                $t1 conf $scr_cmd "$t2 set"
                $t2 conf -command "$t1 $v_cmd"
            }
        }
    }
}

#
# Shows a "hidden" object from information stored
# during the hide. Hidden object attributes are
# not currently saved in the project. FIX.
#
proc vTcl:show {target} {
    global vTcl
    if {[vTcl:streq $target "."]} { return }
    if {![winfo viewable $target]} {
        if {[catch {eval $vTcl(hide,$target,m) $target $vTcl(hide,$target,i)}] == 1} {

            ## don't try to change the manager of childsites or menus !!
            ## only show widgets that are not childsites and have been hidden

            if {[::vTcl::widgets::core::frame::containing_megawidget $target] == "" &&
                [lsearch -exact {Menu Busy} [vTcl:get_class $target]] == -1} {
                catch {$vTcl(w,def_mgr) $target $vTcl($vTcl(w,def_mgr),insert)}
            }
        }
    }
}

#
# Withdraws a widget from display.
#
proc vTcl:hide {} {
    global vTcl
    set class [vTcl:get_class $vTcl(w,widget)]
    if {[vTcl:streq $class Toplevel]} {
        vTcl:hide_top $vTcl(w,widget)
        return
    }

    if {$vTcl(w,manager) != "wm" && $vTcl(w,widget) != ""} {
        lappend vTcl(hide) $vTcl(w,widget)
        set vTcl(hide,$vTcl(w,widget),m) $vTcl(w,manager)
        set vTcl(hide,$vTcl(w,widget),i) [$vTcl(w,manager) info $vTcl(w,widget)]
        $vTcl(w,manager) forget $vTcl(w,widget)
        vTcl:destroy_handles
    }
}

#
# Sets the current widget as the insertion point
# for new widgets.
#
proc vTcl:set_insert {} {
    global vTcl
    set vTcl(w,insert) $vTcl(w,widget)
}

proc vTcl:select_parent {} {
    global vTcl
    vTcl:active_widget [winfo parent $vTcl(w,widget)]
    vTcl:set_insert
}

proc vTcl:select_toplevel {} {
    global vTcl
    vTcl:active_widget [winfo toplevel $vTcl(w,widget)]
    vTcl:set_insert
}

proc vTcl:raise {target} {

    # go figure, but on Unix raise introduces delays of one to
    # 2 seconds at least, which grays out the whole app for a
    # while

    if {$::tcl_platform(platform) != "unix"} {
        raise $target
    } elseif {$::tk_patchLevel >= "8.3.4"} {
        ## tk 8.3.4 fixes the problem
        raise $target
    }
}

proc vTcl:active_widget {target} {
    global vTcl widgetSelected classes
    if {$target == ""} {return}
    if {[vTcl:streq $target "."]} { return }
    if {$vTcl(w,widget) != "$target"} {

        vTcl:destroy_handles
        ## Any custom selection command?
        set class [vTcl:get_class $target]
        if {[info exists classes($class,selectCmd)] &&
            $classes($class,selectCmd) != ""} {
            $classes($class,selectCmd) $target
        }

        vTcl:select_widget $target
        vTcl:attrbar_color $target
        set vTcl(redo) [vTcl:dump_widget_quick $target]
        if {$vTcl(w,class) == "Toplevel"} {
            set vTcl(w,insert) $target
            wm deiconify $target
            vTcl:raise $target
        } else {
            vTcl:create_handles $target
            vTcl:place_handles $target
	    if {[info exists classes($class,insertable)] && $classes($class,insertable)} {
                set vTcl(w,insert) $target
            } else {
                set vTcl(w,insert) [winfo parent $target]
            }
        }
    } elseif {$vTcl(w,class) == "Toplevel"} {
        set vTcl(w,insert) $target
        wm deiconify $target
        vTcl:raise $target
    }
    set widgetSelected 1
}

proc vTcl:select_widget {target} {
    global vTcl classes

    if {[vTcl:streq $target "."]} {
        vTcl:prop:clear
        return
    }

    ## Set the focus to an arbitrary widget when a widget is selected.
    ## This is so that focus_out_cmd gets called on the property manager
    ## if a widget is selected.
    focus .vTcl.widgetname

    vTcl:log "vTcl:select_widget $target"
    if {$target == $vTcl(w,widget)} {
        # show selection in widget tree
        vTcl:show_selection_in_tree $target
        return
    }
    set vTcl(w,last_class) $vTcl(w,class)
    set vTcl(w,last_manager) $vTcl(w,manager)
    vTcl:update_widget_info $target
    vTcl:prop:update_attr
    vTcl:get_bind $target
    vTcl:add_functions_to_rc_menu

    # show selection in widget tree
    vTcl:show_selection_in_tree $target
}

#
# Recurses a widget tree ignoring toplevels
#
proc vTcl:widget_tree {target {include_target 1}} {
    global vTcl classes

    if {$target == ".vTcl" || $target == ".tkcon" || [string range $target 0 2] == ".__"} { return }

    set output ""
    if {$include_target} {
        set output "$target "
    }

    set dumpChildren 1
    set class [winfo class $target]
    if {[info exists classes($class,dumpChildren)]} {
	set dumpChildren $classes($class,dumpChildren)
    }
    if {!$dumpChildren} { return $output }

    set c [vTcl:get_children $target]
    foreach i $c {
	if {[string range $i 0 1] == ".#"} { continue }
        set class [vTcl:get_class $i]
        if {$class != "Toplevel"} {
            append output [vTcl:widget_tree $i]
        }
    }
    return $output
}

#
# Recurses a widget tree with the option of not ignoring built-ins
#
# In the normal case we are not interested by children of megawidgets
#
# However, bindings are set for all children, including megawidgets' children
# so that when a user clicks on a child, the parent megawidget will be
# selected

proc vTcl:list_widget_tree {target {which ""} {include_menus 0} {include_megachildren 0}} {
    if {$which == ""} {
        if {$target == ".vTcl" || $target == ".tkcon" ||[string range $target 0 2] == ".__"} {
            return
        }
    }
    set w_tree "$target "
    set children [vTcl:get_children $target $include_megachildren]
    foreach i $children {
        ## Tix leaves some windows behind
        if {[string match .tix* $i]} {continue}

	## Ignore temporary windows completely.
	if {[string range $i 0 1] == ".#"} { continue }

        ## Don't include temporary windows
        if {[string match {*#*} $i] && (!$include_menus)} { continue }

        ## Don't include unknown widgets
        set c [vTcl:get_class $i]

        if {![vTcl:valid_class $c]} { continue }

        append w_tree \
            "[vTcl:list_widget_tree $i $which $include_menus $include_megachildren] "
    }

    return $w_tree
}

# this func returns the same as list_widget_tree plus all the
# children in megawidgets' childsites
#
# wantsdiff returns along with each megawidget's children the
# level difference for the widget tree (ex. #-4 to skip 4 levels)

proc vTcl:complete_widget_tree {{root .} {wantsdiff 1}} {

    global classes
    set tree [vTcl:list_widget_tree $root]

    set result ""
    foreach i $tree {
        lappend result $i

        set childrenCmd [lindex $classes([vTcl:get_class $i],treeChildrenCmd) 0]
        if {$childrenCmd == ""} {
            continue
        }

        if {$wantsdiff} {
             set children [$childrenCmd $i]
        } else {
             set children [$childrenCmd $i ""]
        }
        eval lappend result $children
    }

    return $result
}

##############################################################################
# WIDGET INFO ROUTINES
##############################################################################
proc vTcl:split_info {target} {
    global vTcl
    set index 0
    set mgr $vTcl(w,manager)
    set mgr_info [$mgr info $target]
    set vTcl(w,info) $mgr_info
    if { $vTcl(var_update) == "yes" } {
        set index a
        foreach i $mgr_info {
            if { $index == "a" } {
                set var vTcl(w,$mgr,$i)
                set last $i
                set index b
            } else {
                set $var $i
                set index a
            }
        }
    }
    if {$mgr == "grid"} {
        set p [winfo parent $target]
        set pre g
        set gcolumn $vTcl(w,grid,-column)
        set grow $vTcl(w,grid,-row)
        foreach a {column row} {
            foreach b {weight minsize} {
                set num [subst $$pre$a]
                if [catch {
                    set x [expr round([grid ${a}conf $p $num -$b])]
                }] {set x 0}
                set vTcl(w,grid,$a,$b) $x
            }
        }
        set vTcl(w,grid,propagate) [grid propagate $target]
    } elseif {$mgr == "pack"} {
        set vTcl(w,pack,propagate) [pack propagate $target]
    }
}

proc vTcl:split_wm_info {target} {
    global vTcl
    set vTcl(w,info) ""
    foreach i $vTcl(attr,tops) {
        if {$i == "geometry"} {
            #
            # because window managers behave unpredictably with wm and
            # winfo, one is used for editing and the other for saving
            #
            ##
            # This causes windows to have the wrong geometry.  At least under
            # my window manager.  Have to look into this further. -D
            ##
            if {$vTcl(mode) == "EDIT"} {
                # set vTcl(w,wm,$i) [winfo $i $target]
                set vTcl(w,wm,$i) [wm $i $target]
            } else {
                set vTcl(w,wm,$i) [wm $i $target]
            }
        } else {
            set vTcl(w,wm,$i) [wm $i $target]
        }
    }
    set vTcl(w,wm,class) [winfo class $target]
    if { $vTcl(var_update) == "yes" } {
        lassign [vTcl:split_geom $vTcl(w,wm,geometry)] w h x y
        set vTcl(w,wm,geometry,w)    $w
        set vTcl(w,wm,geometry,h)    $h
        set vTcl(w,wm,geometry,x)    $x
        set vTcl(w,wm,geometry,y)    $y
        set vTcl(w,wm,minsize,x)     [lindex $vTcl(w,wm,minsize) 0]
        set vTcl(w,wm,minsize,y)     [lindex $vTcl(w,wm,minsize) 1]
        set vTcl(w,wm,maxsize,x)     [lindex $vTcl(w,wm,maxsize) 0]
        set vTcl(w,wm,maxsize,y)     [lindex $vTcl(w,wm,maxsize) 1]
        set vTcl(w,wm,aspect,minnum) [lindex $vTcl(w,wm,aspect) 0]
        set vTcl(w,wm,aspect,minden) [lindex $vTcl(w,wm,aspect) 1]
        set vTcl(w,wm,aspect,maxnum) [lindex $vTcl(w,wm,aspect) 2]
        set vTcl(w,wm,aspect,maxden) [lindex $vTcl(w,wm,aspect) 3]
        set vTcl(w,wm,resizable,w)   [lindex $vTcl(w,wm,resizable) 0]
        set vTcl(w,wm,resizable,h)   [lindex $vTcl(w,wm,resizable) 1]
    }
}

proc vTcl:get_grid_stickies {sticky} {
    global vTcl
    set len [string length $sticky]
    foreach i {n s e w} {
        set vTcl(grid,sticky,$i) ""
    }
    for {set i 0} {$i < $len} {incr i} {
        set val [string index $sticky $i]
        set vTcl(grid,sticky,$val) $val
    }
}

proc vTcl:update_widget_info {target} {
    vTcl:log "update_widget_info $target"

    global vTcl widget
    update idletasks
    set vTcl(w,widget) $target
    set vTcl(w,didmove) 0
    set vTcl(w,options) ""
    set vTcl(w,optlist) ""
    if {![winfo exists $target]} {return}
    foreach i $vTcl(attr,winfo) {
        if {$i == "manager" && $target == "."} {
            # root placer problem
            set vTcl(w,$i) wm
        } else {
            set vTcl(w,$i) [winfo $i $target]
        }
    }
    set vTcl(w,class) [vTcl:get_class $target]
    set vTcl(w,r_class) [winfo class $target]
    set vTcl(w,conf) [$target configure]

    set attrs $vTcl(attr,winfo)
    ##
    # Remove class from the attributes, 'cause we don't want [winfo class]
    # over setting the value we stored from get_class. -Damon
    ##
    lremove attrs class
    switch $vTcl(w,class) {
        Toplevel {
            set vTcl(w,opt,-text) [wm title $target]

            ##
            # Set the geometry based on results from [wm geometry] instead of
            # [winfo geometry].  Remove those attributes from the list of
            # attributes to setup in the vTcl(w,*) array.
            ##
            set remove {geometry height width rootx rooty x y}
            eval lremove attrs $remove
            set geometry [wm geometry $target]
            lassign [vTcl:split_geom $geometry] width height x y
            set rootx $x
            set rooty $y
            foreach var $remove {
                set vTcl(w,$var) [set $var]
            }

            ##
            # Special attributes that do not belong to Tk toplevels but allow
            # control over whether to specify origin and/or size or let the
            # window manager decide instead. Defaults to 1, which means the
            # user has control over toplevel position and size
            ##
            foreach special {set,origin set,size runvisible} {
                if {![info exists ::widgets::${target}::${special}]} {
                    namespace eval ::widgets::${target} "
                        variable $special
                        set $special 1
                    "
                }
                set vTcl(w,wm,$special) [vTcl:at ::widgets::${target}::${special}]
            }
        }
        default {
            set vTcl(w,opt,-text) ""
        }
    }

    foreach i $attrs {
        set vTcl(w,$i) [winfo $i $target]
    }

    switch $vTcl(w,manager) {
        {} {}
        grid -
        pack -
        place {
            vTcl:split_info $target
        }
        wm {
            if { $vTcl(w,class) != "Menu" } {
                vTcl:split_wm_info $target
            }
        }
    }
    set vTcl(w,options) [vTcl:conf_to_pairs $vTcl(w,conf) set]
    if {[catch {set vTcl(w,alias) $widget(rev,$target)}]} {
        set vTcl(w,alias) ""
    }

    ## special options support
    if {[info exist ::classoption($vTcl(w,class))]} {
        foreach spec_opt $::classoption($vTcl(w,class)) {
            $::configcmd($spec_opt,update) $target vTcl(w,opt,$spec_opt)
        }
    }


}

proc vTcl:conf_to_pairs {conf opt} {
    global vTcl
    set pairs ""
    foreach i $conf {
        set option [lindex $i 0]
        set def [lindex $i 3]
        set value [lindex $i 4]
        if {$value != $def && $option != "-class"} {
            lappend pairs $option $value
        }
        if {$opt == "set"} {
            lappend vTcl(w,optlist) $option
            set vTcl(w,opt,$option) $value
        }
    }
    return $pairs
}

proc vTcl:new_widget_name {class base} {
    global vTcl
    set c [vTcl:lower_first $class]
    while { 1 } {
        if $vTcl(pr,shortname) {
            set num "[string range $c 0 2]$vTcl(item_num)"
        } else {
            set num "$c$vTcl(item_num)"
        }
        incr vTcl(item_num)
        if {$base != "." && $class != "Toplevel"} {
            set new_widg $base.$num
        } else {
            set new_widg .$num
        }
        if { [lsearch $vTcl(tops) $new_widg] >= 0 } { continue }
        if { ![winfo exists $new_widg] } { break }
    }
    return $new_widg
}

proc vTcl:setup_vTcl:bind {target} {
    global vTcl
    set bindlist [vTcl:list_widget_tree $target all 1 1]
    update idletasks
    foreach i $bindlist {
        if { [lsearch [bindtags $i] vTcl(a)] < 0 } {
            set vTcl(bindtags,$i) [bindtags $i]
            bindtags $i "vTcl(a) $vTcl(bindtags,$i)"
        }
    }
}

proc vTcl:setup_bind {target} {
    global vTcl
    if {[lsearch [bindtags $target] vTcl(b)] < 0 &&
        [lsearch [bindtags $target] vTcl(a)] < 0} {

        set vTcl(bindtags,$target) [bindtags $target]

        set class [vTcl:get_class $target]

        if { $class == "Toplevel"} {
            wm protocol $target WM_DELETE_WINDOW "vTcl:hide_top $target"
            if {$vTcl(pr,winfocus) == 1} {
                wm protocol $target WM_TAKE_FOCUS "vTcl:wm_take_focus $target"
            }
            bindtags $target "vTcl(bindtags,$target) vTcl(b) vTcl(c)"

        } elseif { $class == "Menu" } {
            bindtags $target "vTcl(a) $vTcl(bindtags,$target)"

        } else {
            bindtags $target vTcl(b)
        }
    }
}

proc vTcl:switch_mode {} {
    global vTcl
    if {$vTcl(mode) == "EDIT"} {
        vTcl:propmgr:deselect_attr
        vTcl:setup_unbind_tree .
        #Save unregistered widgets. 
        vTcl:widget:register_all_widgets
    } else {
        vTcl:setup_bind_tree .
        #remove widgets created at runtime
        vTcl:widget:remove_unregistered_widgets
    }
}

proc vTcl:setup_bind_tree {target} {
    global vTcl
    vTcl:setup_bind_widget $target
    set vTcl(mode) "EDIT"
    ::widgets_bindings::enable_editor 1
    ::menu_edit::enable_all_editors 1

    ## inform subscribers
    ::vTcl::notify::publish edit_mode
}

proc vTcl:setup_bind_widget {target} {
    global vTcl
    # Include special menu windows under X with '#'
    set bindlist [vTcl:list_widget_tree $target "" 1 1]
    update idletasks
    foreach i $bindlist {
        vTcl:setup_bind $i
    }

    foreach i [vTcl:list_widget_tree $target] {
        # Make sure megawidgets' children are properly tagged
        # as such; test mode could have added/removed children
        vTcl:widget:register_widget_megachildren $i
    }
}

proc vTcl:setup_unbind {target} {
    global vTcl
    if { [lsearch [bindtags $target] vTcl(b)] >= 0 } {
        bindtags $target $vTcl(bindtags,$target)
    }
}

proc vTcl:setup_unbind_tree {target} {
    global vTcl
    vTcl:select_widget .
    vTcl:destroy_handles
    vTcl:setup_unbind_widget $target
    set vTcl(mode) "TEST"
    ::widgets_bindings::enable_editor 0
    ::menu_edit::enable_all_editors 0

    ## inform subscribers
    ::vTcl::notify::publish test_mode
}

proc vTcl:setup_unbind_widget {target} {
    global vTcl
    # Include special menu windows under X with '#'
    set bindlist [vTcl:list_widget_tree $target "" 1 1]
    update idletasks
    foreach i $bindlist {
        vTcl:setup_unbind $i
    }
}

##
## This routine checks that we don't mix pack and grid in the same container.
##
proc vTcl:can_insert {parent manager} {

    if {$parent == ""} {
        return 1
    }
    ## Enumerates children
    foreach child [winfo children $parent] {
        set child_manager [winfo manager $child]

	## Don't mix pack and grid together (it's a Tk bug). However, you can
	## mix pack or grid with place.
	if {($child_manager == "grid" && $manager == "pack") ||
	    ($child_manager == "pack" && $manager == "grid")} {
	    return 0
	}
    }

    ## All clear.
    return 1
}

##############################################################################
# INSERT NEW WIDGET ROUTINE
##############################################################################
proc vTcl:auto_place_widget {class {options ""}} {
    global vTcl
    if {$vTcl(mode) == "TEST"} {
        vTcl:error "Inserting widgets is not\nallowed in Test mode."
        return
    }
    if { ($vTcl(w,insert) == "." && $class != "Toplevel") ||
         ([winfo exists $vTcl(w,insert)] == 0 && $class != "Toplevel")} {
        ::vTcl::MessageBox -icon error -message "No insertion point set!" \
            -title "Error!" -type ok
        return
    }

    ## grid and pack managers cannot be mixed in the same container
    if {![vTcl:can_insert $vTcl(w,insert) $vTcl(w,def_mgr)]} {
        ::vTcl::MessageBox -icon error \
	    -message "You cannot mix pack and grid in the same container." \
            -title "Error!" -type ok
        return
    }
    ## last call
    set moreOptions ""
    if {![vTcl::widgets::queryInsertOptions $class $options moreOptions]} {
        return
    }

    append options $moreOptions
    set vTcl(mgrs,update) no
    if $vTcl(pr,getname) {
        set new_widg [vTcl:get_name $class]
    } else {
        set new_widg [vTcl:new_widget_name $class $vTcl(w,insert)]
    }

    if {[lempty $new_widg]} { return }

    set created_widget [vTcl:create_widget $class $options $new_widg 0 0]

    ## when new widget is inserted, automatically refresh
    ## widget tree
    ## we do not destroy the handles that were just created
    ## (remember, the handles are used to grab and move a widget around)
    after idle "\
        vTcl:init_wtree 0
        vTcl:show_selection_in_tree $created_widget"

    return $created_widget
}

proc vTcl:create_widget {class options new_widg x y} {
    global vTcl classes

    set do ""
    set undo ""
    set insert $vTcl(w,insert)
    if {$class == "Toplevel"} {
        set insert .
    }
    if {$vTcl(pr,getname) == 1} {
        if { $vTcl(w,insert) == "." || $class == "Toplevel"} {
            set new_widg ".$new_widg"
        } else {
            set new_widg "$vTcl(w,insert).$new_widg"
        }
    }
    
    set c $class 
    set p ""
    if {[winfo exists $insert]} {
        set p [vTcl:get_class $insert]
    }

    append do "$classes($c,createCmd) $new_widg "
    append do "$classes($c,defaultOptions) $options;"

    if {![lempty $classes($c,insertCmd)]} {
        append do "$classes($c,insertCmd) $new_widg;"
    }
    if {$class != "Toplevel"} {
        append do "$vTcl(w,def_mgr) $new_widg $vTcl($vTcl(w,def_mgr),insert)"
        if {$vTcl(w,def_mgr) == "place"} { append do " -x $x -y $y" }
        append do ";"
    }
    append do "vTcl:setup_bind_widget $new_widg; "
    append do "vTcl:widget:register_widget $new_widg; "
    if {[info exists classes($p,insertChildCmd)] &&
        ![lempty $classes($p,insertChildCmd)]} {
        append do "$classes($p,insertChildCmd) $insert $new_widg;"
    }
    append do "vTcl:active_widget $new_widg; "

    foreach def $classes($c,defaultValues) {
        append do "vTcl:prop:default_opt $new_widg $def vTcl(w,opt,$def); "
    }
    foreach def $classes($c,dontSaveOptions) {
        append do "vTcl:prop:save_or_unsave_opt $new_widg $def vTcl(w,opt,$def) 0; "
    }
	#give it some time, idle should work but it didn't
    	append do "after 500 {vTcl:init_wtree};"

#WAS NOT DELETEING WIDGETS WITH SPECIAL DELETE COMMANDS SUCH AS TOPLEVEL
    if {$undo == ""} {
	append undo "vTcl:unset_alias $new_widg;"
	append undo "::vTcl::notify::publish delete_widget $new_widg;"
	append undo "vTcl:setup_unbind_widget $new_widg;"
	set destroy_command "destroy"
	if {$classes($class,deleteCmd) != ""} {
		set destroy_command $classes($class,deleteCmd)
 	}
	append undo "$destroy_command $new_widg;"
	#append undo "set _cmds \[info commands $new_widg.*\];"
	#append undo "foreach _cmd \$_cmds {catch {rename \$_cmd \"\"}};"
	append undo "vTcl:prop:clear;"
	append undo "after idle {vTcl:init_wtree};"
    	
    }




    vTcl:push_action $do $undo
    update idletasks
    set vTcl(mgrs,update) yes

    if {$class == "Toplevel"} {
        set vTcl(widgets,$new_widg) {}
    } else {
        lappend vTcl(widgets,[winfo toplevel $new_widg]) $new_widg
    }

    if { $vTcl(pr,autoalias) } {
        set alias [vTcl:next_widget_name $c $new_widg]
        vTcl:set_alias $new_widg $alias
    }

    return $new_widg
}

proc vTcl:valid_alias {target alias} {

    global widget
    set toplevel [vTcl:get_top_level_or_alias $target]

    if {[info exists widget($toplevel,$alias)] &&
         $widget($toplevel,$alias) != $target} {
        return 0
    } elseif {[info exists widget($alias)] &&
              [vTcl:get_class $widget($alias)] == "Toplevel"} {
        return 0
    } else {
        return 1
    }
}

proc vTcl:set_alias {target {alias ""} {noupdate ""}} {
    global vTcl widget classes

    if {[lempty $target]} { return }

    set c [vTcl:get_class $target]
    set was {}
    if {[lempty $alias]} {
        if {[info exists widget(rev,$target)]} {
            set was $widget(rev,$target)
        }
        set valid 0
        while {!$valid} {
            set alias [vTcl:get_string "Widget alias for $c" $target $was]
            if {$alias != $was && $alias != ""} {
                # make sure no other widget in the same toplevel has the same alias
                set valid [vTcl:valid_alias $target $alias]
                if {!$valid} {
                    vTcl:dialog "Alias '$alias' already exists"
                }
            } else {
                # user decided not to change the alias, or to cancel
                return
            }
        }
    }

    if {![lempty $was] && $alias != $was} {
        vTcl:unset_alias $target
    }

    if {![lempty $alias] && $alias != $was} {
        set widget($alias) $target
        set widget(rev,$target) $alias

        set widget([vTcl:get_top_level_or_alias $target],$alias) $target

        ## Create an alias in the interpreter.
        if { $vTcl(pr,cmdalias) } {
            interp alias {} $alias {} $classes($c,widgetProc) $target

            if {[winfo toplevel $target] != $target} {
                interp alias {} [vTcl:get_top_level_or_alias $target].$alias {} \
                      $classes($c,widgetProc) $target
            }
        }

	## Remember the list of aliases on a toplevel-basis
	namespace eval ::[winfo toplevel $target] "
	    variable _aliases
	    lappend _aliases $alias
	"

        # Refresh property manager after changing an alias
        if {[lempty $noupdate]} { vTcl:update_widget_info $target }
    }
}

proc vTcl:unset_alias {w} {
    global widget vTcl classes

    if {![info exists widget(rev,$w)]} { return }
    set alias $widget(rev,$w)
    set class [vTcl:get_class $w]
    set other ""

    catch { unset widget([vTcl:get_top_level_or_alias $w],$alias) }
    catch { unset widget([winfo top level $w],$alias) }
    catch { unset widget(rev,$w) }
    catch {
        if {[winfo toplevel $w] != $w} {
            interp alias {} [vTcl:get_top_level_or_alias $w].$alias {}
        }
    }
    catch { interp alias {} $alias {} {} }

    # if alias is defined for another toplevel, let's be more careful
    foreach name [array names widget] {
        if {[string match *,$alias $name]} {
            set other $widget($name)
            break
        }
    }

    catch {

        if {$other == ""} {
            unset widget($alias)
        } else {
            set widget($alias) $other
            if { $vTcl(pr,cmdalias) } {
                interp alias {} $alias {} $classes($class,widgetProc) $other
            }
        }
    }

    namespace eval ::[vTcl:get_toplevel $w] "
	variable _aliases
	::vTcl::lremove _aliases $alias
    "
}

proc vTcl:get_top_level_or_alias {target} {

    global widget

    set top [winfo toplevel $target]

    if {[info exists widget(rev,$top)]} {
        return $widget(rev,$top)
    } else {
        return $top
    }
}

proc vTcl:update_label {t} {
    global vTcl
    if {$t == ""} {return}
    switch [vTcl:get_class $t] {
        Toplevel {
            wm title $t $vTcl(w,opt,-text)
            set vTcl(w,wm,title) $vTcl(w,opt,-text)
        }
        default {
            if [catch {set txt [$t cget -text]}] {
                return
            }
            $t conf -text $vTcl(w,opt,-text)
            vTcl:place_handles $t
        }
    }
}

proc vTcl:set_textvar {t} {
    global vTcl
    if {$t == ""} {return}
    set label [vTcl:get_string "Setting textvariable" $t [$t cget -textvar]]
    if {$label == ""} {
        ## user cancelled
        return
    }
    $t conf -textvar $label
    vTcl:place_handles $t
    vTcl:update_widget_info $t
}

proc vTcl:widget_dblclick {target X Y x y} {
    global vTcl classes
    vTcl:set_mouse_coords $X $Y $x $y
    set c [vTcl:get_class $target 1]
    set class [winfo class $target]

    if {![lempty $classes($class,dblClickCmd)]} {
        eval $classes($class,dblClickCmd) $target
    }
}

proc vTcl:pack_after {target} {
if {[winfo manager $target] != "pack" || $target == "."} {return}
    set l [pack slaves [winfo parent $target]]
    set i [lsearch $l $target]
    set n [lindex $l [expr $i + 1]]
    if {$n != ""} {
        pack conf $target -after $n
    }
    vTcl:place_handles $target
}

proc vTcl:pack_before {target} {
if {[winfo manager $target] != "pack" || $target == "."} {return}
    set l [pack slaves [winfo parent $target]]
    set i [lsearch $l $target]
    set n [lindex $l [expr $i - 1]]
    if {$n != ""} {
        pack conf $target -before $n
    }
    vTcl:place_handles $target
}

proc vTcl:manager_update {mgr} {
    global vTcl
    if {$mgr == ""} {return}
    set options ""
    if {$vTcl(w,manager) != "$mgr"} {return}
    update idletasks
    if {$mgr != "wm" } {
        foreach i $vTcl(m,$mgr,list) {
            set value $vTcl(w,$mgr,$i)
            if { $value == "" } { set value {{}} }
            append options "$i $value "
        }
        set vTcl(var_update) "no"
        set undo [vTcl:dump_widget_quick $vTcl(w,widget)]
        set do "$mgr configure $vTcl(w,widget) $options"
        vTcl:push_action $do $undo
        set vTcl(var_update) "yes"
    } else {
        set    vTcl(w,wm,geometry) \
            "$vTcl(w,wm,geometry,w)x$vTcl(w,wm,geometry,h)"
        append vTcl(w,wm,geometry) \
            "+$vTcl(w,wm,geometry,x)+$vTcl(w,wm,geometry,y)"
        set    vTcl(w,wm,minsize) \
            "$vTcl(w,wm,minsize,x) $vTcl(w,wm,minsize,y)"
        set    vTcl(w,wm,maxsize) \
            "$vTcl(w,wm,maxsize,x) $vTcl(w,wm,maxsize,y)"
        set    vTcl(w,wm,aspect) \
            "$vTcl(w,wm,aspect,minnum) $vTcl(w,wm,aspect,minden)"
        append vTcl(w,wm,aspect) \
            "+$vTcl(w,wm,aspect,maxnum)+$vTcl(w,wm,aspect,maxden)"
        set    vTcl(w,wm,resizable) \
            "$vTcl(w,wm,resizable,w) $vTcl(w,wm,resizable,h)"
#            set    do "$mgr geometry $vTcl(w,widget) $vTcl(w,wm,geometry); "
        append do "$mgr minsize $vTcl(w,widget) $vTcl(w,wm,minsize); "
        append do "$mgr maxsize $vTcl(w,widget) $vTcl(w,wm,maxsize); "
        append do "$mgr focusmodel $vTcl(w,widget) $vTcl(w,wm,focusmodel);"
        append do "$mgr resizable $vTcl(w,widget) $vTcl(w,wm,resizable); "
        append do "$mgr title $vTcl(w,widget) \"$vTcl(w,wm,title)\"; "
        switch $vTcl(w,wm,state) {
            withdrawn { append do "$mgr withdraw $vTcl(w,widget); " }
            iconic { append do "$mgr iconify $vTcl(w,widget); " }
            normal { append do "$mgr deiconify $vTcl(w,widget); " }
        }
        eval $do
        vTcl:wm_button_update
    }
    vTcl:place_handles $vTcl(w,widget)
    vTcl:update_top_list
}

# proc to insert widget in text editor

# insert the current widget name (eg. .top30) or alias into
# given text widget

proc vTcl:insert_widget_in_text {t} {
    global vTcl

    if {$vTcl(w,alias) != ""} {
        set name \$widget\($vTcl(w,alias)\)
    } else {
        set name $vTcl(w,widget)
    }

    $t insert insert $name
}

proc vTcl:add_functions_to_rc_menu {} {
    global vTcl classes

    $vTcl(gui,rc_widget_menu) delete 0 end
    .vTcl.m.widget delete 0 end

    set c $vTcl(w,class)
    if {[lempty $classes($c,functionCmds)]} { return }

    foreach cmd $classes($c,functionCmds) text $classes($c,functionText) {
        $vTcl(gui,rc_widget_menu) add command -label $text -command $cmd
        .vTcl.m.widget add command -label $text -command $cmd
    }
}

proc vTcl:new_widget {autoplace class button {options ""}} {
    global vTcl classes
    if {$vTcl(mode) == "TEST"} {
        vTcl:error "Inserting widgets is not\nallowed in Test mode."
        return
    }

    vTcl:raise_last_button $button

    if {$autoplace || $class == "Toplevel" \
        || $classes($class,autoPlace)} {
        vTcl:status "Status"
        vTcl:rebind_button_1
        return [vTcl:auto_place_widget $class $options]
    }

    # the trick is, ButtonRelease-1 gets processed first (this is
    # how we came here), but then the button class raises the button
    # again, so we wait until we have some free time

    if {[winfo exists $button]} {
       after 0 "$button configure -relief sunken"
    }

    vTcl:status "Insert $class"

    bind vTcl(b) <Button-1> "
        vTcl:place_widget $class $button [list $options] %X %Y %x %y
    "

    bind vTcl(b) <Shift-Button-1> "
        vTcl:place_widget $class $button [list $options] %X %Y %x %y
    "
}

proc vTcl:place_widget {class button options rx ry x y} {
    global vTcl

    if { !$vTcl(pr,multiplace) } {
        if {[winfo exists $button]} {
            $button configure -relief raised
        }
        vTcl:status "Status"
        vTcl:rebind_button_1
    }

    set try_insert [winfo containing $rx $ry]
    set tree [vTcl:complete_widget_tree . 0]

    ## we can only insert inside existing widgets
    if {[lsearch -exact $tree $try_insert] == -1} {
        ::vTcl::MessageBox -title "Insert Widget" \
            -message "You cannot insert a widget here!" -type ok
        return ""
    }

    ## grid and pack managers cannot be mixed in the same container
    if {![vTcl:can_insert $try_insert $vTcl(w,def_mgr)]} {
        ::vTcl::MessageBox -icon error \
	    -message "You cannot mix pack and grid in the same container." \
            -title "Error!" -type ok
        return
    }

    ## last call
    set moreOptions ""
    if {![vTcl::widgets::queryInsertOptions $class $options moreOptions]} {
        return
    }

    append options $moreOptions
    set vTcl(w,insert) $try_insert

    set vTcl(mgrs,update) no
    if $vTcl(pr,getname) {
        set new_widg [vTcl:get_name $class]
    } else {
        set new_widg [vTcl:new_widget_name $class $vTcl(w,insert)]
    }

    if {[lempty $new_widg]} { return }

    set created_widget [vTcl:create_widget $class $options $new_widg $x $y]

    # when new widget is inserted, automatically refresh
    # widget tree

    # we do not destroy the handles that were just created
    # (remember, the handles are used to grab and move a widget around)

    after idle "
        vTcl:init_wtree 0
        vTcl:show_selection_in_tree $created_widget
    "

    return $created_widget
}

## Get the next available widget number for this class.
## IE: Edit1, Edit2, Edit3...
proc vTcl:next_widget_name {class target {old_alias {}}} {
    global classes vTcl

    if {$old_alias == ""} {
        set prefix $class
        set num 1
        if {[info exists classes($class,aliasPrefix)]} {
            set prefix $classes($class,aliasPrefix)
        }
    } else {
        set prefix $old_alias
	set num 1
	## If the alias we want to set is in the form <Prefix><Num> we try
	## to reuse the same number
	regexp {([^0-9]+)([0-9]+)} $old_alias matchall prefix num
    }

    ## If it is a toplevel alias, it must not be the same as any other alias
    ## So we make a list of existing aliases to check for, and increment until
    ## we find a unused name.
    if {$class == "Toplevel"} {
        set tops $vTcl(tops)
    } else {
        set tops [winfo toplevel $target]
    }
    set existing ""
    foreach top $tops {
        namespace eval ::$top {
            variable _aliases
	    if {![info exists _aliases]} {
	        set _aliases {}
	    }
        }
        set existing [concat $existing [vTcl:at ::${top}::_aliases]]
    }
    while {[lsearch -exact $existing $prefix$num] != -1} {
        incr num
    }

    return $prefix$num
}

proc vTcl:update_aliases {} {
    global vTcl widget

    foreach top $vTcl(tops) {
        # all children of the toplevel
        set children [vTcl:list_widget_tree $top "" 1 1]
        foreach child $children {
	    if {![info exists widget(rev,$child)]} { continue }

	    set alias $widget(rev,$child)
            ## Remember the list of aliases on a toplevel-basis
            namespace eval ::$top "
	        variable _aliases
	        lappend _aliases $alias
	    "
	}
    }
}

proc vTcl:widget:get_image {w} {
    global vTcl classes

    set c [vTcl:get_class $w]

    if {! [info exists classes($c,icon)]} {
        return [vTcl:image:get_image hide.gif]
    }

    set i $classes($c,icon)
    if {[vTcl:streq [string index $i 0] "@"]} {
        set i [[string range $i 1 end] $w]
    }
    return $i
}

proc vTcl:widget:get_tree_label {w} {
    global vTcl classes

    set c [vTcl:get_class $w]

    if {! [info exists classes($c,treeLabel)]} {
        return $c
    }

    set t $classes($c,treeLabel)
    if {[vTcl:streq [string index $t 0] "@"]} {
        set t [[string range $t 1 end] $w]
    }
    return $t
}

####
## Register special widget options not available with configure
##
####
proc vTcl:widget:register_widget_custom {w} {

    set class [vTcl:get_class $w]

    ## special options support
    if {[info exist ::classoption($class)]} {
        foreach spec_opt $::classoption($class) {
            set val [$::configcmd($spec_opt,get) $w]
            set ::widgets::${w}::options($spec_opt) $val
            set ::widgets::${w}::defaults($spec_opt) ""
            set ::widgets::${w}::save($spec_opt) [expr {$val != ""}]
        }
    }
}

proc vTcl:widget:register_widget_megachildren {w} {

    global classes

    set wdg_class [vTcl:get_class $w]

    # if this is a megawidget, register special information in the
    # children to allow the megawidget to be manipulated as one unit
    # when the user clicks on such a child, and such an information is
    # found, then the parent will be selected instead

    if {[info exists classes(${wdg_class},megaWidget)]} {
        if {$classes(${wdg_class},megaWidget)} {

            # get all children
            set children [vTcl:list_widget_tree $w "" 1 1]
            foreach child $children {
                namespace eval ::widgets::${child} {
                    variable parent          ;# this one is for dragging items
                    variable parent_widget   ;# same value, but used for saving
                }
                set ::widgets::${child}::parent $w
                set ::widgets::${child}::parent_widget $w
            }

            # Now, we shall unmark those widgets as parent that
            # are in childsites, because the user should be able
            # to manipulate them. First, let try to get a list of
            # eligible children.

            set childrenCmd [lindex $classes($wdg_class,treeChildrenCmd) 0]
            if {$childrenCmd == ""} {
                return
            }

            # don't include levels info for widget tree display
            #                                 v
            set realChildren [$childrenCmd $w ""]

            foreach realChild $realChildren {
                if {[info exists ::widgets::${realChild}::parent]} {
                   unset ::widgets::${realChild}::parent
                }
                vTcl:widget:register_widget $realChild
            }
        }
    }
}

###
## Register a widget and give it a containing namespace to hold data.
#  save_options lists options that we absolutely want to be saved
#  (e.g. for menus we want to save -menu, -label at least)
###
proc vTcl:widget:register_widget {w {save_options ""}} {

    global classes
    set opts [$w configure]

    vTcl:widget:register_widget_megachildren $w

    if {![catch {namespace children ::widgets} namespaces]} {
        if {[lsearch $namespaces ::widgets::${w}] > -1} {

            if {![info exists ::widgets::${w}::options] &&
                 [info exists ::widgets::${w}::save]} {

                # at least, if the widget has already been registered
                # (typically just after a "file open" operation), we
                # need to create the options and defaults arrays

                namespace eval ::widgets::${w} {
                    variable options
                    variable defaults
                }

                set defopts $classes([vTcl:get_class $w],defaultValues)
                set newdefopts ""

                foreach list $opts {
                    lassign $list opt x x def val

                    # if the option is not saved in the project, we
                    # want it to take the default value for the most
                    # common options (on the other hand, some options
                    # are better off if we use the option database)

                    if {[lsearch -exact $defopts $opt] != -1 &&
                        ![info exists ::widgets::${w}::save($opt)]} {
                        set ::widgets::${w}::options($opt) $def
                        set ::widgets::${w}::defaults($opt) $def
                        lappend newdefopts $opt $def
                    } else {
                        set ::widgets::${w}::options($opt) $val
                        set ::widgets::${w}::defaults($opt) $def
                    }

                    # if the option is not saved, make sure we keep the settings
                    if {![info exists ::widgets::${w}::save($opt)]} {
                        set ::widgets::${w}::save($opt) 0
                    }
                }

                if {![lempty $newdefopts]} {
                    eval $w configure $newdefopts
                }

                vTcl:widget:register_widget_custom $w
                return
            }
        }
    }

    namespace eval ::widgets::${w} {
        variable options
        variable save
        variable defaults
    }

    foreach list $opts {
        lassign $list opt x x def val
        set ::widgets::${w}::options($opt) $val
        set ::widgets::${w}::defaults($opt) $def

        if {[lsearch -exact $save_options $opt] >=0 } {
            set ::widgets::${w}::save($opt) 1
            continue
        }

	if {[info exists ::widgets::${w}::save($opt)]} { continue }

        set ::widgets::${w}::save($opt) [expr ![vTcl:streq $def $val]]
    }

    vTcl:widget:register_widget_custom $w
}
##
# Destroy all widgets that have not been registered. These will usually be ones 
# that are created at run time or using tkcon.
##
proc vTcl:widget:remove_unregistered_widgets {{w .}} {
	set widgets [vTcl:list_widget_tree $w]
	foreach w $widgets {
		if {![catch {namespace children ::widgets} namespaces]} {
	        	if { [lsearch $namespaces ::widgets::${w}] <= -1 } {
				pack forget $w
				destroy $w
		   	   }
		}
	}
}

###
## Register all unregistered widgets.  This is called when loading a project.
## If the project has widget registry information already stored, the namespace
## for each widget will already exist, and the widget will not be registered.
##
## If there is no registry, one will be created.  This lets us register old
## imported projects that don't contain saved registry information.
###

proc vTcl:widget:register_all_widgets {{w .}} {
    set widgets [vTcl:list_widget_tree $w]
    foreach w $widgets {
        vTcl:widget:register_widget $w
    }
}

namespace eval vTcl::widgets {

    proc saveOptions {w optionName} {
        namespace eval ::widgets::${w}::options {}
        namespace eval ::widgets::${w}::save    {}
        vTcl:WidgetVar $w options
        vTcl:WidgetVar $w save
        
        set value [$w cget $optionName]
        set options($optionName) $value
        set save($optionName) 1
    }

    ## ensures the list of suboptions are saved
    proc saveSubOptions {w args} {
        set nm ::widgets::${w}::subOptions
        namespace eval $nm {}
        foreach option $args {
            set ${nm}::save($option) 1
        }
    }

    ## actionProc takes as parameter the widget path and an additional param
    ##
    ## returnVal array is set with as index the widget path and as value the
    ## value returned by actionProc
    ##
    ## for example:
    ##    returnVal(.)  core
    ##    returnVal(.top32) core
    ##    returnVal(.top32.arrow28) bwidget
    ##    ...
    proc iterateCompleteWidgetTree {root actionProc actionParam returnVal} {
        upvar $returnVal _returnVal
        set children [vTcl:complete_widget_tree $root 0]
        foreach child $children {
            set _returnVal($child) [$actionProc $child $actionParam]
        }
    }

    proc getClasses {w args} {
        set c [vTcl:get_class $w]

        ## if this is a compound container with a megawidget inside,
        ## save the megawidget support procs into the project as well
        if {$c == "CompoundContainer" && [$w innerClass] == "MegaWidget"} {
            return [concat $c [usedClasses [$w innerWidget]]]
        } else {
            return $c
        }
    }

    proc usedClasses {root} {
        array set classArray {}
        iterateCompleteWidgetTree $root getClasses {} classArray

        set result ""
        foreach index [array names classArray] {
            set result [concat $result $classArray($index)]
        }

        return [lsort -unique $result]
    }

    proc getLibrary {w arg} {
        set c [vTcl:get_class $w]
        return $::classes($c,lib)
    }

    ## return the list of libraries used by a compound
    proc usedLibraries {root} {
        array set libraries {}
        iterateCompleteWidgetTree $root getLibrary {} libraries

        set result ""
        foreach index [array names libraries] {
            lappend result $libraries($index)
        }

        ## return a list without duplicates
        return [lsort -unique $result]
    }

    ## return the list of libraries that have been successfully loaded
    proc loadedLibraries {} {
        return $::vTcl(libs)
    }

    ## verify that the list of libraries passed as parameters are loaded
    ## returns the missing ones
    proc verifyLibraries {libraries} {
        set loaded [loadedLibraries]
        set result ""
        foreach library $libraries {
            if {[lsearch -exact $loaded $library] == -1} {
                lappend result $library
            }
        }
        return $result
    }

    ## asks a widget class if can insert and if so returns additional options
    proc queryInsertOptions {class addOptions refOptions} {
        upvar $refOptions options

        if {![info exists ::classes($class,queryInsertOptionsCmd)]} {
            ## yeah, we can insert, there is no restriction
            set options ""
            return 1
        }

        return [$::classes($class,queryInsertOptionsCmd) $addOptions options]
    }

    ## return the list of used images or fonts for this widget
    ## resourceType parameter needs to be "image" or "font"
    proc getResources {w resourceType} {
        set used {}
        set value {}

        ## 1. use defaut -image or -font option
        catch {set value [$w cget -$resourceType]}
        if {$value != ""} {
            lappend used $value
        }

        ## 2. use custom per class procedure to get used images or fonts
        set c [vTcl:get_class $w]
        set cmd get[string totitle $resourceType]sCmd
        if {[info exists ::classes($c,$cmd)]} {
            set used [concat $used [$::classes($c,$cmd) $w]]
        }

        ## 3. only return vTcl images and fonts objects
        set result {}
        foreach type {stock user} {
            foreach object $used {
                if {[lsearch [set ::vTcl(${resourceType}s,$type)] $object] > -1} {
                   lappend result $object
                }
            }
        } ; # foreach type ...

        return [lsort -unique $result]
    }

    ## return the list of images/font used by a compound
    ## resourceType parameter needs to be "image" or "font"
    proc usedResources {root resourceType} {
        array set resources {}
        iterateCompleteWidgetTree $root getResources $resourceType resources

        set result ""
        foreach index [array names resources] {
            if {![lempty $resources($index)]} {
                set result [concat $result $resources($index)]
            }
        }

        ## return a list without duplicates
        return [lsort -unique $result]
    }
}


