/*
 * itclStubs.c --
 *
 *      This file contains the C-implemeted part of Itcl object-system
 *      Itcl
 *
 * Copyright (c) 2006 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.
 */

#include "itclInt.h"

static void ItclDeleteStub(ClientData cdata);
static int ItclHandleStubCmd(ClientData clientData, Tcl_Interp *interp,
        int objc, Tcl_Obj *const objv[]);


/*
 * ------------------------------------------------------------------------
 *  Itcl_IsStub()
 *
 *  Checks the given Tcl command to see if it represents an autoloading
 *  stub created by the "stub create" command.  Returns non-zero if
 *  the command is indeed a stub.
 * ------------------------------------------------------------------------
 */
int
Itcl_IsStub(
    Tcl_Command cmdPtr)      /* command being tested */
{
    Tcl_CmdInfo cmdInfo;

    /*
     *  This may be an imported command, but don't try to get the
     *  original.  Just check to see if this particular command
     *  is a stub.  If we really want the original command, we'll
     *  find it at a higher level.
     */
    if (Tcl_GetCommandInfoFromToken(cmdPtr, &cmdInfo) == 1) {
        if (cmdInfo.deleteProc == ItclDeleteStub) {
            return 1;
        }
    }
    return 0;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_StubCreateCmd()
 *
 *  Invoked by Tcl whenever the user issues a "stub create" command to
 *  create an autoloading stub for imported commands.  Handles the
 *  following syntax:
 *
 *    stub create <name>
 *
 *  Creates a command called <name>.  Executing this command will cause
 *  the real command <name> to be autoloaded.
 * ------------------------------------------------------------------------
 */
int
Itcl_StubCreateCmd(
    TCL_UNUSED(ClientData),   /* not used */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Command cmdPtr;
    char *cmdName;
    Tcl_CmdInfo cmdInfo;

    ItclShowArgs(1, "Itcl_StubCreateCmd", objc, objv);
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "name");
        return TCL_ERROR;
    }
    cmdName = Tcl_GetString(objv[1]);

    /*
     *  Create a stub command with the characteristic ItclDeleteStub
     *  procedure.  That way, we can recognize this command later
     *  on as a stub.  Save the cmd token as client data, so we can
     *  get the full name of this command later on.
     */
    cmdPtr = Tcl_CreateObjCommand(interp, cmdName,
        ItclHandleStubCmd, NULL,
        (Tcl_CmdDeleteProc*)ItclDeleteStub);

    Tcl_GetCommandInfoFromToken(cmdPtr, &cmdInfo);
    cmdInfo.objClientData = cmdPtr;
    Tcl_SetCommandInfoFromToken(cmdPtr, &cmdInfo);

    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_StubExistsCmd()
 *
 *  Invoked by Tcl whenever the user issues a "stub exists" command to
 *  see if an existing command is an autoloading stub.  Handles the
 *  following syntax:
 *
 *    stub exists <name>
 *
 *  Looks for a command called <name> and checks to see if it is an
 *  autoloading stub.  Returns a boolean result.
 * ------------------------------------------------------------------------
 */
int
Itcl_StubExistsCmd(
    TCL_UNUSED(ClientData),   /* not used */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Command cmdPtr;
    char *cmdName;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "name");
        return TCL_ERROR;
    }
    cmdName = Tcl_GetString(objv[1]);

    cmdPtr = Tcl_FindCommand(interp, cmdName, NULL, 0);

    if ((cmdPtr != NULL) && Itcl_IsStub(cmdPtr)) {
        Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 1);
    } else {
        Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 0);
    }
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclHandleStubCmd()
 *
 *  Invoked by Tcl to handle commands created by "stub create".
 *  Calls "auto_load" with the full name of the current command to
 *  trigger autoloading of the real implementation.  Then, calls the
 *  command to handle its function.  If successful, this command
 *  returns TCL_OK along with the result from the real implementation
 *  of this command.  Otherwise, it returns TCL_ERROR, along with an
 *  error message in the interpreter.
 * ------------------------------------------------------------------------
 */
static int
ItclHandleStubCmd(
    ClientData clientData,   /* command token for this stub */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    Tcl_Command cmdPtr;
    Tcl_Obj **cmdlinev;
    Tcl_Obj *objAutoLoad[2];
    Tcl_Obj *objPtr;
    Tcl_Obj *cmdNamePtr;
    Tcl_Obj *cmdlinePtr;
    char *cmdName;
    int result;
    int loaded;
    int cmdlinec;

    ItclShowArgs(1, "ItclHandleStubCmd", objc, objv);
    cmdPtr = (Tcl_Command) clientData;
    cmdNamePtr = Tcl_NewStringObj(NULL, 0);
    Tcl_IncrRefCount(cmdNamePtr);
    Tcl_GetCommandFullName(interp, cmdPtr, cmdNamePtr);
    cmdName = Tcl_GetString(cmdNamePtr);

    /*
     *  Try to autoload the real command for this stub.
     */
    objAutoLoad[0] = Tcl_NewStringObj("::auto_load", -1);
    objAutoLoad[1] = cmdNamePtr;
    result = Tcl_EvalObjv(interp, 2, objAutoLoad, 0);
    if (result != TCL_OK) {
        Tcl_DecrRefCount(cmdNamePtr);
        return TCL_ERROR;
    }

    objPtr = Tcl_GetObjResult(interp);
    result = Tcl_GetIntFromObj(interp, objPtr, &loaded);
    if ((result != TCL_OK) || !loaded) {
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "can't autoload \"", cmdName, "\"", NULL);
        Tcl_DecrRefCount(cmdNamePtr);
        return TCL_ERROR;
    }

    /*
     *  At this point, the real implementation has been loaded.
     *  Invoke the command again with the arguments passed in.
     */
    cmdlinePtr = Itcl_CreateArgs(interp, cmdName, objc - 1, objv + 1);
    (void) Tcl_ListObjGetElements(NULL, cmdlinePtr,
        &cmdlinec, &cmdlinev);

    Tcl_DecrRefCount(cmdNamePtr);
    Tcl_ResetResult(interp);
    ItclShowArgs(1, "ItclHandleStubCmd", cmdlinec - 1, cmdlinev + 1);
    result = Tcl_EvalObjv(interp, cmdlinec - 1, cmdlinev + 1, TCL_EVAL_DIRECT);
    Tcl_DecrRefCount(cmdlinePtr);
    Tcl_DecrRefCount(objAutoLoad[0]);
    return result;
}


/*
 * ------------------------------------------------------------------------
 *  ItclDeleteStub()
 *
 *  Invoked by Tcl whenever a stub command is deleted.  This procedure
 *  does nothing, but its presence identifies a command as a stub.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static void
ItclDeleteStub(
    TCL_UNUSED(ClientData))      /* not used */
{
    /* do nothing */
}