1/* -*- Mode: c++ -*- 2 * $Id: xotclError.c,v 1.5 2006/09/27 08:12:40 neumann Exp $ 3 * 4 * Extended Object Tcl (XOTcl) 5 * 6 * Copyright (C) 1999-2008 Gustaf Neumann, Uwe Zdun 7 * 8 * 9 * xotclError.c -- 10 * 11 * error return functions for XOTcl 12 * 13 */ 14 15#include "xotclInt.h" 16 17int 18XOTclErrMsg(Tcl_Interp *interp, char *msg, Tcl_FreeProc* type) { 19 Tcl_SetResult(interp, msg, type); 20 return TCL_ERROR; 21} 22 23int 24XOTclVarErrMsg TCL_VARARGS_DEF (Tcl_Interp *, arg1) 25{ 26 va_list argList; 27 char *string; 28 Tcl_Interp *interp; 29 30 interp = TCL_VARARGS_START(Tcl_Interp *, arg1, argList); 31 Tcl_ResetResult(interp); 32 while (1) { 33 string = va_arg(argList, char *); 34 if (string == NULL) { 35 break; 36 } 37 Tcl_AppendResult(interp, string, (char *) NULL); 38 } 39 va_end(argList); 40 return TCL_ERROR; 41} 42 43 44int 45XOTclErrInProc (Tcl_Interp *interp, Tcl_Obj *objName, 46 Tcl_Obj *clName, char *procName) { 47 Tcl_DString errMsg; 48 char *cName, *space; 49 ALLOC_DSTRING(&errMsg, "\n "); 50 if (clName) { 51 cName = ObjStr(clName); 52 space = " "; 53 } else { 54 cName = ""; 55 space =""; 56 } 57 Tcl_DStringAppend(&errMsg, ObjStr(objName),-1); 58 Tcl_DStringAppend(&errMsg, space, -1); 59 Tcl_DStringAppend(&errMsg, cName, -1); 60 Tcl_DStringAppend(&errMsg, "->", 2); 61 Tcl_DStringAppend(&errMsg, procName, -1); 62 Tcl_AddErrorInfo (interp, Tcl_DStringValue(&errMsg)); 63 DSTRING_FREE(&errMsg); 64 return TCL_ERROR; 65} 66 67int 68XOTclObjErrArgCnt(Tcl_Interp *interp, Tcl_Obj *cmdname, char *arglist) { 69 Tcl_ResetResult(interp); 70 Tcl_AppendResult(interp, "wrong # args: should be {", (char *) NULL); 71 if (cmdname) { 72 Tcl_AppendResult(interp, ObjStr(cmdname), " ", (char *) NULL); 73 } 74 if (arglist != 0) Tcl_AppendResult(interp, arglist, (char *) NULL); 75 Tcl_AppendResult(interp, "}", (char *) NULL); 76 return TCL_ERROR; 77} 78 79int 80XOTclErrBadVal(Tcl_Interp *interp, char *context, char *expected, char *value) { 81 Tcl_ResetResult(interp); 82 Tcl_AppendResult(interp, context, ": expected ", expected, " but got '", 83 value, "'", (char *) NULL); 84 return TCL_ERROR; 85} 86 87int 88XOTclErrBadVal_(Tcl_Interp *interp, char *expected, char *value) { 89 fprintf(stderr, "Deprecated call, recompile your program with xotcl 1.5 or newer\n"); 90 Tcl_ResetResult(interp); 91 Tcl_AppendResult(interp, ": expected ", expected, " but got '", 92 value, "'", (char *) NULL); 93 return TCL_ERROR; 94} 95 96extern int 97XOTclObjErrType(Tcl_Interp *interp, Tcl_Obj *nm, char *wt) { 98 Tcl_ResetResult(interp); 99 Tcl_AppendResult(interp,"'",ObjStr(nm), "' method should be called on '", 100 wt, "'", (char *) NULL); 101 return TCL_ERROR; 102} 103