Posted to tcl by apw at Mon Aug 20 12:19:35 GMT 2007view pretty

/*
 * itclNeededFromTclOO.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright (c) 2007 by Arnulf P. Wiedemann
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: itclNeededFromTclOO.c 1.0 2007/07/30 14:20:21 apw Exp $
 */

#include "../oo/generic/tclOOInt.h"


/*
 * ----------------------------------------------------------------------
 *
 * _Tcl_NewProcMethod --
 *
 *	Create a new procedure-like method for an object for Itcl.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
_Tcl_NewProcMethod(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Tcl_Object oPtr,		/* The object to modify. */
    Tcl_Obj *nameObj,		/* The name of the method, which must not be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which must not be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    int flags,                  /* Whether this is a public method. */
    ClientData *clientData)
{
    ProcedureMethod *pmPtr;
    Tcl_Method method;

    method = (Tcl_Method)TclOONewProcMethod(interp, (Object *)oPtr, flags,
            nameObj, argsObj, bodyObj, &pmPtr);
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->clientData = clientData;
    if (clientData != NULL) {
        *clientData = pmPtr;
    }
    return method;
}

/*
 * ----------------------------------------------------------------------
 *
 * _Tcl_NewProcClassMethod --
 *
 *	Create a new procedure-like method for a class for Itcl.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
_Tcl_NewProcClassMethod(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Tcl_Class clsPtr,		/* The class to modify. */
    TclOO_PreCallProc preCallPtr,
    TclOO_PostCallProc postCallPtr,
    ClientData clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which may be NULL; if so, it is equivalent
				 * to an empty list. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    int flags,                  /* Whether this is a public method. */
    ClientData *clientData2)
{
    ProcedureMethod *pmPtr;
    Method *method;

    method = TclOONewProcClassMethod(interp, (Class *)clsPtr, flags,
            nameObj, argsObj, bodyObj, &pmPtr);
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->preCallProc = preCallPtr;
    pmPtr->postCallProc = postCallPtr;
    pmPtr->clientData = clientData;
    if (clientData2 != NULL) {
        *clientData2 = pmPtr;
    }
    return (Tcl_Method)method;
}

/*
 * ----------------------------------------------------------------------
 *
 * _Tcl_ProcPtrFromPM --
 *
 *	Get The ProcPtr from a struct ProcedureMethod
 *
 * ----------------------------------------------------------------------
 */

ClientData
_Tcl_ProcPtrFromPM(
    ClientData *clientData)
{
    return ((ProcedureMethod *)clientData)->procPtr;
}