Tcl Source Code

'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Method
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
              clientData\fR)
.sp
Tcl_Method
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
                      clientData\fR)
.sp
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
.sp
\fBTcl_ClassSetDestructor\fR(\fIinterp, class, method\fR)
.sp
Tcl_Class
\fBTcl_MethodDeclarerClass\fR(\fImethod\fR)
.sp
Tcl_Object
\fBTcl_MethodDeclarerObject\fR(\fImethod\fR)
.sp
Tcl_Obj *
\fBTcl_MethodName\fR(\fImethod\fR)
.sp
.VS TIP500
int
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
.VE TIP500
.sp
int
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
.sp
int
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
.sp
int
\fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR)
.sp

.AP Tcl_Object object in
The object to create the method in.
.AP Tcl_Class class in
The class to create the method in.
.AP Tcl_Obj *nameObj in
The name of the method to create. Should not be NULL unless creating
constructors or destructors.
.AP int flags in
A flag saying (currently) what the visibility of the method is. The supported
public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
for backward compatibility) for an exported method,
\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
.AP ClientData clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP ClientData *clientDataPtr out

that class.
.PP
Given a method, the entity that declared it can be found using
\fBTcl_MethodDeclarerClass\fR which returns the class that the method is
attached to (or NULL if the method is not attached to any class) and
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
attached to (or NULL if the method is not attached to an object). The name of
the method can be retrieved with \fBTcl_MethodName\fR, whether the method
is exported is retrieved with \fBTcl_MethodIsPublic\fR,
.VS TIP500
and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
.VE TIP500
The type of the method
can also be introspected upon to a limited degree; the function
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
assigning the per-method \fIclientData\fR to the variable pointed to by
\fIclientDataPtr\fR if (that is non-NULL) if the type is matched.
.SS "METHOD CREATION"
.PP
Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
which
create a method attached to a class or an object respectively. In both cases,
the \fInameObj\fR argument gives the name of the method to create, the
\fIflags\fR argument states whether the method should be exported
initially
.VS TIP500
or be marked as a private method,
.VE TIP500
the \fImethodTypePtr\fR argument describes the implementation of
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
argument gives some implementation-specific data that is passed on to the
implementation of the method when it is called.
.PP
When the \fInameObj\fR argument to \fBTcl_NewMethod\fR is NULL, an
unnamed method is created, which is used for constructors and destructors.
Constructors should be installed into their class using the

This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside an instance through the instance object's command) by the
class being defined. Note that the methods themselves may be actually defined
by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below)

sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
be exposed or not exposed); it is not an error for a non-existent method to be
named since they may be defined by subclasses.

By default, this slot works by appending.

.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded method called \fIname\fR. The method is
defined be forwarded to the command called \fIcmdName\fR, with additional
arguments, \fIarg\fR etc., added before those arguments specified by the
caller of the method. The \fIcmdName\fR will always be resolved using the
rules of the invoking objects' namespaces, i.e., when \fIcmdName\fR is not
fully-qualified, the command will be searched for in each object's namespace,
using the instances' namespace's path, or by looking in the global namespace.
The method will be exported if \fIname\fR starts with a lower-case letter, and
non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates or updates a method that is implemented as a procedure-like
script. The name of the method is \fIname\fR, the formal arguments to the
method (defined using the same format as for the Tcl \fBproc\fR command) will
be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When
the body of the method is evaluated, the current namespace of the method will
be a namespace that is unique to the current object. The method will be
exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
\fBunexport\fR.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below)

sets or updates the list of additional classes that are to be mixed into
all the instances of the class being defined. Each \fIclassName\fR argument
names a single class that is to be mixed in.

By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current class will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
definition context is just a private definition context. All other definition
commands have no difference in behavior when used in a private definition
context.
.RE
.VE TIP500
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class

.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
.RS
.PP
.VS TIP470
If no arguments at all are used, this gives the name of the class currently
being configured.
.VE TIP470
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), the definitions on the class object will also be made in a private
definition context.
.VE TIP500
.RE
.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below)

allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
being non-classes or vice-versa, that an empty parent class is equivalent to
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
\fBoo::class\fR may not be modified.

By default, this slot works by replacement.

.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the instance through the instance object's command,
but instead just through the \fBmy\fR command visible in each object's
context) by the class being defined. Note that the methods themselves may be
actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made
available in the methods, constructor and destructor declared by the class
being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the namespace of the instance object on which the method
is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
class. By default, this slot works by appending.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
class. In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this class, and the name of the variable in the instance
namespace has a unique prefix that makes accidental use from other classes
extremely unlikely.
.VE TIP500
.RE
.SS "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
.TP
\fBclass\fI className\fR

.
This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside the object through the object's command) by the object
being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below)

sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
not exposed); it is not an error for a non-existent method to be named. Note
that the actual list of filters also depends on the filters set upon any
classes that the object is an instance of.

By default, this slot works by appending.

.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded object method called \fIname\fR. The
method is defined be forwarded to the command called \fIcmdName\fR, with
additional arguments, \fIarg\fR etc., added before those arguments specified
by the caller of the method. Forwarded methods should be deleted using the
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
a lower-case letter, and non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates, updates or deletes an object method. The name of the method is
\fIname\fR, the formal arguments to the method (defined using the same format
as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
method will be \fIbodyScript\fR. When the body of the method is evaluated, the
current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
letter, and non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below)

sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
that is to be mixed in.

By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current object will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
\fBprivate\fR has no cumulative effect; the innermost definition context is
just a private definition context. All other definition commands have no
difference in behavior when used in a private definition context.
.RE
.VE TIP500
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.
.TP
\fBself \fR

.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the object through the object's command, but instead
just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?

.
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made available in the methods declared by the
object being defined.  Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the namespace of the object on which the method is
executed. Note that the
variable lists declared by the classes and mixins of which the object is an
instance are completely disjoint; the list of variable names is just for
methods declared by this object. By default, this slot works by appending.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
object.  In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this instance object, and the name of the variable in the
instance namespace has a unique prefix that makes accidental use from
superclass methods extremely unlikely.
.VE TIP500
.RE
.SH "PRIVATE METHODS"
.VS TIP500
When a class or instance has a private method, that private method can only be
invoked from within methods of that class or instance. Other callers of the
object's methods \fIcannot\fR invoke private methods, it is as if the private
methods do not exist. However, a private method of a class \fIcan\fR be
invoked from the class's methods when those methods are being used on another
instance object; this means that a class can use them to coordinate behaviour
between several instances of itself without interfering with how other
classes (especially either subclasses or superclasses) interact. Private
methods precede all mixed in classes in the method call order (as reported by
\fBself call\fR).
.VE TIP500
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines three operations (as methods) that may be done on
the slot:

.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?

.
This appends the given \fImember\fR elements to the slot definition.

.TP
\fIslot\fR \fB\-clear\fR

.
This sets the slot definition to the empty list.

.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?

.
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
first member argument begins with a hyphen will be an error. One of the above
operations should be used explicitly in those circumstances.
.SS "SLOT IMPLEMENTATION"
Internally, slot objects also define a method \fB\-\-default\-operation\fR
which is forwarded to the default operation of the slot (thus, for the class
.QW \fBvariable\fR
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:

.TP
\fIslot\fR \fBGet\fR

.
Returns a list that is the current contents of the slot. This method must
always be called from a stack frame created by a call to \fBoo::define\fR or
\fBoo::objdefine\fR.

.TP
\fIslot\fR \fBSet \fIelementList\fR

.
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR.
.PP
The implementation of these methods is slot-dependent (and responsible for
accessing the correct part of the class or object definition). Slots also have
an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.

.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
illustrating four of the subcommands of them.
.PP
.CS
oo::class create c

.TP
\fBinfo body \fIprocname\fR
.
Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
the name of a Tcl command procedure.
.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR

.
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.

.TP
\fBinfo cmdcount\fR
.
Returns a count of the total number of commands that have been invoked
in this interpreter.
.TP
\fBinfo commands \fR?\fIpattern\fR?

If the command does not appear to be complete then 0 is returned.
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines;  if the
command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR

.
Returns the name of the currently executing \fBcoroutine\fR, or the empty
string if either no coroutine is currently executing, or the current coroutine
has been deleted (but has not yet returned or yielded since deletion).

.TP
\fBinfo default \fIprocname arg varname\fR
.
\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
must be the name of an argument to that procedure.  If \fIarg\fR
does not have a default value then the command returns \fB0\fR.
Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?

.
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.
.RS
.PP
This form is an even-sized list alternating tokens and parameters. Tokens are
currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be

granularity.
.PP
This information is also present in the \fB\-errorstack\fR entry of the
options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBtclsh\fR.
.RE

.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.
.TP

\fBinfo nameofexecutable\fR
.
Returns the full path name of the binary file from which the application
was invoked.  If Tcl was unable to identify the file, then an empty
string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR

.
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
described in \fBOBJECT INTROSPECTION\fR below.

.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, which holds
the exact version of the Tcl library by default.
.TP
\fBinfo procs \fR?\fIpattern\fR?

has each matching namespace variable qualified with the name
of its namespace.
Note that a currently-visible variable may not yet
.QW exist
if it has not
been set (e.g. a variable declared but not set by \fBvariable\fR).
.SS "CLASS INTROSPECTION"

.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:

.TP
\fBinfo class call\fI class method\fR

.
Returns a description of the method implementations that are used to provide a
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
(stereotypical instances being objects instantiated by a class without having
any object-specific definitions added). This consists of a list of lists of
four elements, where each sublist consists of a word that describes the
general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
.QW \fBunknown\fR
for the \fBunknown\fR type), a word giving the fully qualified name of the
class that defined the method, and a word describing the type of method
implementation (see \fBinfo class methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE

.TP
\fBinfo class constructor\fI class\fR

.
This subcommand returns a description of the definition of the constructor of
class \fIclass\fR. The definition is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
passing to another call to \fBproc\fR or a method definition, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.

.TP
\fBinfo class definition\fI class method\fR

.
This subcommand returns a description of the definition of the method named
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
list; the first element is the list of arguments to the method in a form
suitable for passing to another call to \fBproc\fR or a method definition, and
the second element is the body of the method.

.TP
\fBinfo class destructor\fI class\fR

.
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.

.TP
\fBinfo class filters\fI class\fR

.
This subcommand returns the list of filter methods set on the class.

.TP
\fBinfo class forward\fI class method\fR

.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the class called \fIclass\fR.

.TP
\fBinfo class instances\fI class\fR ?\fIpattern\fR?

.
This subcommand returns a list of instances of class \fIclass\fR. If the
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.

.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?

.
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS

.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
methods defined not just by the class, but also by the class's superclasses
and mixins.

.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the class (and superclasses and
mixins, if \fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIclass\fR that have the given visibility
\fIscope\fR.  When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
of this class) are to be returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
methods) are to be returned.
.RE
.VE TIP500
.RE
.TP
\fBinfo class methodtype\fI class method\fR

.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of class \fIclass\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo class
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.

.TP
\fBinfo class mixins\fI class\fR

.
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.

.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?

.
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.

.TP
\fBinfo class superclasses\fI class\fR

.
This subcommand returns a list of direct superclasses of class \fIclass\fR in
inheritance precedence order.

.TP
\fBinfo class variables\fI class\fR ?\fB\-private\fR?

.
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:

.TP
\fBinfo object call\fI object method\fR

.
Returns a description of the method implementations that are used to provide
\fIobject\fR's implementation of \fImethod\fR.  This consists of a list of
lists of four elements, where each sublist consists of a word that describes
the general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
.QW \fBunknown\fR
for the \fBunknown\fR type), a word giving what defined the method (the fully
qualified name of the class, or the literal string \fBobject\fR if the method
implementation is on an instance), and a word describing the type of method
implementation (see \fBinfo object methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE

.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?

.
If \fIclassName\fR is unspecified, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.TP
\fBinfo object creationid\fI object\fR
.VS TIP500
Returns the unique creation identifier for the \fIobject\fR object. This
creation identifier is unique to the object (within a Tcl interpreter) and
cannot be controlled at object creation time or altered afterwards.
.RS
.PP
\fIImplementation note:\fR the creation identifier is used to generate unique
identifiers associated with the object, especially for private variables.
.RE
.VE TIP500
.TP
\fBinfo object definition\fI object method\fR

.
This subcommand returns a description of the definition of the method named
\fImethod\fR of object \fIobject\fR. The definition is described as a two
element list; the first element is the list of arguments to the method in a
form suitable for passing to another call to \fBproc\fR or a method definition,
and the second element is the body of the method.

.TP
\fBinfo object filters\fI object\fR

.
This subcommand returns the list of filter methods set on the object.

.TP
\fBinfo object forward\fI object method\fR

.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the object called \fIobject\fR.

.TP
\fBinfo object isa\fI category object\fR ?\fIarg\fR?

.
This subcommand tests whether an object belongs to a particular category,
returning a boolean value that indicates whether the \fIobject\fR argument
meets the criteria for the category. The supported categories are:

.RS
.TP
\fBinfo object isa class\fI object\fR

.
This returns whether \fIobject\fR is a class (i.e. an instance of
\fBoo::class\fR or one of its subclasses).

.TP
\fBinfo object isa metaclass\fI object\fR

.
This returns whether \fIobject\fR is a class that can manufacture classes
(i.e. is \fBoo::class\fR or a subclass of it).

.TP
\fBinfo object isa mixin\fI object class\fR

.
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.

.TP
\fBinfo object isa object\fI object\fR

.
This returns whether \fIobject\fR really is an object.

.TP
\fBinfo object isa typeof\fI object class\fR

.
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
direct or indirect).
.RE

.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?

.
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS

.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
methods defined not just by the object, but also by the object's class and
mixins, plus the superclasses of those classes.

.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the object (and classes, if
\fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIobject\fR that have the given visibility
\fIscope\fR.  When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
instance methods) are to be returned.
.RE
.VE TIP500
.RE
.TP
\fBinfo object methodtype\fI object method\fR

.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of object \fIobject\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo object
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo object forward\fR.

.TP
\fBinfo object mixins\fI object\fR

.
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.

.TP
\fBinfo object namespace\fI object\fR

.
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.

.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?

.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?

.
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
that constrains the list of variables returned. Note that this is different
from the list returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).

.SH EXAMPLES
.PP
This command prints out a procedure suitable for saving in a Tcl
script:
.PP
.CS
proc printProc {procName} {

            lappend formals [list $var]
        }
    }
    puts [lappend result $formals [\fBinfo body\fR $procName]]
}
.CE
.SS "EXAMPLES WITH OBJECTS"

.PP
Every object necessarily knows what its class is; this information is
trivially extractable through introspection:
.PP
.CS
oo::class create c
c create o
puts [\fBinfo object class\fR o]
                     \fI\(-> prints "::c"\fR
puts [\fBinfo object class\fR c]
                     \fI\(-> prints "::oo::class"\fR
.CE
.PP
The introspection capabilities can be used to discover what class implements a
method and get how it is defined. This procedure illustrates how:
.PP
.CS
proc getDef {obj method} {
    foreach inf [\fBinfo object call\fR $obj $method] {
        lassign $inf calltype name locus methodtype

        # Assume no forwards or filters, and hence no $calltype
        # or $methodtype checks...

        if {$locus eq "object"} {
            return [\fBinfo object definition\fR $obj $name]
        } else {
            return [\fBinfo class definition\fR $locus $name]
        }
    }
    error "no definition for $method"

.PP
.CS
proc getDef {obj method} {
    if {$method in [\fBinfo object methods\fR $obj]} {
        # Assume no forwards
        return [\fBinfo object definition\fR $obj $method]
    }

    set cls [\fBinfo object class\fR $obj]

    while {$method ni [\fBinfo class methods\fR $cls]} {
        # Assume the simple case
        set cls [lindex [\fBinfo class superclass\fR $cls] 0]
        if {$cls eq ""} {
            error "no definition for $method"
        }
    }

    # Assume no forwards
    return [\fBinfo class definition\fR $cls $method]
}
.CE

.SH "SEE ALSO"

global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),

tcl_library(n), tcl_patchLevel(n), tcl_version(n)
.SH KEYWORDS
command, information, interpreter, introspection, level, namespace,



object, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

package require TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP
The \fBmy\fR command is used to allow methods of objects to invoke methods
of the object (or its class). In particular, the set of valid values for
\fImethodName\fR is the set of all methods supported by an object and its
superclasses, including those that are not exported
.VS TIP500
and private methods of the object or class when used within another method
defined by that object or class.
.VE TIP500
The object upon which the method is invoked is the one that owns the namespace

that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
remains if the command is renamed), which is the currently invoked object by
default.
.PP
Each object has its own \fBmy\fR command, contained in its instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
the \fBoo::object\fR class, which is not publicly visible by default:
.PP
.CS
oo::class create c {
    method count {} {
        \fBmy\fR variable counter
        puts [incr counter]
    }
}

c create o
o count              \fI\(-> prints "1"\fR
o count              \fI\(-> prints "2"\fR
o count              \fI\(-> prints "3"\fR
.CE
.PP
This example shows how you can use \fBmy\fR to make callbacks to private
methods from outside the object (from a \fBtrace\fR), using
\fBnamespace code\fR to enter the correct context:
.PP
.CS
oo::class create HasCallback {
    method makeCallback {} {
        return [namespace code {
            \fBmy\fR Callback
        }]
    }

    method Callback {args} {
        puts "callback: $args"
    }
}

set o [HasCallback new]
trace add variable xyz write [$o makeCallback]
set xyz "called"     \fI\(-> prints "callback: xyz {} write"\fR
.CE
.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method

.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

.PP
.CS
oo::class create theSuperclass {
    method example {args} {
        puts "in the superclass, args = $args"
    }
}

oo::class create theSubclass {
    superclass theSuperclass
    method example {args} {
        puts "before chaining from subclass, args = $args"
        \fBnext\fR a {*}$args b
        \fBnext\fR pureSynthesis
        puts "after chaining from subclass"
    }
}

theSubclass create obj
oo::objdefine obj method example args {
    puts "per-object method, args = $args"
    \fBnext\fR x {*}$args y
    \fBnext\fR
}
obj example 1 2 3

        if {[info exist ValueCache($key)]} {
            return $ValueCache($key)
        }

        \fI# Compute value, insert into cache, and return it\fR
        return [set ValueCache($key) [\fBnext\fR {*}$args]]
    }

    method flushCache {} {
        my variable ValueCache
        unset ValueCache
        \fI# Skip the caching\fR
        return -level 2 ""
    }
}

oo::object create demo
oo::objdefine demo {
    mixin cache

    method compute {a b c} {
        after 3000 \fI;# Simulate deep thought\fR
        return [expr {$a + $b * $c}]
    }

    method compute2 {a b c} {
        after 3000 \fI;# Simulate deep thought\fR
        return [expr {$a * $b + $c}]
    }
}

puts [demo compute  1 2 3]      \fI\(-> prints "7" after delay\fR

\fBself call\fR
.
This returns a two-element list describing the method implementations used to
implement the current call chain. The first element is the same as would be
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
also reports useful values from within constructors and destructors, whose
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
respectively,
.VS TIP500
and for private methods, which are described as being \fBprivate\fR instead of
being a \fBmethod\fR),
.VE TIP500
and the second element is an index into the first element's
list that indicates which actual implementation is currently executing (the
first implementation to execute is always at index 0).
.TP
\fBself caller\fR
.
When the method was invoked from inside another object method, this subcommand
returns a three element list describing the containing object and method. The

				 * clientData field contains a CallContext
				 * reference. Part of TIP#257. */
#define FRAME_IS_OO_DEFINE 0x8	/* The frame is part of the inside workings of
				 * the [oo::define] command; the clientData
				 * field contains an Object reference that has
				 * been confirmed to refer to a class. Part of
				 * TIP#257. */
#define FRAME_IS_PRIVATE_DEFINE 0x10
				/* Marks this frame as being used for private
				 * declarations with [oo::define]. Usually
				 * OR'd with FRAME_IS_OO_DEFINE. TIP#500. */

/*
 * TIP #280
 * The structure below defines a command frame. A command frame provides
 * location information for all commands executing a tcl script (source, eval,
 * uplevel, procedure bodies, ...). The runtime structure essentially contains
 * the stack trace as it would be if the currently executing command were to

} defineCmds[] = {
    {"constructor", TclOODefineConstructorObjCmd, 0},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
    {"destructor", TclOODefineDestructorObjCmd, 0},
    {"export", TclOODefineExportObjCmd, 0},
    {"forward", TclOODefineForwardObjCmd, 0},
    {"method", TclOODefineMethodObjCmd, 0},
    {"private", TclOODefinePrivateObjCmd, 0},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
    {"self", TclOODefineSelfObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 0},
    {NULL, NULL, 0}
}, objdefCmds[] = {
    {"class", TclOODefineClassObjCmd, 1},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
    {"export", TclOODefineExportObjCmd, 1},
    {"forward", TclOODefineForwardObjCmd, 1},
    {"method", TclOODefineMethodObjCmd, 1},
    {"private", TclOODefinePrivateObjCmd, 1},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
    {"self", TclOODefineObjSelfObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 1},
    {NULL, NULL, 0}
};

/*

{
    FOREACH_HASH_DECLS;
    int i;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;
    Foundation *fPtr = oPtr->fPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVariable;

    /*
     * Sanity check!
     */

    if (!Deleted(oPtr)) {
	if (IsRootClass(oPtr)) {

    FOREACH(variableObj, clsPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(clsPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(clsPtr->privateVariables.list);
    }

    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }
}

/*

{
    Object *oPtr = clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    int i;

    if (Deleted(oPtr)) {
	/*
	 * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this
	 * guard could be removed.

     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
     */

    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
	int result;

	Tcl_InterpState state;
	oPtr->flags |= DESTRUCTOR_CALLED;

	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;

    FOREACH(variableObj, oPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(oPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(oPtr->privateVariables.list);
    }

    if (oPtr->chainCache) {
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    /*
     * Run constructors, except when objc < 0, which is a special flag case
     * used for object cloning only.
     */

    if (objc >= 0) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);

	if (contextPtr != NULL) {
	    int isRoot, result;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;

     * object cloning only). If there aren't any constructors, we do nothing.
     */

    if (objc < 0) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }
    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
    if (contextPtr == NULL) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    contextPtr->callPtr->flags |= CONSTRUCTOR;

{
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    CallContext *contextPtr;
    Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
    PrivateVariableMapping *privateVariable;
    int i, result;

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {

    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
    FOREACH(filterObj, o2Ptr->filters) {
	Tcl_IncrRefCount(filterObj);
    }

    /*
     * Copy the object's variable resolution lists to the new object.
     */

    DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
    FOREACH(variableObj, o2Ptr->variables) {
	Tcl_IncrRefCount(variableObj);
    }

    DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
	    PrivateVariableMapping);
    FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
	Tcl_IncrRefCount(privateVariable->variableObj);
	Tcl_IncrRefCount(privateVariable->fullNameObj);
    }

    /*
     * Copy the object's flags to the new object, clearing those that must be
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
	FOREACH(filterObj, cls2Ptr->filters) {
	    Tcl_IncrRefCount(filterObj);
	}

	/*
	 * Copy the source class's variable resolution lists.
	 */

	DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
	FOREACH(variableObj, cls2Ptr->variables) {
	    Tcl_IncrRefCount(variableObj);
	}

	DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
		PrivateVariableMapping);
	FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
	    Tcl_IncrRefCount(privateVariable->variableObj);
	    Tcl_IncrRefCount(privateVariable->fullNameObj);
	}

	/*
	 * Duplicate the source class's mixins (which cannot be circular
	 * references to the duplicate).
	 */

	if (cls2Ptr->mixins.num != 0) {

			    duplicate);
		}
	    }
	}
    }

    TclResetRewriteEnsemble(interp, 1);
    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
	    NULL, NULL);
    if (contextPtr) {
	args[0] = TclOOObjectName(interp, o2Ptr);
	args[1] = oPtr->fPtr->clonedName;
	args[2] = TclOOObjectName(interp, oPtr);
	Tcl_IncrRefCount(args[0]);
	Tcl_IncrRefCount(args[1]);
	Tcl_IncrRefCount(args[2]);

    Class *startCls)		/* Where to start in the call chain, or NULL
				 * if we are to start at the front with
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Object *callerObjPtr = NULL;
    Class *callerClsPtr = NULL;
    int result;

    /*
     * If we've no method name, throw this directly into the unknown
     * processing.
     */

    if (objc < 2) {
	flags |= FORCE_UNKNOWN;
	methodNamePtr = NULL;
	goto noMapping;
    }

    /*
     * Determine if we're in a context that can see the extra, private methods
     * in this class.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContextPtr = framePtr->clientData;
	Method *callerMethodPtr =
		callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;

	if (callerMethodPtr->declaringObjectPtr) {
	    callerObjPtr = callerMethodPtr->declaringObjectPtr;
	}
	if (callerMethodPtr->declaringClassPtr) {
	    callerClsPtr = callerMethodPtr->declaringClassPtr;
	}
    }

    /*
     * Give plugged in code a chance to remap the method name.
     */

    methodNamePtr = objv[1];
    if (oPtr->mapMethodNameProc != NULL) {

	/*
	 * Get the call chain for the remapped name.
	 */

	Tcl_IncrRefCount(mappedMethodName);
	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
		flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
		callerClsPtr, methodNamePtr);
	TclDecrRefCount(mappedMethodName);
	if (contextPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "impossible to invoke method \"%s\": no defined method or"
		    " unknown method", TclGetString(methodNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;
	}
    } else {
	/*
	 * Get the call chain.
	 */

    noMapping:
	contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
		flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
		callerClsPtr, NULL);
	if (contextPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "impossible to invoke method \"%s\": no defined method or"
		    " unknown method", TclGetString(methodNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;

	    ClientData *clientDataPtr)
}
declare 10 {
    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
}
declare 11 {
    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData clientData)
}
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, int objc,
	    Tcl_Obj *const *objv, int skip)
}

declare 27 {
    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
	    Tcl_Method method)
}
declare 28 {
    Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
declare 29 {
    int Tcl_MethodIsPrivate(Tcl_Method method)
}

######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
# TclOO; not intended for general use and does not have any commitment to
# long-term support.
#

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
 * binary compatability.
 */

#define TCL_OO_METHOD_VERSION_CURRENT 1

/*
 * Visibility constants for the flags parameter to Tcl_NewMethod and
 * Tcl_NewInstanceMethod.
 */

#define TCL_OO_METHOD_PUBLIC		1
#define TCL_OO_METHOD_UNEXPORTED	0
#define TCL_OO_METHOD_PRIVATE		0x20

/*
 * The type of some object (or class) metadata. This describes how to delete
 * the metadata (when the object or class is deleted) and how to create a
 * clone of it (when the object or class is copied).
 */

    if (objc != Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
	oPtr->flags |= DESTRUCTOR_CALLED;
	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
		NULL);
	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
		    NULL, NULL, NULL);
	    TclPushTailcallPoint(interp);
	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);

    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *callerObj = NULL;
    Class *callerCls = NULL;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Tcl_Obj *errorMsg;

    /*
     * If no method name, generate an error asking for a method name. (Only by
     * overriding *this* method can an object handle the absence of a method
     * name without an error).
     */

    if (objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Determine if the calling context should know about extra private
     * methods, and if so, which.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContext = framePtr->clientData;
	Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;

	if (mPtr->declaringObjectPtr) {
	    if (oPtr == mPtr->declaringObjectPtr) {
		callerObj = mPtr->declaringObjectPtr;
	    }
	} else {
	    if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
		callerCls = mPtr->declaringClassPtr;
	    }
	}
    }

    /*
     * Get the list of methods that we want to know about.
     */

    numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
	    contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);

    /*
     * Special message when there are no visible methods at all.
     */

    if (numMethodNames == 0) {

				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Var *varPtr, *aryVar;
    Tcl_Obj *varNamePtr, *argPtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    const char *arg;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }

     */

    if (arg[0] == ':' && arg[1] == ':') {
	varNamePtr = argPtr;
    } else {
	Tcl_Namespace *namespacePtr =
		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));

	/*
	 * Private method handling. [TIP 500]
	 *
	 * If we're in a context that can see some private methods of an
	 * object, we may need to precede a variable name with its prefix.
	 * This is a little tricky as we need to check through the inheritance
	 * hierarchy when the method was declared by a class to see if the
	 * current object is an instance of that class.
	 */

	if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
	    CallContext *callerContext = framePtr->clientData;
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    int i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
		    if (!strcmp(Tcl_GetString(pvPtr->variableObj),
			    Tcl_GetString(argPtr))) {
			argPtr = pvPtr->fullNameObj;
			break;
		    }
		}
	    } else if (mPtr->declaringClassPtr &&
		    mPtr->declaringClassPtr->privateVariables.num) {
		Class *clsPtr = mPtr->declaringClassPtr;
		int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls);
		Class *mixinCls;

		if (!isInstance) {
		    FOREACH(mixinCls, oPtr->mixins) {
			if (TclOOIsReachable(clsPtr, mixinCls)) {
			    isInstance = 1;
			    break;
			}
		    }
		}
		if (isInstance) {
		    FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) {
			if (!strcmp(Tcl_GetString(pvPtr->variableObj),
				Tcl_GetString(argPtr))) {
			    argPtr = pvPtr->fullNameObj;
			    break;
			}
		    }
		}
	    }
	}

	varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
	Tcl_AppendToObj(varNamePtr, "::", 2);
	Tcl_AppendObjToObj(varNamePtr, argPtr);
    }
    Tcl_IncrRefCount(varNamePtr);
    varPtr = TclObjLookupVar(interp, varNamePtr, NULL,

    /*
     * Now that we've pinned down what variable we're really talking about
     * (including traversing variable links), convert back to a name.
     */

    varNamePtr = Tcl_NewObj();
    if (aryVar != NULL) {



	Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);

	/*
	 * WARNING! This code pokes inside the implementation of hash tables!
	 */





	Tcl_AppendToObj(varNamePtr, "(", -1);
	Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
		varPtr)->entry.key.objPtr);
	Tcl_AppendToObj(varNamePtr, ")", -1);




    } else {
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
    }
    Tcl_SetObjResult(interp, varNamePtr);
    return TCL_OK;
}


#define BUILDING_MIXINS	   0x400000
#define TRAVERSED_MIXIN	   0x800000
#define OBJECT_MIXIN	   0x1000000
#define MIXIN_CONSISTENT(flags) \
    (((flags) & OBJECT_MIXIN) ||					\
	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))

/*
 * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
 * Itcl's special type of private.
 */

#define IS_PUBLIC(mPtr)				\
    (((mPtr)->flags & PUBLIC_METHOD) != 0)
#define IS_UNEXPORTED(mPtr)			\
    (((mPtr)->flags & SCOPE_FLAGS) == 0)
#define IS_ITCLPRIVATE(mPtr)				\
    (((mPtr)->flags & PRIVATE_METHOD) != 0)
#define IS_PRIVATE(mPtr)			\
    (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
#define WANT_PUBLIC(flags)			\
    (((flags) & PUBLIC_METHOD) != 0)
#define WANT_UNEXPORTED(flags)			\
    (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
#define WANT_ITCLPRIVATE(flags)			\
    (((flags) & PRIVATE_METHOD) != 0)
#define WANT_PRIVATE(flags)			\
    (((flags) & TRUE_PRIVATE_METHOD) != 0)

/*
 * Function declarations for things defined in this file.
 */

static void		AddClassFiltersToCallContext(Object *const oPtr,
			    Class *clsPtr, struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags);
static void		AddClassMethodNames(Class *clsPtr, const int flags,
			    Tcl_HashTable *const namesPtr,
			    Tcl_HashTable *const examinedClassesPtr);
static inline void	AddMethodToCallChain(Method *const mPtr,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters,
			    Class *const filterDecl, int flags);
static inline int	AddInstancePrivateToCallContext(Object *const oPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr, int flags);
static inline void	AddStandardMethodName(int flags, Tcl_Obj *namePtr,
			    Method *mPtr, Tcl_HashTable *namesPtr);
static inline void	AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
			    Tcl_HashTable *namesPtr);
static inline int	AddSimpleChainToCallContext(Object *const oPtr,
			    Class *const contextCls,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		AddPrivatesFromClassChainToCallContext(Class *classPtr,
			    Class *const contextCls,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		AddSimpleClassChainToCallContext(Class *classPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		CmpStr(const void *ptr1, const void *ptr2);
static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
static Tcl_NRPostProc	FinalizeMethodRefs;
static void		FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
			    int flags, int reuseMask);
static Tcl_NRPostProc	ResetFilterFlags;
static Tcl_NRPostProc	SetFilterFlags;
static int		SortMethodNames(Tcl_HashTable *namesPtr, int flags,
			    const char ***stringsPtr);
static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);

/*
 * Object type used to manage type caches attached to method names.
 */

static const Tcl_ObjType methodNameType = {

 *
 * ----------------------------------------------------------------------
 */

int
TclOOGetSortedMethodList(
    Object *oPtr,		/* The object to get the method names for. */
    Object *contextObj,		/* From what context object we are inquiring.
				 * NULL when the context shouldn't see
				 * object-level private methods. Note that
				 * flags can override this. */
    Class *contextCls,		/* From what context class we are inquiring.
				 * NULL when the context shouldn't see
				 * class-level private methods. Note that
				 * flags can override this. */
    int flags,			/* Whether we just want the public method
				 * names. */
    const char ***stringsPtr)	/* Where to write a pointer to the array of
				 * strings to. */
{
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    FOREACH_HASH_DECLS;
    int i, numStrings;
    Class *mixinPtr;
    Tcl_Obj *namePtr;
    Method *mPtr;



    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);

    /*
     * Name the bits used in the names table values.
     */
#define IN_LIST 1
#define NO_IMPLEMENTATION 2

    /*
     * Process method names due to the object.
     */

    if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (IS_PRIVATE(mPtr)) {
		continue;
	    }
	    if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
		continue;
	    }
	    AddStandardMethodName(flags, namePtr, mPtr, &names);






	}
    }

    /*
     * Process method names due to private methods on the object's class.
     */

    if (WANT_UNEXPORTED(flags)) {
	FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
	    if (IS_UNEXPORTED(mPtr)) {
		AddStandardMethodName(flags, namePtr, mPtr, &names);
	    }





	}






    }

    /*
     * Process method names due to private methods on the context's object or
     * class. Which must be correct if either are not NULL.
     */

    if (contextObj && contextObj->methodsPtr) {
	AddPrivateMethodNames(contextObj->methodsPtr, &names);
    }
    if (contextCls) {
	AddPrivateMethodNames(&contextCls->classMethods, &names);
    }

    /*
     * Process (normal) method names from the class hierarchy and the mixin
     * hierarchy.
     */

    AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
    FOREACH(mixinPtr, oPtr->mixins) {
	AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
		&examinedClasses);
    }



    /*



     * Tidy up, sort the names and resolve finally whether we really want



     * them (processing export layering).




     */










    Tcl_DeleteHashTable(&examinedClasses);




    numStrings = SortMethodNames(&names, flags, stringsPtr);










    Tcl_DeleteHashTable(&names);
    return numStrings;
}

int
TclOOGetSortedClassMethodList(
    Class *clsPtr,		/* The class to get the method names for. */
    int flags,			/* Whether we just want the public method
				 * names. */
    const char ***stringsPtr)	/* Where to write a pointer to the array of
				 * strings to. */
{
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */

    int numStrings;



    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);

    /*
     * Process method names from the class hierarchy and the mixin hierarchy.
     */

    AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
    Tcl_DeleteHashTable(&examinedClasses);

    /*
     * Process private method names if we should. [TIP 500]
     */

    if (WANT_PRIVATE(flags)) {
	AddPrivateMethodNames(&clsPtr->classMethods, &names);
	flags &= ~TRUE_PRIVATE_METHOD;
    }

    /*
     * Tidy up, sort the names and resolve finally whether we really want
     * them (processing export layering).
     */

    numStrings = SortMethodNames(&names, flags, stringsPtr);
    Tcl_DeleteHashTable(&names);
    return numStrings;
}

/*
 * ----------------------------------------------------------------------
 *
 * SortMethodNames --
 *
 *	Shared helper for TclOOGetSortedMethodList etc. that knows the method
 *	sorting rules.
 *
 * Returns:
 *	The length of the sorted list.
 *
 * ----------------------------------------------------------------------
 */

static int
SortMethodNames(
    Tcl_HashTable *namesPtr,	/* The table of names; unsorted, but contains
				 * whether the names are wanted and under what
				 * circumstances. */
    int flags,			/* Whether we are looking for unexported
				 * methods. Full private methods are handled
				 * on insertion to the table. */
    const char ***stringsPtr)	/* Where to store the sorted list of strings
				 * that we produce. ckalloced() */
{
    const char **strings;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    void *isWanted;
    int i = 0;

    /*
     * See how many (visible) method names there are. If none, we do not (and
     * should not) try to sort the list of them.
     */


    if (namesPtr->numEntries == 0) {
	*stringsPtr = NULL;
	return 0;
    }

    /*
     * We need to build the list of methods to sort. We will be using qsort()
     * for this, because it is very unlikely that the list will be heavily
     * sorted when it is long enough to matter.
     */

    strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
    FOREACH_HASH(namePtr, isWanted, namesPtr) {
	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		continue;
	    }
	    strings[i++] = TclGetString(namePtr);
	}
    }

    /*
     * Note that 'i' may well be less than names.numEntries when we are
     * dealing with public method names. We don't sort unless there's at least
     * two method names.
     */

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }



    return i;
}

/* Comparator for SortMethodNames */
static int
CmpStr(
    const void *ptr1,
    const void *ptr2)
{
    const char **strPtr1 = (const char **) ptr1;
    const char **strPtr2 = (const char **) ptr2;

    return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
}

/*
 * ----------------------------------------------------------------------
 *
 * AddClassMethodNames --
 *

				 * semantics are handled correctly. */
    Tcl_HashTable *const examinedClassesPtr)
				/* Hash table that tracks what classes have
				 * already been looked at. The keys are the
				 * pointers to the classes, and the values are
				 * immaterial. */
{
    int i;

    /*
     * If we've already started looking at this class, stop working on it now
     * to prevent repeated work.
     */

    if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
	return;

		&isNew);
	if (!isNew) {
	    break;
	}

	if (clsPtr->mixins.num != 0) {
	    Class *mixinPtr;


	    FOREACH(mixinPtr, clsPtr->mixins) {
		if (mixinPtr != clsPtr) {
		    AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
			    namesPtr, examinedClassesPtr);
		}
	    }
	}

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {




	    AddStandardMethodName(flags, namePtr, mPtr, namesPtr);









	}

	if (clsPtr->superclasses.num != 1) {
	    break;
	}
	clsPtr = clsPtr->superclasses.list[0];
    }
    if (clsPtr->superclasses.num != 0) {
	Class *superPtr;


	FOREACH(superPtr, clsPtr->superclasses) {
	    AddClassMethodNames(superPtr, flags, namesPtr,
		    examinedClassesPtr);
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddPrivateMethodNames, AddStandardMethodName --
 *
 *	Factored-out helpers for the sorted name list production functions.
 *
 * ----------------------------------------------------------------------
 */

static inline void
AddPrivateMethodNames(
    Tcl_HashTable *methodsTablePtr,
    Tcl_HashTable *namesPtr)
{
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Tcl_Obj *namePtr;

    FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
	if (IS_PRIVATE(mPtr)) {
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
	    Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
	}
    }
}

static inline void
AddStandardMethodName(
    int flags,
    Tcl_Obj *namePtr,
    Method *mPtr,
    Tcl_HashTable *namesPtr)
{
    if (!IS_PRIVATE(mPtr)) {
	int isNew;
	Tcl_HashEntry *hPtr =
		Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);

	if (isNew) {
	    int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
		    ? IN_LIST : 0;

	    isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
	    Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
		&& mPtr->typePtr != NULL) {
	    int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));

	    isWanted &= ~NO_IMPLEMENTATION;
	    Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	}
    }
}

#undef IN_LIST
#undef NO_IMPLEMENTATION

/*
 * ----------------------------------------------------------------------
 *
 * AddInstancePrivateToCallContext --
 *
 *	Add private methods from the instance. Called when the calling Tcl
 *	context is a TclOO method declared by an object that is the same as
 *	the current object. Returns true iff a private method was actually
 *	found and added to the call chain (as this suppresses caching).
 *
 * ----------------------------------------------------------------------
 */

static inline int
AddInstancePrivateToCallContext(
    Object *const oPtr,		/* Object to add call chain entries for. */
    Tcl_Obj *const methodName,	/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    int flags)			/* What sort of call chain are we building. */
{
    Tcl_HashEntry *hPtr;
    Method *mPtr;
    int donePrivate = 0;

    if (oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
	if (hPtr != NULL) {
	    mPtr = Tcl_GetHashValue(hPtr);
	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
		donePrivate = 1;
	    }
	}
    }
    return donePrivate;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleChainToCallContext --
 *
 *	The core of the call-chain construction engine, this handles calling a
 *	particular method on a particular object. Note that filters and
 *	unknown handling are already handled by the logic that uses this
 *	function. Returns true if a private method was one of those found.
 *
 * ----------------------------------------------------------------------
 */

static inline int
AddSimpleChainToCallContext(
    Object *const oPtr,		/* Object to add call chain entries for. */
    Class *const contextCls,	/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. [TIP 500] */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i, foundPrivate = 0, blockedUnexported = 0;
    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);


	if (hPtr != NULL) {
	    mPtr = Tcl_GetHashValue(hPtr);
	    if (!IS_PRIVATE(mPtr)) {
		if (WANT_PUBLIC(flags)) {
		    if (!IS_PUBLIC(mPtr)) {

			blockedUnexported = 1;
		    } else {
			flags |= DEFINITE_PUBLIC;
		    }
		} else {
		    flags |= DEFINITE_PROTECTED;
		}
	    }
	}
    }
    if (!(flags & SPECIAL)) {

	Class *mixinPtr;

	FOREACH(mixinPtr, oPtr->mixins) {
	    if (contextCls) {
		foundPrivate |= AddPrivatesFromClassChainToCallContext(
			mixinPtr, contextCls, methodNameObj, cbPtr,
			doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
	    }
	    foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
		    methodNameObj, cbPtr, doneFilters,
		    flags | TRAVERSED_MIXIN, filterDecl);
	}
	if (oPtr->methodsPtr && !blockedUnexported) {
	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
	    if (hPtr != NULL) {
		mPtr = Tcl_GetHashValue(hPtr);
		if (!IS_PRIVATE(mPtr)) {
		    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			    flags);
		}
	    }
	}
    }
    if (contextCls) {
	foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
		contextCls, methodNameObj, cbPtr, doneFilters, flags,
		filterDecl);
    }
    if (!blockedUnexported) {
	foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
		methodNameObj, cbPtr, doneFilters, flags, filterDecl);
    }
    return foundPrivate;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddMethodToCallChain --
 *

     *  3) this is a class method, AND
     *  4) this method was not declared by the class of the current object.
     *
     * This does mean that only classes really handle private methods. This
     * should be sufficient for [incr Tcl] support though.
     */

    if (!WANT_UNEXPORTED(callPtr->flags)
	    && IS_UNEXPORTED(mPtr)
	    && (mPtr->declaringClassPtr != NULL)
	    && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
	return;
    }

    /*
     * First test whether the method is already in the call chain. Skip over

     * Need to really add the method. This is made a bit more complex by the
     * fact that we are using some "static" space initially, and only start
     * realloc-ing if the chain gets long.
     */

    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain =
		ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
	memcpy(callPtr->chain, callPtr->staticChain,
		sizeof(struct MInvoke) * callPtr->numChain);
    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain = ckrealloc(callPtr->chain,
		sizeof(struct MInvoke) * (callPtr->numChain + 1));
    }
    callPtr->chain[i].mPtr = mPtr;

    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
				 * for. NULL when getting a constructor or
				 * destructor chain. */
    int flags,			/* What sort of context are we looking for.
				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
				 * PRIVATE_METHOD, DESTRUCTOR and
				 * FILTER_HANDLING are useful. */
    Object *contextObj,		/* Context object; when equal to oPtr, it
				 * means that private methods may also be
				 * added. [TIP 500] */
    Class *contextCls,		/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. [TIP 500] */
    Tcl_Obj *cacheInThisObj)	/* What object to cache in, or NULL if it is
				 * to be in the same object as the
				 * methodNameObj. */
{
    CallContext *contextPtr;
    CallChain *callPtr;
    struct ChainBuilder cb;
    int i, count, doFilters, donePrivate = 0;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;

    if (cacheInThisObj == NULL) {
	cacheInThisObj = methodNameObj;
    }
    if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {

	/*
	 * Check if we can get the chain out of the Tcl_Obj method name or out
	 * of the cache. This is made a bit more complex by the fact that
	 * there are multiple different layers of cache (in the Tcl_Obj, in
	 * the object, and in the class).
	 */

	const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);

	if (cacheInThisObj->typePtr == &methodNameType) {
	    callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }

    cb.oPtr = oPtr;

    /*
     * If we're working with a forced use of unknown, do that now.
     */

    if (flags & FORCE_UNKNOWN) {
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (callPtr->numChain == 0) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	goto returnContext;

	FOREACH(mixinPtr, oPtr->mixins) {
	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
		    TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
		    OBJECT_MIXIN);
	}
	FOREACH(filterObj, oPtr->filters) {
	    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
		    filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
	    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
		    filterObj, &cb, &doneFilters, 0, NULL);
	}
	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
		BUILDING_MIXINS);
	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
		0);
	Tcl_DeleteHashTable(&doneFilters);
    }
    count = cb.filterLength = callPtr->numChain;

    /*
     * Add the actual method implementations. We have to do this twice to
     * handle class mixins right.
     */

    if (oPtr == contextObj) {
	donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
		&cb, flags);
	donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
    }
    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
	    methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
	    methodNameObj, &cb, NULL, flags, NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	/*
	 * Method does not actually exist. If we're dealing with constructors
	 * or destructors, this isn't a problem.
	 */

	if (flags & SPECIAL) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else if (doFilters && !donePrivate) {
	if (hPtr == NULL) {
	    if (oPtr->flags & USE_CLASS_CACHE) {
		if (oPtr->selfCls->classChainCache == NULL) {
		    oPtr->selfCls->classChainCache =
			    ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);

     * in the class).
     */

    if (clsPtr->classChainCache != NULL) {
	hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
		(char *) methodNameObj);
	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
	    const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);


	    callPtr = Tcl_GetHashValue(hPtr);
	    if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
		callPtr->refCount++;
		return callPtr;
	    }
	    Tcl_SetHashValue(hPtr, NULL);

    Tcl_DeleteHashTable(&doneFilters);
    count = cb.filterLength = callPtr->numChain;

    /*
     * Add the actual method implementations.
     */

    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
	    NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {

    if (MIXIN_CONSISTENT(flags)) {
	FOREACH(filterObj, clsPtr->filters) {
	    int isNew;

	    (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
		    &isNew);
	    if (isNew) {
		AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
			doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
		AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
			doneFilters, clearedFlags, clsPtr);
	    }
	}
    }

    /*
     * Now process the recursive case. Notice the tail-call optimization.

	return;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddPrivatesFromClassChainToCallContext --
 *
 *	Helper for AddSimpleChainToCallContext that is used to find private
 *	methds and add them to the call chain. Returns true when a private
 *	method is found and added. [TIP 500]
 *
 * ----------------------------------------------------------------------
 */

static int
AddPrivatesFromClassChainToCallContext(
    Class *classPtr,		/* Class to add the call chain entries for. */
    Class *const contextCls,	/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. */
    Tcl_Obj *const methodName,	/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */

     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
		filterDecl)) {
	    return 1;
	}
    }

    if (classPtr == contextCls) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodName);

	if (hPtr != NULL) {
	    register Method *mPtr = Tcl_GetHashValue(hPtr);

	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
		return 1;
	    }
	}
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		    methodName, cbPtr, doneFilters, flags, filterDecl)) {
		return 1;
	    }
	}
    case 0:
	return 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleClassChainToCallContext --
 *
 *	Construct a call-chain from a class hierarchy.
 *
 * ----------------------------------------------------------------------
 */

static int
AddSimpleClassChainToCallContext(
    Class *classPtr,		/* Class to add the call chain entries for. */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i, privateDanger = 0;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	privateDanger |= AddSimpleClassChainToCallContext(superPtr,
		methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
		filterDecl);
    }

    if (flags & CONSTRUCTOR) {
	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
		filterDecl, flags);

    } else if (flags & DESTRUCTOR) {
	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
		filterDecl, flags);
    } else {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodNameObj);

	if (classPtr->flags & HAS_PRIVATE_METHODS) {
	    privateDanger |= 1;
	}
	if (hPtr != NULL) {
	    register Method *mPtr = Tcl_GetHashValue(hPtr);

	    if (!IS_PRIVATE(mPtr)) {
		if (!(flags & KNOWN_STATE)) {
		    if (flags & PUBLIC_METHOD) {

			if (!IS_PUBLIC(mPtr)) {

			    return privateDanger;
			}
			flags |= DEFINITE_PUBLIC;
		    } else {
			flags |= DEFINITE_PROTECTED;
		    }
		}
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
	    }
	}
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    privateDanger |= AddSimpleClassChainToCallContext(superPtr,
		    methodNameObj, cbPtr, doneFilters, flags, filterDecl);
	}
    case 0:
	return privateDanger;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORenderCallChain --
 *
 *	Create a description of a call chain. Used in [info object call],
 *	[info class call], and [self call].
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj *
TclOORenderCallChain(
    Tcl_Interp *interp,
    CallChain *callPtr)
{
    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
    Tcl_Obj *resultObj, *descObjs[4], **objv;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int i;

    /*
     * Allocate the literals (potentially) used in our description.
     */

    TclNewLiteralStringObj(filterLiteral, "filter");
    Tcl_IncrRefCount(filterLiteral);
    TclNewLiteralStringObj(methodLiteral, "method");
    Tcl_IncrRefCount(methodLiteral);
    TclNewLiteralStringObj(objectLiteral, "object");
    Tcl_IncrRefCount(objectLiteral);
    TclNewLiteralStringObj(privateLiteral, "private");
    Tcl_IncrRefCount(privateLiteral);

    /*
     * Do the actual construction of the descriptions. They consist of a list
     * of triples that describe the details of how a method is understood. For
     * each triple, the first word is the type of invocation ("method" is
     * normal, "unknown" is special because it adds the method name as an
     * extra argument when handled by some method types, and "filter" is
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i=0 ; i<callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;
	descObjs[1] =
	    callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
	    callPtr->flags & DESTRUCTOR ? fPtr->destructorName :

		    miPtr->mPtr->namePtr;
	descObjs[2] = miPtr->mPtr->declaringClassPtr
		? Tcl_GetObjectName(interp,
			(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
		: objectLiteral;
	descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);

	objv[i] = Tcl_NewListObj(4, descObjs);
    }

    /*
     * Drop the local references to the literals; if they're actually used,
     * they'll live on the description itself.
     */

    Tcl_DecrRefCount(filterLiteral);
    Tcl_DecrRefCount(methodLiteral);
    Tcl_DecrRefCount(objectLiteral);
    Tcl_DecrRefCount(privateLiteral);

    /*
     * Finish building the description and return it.
     */

    resultObj = Tcl_NewListObj(callPtr->numChain, objv);
    TclStackFree(interp, objv);

				const Tcl_MethodType *typePtr,
				ClientData *clientDataPtr);
/* 10 */
TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Obj *nameObj,
				int flags, const Tcl_MethodType *typePtr,
				ClientData clientData);
/* 12 */
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				ClientData clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, int objc,
				Tcl_Obj *const *objv, int skip);

				Tcl_Class clazz, Tcl_Method method);
/* 27 */
TCLAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
				Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
				Tcl_Object object);
/* 29 */
TCLAPI int		Tcl_MethodIsPrivate(Tcl_Method method);

typedef struct {
    const struct TclOOIntStubs *tclOOIntStubs;
} TclOOStubHooks;

typedef struct TclOOStubs {
    int magic;
    const TclOOStubHooks *hooks;

    Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */
    Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */
    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
    ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
} TclOOStubs;

extern const TclOOStubs *tclOOStubsPtr;

#ifdef __cplusplus
}
#endif

	(tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */
#define Tcl_ClassSetConstructor \
	(tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */
#define Tcl_ClassSetDestructor \
	(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
#define Tcl_GetObjectName \
	(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
#define Tcl_MethodIsPrivate \
	(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */

#endif /* defined(USE_TCLOO_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLOODECLS */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
 * The actual value used to mark private declaration frames.
 */

#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)

/*
 * The maximum length of fully-qualified object name to use in an errorinfo
 * message. Longer than this will be curtailed.
 */

#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30

    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */

#define PRIVATE_VARIABLE_PATTERN "%d : %s"

/*
 * ----------------------------------------------------------------------
 *
 * IsPrivateDefine --
 *
 *	Extracts whether the current context is handling private definitions.
 *
 * ----------------------------------------------------------------------
 */

static inline int
IsPrivateDefine(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (!iPtr->varFramePtr) {
	return 0;
    }
    return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
}

/*
 * ----------------------------------------------------------------------
 *
 * BumpGlobalEpoch --
 *
 *	Utility that ensures that call chains that are invalid will get thrown

    }
    BumpGlobalEpoch(interp, classPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * InstallStandardVariableMapping, InstallPrivateVariableMapping --
 *
 *	Helpers for installing standard and private variable maps.
 *
 * ----------------------------------------------------------------------
 */
static inline void
InstallStandardVariableMapping(
    VariableNameList *vnlPtr,
    int varc,
    Tcl_Obj *const *varv)
{
    Tcl_Obj *variableObj;
    int i, n, created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    vnlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		vnlPtr->list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	vnlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
    PrivateVariableList *pvlPtr,
    int varc,
    Tcl_Obj *const *varv,
    int creationEpoch)
{
    PrivateVariableMapping *privatePtr;
    int i, n, created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
	}
    }

    pvlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		privatePtr = &(pvlPtr->list[n++]);
		privatePtr->variableObj = varv[i];
		privatePtr->fullNameObj = Tcl_ObjPrintf(
			PRIVATE_VARIABLE_PATTERN,
			creationEpoch, Tcl_GetString(varv[i]));
		Tcl_IncrRefCount(privatePtr->fullNameObj);
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	pvlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * RenameDeleteMethod --
 *
 *	Core of the code to rename and delete methods.
 *
 * ----------------------------------------------------------------------
 */

TclOOGetDefineCmdContext(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object;

    if ((iPtr->varFramePtr == NULL)
	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
	    && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command may only be called from within the context of"
		" an ::oo::define or ::oo::objdefine command", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    object = iPtr->varFramePtr->clientData;

    Tcl_Obj *className,
    const char *errMsg)
{
    Interp *iPtr = (Interp *) interp;
    Object *oPtr;
    CallFrame *savedFramePtr = iPtr->varFramePtr;

    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
	    || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
	if (iPtr->varFramePtr->callerVarPtr == NULL) {
	    Tcl_Panic("getting outer context when already in global context");
	}
	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, className);
    iPtr->varFramePtr = savedFramePtr;

    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Foundation *fPtr = TclOOGetFoundation(interp);
    Object *oPtr;
    int result, private;

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
	return TCL_OK;
    }

    private = IsPrivateDefine(interp);

    /*
     * Make the oo::objdefine namespace the current namespace and evaluate the
     * command(s).
     */

    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
	return TCL_ERROR;
    }
    if (private) {
	((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
    }

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0,
		((Interp *)interp)->cmdFramePtr, 1);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
    }

    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefinePrivateObjCmd --
 *
 *	Implementation of the "private" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefinePrivateObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstancePrivate = (clientData != NULL);
				/* Just so that we can generate the correct
				 * error message depending on the context of
				 * usage of this function. */
    Interp *iPtr = (Interp *) interp;
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int saved;			/* The saved flag. We restore it on exit so
				 * that [private private ...] doesn't make
				 * things go weird. */
    int result;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
	return TCL_OK;
    }

    /*
     * Change the frame type flag while evaluating the body.
     */

    saved = iPtr->varFramePtr->isProcCallFrame;
    iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;

    /*
     * Evaluate the body; standard pattern.
     */

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj,
		    isInstancePrivate ? "object" : "class");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
		1, objc, objv);
    }
    TclOODecrRefCount(oPtr);

    /*
     * Restore the frame type flag to what it was previously.
     */

    iPtr->varFramePtr->isProcCallFrame = saved;
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineClassObjCmd --
 *
 *	Implementation of the "class" subcommand of the "oo::objdefine"

	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
	}
	if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
	    mPtr->flags |= PUBLIC_METHOD;
	    mPtr->flags &= ~TRUE_PRIVATE_METHOD;
	    changed = 1;
	}
    }

    /*
     * Bump the right epoch if we actually changed anything.
     */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method structure.
     */

    prefixObj = Tcl_NewListObj(objc-2, objv+2);
    if (isInstanceForward) {

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method by using the right back-end API.
     */

    if (isInstanceMethod) {
	if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],

	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
	}
	if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
	    mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
	    changed = 1;
	}
    }

    /*
     * Bump the right epoch if we actually changed anything.
     */

    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (IsPrivateDefine(interp)) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, oPtr->classPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassVarsSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }

		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }



















    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,



		varc, varv, oPtr->classPtr->thisPtr->creationEpoch);





    } else {



	InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);









    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *

    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (IsPrivateDefine(interp)) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, oPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjVarsSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }



    if (IsPrivateDefine(interp)) {



















	InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,



		oPtr->creationEpoch);

    } else {



	InstallStandardVariableMapping(&oPtr->variables, varc, varv);









    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc InfoObjectCallCmd;
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectCmds[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.
 */

    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInitInfo --

InfoObjectMethodsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
	SCOPE_LOCALPRIVATE
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);

		recurse = 1;
		break;
	    case OPT_LOCALPRIVATE:
		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
			    NULL);
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
    }
    if (scope != -1) {
	recurse = 0;
	switch (scope) {
	case SCOPE_PRIVATE:
	    flag = TRUE_PRIVATE_METHOD;
	    break;
	case SCOPE_PUBLIC:
	    flag = PUBLIC_METHOD;
	    break;
	case SCOPE_LOCALPRIVATE:
	    flag = PRIVATE_METHOD;
	    break;
	case SCOPE_UNEXPORTED:
	    flag = 0;
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    if (recurse) {
	const char **names;
	int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectIdCmd --
 *
 *	Implements [info object creationid $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectIdCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->creationEpoch));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectNsCmd --
 *
 *	Implements [info object namespace $objName]
 *
 * ----------------------------------------------------------------------
 */

}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectVariablesCmd --
 *
 *	Implements [info object variables $objName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectVariablesCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_Obj *resultObj;
    int i, private = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	private = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (private) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, oPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------

}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassMethodsCmd --
 *
 *	Implements [info class methods $clsName ?options...?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMethodsCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    Class *clsPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);

		recurse = 1;
		break;
	    case OPT_LOCALPRIVATE:
		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
			    NULL);
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
    }
    if (scope != -1) {
	recurse = 0;
	switch (scope) {
	case SCOPE_PRIVATE:
	    flag = TRUE_PRIVATE_METHOD;
	    break;
	case SCOPE_PUBLIC:
	    flag = PUBLIC_METHOD;
	    break;
	case SCOPE_UNEXPORTED:
	    flag = 0;
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    if (recurse) {
	const char **names;
	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else {
	FOREACH_HASH_DECLS;

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassVariablesCmd --
 *
 *	Implements [info class variables $clsName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassVariablesCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    Tcl_Obj *resultObj;
    int i, private = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	private = 1;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    if (private) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, clsPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------

	return TCL_ERROR;
    }

    /*
     * Get the call context and render its call chain.
     */

    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
	    NULL);
    if (contextPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
	    TclOORenderCallChain(interp, contextPtr->callPtr));

typedef struct ForwardMethod {
    Tcl_Obj *prefixObj;		/* The list of values to use to replace the
				 * object and method name with. Will be a
				 * non-empty list. */
} ForwardMethod;

/*
 * Structure used in private variable mappings. Describes the mapping of a
 * single variable from the user's local name to the system's storage name.
 * [TIP #500]
 */

typedef struct {
    Tcl_Obj *variableObj;	/* Name used within methods. This is the part
				 * that is properly under user control. */
    Tcl_Obj *fullNameObj;	/* Name used at the instance namespace level. */
} PrivateVariableMapping;

/*
 * Helper definitions that declare a "list" array. The two varieties are
 * either optimized for simplicity (in the case that the whole array is
 * typically assigned at once) or efficiency (in the case that the array is
 * expected to be expanded over time). These lists are designed to be iterated
 * over with the help of the FOREACH macro (see later in this file).
 *
 * The "num" field always counts the number of listType_t elements used in the
 * "list" field. When a "size" field exists, it describes how many elements
 * are present in the list; when absent, exactly "num" elements are present.
 */

#define LIST_STATIC(listType_t) \
    struct { int num; listType_t *list; }
#define LIST_DYNAMIC(listType_t) \
    struct { int num, size; listType_t *list; }

/*
 * These types are needed in function arguments.
 */

typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;

/*
 * Now, the definition of what an object actually is.
 */

typedef struct Object {
    struct Foundation *fPtr;	/* The basis for the object system. Putting
				 * this here allows the avoidance of quite a

				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
} Object;

#define OBJECT_DELETED	1	/* Flag to say that an object has been
				 * destroyed. */
#define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
				 * called. */
#define CLASS_GONE	4	/* Obsolete. Indicates that the class of this

				 * no methods, mixins, or filters. */
#define ROOT_CLASS 0x8000	/* Flag to say that this object is the root
				 * class of classes, and should be treated
				 * specially during teardown (and in a few
				 * other spots). */
#define FORCE_UNKNOWN 0x10000	/* States that we are *really* looking up the
				 * unknown method handler at that point. */
#define HAS_PRIVATE_METHODS 0x20000
				/* Object/class has (or had) private methods,
				 * and so shouldn't be cached so
				 * aggressively. */

/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {

				/* Places where call chains are stored. For
				 * constructors, the class chain is always
				 * used. For destructors and ordinary methods,
				 * the class chain is only used when the
				 * object doesn't override with its own mixins
				 * (and filters and method implementations for
				 * when getting method chains). */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
} Class;

/*
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.

/*
 * Bits for the 'flags' field of the call chain.
 */

#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
				 * only) method. Supports itcl. */
#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
#define CONSTRUCTOR	  0x08	/* This is a constructor. */
#define DESTRUCTOR	  0x10	/* This is a destructor. */
#define TRUE_PRIVATE_METHOD 0x20
				/* This is a private method only accessible
				 * from other methods defined on this class
				 * or instance. [TIP #500] */
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)

/*
 * Structure containing definition information about basic class methods.
 */

typedef struct {
    const char *name;		/* Name of the method in question. */

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefinePrivateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
			    Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
			    int flags, const char ***stringsPtr);
MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr,
			    Object *contextObj, Class *contextCls, int flags,
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,

 */

#define FOREACH(var,ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
	continue; \
    } else if (var = (ary).list[i], 1) 

/*
 * A variation where the array is an array of structs. There's no issue with
 * possible NULLs; every element of the array will be iterated over and the
 * varable set to a pointer to each of those elements in turn.
 * REQUIRES DECLARATION: int i;
 */

#define FOREACH_STRUCT(var,ary) \
    for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which
 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
 * only iterates over values.
 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\

  populate:
    mPtr->typePtr = typePtr;
    mPtr->clientData = clientData;
    mPtr->flags = 0;
    mPtr->declaringObjectPtr = oPtr;
    mPtr->declaringClassPtr = NULL;
    if (flags) {
	mPtr->flags |= flags &
		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
	if (flags & TRUE_PRIVATE_METHOD) {
	    oPtr->flags |= HAS_PRIVATE_METHODS;
	}
    }
    oPtr->epoch++;
    return (Tcl_Method) mPtr;
}

/*
 * ----------------------------------------------------------------------

    clsPtr->thisPtr->fPtr->epoch++;
    mPtr->typePtr = typePtr;
    mPtr->clientData = clientData;
    mPtr->flags = 0;
    mPtr->declaringObjectPtr = NULL;
    mPtr->declaringClassPtr = clsPtr;
    if (flags) {
	mPtr->flags |= flags &
		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
	if (flags & TRUE_PRIVATE_METHOD) {
	    clsPtr->flags |= HAS_PRIVATE_METHODS;
	}
    }

    return (Tcl_Method) mPtr;
}

/*
 * ----------------------------------------------------------------------

 *
 * TclOOSetupVariableResolver, etc. --
 *
 *	Variable resolution engine used to connect declared variables to local
 *	variables used in methods. The compiled variable resolver is more
 *	important, but both are needed as it is possible to have a variable
 *	that is only referred to in ways that aren't compilable and we can't
 *	force LVT presence. [TIP #320, #500]
 *
 * ----------------------------------------------------------------------
 */

void
TclOOSetupVariableResolver(
    Tcl_Namespace *nsPtr)

    Tcl_ResolvedVarInfo *rPtr)
{
    OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVar;
    Tcl_HashEntry *hPtr;
    int i, isNew, cacheIt, varLen, len;
    const char *match, *varName;

    /*
     * Check that the variable is being requested in a context that is also a
     * method call; if not (i.e. we're evaluating in the object's namespace or

     * is in the list provided by the user). If not, we mustn't do anything
     * either.
     */

    varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
    if (contextPtr->callPtr->chain[contextPtr->index]
	    .mPtr->declaringClassPtr != NULL) {
	FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 0;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 0;
		goto gotMatch;
	    }
	}
    } else {
	FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 1;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->oPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 1;
		goto gotMatch;
	    }
	}

int
Tcl_MethodIsPublic(
    Tcl_Method method)
{
    return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
}

int
Tcl_MethodIsPrivate(
    Tcl_Method method)
{
    return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
}

/*
 * Extended method construction for itcl-ng.
 */

Tcl_Method
TclOONewProcInstanceMethodEx(

    Tcl_ObjectSetMetadata, /* 22 */
    Tcl_ObjectContextInvokeNext, /* 23 */
    Tcl_ObjectGetMethodNameMapper, /* 24 */
    Tcl_ObjectSetMethodNameMapper, /* 25 */
    Tcl_ClassSetConstructor, /* 26 */
    Tcl_ClassSetDestructor, /* 27 */
    Tcl_GetObjectName, /* 28 */
    Tcl_MethodIsPrivate, /* 29 */
};

/* !END!: Do not edit above this line. */

  objectVars:
    if (!includeLinks) {
	return;
    }

    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
	Method *mPtr = (Method *)
		Tcl_ObjectContextMethod(iPtr->varFramePtr->clientData);

	PrivateVariableMapping *privatePtr;

	if (mPtr->declaringObjectPtr) {
	    Object *oPtr = mPtr->declaringObjectPtr;

	    FOREACH(objNamePtr, oPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	} else {
	    Class *clsPtr = mPtr->declaringClassPtr;

	    FOREACH(objNamePtr, clsPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }

	    FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	}
    }
    Tcl_DeleteHashTable(&addedTable);
}


    while executing
\"info object\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
    info object gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list [list [info object class oo::object] \
	      [info object class oo::class] \
	      [info object class meta] \

		 [info object isa mixin list NOTANOBJECT] \
		 [info object isa mixin NOTANOBJECT list] \
		 [info object isa mixin oo::object list] \
		 [info object isa mixin list oo::object]]
} -cleanup {
    meta destroy
} -result {class {0 0} meta {0 0 0} type {0 0 0 0 0 0} mix {0 0 0 0 0 0}}
test oo-16.15 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    info object creationid [cls new]
} -cleanup {
    cls destroy
} -result {^\d+$} -match regexp
test oo-16.16 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set obj [cls new]
    set id [info object creationid $obj]
    rename $obj gorp
    set id2 [info object creationid gorp]
    list $id $id2
} -cleanup {
    cls destroy
} -result {^(\d+) \1$} -match regexp
test oo-16.17 {OO: object introspection: creationid #500} -body {
    info object creationid nosuchobject
} -returnCodes error -result {nosuchobject does not refer to an object}
test oo-16.18 {OO: object introspection: creationid #500} -body {
    info object creationid
} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
test oo-16.18 {OO: object introspection: creationid #500} -body {
    info object creationid oo::object gorp
} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
test oo-16.19 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    set id2 [info object creationid [set o2 [cls new]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal
test oo-16.20 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    $o1 destroy
    set id2 [info object creationid [set o2 [cls new]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal
test oo-16.21 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    set id2 [info object creationid [set o2 [oo::copy $o1]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal

test oo-17.1 {OO: class introspection} -body {
    info class
} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
test oo-17.1.1 {OO: class introspection} -body {
    catch {info class} m o
    dict get $o -errorinfo

    }
    Cls create obj
    list [oo::objdefine obj testself] $result
} -cleanup {
    Cls destroy
    catch {rename oo::objdefine::testself {}}
} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::obj}}

test oo-37.1 {TIP 500: private command propagates errors} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private ::error "this is an error"
    }
} -cleanup {
    cls destroy
} -returnCodes error -result {this is an error}
test oo-37.2 {TIP 500: private command propagates errors} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private {
	    ::error "this is an error"
	}
    }
} -cleanup {
    cls destroy
} -returnCodes error -result {this is an error}
test oo-37.3 {TIP 500: private command propagates errors} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	private ::error "this is an error"
    }
} -cleanup {
    obj destroy
} -returnCodes error -result {this is an error}
test oo-37.4 {TIP 500: private command propagates errors} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	private {
	    ::error "this is an error"
	}
    }
} -cleanup {
    obj destroy
} -returnCodes error -result {this is an error}
test oo-37.5 {TIP 500: private command can't be used outside definitions} -body {
    oo::define::private error "xyz"
} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}
test oo-37.6 {TIP 500: private command can't be used outside definitions} -body {
    oo::objdefine::private error "xyz"
} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}

test oo-38.1 {TIP 500: private variables don't cross-interfere with each other or normal ones} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	private variable x
	constructor {} {
	    set x 1
	}
	method getA {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	private {
	    variable x
	}
	constructor {} {
	    set x 2
	    next
	}
	method getB {} {
	    return $x
	}
    }
    oo::class create clsC {
	superclass clsB
	variable x
	constructor {} {
	    set x 3
	    next
	}
	method getC {} {
	    return $x
	}
    }
    clsC create obj
    oo::objdefine obj {
	private {
	    variable x
	}
	method setup {} {
	    set x 4
	}
	method getO {} {
	    return $x
	}
    }
    obj setup
    list [obj getA] [obj getB] [obj getC] [obj getO] \
	[lsort [string map [list [info object creationid clsA] CLASS-A \
				[info object creationid clsB] CLASS-B \
				[info object creationid obj] OBJ] \
		    [info object vars obj]]]
} -cleanup {
    parent destroy
} -result {1 2 3 4 {{CLASS-A : x} {CLASS-B : x} {OBJ : x} x}}
test oo-38.2 {TIP 500: private variables introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	private {
	    variable x1
	    variable x2
	}
	variable y1 y2
    }
    cls create obj
    oo::objdefine obj {
	private variable a1 a2
	variable b1 b2
    }
    list [lsort [info class variables cls]] \
	[lsort [info class variables cls -private]] \
	[lsort [info object variables obj]] \
	[lsort [info object variables obj -private]]
} -cleanup {
    parent destroy
} -result {{y1 y2} {x1 x2} {b1 b2} {a1 a2}}
test oo-38.3 {TIP 500: private variables and oo::object·varname} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	private {
	    variable x
	}
	method getx {} {
	    set x 1
	    my varname x
	}
	method readx {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method gety {} {
	    set x 1
	    my varname x
	}
	method ready {} {
	    return $x
	}
    }
    clsB create obj
    set [obj getx] 2
    set [obj gety] 3
    list [obj readx] [obj ready]
} -cleanup {
    parent destroy
} -result {2 3}
test oo-38.4 {TIP 500: private variables introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	private {
	    variable x1 x2
	}
	variable y1 y2
	constructor {} {
	    variable z boo
	    set x1 a
	    set y1 c
	}
	method list {} {
	    variable z
	    set ok 1
	    list [info locals] [lsort [info vars]] [info exist x2]
	}
    }
    cls create obj
    oo::objdefine obj {
	private variable a1 a2
	variable b1 b2
	method init {} {
	    # Because we don't have a constructor to do this setup for us
	    set a1 p
	    set b1 r
	}
	method list {} {
	    variable z
	    set yes 1
	    list {*}[next] [info locals] [lsort [info vars]] [info exist a2]
	}
    }
    obj init
    obj list
} -cleanup {
    parent destroy
} -result {ok {ok x1 x2 y1 y2 z} 0 yes {a1 a2 b1 b2 yes z} 0}
test oo-38.5 {TIP 500: private variables and oo::object·variable} -setup {
    oo::class create parent
} -body {
    oo::class create cls1 {
	superclass parent
	private variable x
	method abc val {
	    my variable x
	    set x $val
	}
	method def val {
	    my variable y
	    set y $val
	}
	method get1 {} {
	    my variable x y
	    return [list $x $y]
	}
    }
    oo::class create cls2 {
	superclass cls1
	private variable x
	method x-exists {} {
	    return [info exists x],[uplevel 1 {info exists x}]
	}
	method ghi x {
	    # Additional instrumentation to show that we're not using the
	    # resolved variable until we ask for it; the argument nixed that
	    # happening by default.
	    set val $x
	    set before [my x-exists]
	    unset x
	    set x $val
	    set mid [my x-exists]
	    unset x
	    set mid2 [my x-exists]
	    my variable x
	    set x $val
	    set after [my x-exists]
	    return "$before;$mid;$mid2;$after"
	}
	method jkl val {
	    my variable y
	    set y $val
	}
	method get2 {} {
	    my variable x y
	    return [list $x $y]
	}
    }
    cls2 create a
    a abc 123
    a def 234
    set tmp [a ghi 345]
    a jkl 456
    list $tmp [a get1] [a get2]
} -cleanup {
    parent destroy
} -result {{0,1;0,1;0,0;1,1} {123 456} {345 456}}

test oo-39.1 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    my step
	    my step
	    return
	}
	private {
	    method step {} {
		incr x 2
	    }
	}
	method x {} {
	    return $x
	}
    }
    clsA create obj
    obj act
    list [obj x] [catch {obj step} msg] $msg
} -cleanup {
    parent destroy
} -result {7 1 {unknown method "step": must be act, destroy or x}}
test oo-39.2 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    my step
	    my step
	    return
	}
	private {
	    method step {} {
		incr x 2
	    }
	}
	method x {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method step {} {
	    incr x 5
	}
    }
    clsB create obj
    obj act
    list [obj x] [obj step]
} -cleanup {
    parent destroy
} -result {7 12}
test oo-39.3 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my Step
	    my Step
	    my Step
	    return
	}
	method x {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method Step {} {
	    incr x 5
	}
    }
    clsB create obj
    obj act
    set result [obj x]
    oo::define clsA {
	private {
	    method Step {} {
		incr x 2
	    }
	}
    }
    obj act
    lappend result [obj x]
} -cleanup {
    parent destroy
} -result {16 22}
test oo-39.4 {TIP 500: private methods internal call; instance private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    return
	}
	method step {} {
	    incr x
	}
	method x {} {
	    return $x
	}
    }
    clsA create obj
    obj act
    set result [obj x]
    oo::objdefine obj {
	variable x
	private {
	    method step {} {
		incr x 2
	    }
	}
    }
    obj act
    lappend result [obj x]
    oo::objdefine obj {
	method act {} {
	    my step
	    next
	}
    }
    obj act
    lappend result [obj x]
} -cleanup {
    parent destroy
} -result {2 3 6}
test oo-39.5 {TIP 500: private methods internal call; cross object} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {$x == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    cls create c 1
    list [a equal b] [b equal c] [c equal a] [catch {a x} msg] $msg
} -cleanup {
    parent destroy
} -result {0 0 1 1 {unknown method "x": must be destroy or equal}}
test oo-39.6 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {$x == [$other y]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be destroy, equal or x}
test oo-39.7 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {[[self] y] == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be destroy, equal or x}
test oo-39.8 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {[my y] == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable, varname or x}
test oo-39.9 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
    }
    oo::class create cls2 {
	superclass cls
	method equal {other} {
	    expr {[my y] == [$other x]}
	}
    }
    cls2 create a 1
    cls2 create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
test oo-39.10 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
    }
    oo::class create cls2 {
	superclass cls
	method equal {other} {
	    expr {[my x] == [$other x]}
	}
    }
    cls2 create a 1
    cls2 create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "x": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
test oo-39.11 {TIP 500: private methods; call chain caching and reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method chain {} {
	    return [self call]
	}
    }
    oo::class create cls2 {
	superclass cls
	private method chain {} {
	    next
	}
	method chain2 {} {
	    my chain
	}
	method chain3 {} {
	    [self] chain
	}
    }
    cls create a
    cls2 create b
    list [a chain] [b chain] [b chain2] [b chain3]
} -cleanup {
    parent destroy
} -result {{{{method chain ::cls method}} 0} {{{method chain ::cls method}} 0} {{{private chain ::cls2 method} {method chain ::cls method}} 1} {{{private chain ::cls2 method} {method chain ::cls method}} 1}}
test oo-39.12 {TIP 500: private methods; introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method chain {} {
	    return [self call]
	}
	private method abc {} {}
    }
    oo::class create cls2 {
	superclass cls
	method chain2 {} {
	    my chain
	}
	method chain3 {} {
	    [self] chain
	}
	private method def {} {}
	unexport chain3
    }
    cls create a
    cls2 create b
    oo::objdefine b {
	private method ghi {} {}
	method ABC {} {}
	method foo {} {}
    }
    set scopes {public unexported private}
    list a: [lmap s $scopes {info object methods a -scope $s}] \
	b: [lmap s $scopes {info object methods b -scope $s}] \
	cls: [lmap s $scopes {info class methods cls -scope $s}] \
	cls2: [lmap s $scopes {info class methods cls2 -scope $s}] \
} -cleanup {
    parent destroy
} -result {a: {{} {} {}} b: {foo ABC ghi} cls: {chain {} abc} cls2: {chain2 chain3 def}}

test oo-40.1 {TIP 500: private and self} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	self {
	    private {
		variable a
	    }
	    variable b
	}
	private {
	    self {
		variable c
	    }
	    variable d
	}
	variable e
    }
    list \
	[lsort [info class variables cls]] \
	[lsort [info class variables cls -private]] \
	[lsort [info object variables cls]] \
	[lsort [info object variables cls -private]]
} -cleanup {
    cls destroy
} -result {e d b {a c}}
test oo-40.2 {TIP 500: private and export} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private method foo {} {}
    }
    set result [lmap s {public unexported private} {
	info class methods cls -scope $s}]
    oo::define cls {
	export foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo foo {} {}}
test oo-40.3 {TIP 500: private and unexport} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private method foo {} {}
    }
    set result [lmap s {public unexported private} {
	info class methods cls -scope $s}]
    oo::define cls {
	unexport foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo {} foo {}}

cleanupTests
return

# Local Variables:
# mode: tcl
# End: