C++ Tcl_ResetResult函数代码示例

int
TnmValidateIpHostName(Tcl_Interp *interp, const char *name)
{
    const char *p = name;
    char last = ' ';
    int dots = 0, alpha = 0;

    /*
     * A host name must start with one of the characters [a-zA-Z0-9]
     * and continue with characters from the set [-.a-zA-Z0-9] and
     * must not end with a '-'. Names that only contain
     * digits and three dots are also not allowed.
     *
     * NOTE: a hostname is allowed to end with a dot, which the previous version of this code
     * explicitly disallowed.
     */

    if (! isalnum(*p)) {
	goto error;
    }

    while (isalnum(*p) || *p == '-' || *p == '.') {
	if (*p == '.') dots++;
	if (isalpha(*p)) alpha++;
	last = *p++;
    }

    if (*p == '\0' && (isalnum(last) || last == '.') && (alpha || dots != 3)) {
	return TCL_OK;
    }

 error:
    if (interp) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "illegal IP host name \"",
			 name, "\"", (char *) NULL);
    }
    return TCL_ERROR;
}

LispRef eul_tk_cmd_text
(
    char *name,
    Tcl_CmdInfo *cmdPtr,
    char *command,
    LispRef args
)
{
    struct infoargs infoArgs;
    ParseArguments2(&infoArgs, name, command, args);

    Tcl_ResetResult(interp);

    int result = (cmdPtr->proc)
    (
        cmdPtr->clientData,
        interp,
        infoArgs.argc,
        infoArgs.argv
    );

    if (result == TCL_OK)
    {
        if (strcmp(command, "index") == 0)
        {
            LispRef loc = eul_true;;
            eul_allocate_string(loc, interp->result);
            return loc;
        }
        else
        {
            return eul_nil;
        }
    }
    else
    {
        return eul_nil;
    }
}

static int
ForeachLoopStep (ClientData data[], Tcl_Interp * interp, int result)
{
  ForeachState *const statePtr = data[0];
  Tcl_Obj *const varPtr = data[1];
  DBFHandle const dbfHandle = data[2];
  Tcl_Obj *const bodyPtr = data[3];

  switch (result)
    {
    case TCL_CONTINUE:
      result = TCL_OK;
    case TCL_OK:
      break;
    case TCL_BREAK:
      result = TCL_OK;
      goto done;
    case TCL_ERROR:
    default:
      goto done;
    }

  if (statePtr->length > ++statePtr->i)
    {
      if ((result =
           ForeachAssignments (interp, statePtr, varPtr, dbfHandle)) != TCL_OK)
        {
          goto done;
        }
      Tcl_NRAddCallback (interp, ForeachLoopStep, statePtr, varPtr, dbfHandle,
                         bodyPtr);
      return Tcl_NREvalObj (interp, bodyPtr, 0);
    }
  Tcl_ResetResult (interp);
done:
  ckfree ((char *) statePtr);
  return result;
}

int observable_calc_tclcommand(observable* self) {
  Observable_Tclcommand_Arg_Container* container = (Observable_Tclcommand_Arg_Container*) self->container;
  Tcl_Interp* interp = (Tcl_Interp*) container->interp;
  int error = Tcl_Eval(interp, container->command);
  if (error) {
    return 1;
  }
  char* result = Tcl_GetStringResult(interp);
  char* token;
  int counter=0;
  double* A=self->last_value;
  token = strtok(result, " ");
  while ( token != NULL && counter < self->n) {
    A[counter] = atof(token);
    token = strtok(NULL, " ");
    counter++;
  }
  Tcl_ResetResult(interp);
  if (counter != self->n) {
      return 1;
  }
  return 0;
}

int tclcommand_inter_print_bonded(Tcl_Interp *interp, int i)
{
  char buffer[TCL_INTEGER_SPACE];

  Tcl_ResetResult(interp);

  if(i < 0) {
    Tcl_AppendResult(interp, "interaction type must be nonnegative",
		     (char *) NULL);
    return (TCL_ERROR);
  }
  
  /* print specific interaction information */
  if(i<n_bonded_ia) {
    tclprint_to_result_BondedIA(interp, i);
    return TCL_OK;
  }

  sprintf(buffer, "%d", i);
  Tcl_AppendResult(interp, "unknown bonded interaction number ", buffer,
		   (char *) NULL);
  return TCL_ERROR;
}

/*++

TclGetOctalFromObj

    Retrieves an octal value from the given object.

Arguments:
    interp   - Interpreter to use for error reporting.

    objPtr   - Object to retrieve the octal value from.

    octalPtr - Address to store the octal value.

Return Value:
    A standard Tcl result.

--*/
int
TclGetOctalFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    unsigned long *octalPtr
    )
{
    char *input;

    assert(interp   != NULL);
    assert(objPtr   != NULL);
    assert(octalPtr != NULL);

    input = Tcl_GetString(objPtr);
    *octalPtr = strtoul(input, NULL, 8);

    if (errno == ERANGE) {
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "expected octal but got \"", input, "\"", NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * Get the connection Id from the result Id
 */
int
PgGetConnByResultId(Tcl_Interp *interp, CONST84 char *resid_c)
{
	char	   *mark;
	Tcl_Channel conn_chan;

	if (!(mark = strchr(resid_c, '.')))
		goto error_out;
	*mark = '\0';
	conn_chan = Tcl_GetChannel(interp, resid_c, 0);
	*mark = '.';
	if (conn_chan && Tcl_GetChannelType(conn_chan) == &Pg_ConnType)
	{
		Tcl_SetResult(interp, (char *) Tcl_GetChannelName(conn_chan),
					  TCL_VOLATILE);
		return TCL_OK;
	}

error_out:
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, resid_c, " is not a valid connection\n", 0);
	return TCL_ERROR;
}

static void tclconstraints(int del, double a[], int nt, int nm, int nr, int nb)
{
  int ret;

  if (abortFit) return;

  clipdepth(del,a,nt,nm,nr,nb);
  if (fit_constraints) {
    genshift(a,FALSE);
    ret = Tcl_Eval(fit_interp, fit_constraints);
    if (ret == TCL_OK) {
      /* XXX FIXME XXX we can remove both this genshift and the
       * genshift in fgen/fsgen */
      genshift(a,TRUE);
      Tcl_ResetResult(fit_interp);
    } else {
      if (ret == TCL_ERROR) failure = 1;
      stopFit(0);
    }
  }
  /* XXX FIXME XXX why did I want to run the event loop during constraints? */
  /* flushqueue(); */
}

LispRef eul_tk_set_value_widget
(
    char *name,
    Tcl_CmdInfo *cmdPtr,
    char *index
)
{
    static const char command[] = "set";
    struct infoargs infoArgs;
    ParseArguments3(&infoArgs, name, command, index, eul_nil);

    Tcl_ResetResult(interp);

    int result = (cmdPtr->proc)
    (
        cmdPtr->clientData,
        interp,
        infoArgs.argc,
        infoArgs.argv
    );

    return eul_tk_result(result);
}

int tclcommand_inter_parse_soft(Tcl_Interp * interp,
				int part_type_a, int part_type_b,
				int argc, char ** argv)
{
  /* parameters needed for soft-shere */
  double a, n, cut, offset;
  int change;

  /* get soft-sphere interaction type */
  if (argc < 5) {
    Tcl_AppendResult(interp, "soft-sphere potential needs 4 parameters: "
		     "<soft_a> <soft_n> <soft_cut> <soft_offset>",
		     (char *) NULL);
    return 0;
  }

  /* copy soft-sphere parameters */
  if ((! ARG_IS_D(1, a))     ||
      (! ARG_IS_D(2, n))     ||
      (! ARG_IS_D(3, cut))   ||
      (! ARG_IS_D(4, offset)   )) {
    Tcl_AppendResult(interp, "soft-sphere potential needs 4 parameters: "
		     "<soft_a> <soft_n> <soft_cut> <soft_offset>",
		     (char *) NULL);
    return 0;
  }
  change = 5;
	
  
  Tcl_ResetResult(interp);
  if (soft_sphere_set_params(part_type_a, part_type_b,
                             a, n, cut, offset) == ES_ERROR) {
    Tcl_AppendResult(interp, "particle types must be non-negative", (char *) NULL);
    return 0;
  }
  return change;
}

/// parser for the forcecap
int tclcommand_inter_parse_forcecap(Tcl_Interp * interp, int argc, char ** argv)
{
  char buffer[TCL_DOUBLE_SPACE];

  double forcecap;
  
  if (argc == 0) {
    if (force_cap == -1.0)
      Tcl_AppendResult(interp, "forcecap individual", (char *) NULL);
    else {
      Tcl_PrintDouble(interp, force_cap, buffer);
      Tcl_AppendResult(interp, "forcecap ", buffer, (char *) NULL);
    }
    return TCL_OK;
  }

  if (argc > 1) {
    Tcl_AppendResult(interp, "inter forcecap takes at most 1 parameter",
		     (char *) NULL);      
    return TCL_ERROR;
  }
  
  if (ARG0_IS_S("individual")){
    forcecap = -1.0;
    CHECK_VALUE(forcecap_set_params(forcecap),
	      "If you can read this, you should change it. (Use the source Luke!)");
   }
  else if (! ARG0_IS_D(forcecap) || forcecap < 0) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "force cap must be a nonnegative double value or \"individual\"",
		     (char *) NULL);
    return TCL_ERROR;
  }

  CHECK_VALUE(forcecap_set_params(forcecap),
	      "If you can read this, you should change it. (Use the source Luke!)");
}

int
Tcl_RecordAndEval(
    Tcl_Interp *interp,		/* Token for interpreter in which command will
				 * be executed. */
    const char *cmd,		/* Command to record. */
    int flags)			/* Additional flags. TCL_NO_EVAL means only
				 * record: don't execute command.
				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
				 * instead of Tcl_Eval. */
{
    register Tcl_Obj *cmdPtr;
    int result;

    if (cmd[0]) {
	/*
	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, -1);
	Tcl_IncrRefCount(cmdPtr);
	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);

	/*
	 * Discard the Tcl object created to hold the command.
	 */

	Tcl_DecrRefCount(cmdPtr);
    } else {
	/*
	 * An empty string. Just reset the interpreter's result.
	 */

	Tcl_ResetResult(interp);
	result = TCL_OK;
    }
    return result;
}

/*-----------------------------------------------------------------------------
 * EvalTrapCode --
 *     Run code as the result of a signal.  The symbolic signal name is
 * formatted into the command replacing %S with the symbolic signal name.
 *
 * Parameters:
 *   o interp - The interpreter to run the signal in. If an error
 *     occures, then the result will be left in the interp.
 *   o signalNum - The signal number of the signal that occured.
 * Return:
 *   TCL_OK or TCL_ERROR.
 *-----------------------------------------------------------------------------
 */
static int
EvalTrapCode (Tcl_Interp *interp, int signalNum)
{
    int          result;
    Tcl_DString  command;
    Tcl_Obj     *saveObjPtr;

    saveObjPtr = TclX_SaveResultErrorInfo (interp);
    Tcl_ResetResult (interp);

    /*
     * Format the signal name into the command.  This also allows the signal
     * to be reset in the command.
     */

    result = FormatTrapCode (interp,
                             signalNum,
                             &command);
    if (result == TCL_OK)
        result = Tcl_GlobalEval (interp, 
                                 command.string);

    Tcl_DStringFree (&command);

    if (result == TCL_ERROR) {
        char errorInfo [128];

        sprintf (errorInfo, "\n    while executing signal trap code for %s%s",
                 Tcl_SignalId (signalNum), " signal");
        Tcl_AddErrorInfo (interp, errorInfo);

        return TCL_ERROR;
    }
    
    TclX_RestoreResultErrorInfo (interp, saveObjPtr);
    return TCL_OK;
}

/*int GetRenzInfo(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {

    int num_entry;
    int i;
    char buf[1024];

    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
            argv[0], " filename\"", (char*)NULL);
        return TCL_ERROR;
    }

    if (!renzymes) {
        free_renzymes (renzymes);
    }

    renzymes = get_enzyme(argv[1]);
    printf("num_entry=%d\n", renzymes->used);

    if (!renzymes)
        return TCL_OK;

    num_entry = renzymes->used;
    Tcl_ResetResult(interp);
    for (i = 0; i < num_entry; i++) {
        sprintf(buf, "%s {%s} %s %s %.0f",renzymes->renzyme[i]->name,
                renzymes->renzyme[i]->rec_seq_text,
                renzymes->renzyme[i]->prototype,
                renzymes->renzyme[i]->supplier_codes,
                renzymes->renzyme[i]->av_frag_size);
        Tcl_AppendElement(interp, buf);
    }
    return TCL_OK;
}
*/
int GetRenzInfo(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {

    int num_entry;
    int i;

    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
            argv[0], " filename\"", (char*)NULL);
        return TCL_ERROR;
    }

    if (!renzymes) {
        free_renzymes (renzymes);
    }

    renzymes = get_enzyme(argv[1]);
    /* printf("num_entry=%d\n", renzymes->used); */
    if (!renzymes)
        return TCL_OK;

    num_entry = renzymes->used;
    Tcl_ResetResult(interp);
    for (i = 0; i < num_entry; i++) {
        Tcl_DString dstr;
        Tcl_DStringInit(&dstr);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->name);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->rec_seq_text);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->prototype);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->supplier_codes);
        vTcl_DStringAppendElement(&dstr, "%.f", renzymes->renzyme[i]->av_frag_size);
        Tcl_AppendElement(interp, Tcl_DStringValue(&dstr));

        Tcl_DStringFree(&dstr);
    }
    return TCL_OK;
}

int tclcommand_inter_magnetic_parse_mdlc_params(Tcl_Interp * interp, int argc, char ** argv)
{
  double pwerror;
  double gap_size;
  double far_cut = -1;
 
  MDLC_TRACE(fprintf(stderr, "%d: tclcommand_inter_magnetic_parse_mdlc_params().\n", this_node));
  
  if (argc < 2) {
    Tcl_AppendResult(interp, "either nothing or mdlc <pwerror> <minimal layer distance> {<cutoff>}  expected, not \"", argv[0], "\"", (char *)NULL);
    return TCL_ERROR;
  }
  if (!ARG0_IS_D(pwerror))
    return TCL_ERROR;
  if (!ARG1_IS_D(gap_size))
    return TCL_ERROR;

  argc -= 2; argv += 2;

  if (argc > 0) {
    // if there, parse away manual cutoff
    if(ARG0_IS_D(far_cut)) {
      argc--; argv++;
    }
    else
      Tcl_ResetResult(interp);

    if(argc > 0) {
	Tcl_AppendResult(interp, "either nothing or mdlc <pwerror> <minimal layer distance=size of the gap without particles> {<cutoff>}   expected, not \"", argv[0], "\"", (char *)NULL);
	return TCL_ERROR;
    }
  }

  CHECK_VALUE(mdlc_set_params(pwerror,gap_size,far_cut),
	      "choose a 3d electrostatics method prior to use mdlc");
}