]>
Commit | Line | Data |
---|---|---|
c90f71dd RD |
1 | /* objcmd.swg : Tcl object creation */ |
2 | ||
3 | static int Tcl@CLASS@Cmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { | |
4 | void (*del)(ClientData) = 0; | |
5 | char *name = 0; | |
6 | int (*cmd)(ClientData, Tcl_Interp *, int, char **) = 0; | |
7 | @CLASSTYPE@ newObj = 0; | |
8 | int firstarg = 0; | |
9 | int thisarg = 0; | |
10 | if (argc == 1) { | |
11 | cmd = @TCLCONSTRUCTOR@; | |
12 | } else { | |
13 | if (strcmp(argv[1],"-this") == 0) thisarg = 2; | |
14 | else if (strcmp(argv[1],"-args") == 0) { | |
15 | firstarg = 1; | |
16 | cmd = @TCLCONSTRUCTOR@; | |
17 | } else if (argc == 2) { | |
18 | firstarg = 1; | |
19 | name = argv[1]; | |
20 | cmd = @TCLCONSTRUCTOR@; | |
21 | } else if (argc >= 3) { | |
22 | name = argv[1]; | |
23 | if (strcmp(argv[2],"-this") == 0) thisarg = 3; | |
24 | else { | |
25 | firstarg = 1; | |
26 | cmd = @TCLCONSTRUCTOR@; | |
27 | } | |
28 | } | |
29 | } | |
30 | if (cmd) { | |
31 | int result; | |
32 | result = (*cmd)(clientData,interp,argc-firstarg,&argv[firstarg]); | |
33 | if (result == TCL_OK) { | |
34 | SWIG_GetPtr(interp->result,(void **) &newObj,"@CLASSMANGLE@"); | |
35 | } else { return result; } | |
36 | if (!name) name = interp->result; | |
37 | del = @TCLDESTRUCTOR@; | |
38 | } else if (thisarg > 0) { | |
39 | if (thisarg < argc) { | |
40 | char *r; | |
41 | r = SWIG_GetPtr(argv[thisarg],(void **) &newObj,"@CLASSMANGLE@"); | |
42 | if (r) { | |
43 | interp->result = "Type error. not a @CLASS@ object."; | |
44 | return TCL_ERROR; | |
45 | } | |
46 | if (!name) name = argv[thisarg]; | |
47 | /* Return value is same as pointer value */ | |
48 | Tcl_SetResult(interp,argv[thisarg],TCL_VOLATILE); | |
49 | } else { | |
50 | interp->result = "wrong # args."; | |
51 | return TCL_ERROR; | |
52 | } | |
53 | } else { | |
54 | interp->result = "No constructor available."; | |
55 | return TCL_ERROR; | |
56 | } | |
57 | { | |
58 | Tcl_CmdInfo dummy; | |
59 | if (!Tcl_GetCommandInfo(interp,name,&dummy)) { | |
60 | Tcl_CreateCommand(interp,name, Tcl@CLASS@MethodCmd, (ClientData) newObj, del); | |
61 | return TCL_OK; | |
62 | } else { | |
63 | Tcl_SetResult(interp,"",TCL_VOLATILE); | |
64 | Tcl_AppendResult(interp,"Object ", name, " already exists!", (char *) NULL); | |
65 | return TCL_ERROR; | |
66 | } | |
67 | } | |
68 | } | |
69 |