Fossil

Check-in [54b0567c]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add minimal 'lsearch' command to TH1. Only exact case-sensitive matching is supported.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 54b0567cdaaa87e126b5d5fdef70d1ce70eff711
User & Date: mistachkin 2015-05-29 17:17:13.724
Context
2015-05-29
17:20
Add 'glob_match' command to TH1. ... (check-in: 62f1f484 user: mistachkin tags: trunk)
17:17
Add minimal 'lsearch' command to TH1. Only exact case-sensitive matching is supported. ... (check-in: 54b0567c user: mistachkin tags: trunk)
17:14
Enhance file_tree_name() to be capable of producing absolute paths within the local tree. Fix --hard option to mv/rm to enable them to work properly with certain relative paths. ... (check-in: c56a387d user: mistachkin tags: trunk)
2015-05-27
03:58
Add minimal 'lsearch' command to TH1. Only exact case-sensitive matching is supported. ... (Closed-Leaf check-in: eabd7290 user: mistachkin tags: lsearchCmd)
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/th_lang.c.
253
254
255
256
257
258
259





































260
261
262
263
264
265
266
  }

  return rc;
}

/*
** TH Syntax:





































**
**   set varname ?value?
*/
static int set_command(
  Th_Interp *interp,
  void *ctx,
  int argc,







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
  }

  return rc;
}

/*
** TH Syntax:
**
**   lsearch list string
*/
static int lsearch_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int rc;
  char **azElem;
  int *anElem;
  int nCount;
  int i;

  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "lsearch list string");
  }

  rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount);
  if( rc==TH_OK ){
    Th_SetResultInt(interp, -1);
    for(i=0; i<nCount; i++){
      if( anElem[i]==argl[2] && 0==memcmp(azElem[i], argv[2], argl[2]) ){
        Th_SetResultInt(interp, i);
        break;
      }
    }
    Th_Free(interp, azElem);
  }

  return rc;
}

/*
** TH Syntax:
**
**   set varname ?value?
*/
static int set_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
1128
1129
1130
1131
1132
1133
1134

1135
1136
1137
1138
1139
1140
1141
    {"expr",     expr_command,    0},
    {"for",      for_command,     0},
    {"if",       if_command,      0},
    {"info",     info_command,    0},
    {"lindex",   lindex_command,  0},
    {"list",     list_command,    0},
    {"llength",  llength_command, 0},

    {"proc",     proc_command,    0},
    {"rename",   rename_command,  0},
    {"set",      set_command,     0},
    {"string",   string_command,  0},
    {"unset",    unset_command,   0},
    {"uplevel",  uplevel_command, 0},
    {"upvar",    upvar_command,   0},







>







1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
    {"expr",     expr_command,    0},
    {"for",      for_command,     0},
    {"if",       if_command,      0},
    {"info",     info_command,    0},
    {"lindex",   lindex_command,  0},
    {"list",     list_command,    0},
    {"llength",  llength_command, 0},
    {"lsearch",  lsearch_command, 0},
    {"proc",     proc_command,    0},
    {"rename",   rename_command,  0},
    {"set",      set_command,     0},
    {"string",   string_command,  0},
    {"unset",    unset_command,   0},
    {"uplevel",  uplevel_command, 0},
    {"upvar",    upvar_command,   0},
Changes to test/th1.test.
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
#
fossil test-th-eval "info commands"
test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
enable_output uplevel http expr utime styleFooter catch if tclReady\
searchable reinitialize combobox lindex query html anoncap randhex\
llength for set break regexp styleHeader puts return checkout decorate\
artifact trace wiki proc hascap globalState continue getParameter\
hasfeature setting breakpoint upvar render repository string unset\
setParameter list error info rename anycap httpize}}

###############################################################################

fossil test-th-eval "info vars"
test th1-info-vars-1 {$RESULT eq ""}








|







859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
#
fossil test-th-eval "info commands"
test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
enable_output uplevel http expr utime styleFooter catch if tclReady\
searchable reinitialize combobox lindex query html anoncap randhex\
llength for set break regexp styleHeader puts return checkout decorate\
artifact trace wiki proc hascap globalState continue getParameter\
hasfeature setting lsearch breakpoint upvar render repository string unset\
setParameter list error info rename anycap httpize}}

###############################################################################

fossil test-th-eval "info vars"
test th1-info-vars-1 {$RESULT eq ""}

886
887
888
889
890
891
892





















































fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

###############################################################################

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
test th1-info-vars-5 {$RESULT eq "y"}




























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

###############################################################################

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
test th1-info-vars-5 {$RESULT eq "y"}

###############################################################################

fossil test-th-eval "lsearch"
test th1-lsearch-1 {$RESULT eq \
    {TH_ERROR: wrong # args: should be "lsearch list string"}}

###############################################################################

fossil test-th-eval "lsearch a"
test th1-lsearch-2 {$RESULT eq \
    {TH_ERROR: wrong # args: should be "lsearch list string"}}

###############################################################################

fossil test-th-eval "lsearch a a a"
test th1-lsearch-3 {$RESULT eq \
    {TH_ERROR: wrong # args: should be "lsearch list string"}}

###############################################################################

fossil test-th-eval "lsearch {a b c} a"
test th1-lsearch-4 {$RESULT eq "0"}

###############################################################################

fossil test-th-eval "lsearch {a b c} b"
test th1-lsearch-5 {$RESULT eq "1"}

###############################################################################

fossil test-th-eval "lsearch {a b c} c"
test th1-lsearch-6 {$RESULT eq "2"}

###############################################################################

fossil test-th-eval "lsearch {a b c} d"
test th1-lsearch-7 {$RESULT eq "-1"}

###############################################################################

fossil test-th-eval "lsearch {a b c} aa"
test th1-lsearch-8 {$RESULT eq "-1"}

###############################################################################

fossil test-th-eval "lsearch {aa b c} a"
test th1-lsearch-9 {$RESULT eq "-1"}

###############################################################################

fossil test-th-eval "lsearch \"\{aa b c\" a"
test th1-lsearch-10 {$RESULT eq "TH_ERROR: Expected list, got: \"\{aa b c\""}
Changes to www/th1.md.
94
95
96
97
98
99
100

101
102
103
104
105
106
107
  *  if EXPR SCRIPT (elseif EXPR SCRIPT)* ?else SCRIPT?
  *  info commands
  *  info exists VARNAME
  *  info vars
  *  lindex LIST INDEX
  *  list ARG ...
  *  llength LIST

  *  proc NAME ARG-LIST BODY-SCRIPT
  *  rename OLD NEW
  *  return ?-code CODE? ?VALUE?
  *  set VARNAME VALUE
  *  string compare STR1 STR2
  *  string first NEEDLE HAYSTACK ?START-INDEX?
  *  string is CLASS STRING







>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
  *  if EXPR SCRIPT (elseif EXPR SCRIPT)* ?else SCRIPT?
  *  info commands
  *  info exists VARNAME
  *  info vars
  *  lindex LIST INDEX
  *  list ARG ...
  *  llength LIST
  *  lsearch LIST STRING
  *  proc NAME ARG-LIST BODY-SCRIPT
  *  rename OLD NEW
  *  return ?-code CODE? ?VALUE?
  *  set VARNAME VALUE
  *  string compare STR1 STR2
  *  string first NEEDLE HAYSTACK ?START-INDEX?
  *  string is CLASS STRING