Fossil

Check-in [5cc15d08]
Login

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

Overview
Comment:Reset result prior to direct Tcl invocation. Cast all ckalloc return values. Make sure the global config database is open for the 'test_th_render' command. Allow the 'tcl' setting to be enabled via the environment.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tcl-integration
Files: files | file ages | folders
SHA1: 5cc15d08900cd34eba9dc5a9fad0891e692036aa
User & Date: mistachkin 2011-08-28 06:54:37
Context
2011-08-28
23:45
Use macros to tidy up TH1 to Tcl argument marshalling. Use the Tcl interp result when Tcl_ExprObj does not return ok. Check for Tcl interp deletion. The TH1 'puts' command should flush when writing to stdout. Add 'repository' TH1 command. Use obj API to get Tcl cmdInfo. Add tests for Tcl integration. check-in: 53b9445b user: mistachkin tags: tcl-integration
06:54
Reset result prior to direct Tcl invocation. Cast all ckalloc return values. Make sure the global config database is open for the 'test_th_render' command. Allow the 'tcl' setting to be enabled via the environment. check-in: 5cc15d08 user: mistachkin tags: tcl-integration
03:00
Do not free the Tcl result (or interp) prior to setting the TH1 result. check-in: 0299d484 user: mistachkin tags: tcl-integration
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/th_main.c.

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
...
532
533
534
535
536
537
538

539
540
541
542
    {"wiki",          wikiCmd,              0},
  };
  if( g.interp==0 ){
    int i;
    g.interp = Th_CreateInterp(&vtab);
    th_register_language(g.interp);       /* Basic scripting commands. */
#ifdef FOSSIL_ENABLE_TCL
    if( db_get_boolean("tcl", 0) ){
      th_register_tcl(g.interp);          /* Tcl integration commands. */
    }
#endif
    for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
      Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
                       aCommand[i].pContext, 0);
    }
................................................................................
** COMMAND: test-th-render
*/
void test_th_render(void){
  Blob in;
  if( g.argc<3 ){
    usage("FILE");
  }

  blob_zero(&in);
  blob_read_from_file(&in, g.argv[2]);
  Th_Render(blob_str(&in));
}







|







 







>




361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
...
532
533
534
535
536
537
538
539
540
541
542
543
    {"wiki",          wikiCmd,              0},
  };
  if( g.interp==0 ){
    int i;
    g.interp = Th_CreateInterp(&vtab);
    th_register_language(g.interp);       /* Basic scripting commands. */
#ifdef FOSSIL_ENABLE_TCL
    if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
      th_register_tcl(g.interp);          /* Tcl integration commands. */
    }
#endif
    for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
      Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
                       aCommand[i].pContext, 0);
    }
................................................................................
** COMMAND: test-th-render
*/
void test_th_render(void){
  Blob in;
  if( g.argc<3 ){
    usage("FILE");
  }
  db_open_config(0); /* Needed for "tcl" setting. */
  blob_zero(&in);
  blob_read_from_file(&in, g.argv[2]);
  Th_Render(blob_str(&in));
}

Changes to src/th_tcl.c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165
...
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
...
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
  if( argc==2 ){
    objPtr = Tcl_NewStringObj(argv[1], argl[1]);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
    Tcl_DecrRefCount(objPtr);
  }else{
    int objc = argc-1;
    Tcl_Obj **objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
    int i;
    for(i=1; i<argc; i++){
      objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
      Tcl_IncrRefCount(objv[i-1]);
    }
    objPtr = Tcl_ConcatObj(objc, objv);
    Tcl_IncrRefCount(objPtr);
................................................................................
  if( argc==2 ){
    objPtr = Tcl_NewStringObj(argv[1], argl[1]);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
    Tcl_DecrRefCount(objPtr);
  }else{
    int objc = argc-1;
    Tcl_Obj **objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
    int i;
    for(i=1; i<argc; i++){
      objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
      Tcl_IncrRefCount(objv[i-1]);
    }
    objPtr = Tcl_ConcatObj(objc, objv);
    Tcl_IncrRefCount(objPtr);
................................................................................
    return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
  }
  tclInterp = (Tcl_Interp *)ctx;
  if( !tclInterp ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  if (Tcl_GetCommandInfo(tclInterp, argv[1], &cmdInfo) == 0) {
    Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
    return TH_ERROR;
  }
  objc = argc-1;
  objv = ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
  for(i=1; i<argc; i++){
    objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
    Tcl_IncrRefCount(objv[i-1]);
  }
  Tcl_Preserve((ClientData)tclInterp);

  rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
  for(i=1; i<argc; i++){
    Tcl_DecrRefCount(objv[i-1]);
  }
  ckfree((char *)objv);
  objPtr = Tcl_GetObjResult(tclInterp);
  zResult = Tcl_GetStringFromObj(objPtr, &nResult);
................................................................................
  const char *arg;
  int rc;

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "arg");
    return TCL_ERROR;
  }

  if( !th1Interp ){
    Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
    return TCL_ERROR;
  }

  arg = Tcl_GetStringFromObj(objv[1], &nArg);
  rc = Th_Eval(th1Interp, 0, arg, nArg);
  arg = Th_GetResult(th1Interp, &nArg);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
  return rc;
}

................................................................................
  const char *arg;
  int rc;

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "arg");
    return TCL_ERROR;
  }

  if( !th1Interp ){
    Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
    return TCL_ERROR;
  }

  arg = Tcl_GetStringFromObj(objv[1], &nArg);
  rc = Th_Expr(th1Interp, arg, nArg);
  arg = Th_GetResult(th1Interp, &nArg);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
  return rc;
}

................................................................................
  Tcl_Interp *tclInterp = Tcl_CreateInterp();

  if( !tclInterp ){
    Th_ErrorMessage(interp,
        "Could not create Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }

  if( Tcl_Init(tclInterp)!=TCL_OK ){
    Th_ErrorMessage(interp,
        "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);
    return TH_ERROR;
  }

  Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
  Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
  Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);

  /* Add the Tcl integration commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    void *ctx = aCommand[i].pContext;
    /* Use Tcl interpreter for context? */
    if( !ctx ) ctx = tclInterp;
    Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
  }

  return TH_OK;
}







|







 







|







 







|




|





>







 







<




<







 







<




<







 







<






<



<







<


35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
...
185
186
187
188
189
190
191

192
193
194
195

196
197
198
199
200
201
202
...
216
217
218
219
220
221
222

223
224
225
226

227
228
229
230
231
232
233
...
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
  if( argc==2 ){
    objPtr = Tcl_NewStringObj(argv[1], argl[1]);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
    Tcl_DecrRefCount(objPtr);
  }else{
    int objc = argc-1;
    Tcl_Obj **objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
    int i;
    for(i=1; i<argc; i++){
      objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
      Tcl_IncrRefCount(objv[i-1]);
    }
    objPtr = Tcl_ConcatObj(objc, objv);
    Tcl_IncrRefCount(objPtr);
................................................................................
  if( argc==2 ){
    objPtr = Tcl_NewStringObj(argv[1], argl[1]);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
    Tcl_DecrRefCount(objPtr);
  }else{
    int objc = argc-1;
    Tcl_Obj **objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
    int i;
    for(i=1; i<argc; i++){
      objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
      Tcl_IncrRefCount(objv[i-1]);
    }
    objPtr = Tcl_ConcatObj(objc, objv);
    Tcl_IncrRefCount(objPtr);
................................................................................
    return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");
  }
  tclInterp = (Tcl_Interp *)ctx;
  if( !tclInterp ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  if (Tcl_GetCommandInfo(tclInterp, argv[1], &cmdInfo) == 0){
    Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
    return TH_ERROR;
  }
  objc = argc-1;
  objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *)));
  for(i=1; i<argc; i++){
    objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);
    Tcl_IncrRefCount(objv[i-1]);
  }
  Tcl_Preserve((ClientData)tclInterp);
  Tcl_ResetResult(tclInterp);
  rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
  for(i=1; i<argc; i++){
    Tcl_DecrRefCount(objv[i-1]);
  }
  ckfree((char *)objv);
  objPtr = Tcl_GetObjResult(tclInterp);
  zResult = Tcl_GetStringFromObj(objPtr, &nResult);
................................................................................
  const char *arg;
  int rc;

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "arg");
    return TCL_ERROR;
  }

  if( !th1Interp ){
    Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
    return TCL_ERROR;
  }

  arg = Tcl_GetStringFromObj(objv[1], &nArg);
  rc = Th_Eval(th1Interp, 0, arg, nArg);
  arg = Th_GetResult(th1Interp, &nArg);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
  return rc;
}

................................................................................
  const char *arg;
  int rc;

  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "arg");
    return TCL_ERROR;
  }

  if( !th1Interp ){
    Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
    return TCL_ERROR;
  }

  arg = Tcl_GetStringFromObj(objv[1], &nArg);
  rc = Th_Expr(th1Interp, arg, nArg);
  arg = Th_GetResult(th1Interp, &nArg);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
  return rc;
}

................................................................................
  Tcl_Interp *tclInterp = Tcl_CreateInterp();

  if( !tclInterp ){
    Th_ErrorMessage(interp,
        "Could not create Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }

  if( Tcl_Init(tclInterp)!=TCL_OK ){
    Th_ErrorMessage(interp,
        "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);
    return TH_ERROR;
  }

  Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
  Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
  Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);

  /* Add the Tcl integration commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    void *ctx = aCommand[i].pContext;
    /* Use Tcl interpreter for context? */
    if( !ctx ) ctx = tclInterp;
    Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
  }

  return TH_OK;
}

Changes to win/Makefile.mingw.mistachkin.

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
79
80
81
82
83
84
85

86
87
88
89
90
91
92
...
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
OPENSSLDIR = $(SRCDIR)/../openssl-1.0.0d

#### The directory where the Tcl library source code is located.
#
#
TCLDIR = $(SRCDIR)/../tcl-8.6

#### C Compile and options for use in building executables that 
#    will run on the target platform.  This is usually the same
#    as BCC, unless you are cross-compiling.  This C compiler builds
#    the finished binary for fossil.  The BCC compiler above is used
#    for building intermediate code-generator tools.
#
TCC = gcc -Os -Wall -L$(ZLIBDIR) -I$(ZLIBDIR)

................................................................................
#
LIB = -static

# OpenSSL:
ifdef FOSSIL_ENABLE_SSL
LIB += -lssl -lcrypto -lgdi32
endif

LIB += -lmingwex -lz -lws2_32

ifdef FOSSIL_ENABLE_TCL
LIB += -ltcl86t
endif

#### Tcl shell for use in running the fossil testsuite.  This is only
................................................................................

$(APPNAME):	$(OBJDIR)/headers $(OBJ) $(EXTRAOBJ) $(OBJDIR)/icon.o
	$(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB) $(OBJDIR)/icon.o

# This rule prevents make from using its default rules to try build
# an executable named "manifest" out of the file named "manifest.c"
#
$(SRCDIR)/../manifest:	
	# noop

# Requires msys to be installed in addition to the mingw, for the "rm"
# command.  "del" will not work here because it is not a separate command
# but a MSDOS-shell builtin.
#
clean:	
	rm -rf $(OBJDIR) $(APPNAME)

setup: $(OBJDIR) $(APPNAME)
	$(MAKENSIS) ./fossil.nsi


$(OBJDIR)/page_index.h: $(TRANS_SRC) $(OBJDIR)/mkindex







|







 







>







 







|






|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
...
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
OPENSSLDIR = $(SRCDIR)/../openssl-1.0.0d

#### The directory where the Tcl library source code is located.
#
#
TCLDIR = $(SRCDIR)/../tcl-8.6

#### C Compile and options for use in building executables that
#    will run on the target platform.  This is usually the same
#    as BCC, unless you are cross-compiling.  This C compiler builds
#    the finished binary for fossil.  The BCC compiler above is used
#    for building intermediate code-generator tools.
#
TCC = gcc -Os -Wall -L$(ZLIBDIR) -I$(ZLIBDIR)

................................................................................
#
LIB = -static

# OpenSSL:
ifdef FOSSIL_ENABLE_SSL
LIB += -lssl -lcrypto -lgdi32
endif

LIB += -lmingwex -lz -lws2_32

ifdef FOSSIL_ENABLE_TCL
LIB += -ltcl86t
endif

#### Tcl shell for use in running the fossil testsuite.  This is only
................................................................................

$(APPNAME):	$(OBJDIR)/headers $(OBJ) $(EXTRAOBJ) $(OBJDIR)/icon.o
	$(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB) $(OBJDIR)/icon.o

# This rule prevents make from using its default rules to try build
# an executable named "manifest" out of the file named "manifest.c"
#
$(SRCDIR)/../manifest:
	# noop

# Requires msys to be installed in addition to the mingw, for the "rm"
# command.  "del" will not work here because it is not a separate command
# but a MSDOS-shell builtin.
#
clean:
	rm -rf $(OBJDIR) $(APPNAME)

setup: $(OBJDIR) $(APPNAME)
	$(MAKENSIS) ./fossil.nsi


$(OBJDIR)/page_index.h: $(TRANS_SRC) $(OBJDIR)/mkindex