# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: contain.tcl,v 1.7 2006/01/28 19:16:59 jfontain Exp $


# A simple container scheme that allows hierarchical memory data storage, can be seen as a hierarchy of named associative arrays.
# A container object has a name, can store data in an internal array and knows its children.


class container {

    proc container {this {name {}}} {
        ::set ($this,name) $name                                                                                 ;# read-only member
        ::set ($this,children) {}
    }

    proc ~container {this} {
        variable ${this}data

        eval delete $($this,children)
        catch {unset ${this}data}                                                                                   ;# may not exist
    }

    # public procedures below:

    proc bind {this child} {                                                                   ;# adopt and manage a child container
        lappend ($this,children) $child
    }

    proc set {this name value} {                                                             ;# set a value in the associative array
        variable ${this}data

        ::set ${this}data($name) $value
    }

    proc get {this name} {                                                            ;# retrieve a value from the associative array
        variable ${this}data

        return [::set ${this}data($name)]
    }

    proc equal {container1 container2} {             ;# compare data stored in containers, including data held in children hierarchy
        variable ${container1}data
        variable ${container2}data

        if {\
            ![string equal $($container1,name) $($container2,name)] ||\
            ([array size ${container1}data] != [array size ${container2}data]) ||\
            ([llength $($container1,children)] != [llength $($container2,children)])\
        } {return 0}                                                            ;# stop at first trivial and fast comparison failure
        foreach\
            name1 [lsort -dictionary [array names ${container1}data]] name2 [lsort -dictionary [array names ${container2}data]] {
            if {![string equal $name1 $name2]} {return 0}
            if {![string equal [::set ${container1}data($name1)] [::set ${container2}data($name2)]]} {return 0}
        }
        foreach child1 $($container1,children) child2 $($container2,children) {
            if {![equal $child1 $child2]} {return 0}                                                        ;# recurse with children
        }
        return 1
    }

}
