#
# Sterno core object support.  All objects, including classes are base on a
# namespace created with this code.  This is a common code base; other
# objects don't inherit from anything here.
#
# 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: object.tcl,v 1.19 1998/06/28 04:40:12 markd Exp $
#

##
# Core 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 fref - Get a fully qualified field reference.
#  o Standard fields:
#    o self - Object command.
#    o selfns - Object's namespace.
#  o Internal methods:
#    o ___call - Call a method.
#  o Internal fields:
#    o ___aliaseCmds - List of command aliases assoiciated with the object.
#    o ___deleteCmds - A string of commands to eval when object is deleted.
#    o ___fields - List of fields.
#
# Notes:
#  o Calling [namespace current] is faster than using a variable with the
#    current namespace unless the variable is already imported into the proc.
#

#
# Make sure namespace exists.
#
namespace eval ::Sterno {}

#
# Define an object namespace.  This sets up a namespace with a few standard
# methods and fields.
#
# A object command in the namespace is returned.  If the object already exists,
# it is destroyed.
#
proc ::Sterno::_defineObjectNS {objNS} {
    # Start with a fresh namespace.
    catch {namespace delete $objNS}
     
    namespace eval $objNS {
        # Standard fields.
        variable selfns [namespace current]
        variable self ${selfns}::___call

        # Internal fields.
        variable ___aliasCmds {}
        variable ___deleteCmds {}
        variable ___fields {self selfns}

        # Standard methods.
        proc ___call {method args} {
            uplevel 1 [concat [namespace current]::$method $args]
        }

        proc delete {} {
            ::Sterno::_deleteObj [namespace current]
        }

        # fget/fset/fref generate full name so that arrays work.
        proc fget field {
            return [set [namespace current]::${field}]
        }
        proc fset {field value} {
            return [set [namespace current]::${field} $value]
        }
        proc fref field {
            return [namespace current]::${field}
        }
        proc fields {} {
            return [set [namespace current]::___fields]
        }
    }
    return ${objNS}::___call
}

#
# Define alias commands for an object.  These are commands in other name
# spaces that are bound to the object's ___call command.  Use to assign
# fixed names to an object.  The alias will be defined aliasLevel if not
# fully qualified.
#
proc ::Sterno::_defineObjectAlias {objNS aliasCmd aliasLevel} {
    if {![string match ::* $aliasCmd]} {
        set aliasCmd [uplevel #$aliasLevel [list namespace current]]::$aliasCmd
    }
    uplevel #$aliasLevel [list interp alias {} $aliasCmd {} ${objNS}::___call]
    
    lappend ${objNS}::___aliasCmds $aliasCmd
}

#
# Do the work of deleting an object.  Also deletes the alias comand.
#
proc ::Sterno::_deleteObj objNS {
    foreach aliasCmd [set ${objNS}::___aliasCmds] {
        rename $aliasCmd {}
    }

    eval [set ${objNS}::___deleteCmds]

    namespace delete $objNS
}
