C++ Tcl_WrongNumArgs函数代码示例

	/* ARGSUSED */
static int
ChanPendingObjCmd(
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    int index, mode;
    static const char *options[] = {"input", "output", NULL};
    enum options {PENDING_INPUT, PENDING_OUTPUT};

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
    case PENDING_INPUT:
	if ((mode & TCL_READABLE) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
	}
	break;
    case PENDING_OUTPUT:
	if ((mode & TCL_WRITABLE) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
	}
	break;
    }
    return TCL_OK;
}

static int
idle(ClientData UNUSED(clientData), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    Togl   *togl;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName");
	return TCL_ERROR;
    }

    if (Togl_GetToglFromObj(interp, objv[1], &togl) != TCL_OK) {
	return TCL_ERROR;
    }

    (void)Togl_GetClientData(togl);
    Togl_PostRedisplay(togl);

    return TCL_OK;
}

static int
Tcl_ALS_Prolog_Read_Call(ClientData prolog_world, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
	AP_World *w = prolog_world;
	const char *s;
	AP_Obj call;
	AP_Result result;

	if (objc < 3) {
		Tcl_WrongNumArgs(interp, 1, objv, (char *)"termString ?varName ...?");
		return TCL_ERROR;
	}
	
	s = Tcl_GetStringFromObj(objv[2], NULL);
	
	call = AP_NewInitStructure(w, AP_NewSymbolFromStr(w, "read_eval_results"), 2,
					AP_NewUIAFromStr(w, s), AP_UNBOUND_OBJ);
			
	result = AP_Call(w, tcltk_module, &call);
	
	if (result == AP_SUCCESS) {
		int i;
		AP_Obj j, vars = AP_GetArgument(w, call, 2);
		
		for (i = 3, j = vars; !AP_IsNullList(w, j) && i < objc; i++, j = AP_ListTail(w, j)) {
			Tcl_ObjSetVar2(interp, objv[i], NULL, PrologToTclObj(w, AP_ListHead(w, j), interp), 0);
		}

		if (i < objc) {
			int k;
			Tcl_ResetResult(interp);
			Tcl_AppendResult(interp, "unset variables: ", NULL);
			for (k = i; k < objc; k++) {
				Tcl_AppendResult(interp,
					Tcl_GetStringFromObj(objv[k], NULL),
					NULL);
			}
			return TCL_ERROR;
		}
	}
	
	return PrologToTclResult(interp, w, result);
}

/*
 * Destroy a Duktape interpreter heap.
 * Return value: nothing.
 * Side effects: destroys a Duktape interpreter heap.
 */
static int
Close_Cmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    duk_context *ctx;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, USAGE_CLOSE);
        return TCL_ERROR;
    }

    ctx = parse_id(cdata, interp, objv[1], 1);
    if (ctx == NULL) {
        return TCL_ERROR;
    }

    duk_destroy_heap(ctx);

    return TCL_OK;
}

/*************************************************************************
* FUNCTION      :   RPMTransaction_Set::Test                             *
* ARGUMENTS     :   none                                                 *
* RETURNS       :   TCL_OK or TCL_ERROR                                  *
* EXCEPTIONS    :   none                                                 *
* PURPOSE       :   Check the transaction set for problems               *
*************************************************************************/
int RPMTransaction_Set::Test(Tcl_Interp *interp,int objc, Tcl_Obj *const objv[])
{
    if (objc != 2)
    {
        Tcl_WrongNumArgs(interp,2,objv,0);
        return TCL_ERROR;
    }
    rpmtsSetFlags(transaction,(rpmtransFlags)(RPMTRANS_FLAG_TEST ));

    int status = rpmtsRun(transaction,0,(rpmprobFilterFlags)prob_flags);
    // Assume we've dirtied the database
    RPM_for_TCL::DBs_are_dirty();
    if (status == 0)
        return TCL_OK;
    else if (status < 0)
        return Error("Error on test: %d %s",status,rpmErrorString());

    return Problems(interp);
}

/* $pw insert $index $slave ?-option value ...?
 * 	Insert new slave, or move existing one.
 */
static int PanedInsertCommand(
    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    Paned *pw = recordPtr;
    int nSlaves = Ttk_NumberSlaves(pw->paned.mgr);
    int srcIndex, destIndex;
    Tk_Window slaveWindow;

    if (objc < 4) {
        Tcl_WrongNumArgs(interp, 2,objv, "index slave ?-option value ...?");
        return TCL_ERROR;
    }

    slaveWindow = Tk_NameToWindow(
                      interp, Tcl_GetString(objv[3]), pw->core.tkwin);
    if (!slaveWindow) {
        return TCL_ERROR;
    }

    if (!strcmp(Tcl_GetString(objv[2]), "end")) {
        destIndex = Ttk_NumberSlaves(pw->paned.mgr);
    } else if (TCL_OK != Ttk_GetSlaveIndexFromObj(
                   interp,pw->paned.mgr,objv[2],&destIndex))
    {
        return TCL_ERROR;
    }

    srcIndex = Ttk_SlaveIndex(pw->paned.mgr, slaveWindow);
    if (srcIndex < 0) { /* New slave: */
        return AddPane(interp, pw, destIndex, slaveWindow, objc-4, objv+4);
    } /* else -- move existing slave: */

    if (destIndex >= nSlaves)
        destIndex  = nSlaves - 1;
    Ttk_ReorderSlave(pw->paned.mgr, srcIndex, destIndex);

    return objc == 4 ? TCL_OK :
           ConfigurePane(interp, pw,
                         Ttk_SlaveData(pw->paned.mgr, destIndex),
                         Ttk_SlaveWindow(pw->paned.mgr, destIndex),
                         objc-4,objv+4);
}

int gnoclSessionCmd( ClientData data, Tcl_Interp *interp,
      int objc, Tcl_Obj * const objv[] )
{
   static const char *cmd[] = { "configure", NULL };
   enum optIdx { ConfigureIdx };
   int idx;

   static GnomeClient *client = NULL;
   if( client == NULL )
      client = gnome_master_client();

   if( client == NULL )
   {
      Tcl_SetResult( interp, "Unable to initialize session.", TCL_STATIC );
      return TCL_ERROR;
   }

   if( objc < 2 )
   {
      Tcl_WrongNumArgs( interp, 1, objv, "command" );
      return TCL_ERROR;
   }
   if( Tcl_GetIndexFromObj( interp, objv[1], cmd, "command", TCL_EXACT,
         &idx ) != TCL_OK )
      return TCL_ERROR;
   switch( idx )
   {
      case ConfigureIdx:
            {
               int ret = TCL_ERROR;
               if( gnoclParseAndSetOptions( interp, objc - 1, objv + 1, 
                     sessionOptions, G_OBJECT( client ) ) == TCL_OK )
               {
                  ret = configure( interp, client, sessionOptions );
               }
               gnoclClearOptions( sessionOptions );
               return ret;
            }
            break;
   }
   return TCL_OK;
}

static int PutCmd(Tcl_Interp *interp, pvInfo *info, int objc, Tcl_Obj * const objv[]) {
	if (objc != 5 && objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "<value> ?-command <cmdprefix>?");
		return TCL_ERROR;
	}

	int callback = (objc == 5);

	Tcl_Obj *value  = objv[2];
	Tcl_Obj *cmdopt = NULL;
	Tcl_Obj *cmdprefix = NULL;
	
	if (callback) {
		cmdopt = objv[3];
		cmdprefix = objv[4];

		/* check that the option is -command */
		if (strcmp(Tcl_GetString(cmdopt), "-command") != 0) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown option, must be -command", -1));
			return TCL_ERROR;
		}
	}

	/* Convert value into the EPICS record format */
	void *dbr;
	chtype puttype;
	if (GetEpicsValueFromObj(interp, value, info->type, info->nElem, &puttype, &dbr) != TCL_OK) {
		return TCL_ERROR;
	}

	//printf("Data type %d, native %d\n", (int)puttype, (int)(info->type));
	
	/* Issue put operation */
	if (callback) {	
		putEvent *ev = ckalloc(sizeof(putEvent));
		ev->info = info;
		ev->putCmdPrefix = cmdprefix;
		if (cmdprefix) Tcl_IncrRefCount(ev->putCmdPrefix);
		ev->code = TCL_OK;
		int code = ca_array_put_callback (puttype, info->nElem, info->id, dbr, putHandler, ev);
		CACHECKTCL(ckfree(dbr); Tcl_DecrRefCount(ev->putCmdPrefix); ckfree(ev));
	} else {

	/* ARGSUSED */
int
Tcl_FlushObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *chanObjPtr;
    Tcl_Channel chan;		/* The channel to flush on. */
    int mode;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((mode & TCL_WRITABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
		"\" wasn't opened for writing", NULL);
	return TCL_ERROR;
    }

    if (Tcl_Flush(chan) != TCL_OK) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_AppendResult(interp, "error flushing \"",
		    TclGetString(chanObjPtr), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

static int itemBounds( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[], 
      CanvasParams *param, GPtrArray *items )
{
   if( objc != 3 )
   {
      Tcl_WrongNumArgs( interp, 2, objv, NULL );
      return TCL_ERROR;
   }

   if( items != NULL && items->len > 0 )
   {
      Tcl_Obj *resList;
      double  xMin, yMin, xMax, yMax;
      guint   k;
      Gnocl_CanvasItemInfo *info = GET_INFO( items, 0 );
      gnome_canvas_item_get_bounds( info->item, &xMin, &yMin, &xMax, &yMax );

      for( k = 1; k < items->len; ++k )
      {
         double x1, y1, x2, y2;
         info = GET_INFO( items, k );
         gnome_canvas_item_get_bounds( info->item, &x1, &y1, &x2, &y2 );
         if( x1 < xMin )
            xMin = x1;
         if( y1 < yMin )
            yMin = y1;
         if( x2 > xMax )
            xMax = x2;
         if( y2 > yMax )
            yMax = y2;
      }

      resList = Tcl_NewListObj( 0, NULL );
      Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( xMin ) );
      Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( yMin ) );
      Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( xMax ) );
      Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( yMax ) );
      Tcl_SetObjResult( interp, resList );
   }

   return TCL_OK;
}

static int
command_sendheader(ClientData clientData, Tcl_Interp *interp, int objc,
    Tcl_Obj *const objv[])
{
    ngx_http_request_t *r = getrequest(clientData);
    int rc;

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, NULL);
        return TCL_ERROR;
    }

    rc = ngx_http_send_header(r);
    if (rc != NGX_OK) {
        ngx_tcl_set_error_code(interp, rc);
        return TCL_ERROR;
    }

    return TCL_OK;
}

static int
zap(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
    WHIRLYGIZMO *Wg;
    Togl   *togl;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "pathName");
        return TCL_ERROR;
    }

    if (Togl_GetToglFromObj(interp, objv[1], &togl) != TCL_OK) {
        return TCL_ERROR;
    }

    Wg = (WHIRLYGIZMO *) Togl_GetClientData(togl);
    free(Wg);

    return TCL_OK;
}

static int
Ta4r_Uniform_Cmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
	int ubound;

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "upperbound");
		return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[1], &ubound) != TCL_OK) {
		return TCL_ERROR;
	}
	if (ubound < 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad value \"%d\" for upperbound: must be >= 0", ubound));
		return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(arc4random_uniform(ubound)));

	return TCL_OK;
}

int
GenericValueToTclObj(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "GenVal");
        return TCL_ERROR;
    }

    LLVMGenericValueRef arg = nullptr;
    if (GetLLVMGenericValueRefFromObj(interp, objv[1], arg) != TCL_OK)
        return TCL_ERROR;

    Tcl_Obj *rt = (Tcl_Obj *) LLVMGenericValueToPointer(arg);
    Tcl_SetObjResult(interp, rt);
    return TCL_OK;
}

static int
Pkgd_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
    return TCL_OK;
}