tcl » wrapper » wrapper
gmlTcl_WrapperDefaults_T.h

00001 // gmlTcl_Wrapper_T.cc --
00002 // 
00003 //    Function template definition for the Tcl wrapper. See "gmlWrapper.cc".
00004 // 
00005 //  Copyright (c) 1996-2002 CLIPS-IMAG
00006 // 
00007 //  See the file "gml_LicenseTerms.txt" for information on usage and redistribution
00008 //  of this file, and for a DISCLAIMER OF ALL WARRANTIES.
00009 //
00010 //  Created on August 26, 2002 (FB).
00011 
00012 #include "gml/base/gml_Alloc.h"
00013 
00014 #include "tcl.h"
00015 
00016 #include "gml/tcl/wrapper/wrapper/gmlTcl_Wrapper.h"
00017 
00018 
00019 // gmlTcl_DefaultNewObjProc<T> --
00020 //
00021 //  Default behavior for the allocation of a new object.
00022 //  Assumes that the creation has no options (i.e. syntax is
00023 //    "<className> <objectName>").
00024 //  <T> must be a proper C++ class with at least the 2
00025 //    following public methods:
00026 //      gml_TError  Init ();
00027 //      void        Dispose ();
00028 //    (Init is called after allocation, Dispose before deletion).
00029 
00030 template<class T>
00031 int gmlTcl_DefaultNewObjProc (Tcl_Interp*           interp,
00032                               gmlTcl_TWrapClass*    /* classWrap */,
00033                               int                   argc,
00034                               Tcl_Obj*              argv[],
00035                               T*                   &obj,
00036                               gmlTcl_TWrapObject*  &objWrap)
00037 {
00038   int         res       = TCL_OK;
00039   gml_TError  err;
00040 
00041   obj       = (T*)NULL;
00042   objWrap   = (gmlTcl_TWrapObject*)NULL;
00043   
00044   if (argc != 2) {
00045     Tcl_AppendResult (interp, "wrong # args: should be \"",
00046                               Tcl_GetString (argv[0]), " ",
00047                               Tcl_GetString (argv[1]), "\"", (char*)NULL);
00048     return TCL_ERROR;
00049   }
00050 
00051   if ((err = gml_NewAndInit (obj)) != gml_cNoError ) {
00052     Tcl_AppendResult (interp, "could not create object: ",
00053                               gml_ErrorGetMessage (err), (char*)NULL);
00054     res = TCL_ERROR;
00055   }
00056 
00057   if (res == TCL_OK)
00058     if ((err = gml_NewAndInit (objWrap)) != gml_cNoError ) {
00059       Tcl_AppendResult (interp, "could not create object: ",
00060                                 gml_ErrorGetMessage (err), (char*)NULL);
00061       res = TCL_ERROR;
00062     }
00063 
00064   if (res != TCL_OK) {
00065     gml_TestDisposeAndDelete (objWrap);
00066     gml_TestDisposeAndDelete (obj);
00067   }
00068 
00069   return res;
00070 }