Fossil

Check-in [fa4e828653]
Login

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

Overview
Comment:Add 'tcl-setup' setting for the optional Tcl script to evaluate after creating and initializing the Tcl interpreter. Make sure Tcl gets a copy of all the original expanded arguments.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: fa4e828653c9b06f4e92cc64bdf8642529f3ca82
User & Date: mistachkin 2012-10-07 10:12:16.735
Context
2012-10-07
13:55
Enhance Tcl integration with support for notifications before and after Tcl scripts are evaluated. check-in: 49c63f8c78 user: mistachkin tags: trunk
10:15
Merge updates from trunk. check-in: a8add9c1bd user: mistachkin tags: markdown
10:12
Add 'tcl-setup' setting for the optional Tcl script to evaluate after creating and initializing the Tcl interpreter. Make sure Tcl gets a copy of all the original expanded arguments. check-in: fa4e828653 user: mistachkin tags: trunk
2012-10-05
20:39
Add the "stash show" command. Simplifications to the diff code, and especially the looks_like_binary() function. check-in: 4e0e69f691 user: drh tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/configure.c.
87
88
89
90
91
92
93

94
95

96
97
98
99
100
101
102
  { "background-image",       CONFIGSET_SKIN },
  { "index-page",             CONFIGSET_SKIN },
  { "timeline-block-markup",  CONFIGSET_SKIN },
  { "timeline-max-comment",   CONFIGSET_SKIN },
  { "adunit",                 CONFIGSET_SKIN },
  { "adunit-omit-if-admin",   CONFIGSET_SKIN },
  { "adunit-omit-if-user",    CONFIGSET_SKIN },

#ifdef FOSSIL_ENABLE_TCL
  { "tcl",                    CONFIGSET_SKIN|CONFIGSET_TKT|CONFIGSET_XFER },

#endif

  { "project-name",           CONFIGSET_PROJ },
  { "project-description",    CONFIGSET_PROJ },
  { "manifest",               CONFIGSET_PROJ },
  { "binary-glob",            CONFIGSET_PROJ },
  { "ignore-glob",            CONFIGSET_PROJ },







>


>







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
  { "background-image",       CONFIGSET_SKIN },
  { "index-page",             CONFIGSET_SKIN },
  { "timeline-block-markup",  CONFIGSET_SKIN },
  { "timeline-max-comment",   CONFIGSET_SKIN },
  { "adunit",                 CONFIGSET_SKIN },
  { "adunit-omit-if-admin",   CONFIGSET_SKIN },
  { "adunit-omit-if-user",    CONFIGSET_SKIN },

#ifdef FOSSIL_ENABLE_TCL
  { "tcl",                    CONFIGSET_SKIN|CONFIGSET_TKT|CONFIGSET_XFER },
  { "tcl-setup",              CONFIGSET_SKIN|CONFIGSET_TKT|CONFIGSET_XFER },
#endif

  { "project-name",           CONFIGSET_PROJ },
  { "project-description",    CONFIGSET_PROJ },
  { "manifest",               CONFIGSET_PROJ },
  { "binary-glob",            CONFIGSET_PROJ },
  { "ignore-glob",            CONFIGSET_PROJ },
Changes to src/db.c.
2037
2038
2039
2040
2041
2042
2043

2044
2045
2046
2047
2048
2049
2050
  { "repo-cksum",    0,                0, 0, "on"                  },
  { "self-register", 0,                0, 0, "off"                 },
  { "ssl-ca-location",0,              40, 0, ""                    },
  { "ssl-identity",  0,               40, 0, ""                    },
  { "ssh-command",   0,               32, 0, ""                    },
#ifdef FOSSIL_ENABLE_TCL
  { "tcl",           0,                0, 0, "off"                 },

#endif
  { "web-browser",   0,               32, 0, ""                    },
  { "white-foreground", 0,             0, 0, "off"                 },
  { 0,0,0,0,0 }
};

/*







>







2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
  { "repo-cksum",    0,                0, 0, "on"                  },
  { "self-register", 0,                0, 0, "off"                 },
  { "ssl-ca-location",0,              40, 0, ""                    },
  { "ssl-identity",  0,               40, 0, ""                    },
  { "ssh-command",   0,               32, 0, ""                    },
#ifdef FOSSIL_ENABLE_TCL
  { "tcl",           0,                0, 0, "off"                 },
  { "tcl-setup",     0,               40, 0, ""                    },
#endif
  { "web-browser",   0,               32, 0, ""                    },
  { "white-foreground", 0,             0, 0, "off"                 },
  { 0,0,0,0,0 }
};

/*
2201
2202
2203
2204
2205
2206
2207

2208
2209
2210
2211



2212

2213
2214
2215
2216
2217
2218
2219
**                     This identity will be presented to SSL servers to
**                     authenticate this client, in addition to the normal
**                     password authentication.
**
**    ssh-command      Command used to talk to a remote machine with
**                     the "ssh://" protocol.
**

**    tcl              If enabled, Tcl integration commands will be added to
**                     the TH1 interpreter, allowing Tcl expressions and
**                     scripts to be evaluated from TH1.  Additionally, the
**                     Tcl interpreter will be able to evaluate TH1 expressions



**                     and scripts.  Default: off.

**
**    web-browser      A shell command used to launch your preferred
**                     web browser when given a URL as an argument.
**                     Defaults to "start" on windows, "open" on Mac,
**                     and "firefox" on Unix.
**
** Options:







>
|
|
|
|
>
>
>
|
>







2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
**                     This identity will be presented to SSL servers to
**                     authenticate this client, in addition to the normal
**                     password authentication.
**
**    ssh-command      Command used to talk to a remote machine with
**                     the "ssh://" protocol.
**
**    tcl              If enabled (and Fossil was compiled with Tcl support),
**                     Tcl integration commands will be added to the TH1
**                     interpreter, allowing arbitrary Tcl expressions and
**                     scripts to be evaluated from TH1.  Additionally, the Tcl
**                     interpreter will be able to evaluate arbitrary TH1
**                     expressions and scripts. Default: off.
**
**    tcl-setup        This is the setup script to be evaluated after creating
**                     and initializing the Tcl interpreter.  By default, this
**                     is empty and no extra setup is performed.
**
**    web-browser      A shell command used to launch your preferred
**                     web browser when given a URL as an argument.
**                     Defaults to "start" on windows, "open" on Mac,
**                     and "firefox" on Unix.
**
** Options:
Changes to src/main.c.
86
87
88
89
90
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
#ifdef FOSSIL_ENABLE_TCL
/*
** All Tcl related context information is in this structure.  This structure
** definition has been copied from and should be kept in sync with the one in
** "th_tcl.c".
*/
struct TclContext {
  int argc;
  char **argv;
  void *library;
  void *xFindExecutable; /* see tcl_FindExecutableProc in th_tcl.c */
  void *xCreateInterp;   /* see tcl_CreateInterpProc in th_tcl.c */
  Tcl_Interp *interp;

};
#endif

/*
** All global variables are in this structure.
*/
struct Global {







|
|
|
|
|
|
>







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
#ifdef FOSSIL_ENABLE_TCL
/*
** All Tcl related context information is in this structure.  This structure
** definition has been copied from and should be kept in sync with the one in
** "th_tcl.c".
*/
struct TclContext {
  int argc;              /* Number of original (expanded) arguments. */
  char **argv;           /* Full copy of the original (expanded) arguments. */
  void *library;         /* The Tcl library module handle. */
  void *xFindExecutable; /* See tcl_FindExecutableProc in th_tcl.c. */
  void *xCreateInterp;   /* See tcl_CreateInterpProc in th_tcl.c. */
  Tcl_Interp *interp;    /* The on-demand created Tcl interpreter. */
  char *setup;           /* The optional Tcl setup script. */
};
#endif

/*
** All global variables are in this structure.
*/
struct Global {
547
548
549
550
551
552
553














554
555
556
557
558
559
560
  }
  i += 2;
  while( i<g.argc ) newArgv[j++] = g.argv[i++];
  newArgv[j] = 0;
  g.argc = j;
  g.argv = newArgv;
}















/*
** This procedure runs first.
*/
int main(int argc, char **argv)
{
  const char *zCmdName = "unknown";







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







548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
  }
  i += 2;
  while( i<g.argc ) newArgv[j++] = g.argv[i++];
  newArgv[j] = 0;
  g.argc = j;
  g.argv = newArgv;
}

/*
** Make a deep copy of the provided argument array and return it.
*/
static char **copy_args(int argc, char **argv){
  char **zNewArgv;
  int i;
  zNewArgv = fossil_malloc( sizeof(char*)*(argc+1) );
  memset(zNewArgv, 0, sizeof(char*)*(argc+1));
  for(i=0; i<argc; i++){
    zNewArgv[i] = fossil_strdup(argv[i]);
  }
  return zNewArgv;
}

/*
** This procedure runs first.
*/
int main(int argc, char **argv)
{
  const char *zCmdName = "unknown";
575
576
577
578
579
580
581

582
583
584
585
586
587
588
589
590
591
#endif
  g.json.outOpt = cson_output_opt_empty;
  g.json.outOpt.addNewline = 1;
  g.json.outOpt.indentation = 1 /* in CGI/server mode this can be configured */;
#endif /* FOSSIL_ENABLE_JSON */
  expand_args_option(argc, argv);
#ifdef FOSSIL_ENABLE_TCL

  g.tcl.argc = g.argc;
  g.tcl.argv = g.argv;
  g.tcl.interp = 0;
#endif
  if( fossil_getenv("GATEWAY_INTERFACE")!=0 && !find_option("nocgi", 0, 0)){
    zCmdName = "cgi";
    g.isHTTP = 1;
  }else if( g.argc<2 ){
    fossil_print(
       "Usage: %s COMMAND ...\n"







>

|
<







590
591
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
#endif
  g.json.outOpt = cson_output_opt_empty;
  g.json.outOpt.addNewline = 1;
  g.json.outOpt.indentation = 1 /* in CGI/server mode this can be configured */;
#endif /* FOSSIL_ENABLE_JSON */
  expand_args_option(argc, argv);
#ifdef FOSSIL_ENABLE_TCL
  memset(&g.tcl, 0, sizeof(TclContext));
  g.tcl.argc = g.argc;
  g.tcl.argv = copy_args(g.argc, g.argv); /* save full arguments */

#endif
  if( fossil_getenv("GATEWAY_INTERFACE")!=0 && !find_option("nocgi", 0, 0)){
    zCmdName = "cgi";
    g.isHTTP = 1;
  }else if( g.argc<2 ){
    fossil_print(
       "Usage: %s COMMAND ...\n"
Changes to src/th_main.c.
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234
235

/*
** TH command:     hasfeature STRING
**
** Return true if the fossil binary has the given compile-time feature
** enabled. The set of features includes:
**
** "json" = FOSSIL_ENABLE_JSON

** "tcl" = FOSSIL_ENABLE_TCL
** "ssl" = FOSSIL_ENABLE_SSL
**
*/
static int hasfeatureCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 







|
>
|
|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236

/*
** TH command:     hasfeature STRING
**
** Return true if the fossil binary has the given compile-time feature
** enabled. The set of features includes:
**
** "json"     = FOSSIL_ENABLE_JSON
** "ssl"      = FOSSIL_ENABLE_SSL
** "tcl"      = FOSSIL_ENABLE_TCL
** "tclStubs" = FOSSIL_ENABLE_TCL_STUBS
**
*/
static int hasfeatureCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
254
255
256
257
258
259
260





261
262
263
264
265
266
267
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL)
  else if( 0 == fossil_strnicmp( zArg, "tcl", 3 ) ){
    rc = 1;
  }





#endif
  if( g.thTrace ){
    Th_Trace("[hasfeature %#h] => %d<br />\n", argl[1], zArg, rc);
  }
  Th_SetResultInt(interp, rc);
  return TH_OK;
}







>
>
>
>
>







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL)
  else if( 0 == fossil_strnicmp( zArg, "tcl", 3 ) ){
    rc = 1;
  }
#endif
#if defined(FOSSIL_ENABLE_TCL_STUBS)
  else if( 0 == fossil_strnicmp( zArg, "tclStubs", 8 ) ){
    rc = 1;
  }
#endif
  if( g.thTrace ){
    Th_Trace("[hasfeature %#h] => %d<br />\n", argl[1], zArg, rc);
  }
  Th_SetResultInt(interp, rc);
  return TH_OK;
}
445
446
447
448
449
450
451

452
453
454
455
456
457
458
  };
  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, &g.tcl);  /* Tcl integration commands. */
    }
#endif
    for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
      if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
      Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
                       aCommand[i].pContext, 0);







>







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
  };
  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) ){
      g.tcl.setup = db_get("tcl-setup", 0); /* Grab optional setup script. */
      th_register_tcl(g.interp, &g.tcl);  /* Tcl integration commands. */
    }
#endif
    for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
      if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
      Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
                       aCommand[i].pContext, 0);
Changes to src/th_tcl.c.
164
165
166
167
168
169
170
171
172
173
174
175
176

177
178
179
180
181
182
183
}

/*
** Tcl context information used by TH1.  This structure definition has been
** copied from and should be kept in sync with the one in "main.c".
*/
struct TclContext {
  int argc;
  char **argv;
  void *library;
  tcl_FindExecutableProc *xFindExecutable;
  tcl_CreateInterpProc *xCreateInterp;
  Tcl_Interp *interp;

};

/*
** Syntax:
**
**   tclEval arg ?arg ...?
*/







|
|
|
|
|
|
>







164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
}

/*
** Tcl context information used by TH1.  This structure definition has been
** copied from and should be kept in sync with the one in "main.c".
*/
struct TclContext {
  int argc;           /* Number of original arguments. */
  char **argv;        /* Full copy of the original arguments. */
  void *library;      /* The Tcl library module handle. */
  tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
  tcl_CreateInterpProc *xCreateInterp;     /* Tcl_CreateInterp() pointer. */
  Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
  char *setup;        /* The optional Tcl setup script. */
};

/*
** Syntax:
**
**   tclEval arg ?arg ...?
*/
580
581
582
583
584
585
586

587
588
589
590
591
592
593
  void *pContext
){
  struct TclContext *tclContext = (struct TclContext *)pContext;
  int argc;
  char **argv;
  char *argv0 = 0;
  Tcl_Interp *tclInterp;


  if ( !tclContext ){
    Th_ErrorMessage(interp,
        "Invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
  if ( tclContext->interp ){







>







581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
  void *pContext
){
  struct TclContext *tclContext = (struct TclContext *)pContext;
  int argc;
  char **argv;
  char *argv0 = 0;
  Tcl_Interp *tclInterp;
  char *setup;

  if ( !tclContext ){
    Th_ErrorMessage(interp,
        "Invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
  if ( tclContext->interp ){
628
629
630
631
632
633
634









635
636
637
638
639
640
641
    tclContext->interp = tclInterp = 0;
    return TH_ERROR;
  }
  /* Add the TH1 integration commands to Tcl. */
  Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
  Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
  Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);









  return TH_OK;
}

/*
** Register the Tcl language commands with interpreter interp.
** Usually this is called soon after interpreter creation.
*/







>
>
>
>
>
>
>
>
>







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    tclContext->interp = tclInterp = 0;
    return TH_ERROR;
  }
  /* Add the TH1 integration commands to Tcl. */
  Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
  Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
  Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
  /* If necessary, evaluate the custom Tcl setup script. */
  setup = tclContext->setup;
  if( setup && Tcl_Eval(tclInterp, setup)!=TCL_OK ){
    Th_ErrorMessage(interp,
        "Tcl setup script error:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);
    tclContext->interp = tclInterp = 0;
    return TH_ERROR;
  }
  return TH_OK;
}

/*
** Register the Tcl language commands with interpreter interp.
** Usually this is called soon after interpreter creation.
*/