core: improvements to garbage collection
[jimtcl.git] / jim-tclprefix.c
blobc4922340113f3669248c13cb806e7a4f4d4a4089
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;
32 * Like Jim_StringCompareObj() except only matches as much as the length of firstObjPtr.
33 * So "abc" matches "abcdef" but "abcdef" does not match "abc".
35 int JimStringComparePrefix(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr)
37 /* We do this the easy way by creating a (possibly) shorter version of secondObjPtr */
38 int l1 = Jim_Utf8Length(interp, firstObjPtr);
39 const char *s2 = Jim_String(secondObjPtr);
40 int l2 = Jim_Utf8Length(interp, secondObjPtr);
41 Jim_Obj *objPtr;
42 int ret;
44 if (l2 > l1) {
45 objPtr = Jim_NewStringObjUtf8(interp, s2, l1);
47 else {
48 objPtr = secondObjPtr;
50 Jim_IncrRefCount(objPtr);
52 ret = Jim_StringCompareObj(interp, firstObjPtr, objPtr, 0);
53 Jim_DecrRefCount(interp, objPtr);
54 return ret;
57 /* [tcl::prefix]
59 static int Jim_TclPrefixCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
61 Jim_Obj *objPtr;
62 Jim_Obj *stringObj;
63 int option;
64 static const char * const options[] = { "match", "all", "longest", NULL };
65 enum { OPT_MATCH, OPT_ALL, OPT_LONGEST };
67 if (argc < 2) {
68 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arg ...?");
69 return JIM_ERR;
71 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
72 return Jim_CheckShowCommands(interp, argv[1], options);
74 switch (option) {
75 case OPT_MATCH:{
76 int i;
77 int ret;
78 int tablesize;
79 const char **table;
80 Jim_Obj *tableObj;
81 Jim_Obj *errorObj = NULL;
82 const char *message = "option";
83 static const char * const matchoptions[] = { "-error", "-exact", "-message", NULL };
84 enum { OPT_MATCH_ERROR, OPT_MATCH_EXACT, OPT_MATCH_MESSAGE };
85 int flags = JIM_ERRMSG | JIM_ENUM_ABBREV;
87 if (argc < 4) {
88 Jim_WrongNumArgs(interp, 2, argv, "?options? table string");
89 return JIM_ERR;
91 tableObj = argv[argc - 2];
92 stringObj = argv[argc - 1];
93 argc -= 2;
94 for (i = 2; i < argc; i++) {
95 int matchoption;
96 if (Jim_GetEnum(interp, argv[i], matchoptions, &matchoption, "option", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
97 return JIM_ERR;
98 switch (matchoption) {
99 case OPT_MATCH_EXACT:
100 flags &= ~JIM_ENUM_ABBREV;
101 break;
103 case OPT_MATCH_ERROR:
104 if (++i == argc) {
105 Jim_SetResultString(interp, "missing error options", -1);
106 return JIM_ERR;
108 errorObj = argv[i];
109 if (Jim_Length(errorObj) % 2) {
110 Jim_SetResultString(interp, "error options must have an even number of elements", -1);
111 return JIM_ERR;
113 break;
115 case OPT_MATCH_MESSAGE:
116 if (++i == argc) {
117 Jim_SetResultString(interp, "missing message", -1);
118 return JIM_ERR;
120 message = Jim_String(argv[i]);
121 break;
124 /* Do the match */
125 tablesize = Jim_ListLength(interp, tableObj);
126 table = Jim_Alloc((tablesize + 1) * sizeof(*table));
127 for (i = 0; i < tablesize; i++) {
128 Jim_ListIndex(interp, tableObj, i, &objPtr, JIM_NONE);
129 table[i] = Jim_String(objPtr);
131 table[i] = NULL;
133 ret = Jim_GetEnum(interp, stringObj, table, &i, message, flags);
134 Jim_Free(table);
135 if (ret == JIM_OK) {
136 Jim_ListIndex(interp, tableObj, i, &objPtr, JIM_NONE);
137 Jim_SetResult(interp, objPtr);
138 return JIM_OK;
140 if (tablesize == 0) {
141 Jim_SetResultFormatted(interp, "bad %s \"%#s\": no valid options", message, stringObj);
142 return JIM_ERR;
144 if (errorObj) {
145 if (Jim_Length(errorObj) == 0) {
146 Jim_SetEmptyResult(interp);
147 return JIM_OK;
149 /* Do this the easy way. Build a list to evaluate */
150 objPtr = Jim_NewStringObj(interp, "return -level 0 -code error", -1);
151 Jim_ListAppendList(interp, objPtr, errorObj);
152 Jim_ListAppendElement(interp, objPtr, Jim_GetResult(interp));
153 return Jim_EvalObjList(interp, objPtr);
155 return JIM_ERR;
158 case OPT_ALL:
159 if (argc != 4) {
160 Jim_WrongNumArgs(interp, 2, argv, "table string");
161 return JIM_ERR;
163 else {
164 int i;
165 int listlen = Jim_ListLength(interp, argv[2]);
166 objPtr = Jim_NewListObj(interp, NULL, 0);
167 for (i = 0; i < listlen; i++) {
168 Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i);
169 if (JimStringComparePrefix(interp, argv[3], valObj) == 0) {
170 Jim_ListAppendElement(interp, objPtr, valObj);
173 Jim_SetResult(interp, objPtr);
174 return JIM_OK;
177 case OPT_LONGEST:
178 if (argc != 4) {
179 Jim_WrongNumArgs(interp, 2, argv, "table string");
180 return JIM_ERR;
182 else if (Jim_ListLength(interp, argv[2])) {
183 const char *longeststr = NULL;
184 int longestlen = 0;
185 int i;
186 int listlen = Jim_ListLength(interp, argv[2]);
188 stringObj = argv[3];
190 for (i = 0; i < listlen; i++) {
191 Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i);
193 if (JimStringComparePrefix(interp, stringObj, valObj)) {
194 /* Does not begin with 'string' */
195 continue;
198 if (longeststr == NULL) {
199 longestlen = Jim_Utf8Length(interp, valObj);
200 longeststr = Jim_String(valObj);
202 else {
203 longestlen = JimStringCommonLength(longeststr, longestlen, Jim_String(valObj), Jim_Utf8Length(interp, valObj));
206 if (longeststr) {
207 Jim_SetResultString(interp, longeststr, longestlen);
209 return JIM_OK;
212 return JIM_ERR; /* Cannot ever get here */
215 int Jim_tclprefixInit(Jim_Interp *interp)
217 if (Jim_PackageProvide(interp, "tclprefix", "1.0", JIM_ERRMSG)) {
218 return JIM_ERR;
221 Jim_CreateCommand(interp, "tcl::prefix", Jim_TclPrefixCoreCommand, NULL, NULL);
222 return JIM_OK;