#@package: NeoSharedObject NeoSharedObject
#
# NeoSharedObject - incr tcl class library to create objects
# capable of being distributed as distribued objects under
# Tcl-DP
#
# $Id: neo-shared-object.tcl,v 1.1.1.1 1999/03/31 20:34:38 damon Exp $
#

package require Itcl

itcl_class NeoSharedObject {

    # The constructor takes as optional arguments an arbitrary number
    # of "-key value" pairs.  These are created as slots which
    # will be distributed and maintained as a shared object across
    # all of the programs on the net that have attached the
    # object.
    #
    # This format is specified by tcl-dp.
    #
    constructor {args} {
	while {[llength $args] > 1} {
	    set args [lassign $args key value]
	    set key [string trimleft $key -]
	    create-slot $key $value
	}
	return ""
    }

    destructor {
    }

    # configure is required by tcl-dp.
    # configure with no args lists all slots as "-key initial current"
    # triples.  With one argument, it returns the value associated with
    # the specified slot.  With more than two arguments, they are
    # key-value pairs to be set into the specified slots.
    #
    method configure {args} {
	if {$args == ""} {
	    if ![info exists defaultValues] {return ""}
	    foreach slotName [array names defaultValues] {
		lappend result [list -$slotName $defaultValues($slotName) \
		    $currentValues($slotName)]
	    }
	    return $result
	}
	if {[llength $args] == 1} {
	    set key [string trimleft $args -]
	    if ![info exists defaultValues($key)] {
		return ""
	    }
	    return "$args $defaultValues($key) $currentValues($key)"
	}
	while {[llength $args] > 1} {
	    set args [lassign $args key value]
	    set key [string trimleft $key -]
	    set currentValues($key) $value
	}
	return ""
    }

    # slot-value is required by tcl-dp.
    # slot-value returns the value at the specified slot.  Note that
    # the leading dash is not specified as part of the key.
    method slot-value {key} {
	return $currentValues($key)
    }

    # destroy is required by tcl-dp and destroys the object.
    method destroy {} {
	$this delete
    }

    # create-slot creates slots in the object.  All slots that are
    # to be shared must be created before the object is served out,
    # or they will not be seen... or worse.
    method create-slot {slotName defaultValue} {
	set currentValues($slotName) $defaultValue
	set defaultValues($slotName) $defaultValue
    }

    method setf {slot value} {
	dp_setf $this $slot $value
    }

    method getf {slot} {
	return [dp_getf $this $slot]
    }

    method lappendf {slot value} {
	set list [dp_getf $this $slot]
	lappend list $value
	dp_setf $this $slot $value
    }

    public defaultValues
    public currentValues
}

