#
# 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.13 1998/06/27 21:32:35 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 Standard fields:
#     o self - Object command.
#     o selfns - Object namespace.
#     o class - Class command.
#     o classns - Class namespace.
#  o Internal fields:
#     o ___fields - List of fields defined in the object.
#

#
# Initialize an object's methods and fields and build the command that
# is used to import all fields into a method. If 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

    set objCmd [_defineObjectNS $objNS]
    if [catch {
        namespace eval $objNS [set ${classNS}::___instInit]
        
        # 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]] {
            append ${objNS}::___deleteCmds ${objNS}::destruct \;
        }        

        # Remember local objects for cleanup.
        if [llength $inNS] {
            lappend ${classNS}::___localObjs $objCmd
        }
    } errorResult] {
        global errorInfo errorCode
        set err [list error $errorResult $errorInfo $errorCode]
        catch {namespace delete $objNS}
        eval $err
    }

    return $objCmd
}

