Fossil SCM

Add minimal 'lsearch' command to TH1. Only exact case-sensitive matching is supported.

mistachkin 2015-05-27 03:58 UTC trunk
Commit eabd7290fb0cd623b7cb290c2424e33d90ae82c8
Parent d10b1e022af373b…
3 files changed +38 +54 -1 +1
~ src/th_lang.c ~ test/th1.test ~ www/th1.md
M src/th_lang.c
+38
--- src/th_lang.c
+++ src/th_lang.c
@@ -255,10 +255,47 @@
255255
 return rc;
256256
 }
257257
258258
 /*
259259
 ** TH Syntax:
260
+**
261
+** lsearch list string
262
+*/
263
+static int lsearch_command(
264
+ Th_Interp *interp,
265
+ void *ctx,
266
+ int argc,
267
+ const char **argv,
268
+ int *argl
269
+){
270
+ int rc;
271
+ char **azElem;
272
+ int *anElem;
273
+ int nCount;
274
+ int i;
275
+
276
+ if( argc!=3 ){
277
+ return Th_WrongNumArgs(interp, "lsearch list string");
278
+ }
279
+
280
+ rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount);
281
+ if( rc==TH_OK ){
282
+ Th_SetResultInt(interp, -1);
283
+ for(i=0; i<nCount; i++){
284
+ if( anElem[i]==argl[2] && 0==memcmp(azElem[i], argv[2], argl[2]) ){
285
+ Th_SetResultInt(interp, i);
286
+ break;
287
+ }
288
+ }
289
+ Th_Free(interp, azElem);
290
+ }
291
+
292
+ return rc;
293
+}
294
+
295
+/*
296
+** TH Syntax:
260297
 **
261298
 ** set varname ?value?
262299
 */
263300
 static int set_command(
264301
 Th_Interp *interp,
@@ -1130,10 +1167,11 @@
11301167
 {"if", if_command, 0},
11311168
 {"info", info_command, 0},
11321169
 {"lindex", lindex_command, 0},
11331170
 {"list", list_command, 0},
11341171
 {"llength", llength_command, 0},
1172
+ {"lsearch", lsearch_command, 0},
11351173
 {"proc", proc_command, 0},
11361174
 {"rename", rename_command, 0},
11371175
 {"set", set_command, 0},
11381176
 {"string", string_command, 0},
11391177
 {"unset", unset_command, 0},
11401178
--- src/th_lang.c
+++ src/th_lang.c
@@ -255,10 +255,47 @@
255 return rc;
256 }
257
258 /*
259 ** TH Syntax:
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
260 **
261 ** set varname ?value?
262 */
263 static int set_command(
264 Th_Interp *interp,
@@ -1130,10 +1167,11 @@
1130 {"if", if_command, 0},
1131 {"info", info_command, 0},
1132 {"lindex", lindex_command, 0},
1133 {"list", list_command, 0},
1134 {"llength", llength_command, 0},
 
1135 {"proc", proc_command, 0},
1136 {"rename", rename_command, 0},
1137 {"set", set_command, 0},
1138 {"string", string_command, 0},
1139 {"unset", unset_command, 0},
1140
--- src/th_lang.c
+++ src/th_lang.c
@@ -255,10 +255,47 @@
255 return rc;
256 }
257
258 /*
259 ** TH Syntax:
260 **
261 ** lsearch list string
262 */
263 static int lsearch_command(
264 Th_Interp *interp,
265 void *ctx,
266 int argc,
267 const char **argv,
268 int *argl
269 ){
270 int rc;
271 char **azElem;
272 int *anElem;
273 int nCount;
274 int i;
275
276 if( argc!=3 ){
277 return Th_WrongNumArgs(interp, "lsearch list string");
278 }
279
280 rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount);
281 if( rc==TH_OK ){
282 Th_SetResultInt(interp, -1);
283 for(i=0; i<nCount; i++){
284 if( anElem[i]==argl[2] && 0==memcmp(azElem[i], argv[2], argl[2]) ){
285 Th_SetResultInt(interp, i);
286 break;
287 }
288 }
289 Th_Free(interp, azElem);
290 }
291
292 return rc;
293 }
294
295 /*
296 ** TH Syntax:
297 **
298 ** set varname ?value?
299 */
300 static int set_command(
301 Th_Interp *interp,
@@ -1130,10 +1167,11 @@
1167 {"if", if_command, 0},
1168 {"info", info_command, 0},
1169 {"lindex", lindex_command, 0},
1170 {"list", list_command, 0},
1171 {"llength", llength_command, 0},
1172 {"lsearch", lsearch_command, 0},
1173 {"proc", proc_command, 0},
1174 {"rename", rename_command, 0},
1175 {"set", set_command, 0},
1176 {"string", string_command, 0},
1177 {"unset", unset_command, 0},
1178
M test/th1.test
+54 -1
--- test/th1.test
+++ test/th1.test
@@ -861,11 +861,11 @@
861861
 test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
862862
 enable_output uplevel http expr utime styleFooter catch if tclReady\
863863
 searchable reinitialize combobox lindex query html anoncap randhex\
864864
 llength for set break regexp styleHeader puts return checkout decorate\
865865
 artifact trace wiki proc hascap globalState continue getParameter\
866
-hasfeature setting breakpoint upvar render repository string unset\
866
+hasfeature setting lsearch breakpoint upvar render repository string unset\
867867
 setParameter list error info rename anycap httpize}}
868868
869869
 ###############################################################################
870870
871871
 fossil test-th-eval "info vars"
@@ -888,5 +888,58 @@
888888
889889
 ###############################################################################
890890
891891
 fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
892892
 test th1-info-vars-5 {$RESULT eq "y"}
893
+
894
+###############################################################################
895
+
896
+fossil test-th-eval "lsearch"
897
+test th1-lsearch-1 {$RESULT eq \
898
+ {TH_ERROR: wrong # args: should be "lsearch list string"}}
899
+
900
+###############################################################################
901
+
902
+fossil test-th-eval "lsearch a"
903
+test th1-lsearch-2 {$RESULT eq \
904
+ {TH_ERROR: wrong # args: should be "lsearch list string"}}
905
+
906
+###############################################################################
907
+
908
+fossil test-th-eval "lsearch a a a"
909
+test th1-lsearch-3 {$RESULT eq \
910
+ {TH_ERROR: wrong # args: should be "lsearch list string"}}
911
+
912
+###############################################################################
913
+
914
+fossil test-th-eval "lsearch {a b c} a"
915
+test th1-lsearch-4 {$RESULT eq "0"}
916
+
917
+###############################################################################
918
+
919
+fossil test-th-eval "lsearch {a b c} b"
920
+test th1-lsearch-5 {$RESULT eq "1"}
921
+
922
+###############################################################################
923
+
924
+fossil test-th-eval "lsearch {a b c} c"
925
+test th1-lsearch-6 {$RESULT eq "2"}
926
+
927
+###############################################################################
928
+
929
+fossil test-th-eval "lsearch {a b c} d"
930
+test th1-lsearch-7 {$RESULT eq "-1"}
931
+
932
+###############################################################################
933
+
934
+fossil test-th-eval "lsearch {a b c} aa"
935
+test th1-lsearch-8 {$RESULT eq "-1"}
936
+
937
+###############################################################################
938
+
939
+fossil test-th-eval "lsearch {aa b c} a"
940
+test th1-lsearch-9 {$RESULT eq "-1"}
941
+
942
+###############################################################################
943
+
944
+fossil test-th-eval "lsearch \"\{aa b c\" a"
945
+test th1-lsearch-10 {$RESULT eq "TH_ERROR: Expected list, got: \"\{aa b c\""}
893946
--- test/th1.test
+++ test/th1.test
@@ -861,11 +861,11 @@
861 test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
862 enable_output uplevel http expr utime styleFooter catch if tclReady\
863 searchable reinitialize combobox lindex query html anoncap randhex\
864 llength for set break regexp styleHeader puts return checkout decorate\
865 artifact trace wiki proc hascap globalState continue getParameter\
866 hasfeature setting breakpoint upvar render repository string unset\
867 setParameter list error info rename anycap httpize}}
868
869 ###############################################################################
870
871 fossil test-th-eval "info vars"
@@ -888,5 +888,58 @@
888
889 ###############################################################################
890
891 fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
892 test th1-info-vars-5 {$RESULT eq "y"}
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
893
--- test/th1.test
+++ test/th1.test
@@ -861,11 +861,11 @@
861 test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
862 enable_output uplevel http expr utime styleFooter catch if tclReady\
863 searchable reinitialize combobox lindex query html anoncap randhex\
864 llength for set break regexp styleHeader puts return checkout decorate\
865 artifact trace wiki proc hascap globalState continue getParameter\
866 hasfeature setting lsearch breakpoint upvar render repository string unset\
867 setParameter list error info rename anycap httpize}}
868
869 ###############################################################################
870
871 fossil test-th-eval "info vars"
@@ -888,5 +888,58 @@
888
889 ###############################################################################
890
891 fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
892 test th1-info-vars-5 {$RESULT eq "y"}
893
894 ###############################################################################
895
896 fossil test-th-eval "lsearch"
897 test th1-lsearch-1 {$RESULT eq \
898 {TH_ERROR: wrong # args: should be "lsearch list string"}}
899
900 ###############################################################################
901
902 fossil test-th-eval "lsearch a"
903 test th1-lsearch-2 {$RESULT eq \
904 {TH_ERROR: wrong # args: should be "lsearch list string"}}
905
906 ###############################################################################
907
908 fossil test-th-eval "lsearch a a a"
909 test th1-lsearch-3 {$RESULT eq \
910 {TH_ERROR: wrong # args: should be "lsearch list string"}}
911
912 ###############################################################################
913
914 fossil test-th-eval "lsearch {a b c} a"
915 test th1-lsearch-4 {$RESULT eq "0"}
916
917 ###############################################################################
918
919 fossil test-th-eval "lsearch {a b c} b"
920 test th1-lsearch-5 {$RESULT eq "1"}
921
922 ###############################################################################
923
924 fossil test-th-eval "lsearch {a b c} c"
925 test th1-lsearch-6 {$RESULT eq "2"}
926
927 ###############################################################################
928
929 fossil test-th-eval "lsearch {a b c} d"
930 test th1-lsearch-7 {$RESULT eq "-1"}
931
932 ###############################################################################
933
934 fossil test-th-eval "lsearch {a b c} aa"
935 test th1-lsearch-8 {$RESULT eq "-1"}
936
937 ###############################################################################
938
939 fossil test-th-eval "lsearch {aa b c} a"
940 test th1-lsearch-9 {$RESULT eq "-1"}
941
942 ###############################################################################
943
944 fossil test-th-eval "lsearch \"\{aa b c\" a"
945 test th1-lsearch-10 {$RESULT eq "TH_ERROR: Expected list, got: \"\{aa b c\""}
946
M www/th1.md
+1
--- www/th1.md
+++ www/th1.md
@@ -96,10 +96,11 @@
9696
 * info exists VARNAME
9797
 * info vars
9898
 * lindex LIST INDEX
9999
 * list ARG ...
100100
 * llength LIST
101
+ * lsearch LIST STRING
101102
 * proc NAME ARG-LIST BODY-SCRIPT
102103
 * rename OLD NEW
103104
 * return ?-code CODE? ?VALUE?
104105
 * set VARNAME VALUE
105106
 * string compare STR1 STR2
106107
--- www/th1.md
+++ www/th1.md
@@ -96,10 +96,11 @@
96 * info exists VARNAME
97 * info vars
98 * lindex LIST INDEX
99 * list ARG ...
100 * llength LIST
 
101 * proc NAME ARG-LIST BODY-SCRIPT
102 * rename OLD NEW
103 * return ?-code CODE? ?VALUE?
104 * set VARNAME VALUE
105 * string compare STR1 STR2
106
--- www/th1.md
+++ www/th1.md
@@ -96,10 +96,11 @@
96 * info exists VARNAME
97 * info vars
98 * lindex LIST INDEX
99 * list ARG ...
100 * llength LIST
101 * lsearch LIST STRING
102 * proc NAME ARG-LIST BODY-SCRIPT
103 * rename OLD NEW
104 * return ?-code CODE? ?VALUE?
105 * set VARNAME VALUE
106 * string compare STR1 STR2
107

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button