##############################################################################
# $Id: lib_core.tcl,v 1.76 2005/12/05 06:58:31 kenparkerjr Exp $
#
# lib_core.tcl - core tcl/tk widget support library
#
# 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.

#
# initializes this library
#
proc vTcl:lib_core:init {} {
    global vTcl

    lappend vTcl(libNames) "Tcl/Tk Core Widget Library"
    return 1
}

proc vTcl:widget:lib:lib_core {args} {
    global vTcl

    set order {
    	Toplevel
	Message
	Frame
	Canvas
	Button
	Entry
	Label
	Listbox
	Text
	Checkbutton
	Radiobutton
	Scrollbar
	Scale
	Menubutton
      CompoundContainer
      MegaWidget
	UnmanagedFrame
    } 

    if {[info tclversion] >= 8.4} {
	lappend order Spinbox
	lappend order Labelframe
	lappend order Panedwindow
    }

    vTcl:lib:add_widgets_to_toolbar $order core "Standard/vTcl Tcl/Tk Widgets"

    append vTcl(head,core,importheader) {
    package require Tk
    switch $tcl_platform(platform) {
	windows {
	    option add *Button.padY 0
	}
	default {
	    option add *Scrollbar.width 10
	    option add *Scrollbar.highlightThickness 0
	    option add *Scrollbar.elementBorderWidth 2
	    option add *Scrollbar.borderWidth 2
	}
    }
    }
}

####################################################################
# Tooltip support
#

proc vTcl:get_balloon {target} {
    set events [bind $target]
    if {[lsearch -exact $events <<SetBalloon>>] == -1} {
	return ""
    }
    set event [string trim [bind $target <<SetBalloon>>]]
    if {[string match {set ::vTcl::balloon::%W*} $event]} {
	return [lindex $event 2]
    }
    return ""
}

proc vTcl:update_balloon {target var} {
    set ::$var [vTcl:get_balloon $target]
}

proc vTcl:config_balloon {target value} {
    set old [vTcl:get_balloon $target]
    set new $value
    if {$old == "" && $new == ""} {
	return
    }
    if {$old != "" && $new == ""} {
	bind $target <<SetBalloon>> {}
	::widgets_bindings::remove_tag_from_widget $target _vTclBalloon
    } else {
	bind $target <<SetBalloon>> "set ::vTcl::balloon::%W \{$new\}"
	::widgets_bindings::add_tag_to_widget $target _vTclBalloon
	::widgets_bindings::add_tag_to_tagslist _vTclBalloon
    }

    ## if the bindings editor is there, refresh it
    if {[winfo exists .vTcl.bind]} {
	::widgets_bindings::save_current_binding
	vTcl:get_bind $target
    }
}

####################################################################
# Procedures to support extra geometry mgr configuration
#

proc vTcl:grid:conf_ext {target var value} {
    global vTcl
    set parent [winfo parent $target]
    grid columnconf $parent $vTcl(w,grid,-column) -weight  $vTcl(w,grid,column,weight)
    grid columnconf $parent $vTcl(w,grid,-column) -minsize $vTcl(w,grid,column,minsize)
    grid rowconf    $parent $vTcl(w,grid,-row)    -weight  $vTcl(w,grid,row,weight)
    grid rowconf    $parent $vTcl(w,grid,-row)    -minsize $vTcl(w,grid,row,minsize)
    # Both required for better compatibilty!
    grid propagate  $target $vTcl(w,grid,propagate)
    pack propagate  $target $vTcl(w,grid,propagate)
}

proc vTcl:pack:conf_ext {target var value} {
    global vTcl
    # Both required for better compatibilty!
    pack propagate  $target $vTcl(w,pack,propagate)
    grid propagate  $target $vTcl(w,pack,propagate)
}

proc vTcl:wm:enable_geom {} {
    global vTcl
    # Enable/disable UI elements
    array set state {0 disabled 1 normal}
    if {$vTcl(w,class) == "Menu"} {
	set origin_state disabled
	set size_state   disabled
    } else {
	set origin_state $state($vTcl(w,wm,set,origin))
	set size_state   $state($vTcl(w,wm,set,size))
    }

    vTcl:prop:enable_manager_entry geometry,x $origin_state
    vTcl:prop:enable_manager_entry geometry,y $origin_state
    vTcl:prop:enable_manager_entry geometry,w $size_state
    vTcl:prop:enable_manager_entry geometry,h $size_state
}

proc vTcl:wm:conf_geom {target var value} {
    global vTcl
    set ::widgets::${target}::set,origin $vTcl(w,wm,set,origin)
    set ::widgets::${target}::set,size   $vTcl(w,wm,set,size)
    set ::widgets::${target}::runvisible $vTcl(w,wm,runvisible)
    set x $vTcl(w,wm,geometry,x)
    set y $vTcl(w,wm,geometry,y)
    set w $vTcl(w,wm,geometry,w)
    set h $vTcl(w,wm,geometry,h)
    wm geometry $target ${w}x${h}+${x}+${y}
    vTcl:wm:enable_geom
}

proc vTcl:wm:conf_resize {target var value} {
    global vTcl
    set w $vTcl(w,wm,resizable,w)
    set h $vTcl(w,wm,resizable,h)
    wm resizable $target $w $h
}

proc vTcl:wm:conf_minmax {target var value} {
    global vTcl
    set min_x $vTcl(w,wm,minsize,x)
    set min_y $vTcl(w,wm,minsize,y)
    set max_x $vTcl(w,wm,maxsize,x)
    set max_y $vTcl(w,wm,maxsize,y)
    wm minsize $target $min_x $min_y
    wm maxsize $target $max_x $max_y
}

proc vTcl:wm:conf_state {target var value} {
    global vTcl
    catch {wm $vTcl(w,wm,state) $target}
}

proc vTcl:wm:conf_title {target var value} {
    global vTcl
    wm title $target "$vTcl(w,wm,title)"
}

proc vTcl:wm:dump_info {target basename} {
    global vTcl
    set out ""
    append out $vTcl(tab)
    append out "namespace eval ::widgets::$basename \{\n"
    foreach wm_option $vTcl(m,wm,savelist) {
	if {[info exists ::widgets::${target}::${wm_option}]} {
	    append out $vTcl(tab2)
	    append out "set $wm_option [vTcl:at ::widgets::${target}::${wm_option}]\n"
	}
    }
    append out "$vTcl(tab)\}\n"
    return $out
}

####################################################################
# Procedures to support "double-click" action on widets
# There are mostly procedures to support the special case of menus
#

proc vTcl:edit_target_menu {target} {
    global vTcl
    if [catch {set menu [$target cget -menu]}] {
	return
    }
    if {$menu == ""} {
	set menu [vTcl:new_widget_name m $target]
	menu $menu
	vTcl:widget:register_widget $menu -tearoff
	vTcl:setup_vTcl:bind $menu
	$target conf -menu $menu
	foreach def {-activebackground -activeforeground
		     -background -foreground -font} {
	    vTcl:prop:default_opt $menu $def vTcl(w,opt,$def)
	}
    }

    set name [vTcl:rename $menu]
    set base ".vTcl.menu_$name"

    vTclWindow.vTclMenuEdit $base $menu
}

proc vTcl:edit_menu {menu} {
    set name [vTcl:rename $menu]
    set base ".vTcl.menu_$name"

    vTclWindow.vTclMenuEdit $base $menu
}

# translation for options when saving files

TranslateOption    -menu vTcl:core:menutranslate
NoEncaseOption     -menu 1
NoEncaseOptionWhen -menu vTcl:core:noencasewhen

proc vTcl:core:menutranslate {value} {

	global vTcl

	if [regexp {((\.[a-zA-Z0-9_]+)+)} $value matchAll path] {

		if {$matchAll == $value} {

		       	set path [vTcl:base_name $path]

			return "\"$path\""
		}
	}

      	return $value
}

TranslateOption    -xscrollcommand vTcl:core:scrolltranslate
NoEncaseOption     -xscrollcommand 1
NoEncaseOptionWhen -xscrollcommand vTcl:core:noencasewhen

TranslateOption    -yscrollcommand vTcl:core:scrolltranslate
NoEncaseOption     -yscrollcommand 1
NoEncaseOptionWhen -yscrollcommand vTcl:core:noencasewhen

TranslateOption    -command vTcl:core:commandtranslate
NoEncaseOption     -command 1
NoEncaseOptionWhen -command vTcl:core:noencasecommandwhen

TranslateOption    -listvariable vTcl:core:variabletranslate
NoEncaseOption     -listvariable 1
NoEncaseOptionWhen -listvariable vTcl:core:noencasewhen

TranslateOption    -variable vTcl:core:variabletranslate
NoEncaseOption     -variable 1
NoEncaseOptionWhen -variable vTcl:core:noencasewhen

TranslateOption    -textvariable vTcl:core:variabletranslate
NoEncaseOption     -textvariable 1
NoEncaseOptionWhen -textvariable vTcl:core:noencasewhen

proc vTcl:core:variabletranslate {value} {

	global vTcl

	if {[regexp {(\.[\.a-zA-Z0-9_]+)::(.*)} $value matchAll path variable]} {

	    ## potential candidate, is it a window ?
	    if {![winfo exists $path]} {return $value}

	    if {"$path" == "[winfo toplevel $path]"} {
		set path {$top}
	    } else {
		set path [vTcl:base_name $path]
	    }

	    return "\"${path}\\::${variable}\""
	}

	return $value
}

proc vTcl:core:scrolltranslate {value} {

	global vTcl

	if [regexp {((\.[a-zA-Z0-9_]+)+) set} $value matchAll path] {

	       	set path [vTcl:base_name $path]

		return "\"$path set\""
	}

      	return $value
}

proc vTcl:core:commandtranslate {value} {

    global vTcl

    if {[regexp {(\.[\.a-zA-Z0-9_]+) (x|y)view} $value matchAll path axis]} {

       	set path [vTcl:base_name $path]

	return "\"$path ${axis}view\""

    } elseif {[regexp {vTcl:DoCmdOption (\.[\.a-zA-Z0-9_]+) (.*)} $value matchAll path cmd]} {

	set path [vTcl:base_name $path]

	return "\[list vTcl:DoCmdOption $path $cmd\]"
    }

    return $value
}

proc vTcl:core:noencasewhen {value} {

    if { [string match {"$base*} $value] ||
	 [string match {"$site*} $value] ||
	 [string match {"$target*} $value] ||
	 [string match {"$top*} $value] } {
	return 1
    }

    return 0
}

proc vTcl:core:noencasecommandwhen {value} {

	if { [string match {"$base*?view"} $value] ||
	     [string match {"$site*?view"} $value] ||
	     [string match {"$top*?view"} $value] ||
	     [string match {\[list vTcl:DoCmdOption $base*} $value] ||
	     [string match {\[list vTcl:DoCmdOption $top*} $value] ||
	     [string match {\[list vTcl:DoCmdOption $site*} $value] } {
		return 1
	} else {
		return 0
	}
}

proc vTcl:core:set_option {target option description} {

    global vTcl

    set value [$target cget $option]
    set newvalue [vTcl:get_string $description $target $value]
    # cancelled?
    if {$newvalue == ""} {
	return
    }

    if {! [vTcl:streq $value $newvalue]} {
	$target configure $option $newvalue

	# we better save that option, too
	set vTcl(w,opt,$option) $newvalue
	vTcl:prop:save_opt $target $option vTcl(w,opt,$option)

	# keep showing the selection in the toplevel
	# (do not destroy the selection handles)
	vTcl:init_wtree 0
    }
}

namespace eval vTcl::widgets::core {

    ## Utility proc.  Dump a megawidget's children, but not those that are
    ## part of the megawidget itself.  Differs from vTcl:dump:widgets in that
    ## it dumps the geometry of $subwidget, but it doesn't dump $subwidget
    ## itself (`vTcl:dump:widgets $subwidget' doesn't do the right thing if
    ## the grid geometry manager is used to manage children of $subwidget.
    proc dump_subwidgets {subwidget {sitebasename {}}} {
	puts "dump_subwidgets $subwidget"
	global vTcl basenames classes
	set output ""
	set geometry ""
	set length      [string length $subwidget]
	set basenames($subwidget) $sitebasename

	foreach i [vTcl:get_children $subwidget] {

	    set basename [vTcl:base_name $i]

	    # don't try to dump subwidget itself
	    if {"$i" != "$subwidget"} {
		set basenames($i) $basename
		set class [vTcl:get_class $i]
		append output [$classes($class,dumpCmd) $i $basename]
		append geometry [vTcl:dump_widget_geom $i $basename]
		unset basenames($i)
	    }
	}
	append output $geometry

	unset basenames($subwidget)
	return $output
    }
}

####################################################################
# Add/remove pages to notebooks, columns to the multicolumn listbox,
# edit sites in a paned window, etc.

proc vTclWindow.vTcl.itemEdit {base} {
    if {$base == ""} {
	set base .vTcl.itemEdit
    }
    if {[winfo exists $base]} {
	wm deiconify $base; return
    }

    global widget

    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $base -class Toplevel -menu $base.m73
    wm focusmodel $base passive
    set defaultGeometry 1
    if {[info exists ::vTcl(pr,edit[vTcl:at ::vTcl::itemEdit::class($base)])]} {
	wm geometry $base $::vTcl(pr,edit[vTcl:at ::vTcl::itemEdit::class($base)])
	set defaultGeometry 0
    } else {
	wm geometry $base 490x343
    }
    wm withdraw $base
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base "Edit"
    vTcl:FireEvent $base <<Create>>
    wm protocol $base WM_DELETE_WINDOW "::vTcl::itemEdit::close $base"
    wm transient $base .vTcl

    ###################
    # DEFINING ALIASES
    ###################
    vTcl:DefineAlias $base.cpd37.01.cpd38.01 ItemsListbox vTcl:WidgetProc $base 1
    vTcl:DefineAlias $base.cpd37.02.sw.c.f PropertiesFrame vTcl:WidgetProc $base 1
    vTcl:DefineAlias $base.cpd37.02.sw.c PropertiesCanvas vTcl:WidgetProc $base 1
    vTcl:DefineAlias $base.fra34.but36 ItemsEditDelete vTcl:WidgetProc $base 1
    vTcl:DefineAlias $base.m73.men74 ItemsEditMenuAddDelete vTcl:WidgetProc $base 1

    menu $base.m73 -relief flat
    $base.m73 add cascade \
	-menu "$base.m73.men74" -label Item
    $base.m73 add cascade \
	-menu "$base.m73.men75" -label Move
    menu $base.m73.men74 \
	-tearoff 0
    $base.m73.men74 add command \
	-command "::vTcl::itemEdit::addItem $base" -label Add
    $base.m73.men74 add command \
	-command "::vTcl::itemEdit::removeItem $base" -label Delete
    menu $base.m73.men75 \
	-tearoff 0
    $base.m73.men75 add command \
	-command "::vTcl::itemEdit::moveUpOrDown $base up" -label Up
    $base.m73.men75 add command \
	-command "::vTcl::itemEdit::moveUpOrDown $base down" -label Down

    frame $base.fra34 \
	-width 125
    vTcl:toolbar_button $base.fra34.but35 \
	-image [vTcl:image:get_image add.gif] \
	-command "::vTcl::itemEdit::addItem $base"
    vTcl:set_balloon $base.fra34.but35 {Add}
    vTcl:toolbar_button $base.fra34.but36 \
	-image [vTcl:image:get_image remove.gif] \
	-command "::vTcl::itemEdit::removeItem $base"
    vTcl:set_balloon $base.fra34.but36 {Delete}
    vTcl:toolbar_button $base.fra34.but37 \
	-image up -command "::vTcl::itemEdit::moveUpOrDown $base up"
    vTcl:set_balloon $base.fra34.but37 {Move Up}
    vTcl:toolbar_button $base.fra34.but38 \
	-image down -command "::vTcl::itemEdit::moveUpOrDown $base down"
    vTcl:set_balloon $base.fra34.but38 {Move Down}
    vTcl:toolbar_button $base.fra34.but39 \
	-image [vTcl:image:get_image ok.gif] \
	-command "::vTcl::itemEdit::close $base"
    vTcl:set_balloon $base.fra34.but39 {Close}
    frame $base.cpd37 \
	-background #000000 -height 100 -width 200
    frame $base.cpd37.01
    frame $base.cpd37.01.cpd38 \
	-borderwidth 1 -height 30 -relief raised -width 30
    listbox $base.cpd37.01.cpd38.01 \
	-background #ffffff \
	-xscrollcommand "$base.cpd37.01.cpd38.02 set" \
	-yscrollcommand "$base.cpd37.01.cpd38.03 set" \
	-listvariable ::${base}::list_items
    bind $base.cpd37.01.cpd38.01 <<ListboxSelect>> {
	::vTcl::itemEdit::selectItem [winfo toplevel %W] \
	    [lindex [%W curselection] 0]
    }
    scrollbar $base.cpd37.01.cpd38.02 \
	-command "$base.cpd37.01.cpd38.01 xview" -orient horizontal
    scrollbar $base.cpd37.01.cpd38.03 \
	-command "$base.cpd37.01.cpd38.01 yview"
    frame $base.cpd37.02
    frame $base.cpd37.03 \
	-background #ff0000 -borderwidth 2 -relief raised
    bind $base.cpd37.03 <B1-Motion> {
	set root [ split %W . ]
    set nb [ llength $root ]
    incr nb -1
    set root [ lreplace $root $nb $nb ]
    set root [ join $root . ]
    set width [ winfo width $root ].0
    set val [ expr (%X - [winfo rootx $root]) /$width ]
    if { $val >= 0 && $val <= 1.0 } {

	place $root.01 -relwidth $val
	place $root.03 -relx $val
	place $root.02 -relwidth [ expr 1.0 - $val ]
    }
    }
    ScrolledWindow $base.cpd37.02.sw
    canvas $base.cpd37.02.sw.c \
	-highlightthickness 0 -yscrollincrement 20
    ###################
    # SETTING GEOMETRY
    ###################
    pack $base.fra34 \
	-in $base -anchor center -expand 0 -fill x -side top
    pack $base.fra34.but35 \
	-in $base.fra34 -anchor center -expand 0 -fill none -side left
    pack $base.fra34.but36 \
	-in $base.fra34 -anchor center -expand 0 -fill none -side left
    pack $base.fra34.but37 \
	-in $base.fra34 -anchor center -expand 0 -fill none -side left
    pack $base.fra34.but38 \
	-in $base.fra34 -anchor center -expand 0 -fill none -side left
    pack $base.fra34.but39 \
	-in $base.fra34 -anchor center -expand 0 -fill none -side right
    pack $base.cpd37 \
	-in $base -anchor center -expand 1 -fill both -side top
    place $base.cpd37.01 \
	-x 0 -y 0 -width -1 -relwidth 0.55 -relheight 1 -anchor nw \
	-bordermode ignore
    pack $base.cpd37.01.cpd38 \
	-in $base.cpd37.01 -anchor center -expand 1 -fill both -side top
    grid columnconf $base.cpd37.01.cpd38 0 -weight 1
    grid rowconf $base.cpd37.01.cpd38 0 -weight 1
    grid $base.cpd37.01.cpd38.01 \
	-in $base.cpd37.01.cpd38 -column 0 -row 0 -columnspan 1 -rowspan 1 \
	-sticky nesw
    grid $base.cpd37.01.cpd38.02 \
	-in $base.cpd37.01.cpd38 -column 0 -row 1 -columnspan 1 -rowspan 1 \
	-sticky ew
    grid $base.cpd37.01.cpd38.03 \
	-in $base.cpd37.01.cpd38 -column 1 -row 0 -columnspan 1 -rowspan 1 \
	-sticky ns
    place $base.cpd37.02 \
	-x 0 -relx 1 -y 0 -width -1 -relwidth 0.45 -relheight 1 -anchor ne \
	-bordermode ignore
    place $base.cpd37.03 \
	-x 0 -relx 0.55 -y 0 -rely 0.9 -width 10 -height 10 -anchor s \
	-bordermode ignore
    pack $base.cpd37.02.sw \
	-in $base.cpd37.02 -anchor center -expand 1 -fill both -side top
    pack $base.cpd37.02.sw.c \
	-in $base.cpd37.02.sw

    ## tell the scrolledwindow what widget it should scroll
    $base.cpd37.02.sw setwidget $base.cpd37.02.sw.c

    ## insert a frame into the canvas so we can put stuff in it
    frame $base.cpd37.02.sw.c.f
    $base.cpd37.02.sw.c create window 0 0 -window $base.cpd37.02.sw.c.f \
	-anchor nw -tag properties

    ## set up visual Tcl keyboard accelerators
    vTcl:setup_vTcl:bind $base

    if {$defaultGeometry} {
       vTcl:center $base 490 343
    }
    wm deiconify $base

    vTcl:FireEvent $base <<Ready>>
}

namespace eval ::vTcl::itemEdit {

    variable cmds
    variable target
    variable counter
    variable suffix
    variable current
    variable allOptions
    variable enableData
    variable adding
    variable class
    set counter 0

    proc edit {target cmds} {
	variable counter
	variable suffix
	variable class

	incr counter
	set top .vTcl.itemEdit_$counter
	set suffix($top) $counter
	set class($top) [vTcl:get_class $target]
	Window show .vTcl.itemEdit $top
	init $top $target $cmds
    }

    ## get initial values for the checkboxes
    proc initBoxes {top} {
	variable target
	variable allOptions
	variable cmds

	set w $target($top)
	set nm ::widgets::${w}::subOptions
	namespace eval $nm {}

	## first time ? if so, check values that are not the default
	if {![info exists ${nm}::save]} {
	    ## how many subitems ?
	    set size [llength [vTcl:at ::${top}::list_items]]
	    for {set i 0} {$i < $size} {incr i} {
		set conf [::$cmds($top)::itemConfigure $target($top) $i]
		foreach opt $conf {
		    set option  [lindex $opt 0]
		    set default [lindex $opt 3]
		    set value   [lindex $opt 4]
		    if {$value != $default} {
			set ${nm}::save($option) 1
		    }
		}
	    }
	}
    }

    ## action to take when a box is checked
    proc setGetBox {top option {var {}}} {
	variable target

	set w $target($top)
	set nm ::widgets::${w}::subOptions
	if {$var != ""} {
	    set ${nm}::save($option) [vTcl:at $var]
	} else {
	    if {[info exists ${nm}::save($option)]} {
		return [vTcl:at ${nm}::save($option)]
	    } else {
		return 0
	    }
	}
    }

    ## action to take when a key is released in an option
    proc keyRelease {top option var boxvar} {
	variable cmds
	variable current
	variable target

	set conf [::$cmds($top)::itemConfigure $target($top) $current($top) $option]
	set default [lindex $conf 3]
	set value [vTcl:at $var]

	if {$value != $default} {
	    set $boxvar 1
	    setGetBox $top $option $boxvar
	}
    }

    proc init {top w cmdsEdit} {
	variable cmds
	variable target
	variable current
	variable adding

	set cmds($top) $cmdsEdit
	set target($top) $w
	set adding($top) 0
	set list_items [::$cmds($top)::getItems $target($top)]
	set current($top) [lindex $list_items 0]
	set list_items [lrange $list_items 1 end]
	set ::${top}::list_items $list_items
	initBoxes $top
	initProperties $top
	selectItem $top $current($top)
	wm title $top [::$cmds($top)::getTitle $w]

	::vTcl::notify::subscribe delete_widget $top ::vTcl::itemEdit::widgetDeleted
	::vTcl::notify::subscribe deleted_childsite $top ::vTcl::itemEdit::childsiteDeleted
    }

    ## find the superset of all options for all subitems
    proc allOptions {top} {
	variable cmds
	variable target

	set optionsList ""
	if {[info proc ::$cmds($top)::getMinimumOptions] != ""} {
	    return [::$cmds($top)::getMinimumOptions]
	}

	## how many subitems ?
	set size [llength [vTcl:at ::${top}::list_items]]
	for {set i 0} {$i < $size} {incr i} {
	    set conf [::$cmds($top)::itemConfigure $target($top) $i]
	    foreach option $conf {
		lappend optionsList [lindex $option 0]
	    }
	}

	## remove duplicates
	set optionsList [vTcl:lrmdups $optionsList]
	return $optionsList
    }

    proc initProperties {top} {
	variable cmds
	variable target
	variable suffix
	variable current
	variable allOptions
	variable enableData

	set options [allOptions $top]
	set allOptions($top) $options

	foreach option $options {
	    set variable ::vTcl::itemEdit::${option}_$suffix($top)
	    set $variable ""
	    set f [$top.PropertiesFrame].$option
	    frame $f
	    set config_cmd "
	       ::$cmds($top)::itemConfigure $target($top) \
		   \[vTcl:at ::vTcl::itemEdit::current($top)\] \
		   $option \[vTcl:at $variable\]
	       "
	    set enableData($top,$option) [::vTcl::ui::attributes::newAttribute \
		$target($top) $f $option $variable $config_cmd \
		"::vTcl::itemEdit::setGetBox $top" \
		"::vTcl::itemEdit::keyRelease $top"]
	    pack $f -side top -fill x -expand 0
	}

	## the label option is kinda special, it updates the label in the
	## listbox as well
	set labelOption [::$cmds($top)::getLabelOption]
	if {$labelOption != ""} {
	    set variable ::vTcl::itemEdit::${labelOption}_$suffix($top)
	    trace variable $variable w \
		"::vTcl::itemEdit::setLabel $top $labelOption $variable"
	}

	## calculate the scrolling region
	update idletasks
	set w [winfo width  [$top.PropertiesFrame]]
	set h [winfo height [$top.PropertiesFrame]]
	${top}.PropertiesCanvas configure -scrollregion [list 0 0 $w $h]

	## keyboard accelerators
	vTcl:setup_vTcl:bind [$top.PropertiesFrame]
    }

    proc setLabel {top option variable args} {
	variable current
	variable target
	variable cmds
	variable adding

	## when adding items, prevent the trace from being executed
	if {$adding($top)} {return}

	set label [::vTcl:at $variable]
	set ::${top}::list_items [lreplace [::vTcl:at ::${top}::list_items] \
	    $current($top) $current($top) $label]
	::$cmds($top)::itemConfigure $target($top) $current($top) \
	    $option $label
    }

    proc selectItem {top index} {
	variable cmds
	variable target
	variable suffix
	variable current
	variable allOptions
	variable enableData

	## first, sets any pending options
	::vTcl::ui::attributes::setPending

	${top}.ItemsListbox selection clear 0 end
	${top}.ItemsListbox selection set $index
	set current($top) $index

	set properties [::$cmds($top)::itemConfigure $target($top) $index]
	foreach property $properties {
	    set option [lindex $property 0]
	    set value  [lindex $property 4]
	    set variable ::vTcl::itemEdit::${option}_$suffix($top)
	    set $variable $value
	    lappend currentOptions $option
	}

	foreach option $allOptions($top) {
	    # enable/disable option if it does/does not apply to subitem
	    if {[lsearch -exact $currentOptions $option] == -1} {
		::vTcl::ui::attributes::enableAttribute $enableData($top,$option) 0
	    } else {
		::vTcl::ui::attributes::enableAttribute $enableData($top,$option) 1
	    }
	}
    }

    proc widgetDeleted {top w} {
	variable target
	if {$target($top) == $w} {
	    close $top
	}
    }

    proc close {top} {
	variable cmds
	variable target
	variable suffix
	variable current
	variable allOptions
	variable enableData
	variable class

	## first, sets any pending options
	::vTcl::ui::attributes::setPending

	set ::vTcl(pr,edit$class($top)) [wm geometry $top]
	destroy $top
	## clean up after ourselves
	foreach option $allOptions($top) {
	    set variable ${option}_$suffix($top)
	    variable $variable
	    unset $variable
	    unset enableData($top,$option)
	}
	unset cmds($top)
	unset target($top)
	unset suffix($top)
	unset current($top)
	unset allOptions($top)

	::vTcl::notify::unsubscribe delete_widget $top
	::vTcl::notify::unsubscribe deleted_childsite $top
    }

    proc addItem {top} {
	variable cmds
	variable target
	variable adding

	::vTcl::ui::attributes::setPending
	vTcl:setup_unbind_widget $target($top)
	set added [::$cmds($top)::addItem $target($top)]
	vTcl:setup_bind_widget $target($top)
	## user canceled ?
	if {$added == ""} {return}
	set adding($top) 1
	lappend ::${top}::list_items $added
	set length [llength [vTcl:at ::${top}::list_items]]
	selectItem $top [expr $length - 1]
	set adding($top) 0
    	enableMenus $top

	## update attributes editor
	if {$::vTcl(w,widget) == $target($top)} {
	    vTcl:update_widget_info $target($top)
	}
    }

    ## a childsite has been deleted, need to refresh the display
    proc childsiteDeleted {top w index} {
	variable cmds
	variable target
	variable current

	if {$index == -1} {return}
	::vTcl::ui::attributes::setPending
	set ::${top}::list_items [lreplace [::vTcl:at ::${top}::list_items] \
	    $index $index]
	set length [llength [::vTcl:at ::${top}::list_items]]

	set current($top) [expr $current($top) % $length]
	selectItem $top $current($top)

	enableMenus $top
    }

    proc removeItem {top} {
	variable cmds
	variable target
	variable current

	::vTcl::ui::attributes::setPending
	vTcl:setup_unbind_widget $target($top)
	::$cmds($top)::removeItem $target($top) $current($top)
	vTcl:setup_bind_widget $target($top)
	set ::${top}::list_items [lreplace [::vTcl:at ::${top}::list_items] \
	    $current($top) $current($top)]
	set length [llength [::vTcl:at ::${top}::list_items]]
	set current($top) [expr $current($top) % $length]
	selectItem $top $current($top)
	enableMenus $top

	## update attributes editor
	if {$::vTcl(w,widget) == $target($top)} {
	    vTcl:update_widget_info $target($top)
	}
    }

    proc moveUpOrDown {top direction} {
	variable cmds
	variable target
	variable current

	::vTcl::ui::attributes::setPending
	set offset(up) -1
	set offset(down) 1
	::$cmds($top)::moveUpOrDown $target($top) $current($top) $direction
	set list_items [::$cmds($top)::getItems $target($top)]
	set list_items [lrange $list_items 1 end]
	set ::${top}::list_items $list_items
	set length [llength $list_items]
	set current($top) [expr ($current($top) + $offset($direction)) % $length]
	selectItem $top $current($top)
    }

    proc enableMenus {top} {
	set length [llength [vTcl:at ::${top}::list_items]]

	## if there is only one item left, we don't allow the user to delete it
	## (it wouldn't make much sense to have a tabnotebook with no pages or a toolbar
	##  with no buttons)
	set enabled [expr $length > 1]
	set state(1) normal
	set state(0) disabled
	$top.ItemsEditDelete configure -state $state($enabled)
	$top.ItemsEditMenuAddDelete entryconfigure 1 -state $state($enabled)
    }
}





