Posted to tcl by patthoyts at Mon Oct 15 23:43:11 GMT 2007view raw

  1. /* bgeval.c - Copyright (C) 2006 Pat Thoyts <patthoyts@users.sourceforge.net>
  2. *
  3. * $Id: bgeval.c,v 1.2 2006/10/25 08:26:21 pat Exp $
  4. */
  5.  
  6. #include "tms.h"
  7.  
  8. /*
  9. * ----------------------------------------------------------------------
  10. *
  11. * Tms_BackgroundEvalObjEx --
  12. *
  13. * Evaluate a command while ensuring that we do not affect the
  14. * interpreters state. This is important when evaluating script
  15. * during background tasks.
  16. *
  17. * Results:
  18. * A standard Tcl result code.
  19. *
  20. * Side Effects:
  21. * The interpreters variables and code may be modified by the script
  22. * but the result will not be modified.
  23. *
  24. * ----------------------------------------------------------------------
  25. */
  26.  
  27. TMSAPI int
  28. Tms_BackgroundEvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv,
  29. int flags)
  30. {
  31. Tcl_DString errorInfo, errorCode;
  32. Tcl_SavedResult state;
  33. int r = TCL_OK;
  34.  
  35. Tcl_DStringInit(&errorInfo);
  36. Tcl_DStringInit(&errorCode);
  37.  
  38. /*
  39. * Record the state of the interpreter
  40. */
  41.  
  42. Tcl_SaveResult(interp, &state);
  43. Tcl_DStringAppend(&errorInfo,
  44. Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
  45. Tcl_DStringAppend(&errorCode,
  46. Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1);
  47.  
  48. /*
  49. * Evaluate the command and handle any error.
  50. */
  51.  
  52. r = Tcl_EvalObjv(interp, objc, objv, flags);
  53. if (r == TCL_ERROR) {
  54. Tcl_AddErrorInfo(interp, "\n (background event handler)");
  55. Tcl_BackgroundError(interp);
  56. }
  57.  
  58. /*
  59. * Restore the state of the interpreter
  60. */
  61.  
  62. Tcl_SetVar(interp, "errorInfo",
  63. Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY);
  64. Tcl_SetVar(interp, "errorCode",
  65. Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY);
  66. Tcl_RestoreResult(interp, &state);
  67.  
  68. /*
  69. * Clean up references.
  70. */
  71.  
  72. Tcl_DStringFree(&errorInfo);
  73. Tcl_DStringFree(&errorCode);
  74.  
  75. return r;
  76. }
  77.  
  78. /*
  79. * Local variables:
  80. * indent-tabs-mode: t
  81. * tab-width: 8
  82. * End:
  83. */
  84.