Fossil

** when the Tcl library is being loaded dynamically by a stubs-enabled
** application (i.e. the inverse of using a stubs-enabled package).  These are
** the only Tcl API functions that MUST be called prior to being able to call
** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).  For complete
** cleanup if the Tcl stubs initialization fails somehow, the Tcl_DeleteInterp
** and Tcl_Finalize function types are also required.
*/
typedef void (tcl_FindExecutableProc) (const char * argv0);
typedef void (tcl_FindExecutableProc) (const char *);
typedef Tcl_Interp *(tcl_CreateInterpProc) (void);
typedef void (tcl_DeleteInterpProc) (Tcl_Interp *interp);
typedef void (tcl_DeleteInterpProc) (Tcl_Interp *);
typedef void (tcl_FinalizeProc) (void);

/*
** The function types for the "hook" functions to be called before and after a
** TH1 command makes a call to evaluate a Tcl script.  If the "pre" function
** returns anything but TH_OK, then evaluation of the Tcl script is skipped and
** that value is used as the return code.  If the "post" function returns

    return 0; /* NOTE: Disabled on Tcl 8.4, missing public API. */
  }
  if( major==8 && minor==6 && type==TCL_BETA_RELEASE && patchLevel<3 ){
    return 0; /* NOTE: Disabled on Tcl 8.6b1/b2, SF bug #3399564. */
  }
  return 1;   /* NOTE: For all other cases, assume good. */
}

/*
** Is the loaded version of Tcl one where TIP #285 (asynchronous script
** cancellation) is available?  This should return non-zero only for Tcl
** 8.6 and higher.
*/
static int canUseTip285(){
  int major = -1, minor = -1, patchLevel = -1, type = -1;

  Tcl_GetVersion(&major, &minor, &patchLevel, &type);
  if( major<0 || minor<0 || patchLevel<0 || type<0 ){
    return 0; /* NOTE: Invalid version info, assume bad. */
  }
  return (major>8 || (major==8 && minor>=6));
}

/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter.  Stores the created Tcl interpreter in the Tcl context supplied
** by the caller.  This must be declared here because quite a few functions in
** this file need to use it before it can be defined.
*/

  void *hLibrary;     /* The Tcl library module handle. */
  tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
  tcl_CreateInterpProc *xCreateInterp;     /* Tcl_CreateInterp() pointer. */
  tcl_DeleteInterpProc *xDeleteInterp;     /* Tcl_DeleteInterp() pointer. */
  tcl_FinalizeProc *xFinalize;             /* Tcl_Finalize() pointer. */
  Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
  int useObjProc;     /* Non-zero if an objProc can be called directly. */
  int useTip285;      /* Non-zero if TIP #285 is available. */
  char *setup;        /* The optional Tcl setup script. */
  tcl_NotifyProc *xPreEval;  /* Optional, called before Tcl_Eval*(). */
  void *pPreContext;         /* Optional, provided to xPreEval(). */
  tcl_NotifyProc *xPostEval; /* Optional, called after Tcl_Eval*(). */
  void *pPostContext;        /* Optional, provided to xPostEval(). */
};

void fossil_print(const char *zFormat, ...); /* printf.h */

int evaluateTclWithEvents(
  Th_Interp *interp,
  void *pContext,
  const char *zScript,
  int nScript,
  int bCancel,
  int bWait,
  int bVerbose
){
  struct TclContext *tclContext = (struct TclContext *)pContext;
  Tcl_Interp *tclInterp;
  int rc;
  int flags = TCL_ALL_EVENTS;
  int useTip285;

  if( createTclInterp(interp, pContext)!=TH_OK ){
    return TH_ERROR;
  }
  tclInterp = tclContext->interp;
  useTip285 = bCancel ? tclContext->useTip285 : 0;
  rc = Tcl_EvalEx(tclInterp, zScript, nScript, TCL_EVAL_GLOBAL);
  if( rc!=TCL_OK ){
    if( bVerbose ){
      const char *zResult = getTclResult(tclInterp, 0);
      fossil_print("%s: ", getTclReturnCodeName(rc, 0));
      fossil_print("%s\n", zResult);
    }
    return rc;
  }
  if( !bWait ) flags |= TCL_DONT_WAIT;
  Tcl_Preserve((ClientData)tclInterp);
  while( Tcl_DoOneEvent(flags) ){
    /* do nothing */
  }
    if( Tcl_InterpDeleted(tclInterp) ){
      break;
    }
    if( useTip285 && Tcl_Canceled(tclInterp, 0)!=TCL_OK ){
      break;
    }
  }
  Tcl_Release((ClientData)tclInterp);
  return rc;
}

/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter.  Stores the created Tcl interpreter in the Tcl context supplied
** by the caller.

    Th_ErrorMessage(interp,
        "Tcl error setting arguments:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);
    tclContext->interp = tclInterp = 0;
    return TH_ERROR;
  }
  /*
  ** Determine if an objProc can be called directly for a Tcl command invoked
  ** via the tclInvoke TH1 command.
  ** Determine (and cache) if an objProc can be called directly for a Tcl
  ** command invoked via the tclInvoke TH1 command.
  */
  tclContext->useObjProc = canUseObjProc();
  /*
  ** Determine (and cache) whether or not we can use TIP #285 (asynchronous
  ** script cancellation).
  */
  tclContext->useTip285 = canUseTip285();
  /* Add the TH1 integration commands to Tcl. */
  Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
  Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
  Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
  /* If necessary, evaluate the custom Tcl setup script. */
  setup = tclContext->setup;
  if( setup && Tcl_Eval(tclInterp, setup)!=TCL_OK ){