tcltest: do a better job of cleanup up after tests
[jimtcl.git] / jim-tclprefix.c
blobe041cc6305ce95b35d69a280e4fecc45eddff43f
1 /*
2 * Implements the tcl::prefix command for Jim Tcl
4 * (c) 2011 Steve Bennett <steveb@workware.net.au>
6 * See LICENSE for license details.
7 */
9 #include <jim.h>
10 #include "utf8.h"
12 /**
13 * Returns the common initial length of the two strings.
15 static int JimStringCommonLength(const char *str1, int charlen1, const char *str2, int charlen2)
17 int maxlen = 0;
18 while (charlen1-- && charlen2--) {
19 int c1;
20 int c2;
21 str1 += utf8_tounicode(str1, &c1);
22 str2 += utf8_tounicode(str2, &c2);
23 if (c1 != c2) {
24 break;
26 maxlen++;
28 return maxlen;
31 /* [tcl::prefix]
33 static int Jim_TclPrefixCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
35 Jim_Obj *objPtr;
36 Jim_Obj *stringObj;
37 int option;
38 static const char * const options[] = { "match", "all", "longest", NULL };
39 enum { OPT_MATCH, OPT_ALL, OPT_LONGEST };
41 if (argc < 2) {
42 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arg ...?");
43 return JIM_ERR;
45 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
46 return JIM_ERR;
48 switch (option) {
49 case OPT_MATCH:{
50 int i;
51 int ret;
52 int tablesize;
53 const char **table;
54 Jim_Obj *tableObj;
55 Jim_Obj *errorObj = NULL;
56 Jim_Obj *messageObj = NULL;
57 static const char * const matchoptions[] = { "-error", "-exact", "-message", NULL };
58 enum { OPT_MATCH_ERROR, OPT_MATCH_EXACT, OPT_MATCH_MESSAGE };
59 int flags = JIM_ERRMSG | JIM_ENUM_ABBREV;
61 if (argc < 4) {
62 Jim_WrongNumArgs(interp, 2, argv, "?options? table string");
63 return JIM_ERR;
65 tableObj = argv[argc - 2];
66 stringObj = argv[argc - 1];
67 argc -= 2;
68 for (i = 2; i < argc; i++) {
69 int matchoption;
70 if (Jim_GetEnum(interp, argv[i], matchoptions, &matchoption, "option", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
71 return JIM_ERR;
72 switch (matchoption) {
73 case OPT_MATCH_EXACT:
74 flags &= ~JIM_ENUM_ABBREV;
75 break;
77 case OPT_MATCH_ERROR:
78 if (++i == argc) {
79 Jim_SetResultString(interp, "missing error options", -1);
80 return JIM_ERR;
82 errorObj = argv[i];
83 if (Jim_Length(errorObj) % 2) {
84 Jim_SetResultString(interp, "error options must have an even number of elements", -1);
85 return JIM_ERR;
87 break;
89 case OPT_MATCH_MESSAGE:
90 if (++i == argc) {
91 Jim_SetResultString(interp, "missing message", -1);
92 return JIM_ERR;
94 messageObj = argv[i];
95 break;
98 /* Do the match */
99 tablesize = Jim_ListLength(interp, tableObj);
100 table = Jim_Alloc((tablesize + 1) * sizeof(*table));
101 for (i = 0; i < tablesize; i++) {
102 Jim_ListIndex(interp, tableObj, i, &objPtr, JIM_NONE);
103 table[i] = Jim_String(objPtr);
105 table[i] = NULL;
107 ret = Jim_GetEnum(interp, stringObj, table, &i, messageObj ? Jim_String(messageObj) : NULL, flags);
108 Jim_Free(table);
109 if (ret == JIM_OK) {
110 Jim_ListIndex(interp, tableObj, i, &objPtr, JIM_NONE);
111 Jim_SetResult(interp, objPtr);
112 return JIM_OK;
114 if (tablesize == 0) {
115 Jim_SetResultFormatted(interp, "bad option \"%#s\": no valid options", stringObj);
116 return JIM_ERR;
118 if (errorObj) {
119 if (Jim_Length(errorObj) == 0) {
120 Jim_SetEmptyResult(interp);
121 return JIM_OK;
123 /* Do this the easy way. Build a list to evaluate */
124 objPtr = Jim_NewStringObj(interp, "return -level 0 -code error", -1);
125 Jim_ListAppendList(interp, objPtr, errorObj);
126 Jim_ListAppendElement(interp, objPtr, Jim_GetResult(interp));
127 return Jim_EvalObjList(interp, objPtr);
129 return JIM_ERR;
131 break;
133 case OPT_ALL:
134 if (argc != 4) {
135 Jim_WrongNumArgs(interp, 2, argv, "table string");
136 return JIM_ERR;
138 else {
139 int i;
140 int listlen = Jim_ListLength(interp, argv[2]);
141 objPtr = Jim_NewListObj(interp, NULL, 0);
142 for (i = 0; i < listlen; i++) {
143 Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i);
144 if (Jim_StringCompareLenObj(interp, argv[3], valObj, 0) == 0) {
145 Jim_ListAppendElement(interp, objPtr, valObj);
148 Jim_SetResult(interp, objPtr);
149 return JIM_OK;
152 case OPT_LONGEST:
153 if (argc != 4) {
154 Jim_WrongNumArgs(interp, 2, argv, "table string");
155 return JIM_ERR;
157 else if (Jim_ListLength(interp, argv[2])) {
158 const char *longeststr = NULL;
159 int longestlen = 0;
161 stringObj = argv[3];
163 int i;
164 int listlen = Jim_ListLength(interp, argv[2]);
165 for (i = 0; i < listlen; i++) {
166 Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i);
168 if (Jim_StringCompareLenObj(interp, stringObj, valObj, 0)) {
169 /* Does not begin with 'string' */
170 continue;
173 if (longeststr == NULL) {
174 longestlen = Jim_Utf8Length(interp, valObj);
175 longeststr = Jim_String(valObj);
177 else {
178 longestlen = JimStringCommonLength(longeststr, longestlen, Jim_String(valObj), Jim_Utf8Length(interp, valObj));
181 if (longeststr) {
182 Jim_SetResultString(interp, longeststr, longestlen);
184 return JIM_OK;
187 return JIM_ERR;
190 int Jim_tclprefixInit(Jim_Interp *interp)
192 if (Jim_PackageProvide(interp, "tclprefix", "1.0", JIM_ERRMSG)) {
193 return JIM_ERR;
196 Jim_CreateCommand(interp, "tcl::prefix", Jim_TclPrefixCoreCommand, NULL, NULL);
197 return JIM_OK;