#
# Sterno class instance objects.
#
# Copyright (c) 1997-1998 Mark Diekhans
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: instance.tcl,v 1.9 1998/01/13 00:14:00 markd Exp $
#

##
# Class instance objects:
#  o Standard Methods:
#     o delete - Delete the object.
#     o fget - Get a field of the object.  This is any namespace
#       variable, not just ones defined by the class field method.
#     o fset - Set a field of the object.
#     o fields - Get list of fields asssociate with the object
#     o fimport - Import fields into a method.
#  o Standard fields:
#     o self - Object command.
#     o selfns - Object command.
#     o class - Class command.
#  o Internal fields:
#     o ___fields - List of fields defined in the object (for import).
#

#
# Do work of create a new object.  In inNS is not {}, then
# create the object it that namespace rather than the classes.
#
proc ::Sterno::_doNew {classNS inNS argList} {
    variable ${classNS}::___nextObjectNum
    if [llength $inNS] {
        set objNS ${inNS}::obj${___nextObjectNum}
    } else {
        set objNS ${classNS}::obj${___nextObjectNum}
    }
    incr ___nextObjectNum

    if [catch {
        set objCmd [_defineObjectNS $objNS]
        
        _initInstanceMembers $classNS $objNS

        # Run constructor
        if [llength [info command ${objNS}::construct]] {
            eval ${objNS}::construct $argList
        } else {
            if [llength $argList] {
                error "new called with arguments but no constructor is defined"
            }
        }

        # If destructor is defined, arrange for it to be called
        # when the object is deleted.
        if [llength [info command ${objNS}::destruct]] {
            ::Sterno::_addObjDeleteCmd $objNS ${objNS}::destruct
        }        

        if [llength $inNS] {
            lappend ${classNS}::___localObjs $objCmd
        }
    } errorResult] {
        global errorInfo errorCode
        set err [list error $errorResult $errorInfo $errorCode]
        catch {namespace delete $objNS}
        incr ___nextObjectNum -1
        eval $err
    }

    return $objCmd
}

#
# Initialize an object's methods and fields and build the command that
# is used to import all fields into a method.
#
proc ::Sterno::_initInstanceMembers {classNS objNS} {
    variable ${classNS}::___instFields
    variable ${classNS}::___instMethods

    # Import class methods first, maybe overriden
    namespace eval $objNS [set ${classNS}::___classMethodImport]

    variable ${objNS}::class [set ${classNS}::self]
    variable ${objNS}::___fields {self selfns class}

    foreach fld [array names ___instFields] {
        # $args list with initial value was saved in ___instFields
        if [llength $___instFields($fld)] {
            namespace eval $objNS [list variable $fld [lindex $___instFields($fld) 0]]
        } else {
            namespace eval $objNS [list variable $fld]
        }
        lappend ___fields $fld
    }

    # Define fimport Method.
    proc ${objNS}::fimport args {
        if [llength $args] {
            set flds $args
        } else {
            variable ___fields
            set flds $___fields
        }
        foreach fld $flds {
            uplevel 1 variable $fld
        }
    }

    # Define methods.
    foreach method [array names ___instMethods] {
        namespace eval $objNS $___instMethods($method)
    }

}

