00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00040 #include "TclXPCOMPrivate.h"
00041
00042
00049 void
00050 TclXPCOM_SetErrorCode(
00051 Tcl_Interp *interp,
00052 nsresult res
00053 )
00054 {
00055 Tcl_Obj *errorCode;
00056
00057 NS_PRECONDITION(interp, "null pointer");
00058
00059 errorCode = Tcl_NewListObj(0, NULL);
00060 Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewStringObj("XPCOM", -1));
00061 Tcl_ListObjAppendElement(NULL, errorCode, Tcl_NewLongObj((long)res));
00062 Tcl_SetObjErrorCode(interp, errorCode);
00063 }
00064
00065
00073 int
00074 TclXPCOM_GetErrorCode(
00075 Tcl_Interp *interp,
00076 nsresult *res
00077
00078 )
00079 {
00080 Tcl_Obj *errorCode;
00081 int objc;
00082 Tcl_Obj **objv;
00083 long longVal;
00084
00085 NS_PRECONDITION(interp, "null pointer");
00086 NS_PRECONDITION(res, "null pointer");
00087
00088 errorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
00089
00090 if (errorCode && (Tcl_ListObjGetElements(NULL, errorCode, &objc, &objv) == TCL_OK))
00091 {
00092 if ((objc == 2) && (!strcmp("XPCOM", Tcl_GetString(objv[0]))))
00093 {
00094 if (Tcl_GetLongFromObj(NULL, objv[1], &longVal) == TCL_OK)
00095 {
00096 *res = (nsresult)longVal;
00097 return 1;
00098 }
00099 }
00100 }
00101
00102 return 0;
00103 }
00104
00105
00110 void
00111 TclXPCOM_SetErrorMessage(
00112 Tcl_Interp *interp,
00113 nsresult res
00114 )
00115 {
00116 int rv;
00117 Tcl_CmdInfo cmdinfo;
00118 Tcl_Obj *script;
00119
00120 NS_PRECONDITION(interp, "null pointer");
00121
00122 if (Tcl_GetCommandInfo(interp, TCLXPCOM_ERRORMSGPROC, &cmdinfo))
00123 {
00124 script = Tcl_NewListObj(0, NULL);
00125 Tcl_IncrRefCount(script);
00126 Tcl_ListObjAppendElement(interp, script, Tcl_NewStringObj(TCLXPCOM_ERRORMSGPROC, -1));
00127 Tcl_ListObjAppendElement(interp, script, Tcl_NewLongObj((long)res));
00128
00129 rv = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
00130
00131 Tcl_DecrRefCount(script);
00132
00133 if (rv != TCL_OK)
00134 {
00135 Tcl_AddObjErrorInfo(interp, "\nwhile executing error message procedure", -1);
00136 }
00137
00138 } else
00139 {
00140 Tcl_ResetResult(interp);
00141 Tcl_AppendResult(interp, "xpcom error: unknown (no error message procedure defined)", NULL);
00142 }
00143 }
00144
00145
00150 void
00151 TclXPCOM_SetError(
00152 Tcl_Interp *interp,
00153 nsresult res
00154 )
00155 {
00156 NS_PRECONDITION(interp, "null pointer");
00157
00158 TclXPCOM_SetErrorMessage(interp, res);
00159 TclXPCOM_SetErrorCode (interp, res);
00160 }
00161
00162
00174 void
00175 TclXPCOM_BackgroundError(
00176 Tcl_Interp *interp
00177 )
00178 {
00179 int rv;
00180 Tcl_CmdInfo cmdinfo;
00181 Tcl_Obj *script;
00182
00183 NS_PRECONDITION(interp, "null pointer");
00184
00185 if (Tcl_GetCommandInfo(interp, TCLXPCOM_BGERRORPROC, &cmdinfo))
00186 {
00187 script = Tcl_NewListObj(0, NULL);
00188 Tcl_IncrRefCount(script);
00189 Tcl_ListObjAppendElement(interp, script, Tcl_NewStringObj(TCLXPCOM_BGERRORPROC, -1));
00190 Tcl_ListObjAppendElement(interp, script, Tcl_GetObjResult(interp));
00191
00192 rv = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
00193
00194 Tcl_DecrRefCount(script);
00195
00196 if (rv != TCL_OK)
00197 {
00198 Tcl_BackgroundError(interp);
00199 }
00200
00201 } else
00202 {
00203 Tcl_BackgroundError(interp);
00204 }
00205 }