Fossil SCM

(!Experiment, not meant for trunk, ever!) How would the fossil code look like, if the Tcl_InitSubsystems() function (TIP #414) was available.

jan.nijtmans 2013-03-28 22:30 UTC trunk
Commit be1a7396942f108ca01bc3bd7f146edadeda1cf4
Parent 3f78dfe593630c2…
2 files changed +1 -2 +20 -109
~ src/main.c ~ src/th_tcl.c
M src/main.c
+1 -2
--- src/main.c
+++ src/main.c
@@ -97,12 +97,11 @@
9797
 */
9898
 struct TclContext {
9999
 int argc; /* Number of original (expanded) arguments. */
100100
 char **argv; /* Full copy of the original (expanded) arguments. */
101101
 void *library; /* The Tcl library module handle. */
102
- void *xFindExecutable; /* See tcl_FindExecutableProc in th_tcl.c. */
103
- void *xCreateInterp; /* See tcl_CreateInterpProc in th_tcl.c. */
102
+ void *xInitSubsystems; /* See tcl_InitSubsystemsProc in th_tcl.c. */
104103
 Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
105104
 char *setup; /* The optional Tcl setup script. */
106105
 void *xPreEval; /* Optional, called before Tcl_Eval*(). */
107106
 void *pPreContext; /* Optional, provided to xPreEval(). */
108107
 void *xPostEval; /* Optional, called after Tcl_Eval*(). */
109108
--- src/main.c
+++ src/main.c
@@ -97,12 +97,11 @@
97 */
98 struct TclContext {
99 int argc; /* Number of original (expanded) arguments. */
100 char **argv; /* Full copy of the original (expanded) arguments. */
101 void *library; /* The Tcl library module handle. */
102 void *xFindExecutable; /* See tcl_FindExecutableProc in th_tcl.c. */
103 void *xCreateInterp; /* See tcl_CreateInterpProc in th_tcl.c. */
104 Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
105 char *setup; /* The optional Tcl setup script. */
106 void *xPreEval; /* Optional, called before Tcl_Eval*(). */
107 void *pPreContext; /* Optional, provided to xPreEval(). */
108 void *xPostEval; /* Optional, called after Tcl_Eval*(). */
109
--- src/main.c
+++ src/main.c
@@ -97,12 +97,11 @@
97 */
98 struct TclContext {
99 int argc; /* Number of original (expanded) arguments. */
100 char **argv; /* Full copy of the original (expanded) arguments. */
101 void *library; /* The Tcl library module handle. */
102 void *xInitSubsystems; /* See tcl_InitSubsystemsProc in th_tcl.c. */
 
103 Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
104 char *setup; /* The optional Tcl setup script. */
105 void *xPreEval; /* Optional, called before Tcl_Eval*(). */
106 void *pPreContext; /* Optional, provided to xPreEval(). */
107 void *xPostEval; /* Optional, called after Tcl_Eval*(). */
108
M src/th_tcl.c
+20 -109
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -113,27 +113,23 @@
113113
 # ifndef TCL_MINOR_OFFSET
114114
 # define TCL_MINOR_OFFSET (8)
115115
 # endif
116116
 # endif /* defined(__CYGWIN__) */
117117
 # endif /* defined(_WIN32) */
118
-# ifndef TCL_FINDEXECUTABLE_NAME
119
-# define TCL_FINDEXECUTABLE_NAME "_Tcl_FindExecutable"
120
-# endif
121
-# ifndef TCL_CREATEINTERP_NAME
122
-# define TCL_CREATEINTERP_NAME "_Tcl_CreateInterp"
118
+# ifndef TCL_INITSUBSYSTEMS_NAME
119
+# define TCL_INITSUBSYSTEMS_NAME "_Tcl_InitSubsystems"
123120
 # endif
124121
 #endif /* defined(USE_TCL_STUBS) */
125122
126123
 /*
127
-** The function types for Tcl_FindExecutable and Tcl_CreateInterp are needed
124
+** The function types for Tcl_InitSubsystems are needed
128125
 ** when the Tcl library is being loaded dynamically by a stubs-enabled
129126
 ** application (i.e. the inverse of using a stubs-enabled package). These are
130127
 ** the only Tcl API functions that MUST be called prior to being able to call
131128
 ** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).
132129
 */
133
-typedef void (tcl_FindExecutableProc) (CONST char * argv0);
134
-typedef Tcl_Interp *(tcl_CreateInterpProc) (void);
130
+typedef Tcl_Interp *(tcl_InitSubsystemsProc) (int flags, ...);
135131
136132
 /*
137133
 ** The function types for the "hook" functions to be called before and after a
138134
 ** TH1 command makes a call to evaluate a Tcl script. If the "pre" function
139135
 ** returns anything but TH_OK, then evaluation of the Tcl script is skipped and
@@ -187,12 +183,11 @@
187183
 */
188184
 struct TclContext {
189185
 int argc; /* Number of original arguments. */
190186
 char **argv; /* Full copy of the original arguments. */
191187
 void *library; /* The Tcl library module handle. */
192
- tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
193
- tcl_CreateInterpProc *xCreateInterp; /* Tcl_CreateInterp() pointer. */
188
+ tcl_InitSubsystemsProc *xInitSubsystems; /* Tcl_FindExecutable() pointer. */
194189
 Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
195190
 char *setup; /* The optional Tcl setup script. */
196191
 tcl_NotifyProc *xPreEval; /* Optional, called before Tcl_Eval*(). */
197192
 void *pPreContext; /* Optional, provided to xPreEval(). */
198193
 tcl_NotifyProc *xPostEval; /* Optional, called after Tcl_Eval*(). */
@@ -525,123 +520,52 @@
525520
 ** functions.
526521
 */
527522
 static int loadTcl(
528523
 Th_Interp *interp,
529524
 void **pLibrary,
530
- tcl_FindExecutableProc **pxFindExecutable,
531
- tcl_CreateInterpProc **pxCreateInterp
525
+ tcl_InitSubsystemsProc **pxInitSubsystems
532526
 ){
533527
 #if defined(USE_TCL_STUBS)
534528
 char fileName[] = TCL_LIBRARY_NAME;
535529
 #endif
536
- if( !pLibrary || !pxFindExecutable || !pxCreateInterp ){
530
+ if( !pLibrary || !pxInitSubsystems ){
537531
 Th_ErrorMessage(interp,
538532
 "invalid Tcl loader argument(s)", (const char *)"", 0);
539533
 return TH_ERROR;
540534
 }
541535
 #if defined(USE_TCL_STUBS)
542536
 do {
543537
 void *library = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
544538
 if( library ){
545
- tcl_FindExecutableProc *xFindExecutable;
546
- tcl_CreateInterpProc *xCreateInterp;
547
- const char *procName = TCL_FINDEXECUTABLE_NAME;
548
- xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName + 1);
549
- if( !xFindExecutable ){
550
- xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName);
551
- }
552
- if( !xFindExecutable ){
553
- Th_ErrorMessage(interp,
554
- "could not locate Tcl_FindExecutable", (const char *)"", 0);
555
- dlclose(library);
556
- return TH_ERROR;
557
- }
558
- procName = TCL_CREATEINTERP_NAME;
559
- xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName + 1);
560
- if( !xCreateInterp ){
561
- xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName);
562
- }
563
- if( !xCreateInterp ){
564
- Th_ErrorMessage(interp,
565
- "could not locate Tcl_CreateInterp", (const char *)"", 0);
539
+ tcl_InitSubsystemsProc *xInitSubsystems;
540
+ const char *procName = TCL_INITSUBSYSTEMS_NAME;
541
+ xInitSubsystems = (tcl_InitSubsystemsProc *)dlsym(library, procName + 1);
542
+ if( !xInitSubsystems ){
543
+ xInitSubsystems = (tcl_InitSubsystemsProc *)dlsym(library, procName);
544
+ }
545
+ if( !xInitSubsystems ){
546
+ Th_ErrorMessage(interp,
547
+ "could not locate Tcl_InitSubsystems", (const char *)"", 0);
566548
 dlclose(library);
567549
 return TH_ERROR;
568550
 }
569551
 *pLibrary = library;
570
- *pxFindExecutable = xFindExecutable;
571
- *pxCreateInterp = xCreateInterp;
552
+ *pxInitSubsystems = xInitSubsystems;
572553
 return TH_OK;
573554
 }
574555
 } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
575556
 Th_ErrorMessage(interp,
576557
 "could not load Tcl shared library \"" TCL_LIBRARY_NAME "\"",
577558
 (const char *)"", 0);
578559
 return TH_ERROR;
579560
 #else
580561
 *pLibrary = 0;
581
- *pxFindExecutable = Tcl_FindExecutable;
582
- *pxCreateInterp = Tcl_CreateInterp;
562
+ *pxInitSubsystems = Tcl_InitSubsystems;
583563
 return TH_OK;
584564
 #endif
585565
 }
586566
587
-/*
588
-** Sets the "argv0", "argc", and "argv" script variables in the Tcl interpreter
589
-** based on the supplied command line arguments.
590
- */
591
-static int setTclArguments(
592
- Tcl_Interp *pInterp,
593
- int argc,
594
- char **argv
595
-){
596
- Tcl_Obj *objPtr;
597
- Tcl_Obj *resultObjPtr;
598
- Tcl_Obj *listPtr;
599
- int rc = TCL_OK;
600
- if( argc<=0 || !argv ){
601
- return TCL_OK;
602
- }
603
- objPtr = Tcl_NewStringObj(argv[0], -1);
604
- Tcl_IncrRefCount(objPtr);
605
- resultObjPtr = Tcl_SetVar2Ex(pInterp, "argv0", NULL, objPtr,
606
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
607
- Tcl_DecrRefCount(objPtr);
608
- if( !resultObjPtr ){
609
- return TCL_ERROR;
610
- }
611
- objPtr = Tcl_NewIntObj(argc - 1);
612
- Tcl_IncrRefCount(objPtr);
613
- resultObjPtr = Tcl_SetVar2Ex(pInterp, "argc", NULL, objPtr,
614
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
615
- Tcl_DecrRefCount(objPtr);
616
- if( !resultObjPtr ){
617
- return TCL_ERROR;
618
- }
619
- listPtr = Tcl_NewListObj(0, NULL);
620
- Tcl_IncrRefCount(listPtr);
621
- if( argc>1 ){
622
- while( --argc ){
623
- objPtr = Tcl_NewStringObj(*++argv, -1);
624
- Tcl_IncrRefCount(objPtr);
625
- rc = Tcl_ListObjAppendElement(pInterp, listPtr, objPtr);
626
- Tcl_DecrRefCount(objPtr);
627
- if( rc!=TCL_OK ){
628
- break;
629
- }
630
- }
631
- }
632
- if( rc==TCL_OK ){
633
- resultObjPtr = Tcl_SetVar2Ex(pInterp, "argv", NULL, listPtr,
634
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
635
- if( !resultObjPtr ){
636
- rc = TCL_ERROR;
637
- }
638
- }
639
- Tcl_DecrRefCount(listPtr);
640
- return rc;
641
-}
642
-
643567
 /*
644568
 ** Creates and initializes a Tcl interpreter for use with the specified TH1
645569
 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
646570
 ** by the caller.
647571
 */
@@ -650,11 +574,10 @@
650574
 void *pContext
651575
 ){
652576
 struct TclContext *tclContext = (struct TclContext *)pContext;
653577
 int argc;
654578
 char **argv;
655
- char *argv0 = 0;
656579
 Tcl_Interp *tclInterp;
657580
 char *setup;
658581
659582
 if ( !tclContext ){
660583
 Th_ErrorMessage(interp,
@@ -662,21 +585,16 @@
662585
 return TH_ERROR;
663586
 }
664587
 if ( tclContext->interp ){
665588
 return TH_OK;
666589
 }
667
- if( loadTcl(interp, &tclContext->library, &tclContext->xFindExecutable,
668
- &tclContext->xCreateInterp)!=TH_OK ){
590
+ if( loadTcl(interp, &tclContext->library, &tclContext->xInitSubsystems)!=TH_OK ){
669591
 return TH_ERROR;
670592
 }
671593
 argc = tclContext->argc;
672594
 argv = tclContext->argv;
673
- if( argc>0 && argv ){
674
- argv0 = argv[0];
675
- }
676
- tclContext->xFindExecutable(argv0);
677
- tclInterp = tclContext->xCreateInterp();
595
+ tclInterp = tclContext->xInitSubsystems(TCL_INIT_CREATE_UTF8, argc, argv);
678596
 if( !tclInterp ||
679597
 #if defined(USE_TCL_STUBS)
680598
 !Tcl_InitStubs(tclInterp, "8.4", 0) ||
681599
 #endif
682600
 Tcl_InterpDeleted(tclInterp) ){
@@ -687,17 +605,10 @@
687605
 tclContext->interp = tclInterp;
688606
 if( Tcl_Init(tclInterp)!=TCL_OK ){
689607
 Th_ErrorMessage(interp,
690608
 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
691609
 Tcl_DeleteInterp(tclInterp);
692
- tclContext->interp = tclInterp = 0;
693
- return TH_ERROR;
694
- }
695
- if( setTclArguments(tclInterp, argc, argv)!=TCL_OK ){
696
- Th_ErrorMessage(interp,
697
- "Tcl error setting arguments:", Tcl_GetStringResult(tclInterp), -1);
698
- Tcl_DeleteInterp(tclInterp);
699610
 tclContext->interp = tclInterp = 0;
700611
 return TH_ERROR;
701612
 }
702613
 /* Add the TH1 integration commands to Tcl. */
703614
 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
704615
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -113,27 +113,23 @@
113 # ifndef TCL_MINOR_OFFSET
114 # define TCL_MINOR_OFFSET (8)
115 # endif
116 # endif /* defined(__CYGWIN__) */
117 # endif /* defined(_WIN32) */
118 # ifndef TCL_FINDEXECUTABLE_NAME
119 # define TCL_FINDEXECUTABLE_NAME "_Tcl_FindExecutable"
120 # endif
121 # ifndef TCL_CREATEINTERP_NAME
122 # define TCL_CREATEINTERP_NAME "_Tcl_CreateInterp"
123 # endif
124 #endif /* defined(USE_TCL_STUBS) */
125
126 /*
127 ** The function types for Tcl_FindExecutable and Tcl_CreateInterp are needed
128 ** when the Tcl library is being loaded dynamically by a stubs-enabled
129 ** application (i.e. the inverse of using a stubs-enabled package). These are
130 ** the only Tcl API functions that MUST be called prior to being able to call
131 ** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).
132 */
133 typedef void (tcl_FindExecutableProc) (CONST char * argv0);
134 typedef Tcl_Interp *(tcl_CreateInterpProc) (void);
135
136 /*
137 ** The function types for the "hook" functions to be called before and after a
138 ** TH1 command makes a call to evaluate a Tcl script. If the "pre" function
139 ** returns anything but TH_OK, then evaluation of the Tcl script is skipped and
@@ -187,12 +183,11 @@
187 */
188 struct TclContext {
189 int argc; /* Number of original arguments. */
190 char **argv; /* Full copy of the original arguments. */
191 void *library; /* The Tcl library module handle. */
192 tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
193 tcl_CreateInterpProc *xCreateInterp; /* Tcl_CreateInterp() pointer. */
194 Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
195 char *setup; /* The optional Tcl setup script. */
196 tcl_NotifyProc *xPreEval; /* Optional, called before Tcl_Eval*(). */
197 void *pPreContext; /* Optional, provided to xPreEval(). */
198 tcl_NotifyProc *xPostEval; /* Optional, called after Tcl_Eval*(). */
@@ -525,123 +520,52 @@
525 ** functions.
526 */
527 static int loadTcl(
528 Th_Interp *interp,
529 void **pLibrary,
530 tcl_FindExecutableProc **pxFindExecutable,
531 tcl_CreateInterpProc **pxCreateInterp
532 ){
533 #if defined(USE_TCL_STUBS)
534 char fileName[] = TCL_LIBRARY_NAME;
535 #endif
536 if( !pLibrary || !pxFindExecutable || !pxCreateInterp ){
537 Th_ErrorMessage(interp,
538 "invalid Tcl loader argument(s)", (const char *)"", 0);
539 return TH_ERROR;
540 }
541 #if defined(USE_TCL_STUBS)
542 do {
543 void *library = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
544 if( library ){
545 tcl_FindExecutableProc *xFindExecutable;
546 tcl_CreateInterpProc *xCreateInterp;
547 const char *procName = TCL_FINDEXECUTABLE_NAME;
548 xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName + 1);
549 if( !xFindExecutable ){
550 xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName);
551 }
552 if( !xFindExecutable ){
553 Th_ErrorMessage(interp,
554 "could not locate Tcl_FindExecutable", (const char *)"", 0);
555 dlclose(library);
556 return TH_ERROR;
557 }
558 procName = TCL_CREATEINTERP_NAME;
559 xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName + 1);
560 if( !xCreateInterp ){
561 xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName);
562 }
563 if( !xCreateInterp ){
564 Th_ErrorMessage(interp,
565 "could not locate Tcl_CreateInterp", (const char *)"", 0);
566 dlclose(library);
567 return TH_ERROR;
568 }
569 *pLibrary = library;
570 *pxFindExecutable = xFindExecutable;
571 *pxCreateInterp = xCreateInterp;
572 return TH_OK;
573 }
574 } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
575 Th_ErrorMessage(interp,
576 "could not load Tcl shared library \"" TCL_LIBRARY_NAME "\"",
577 (const char *)"", 0);
578 return TH_ERROR;
579 #else
580 *pLibrary = 0;
581 *pxFindExecutable = Tcl_FindExecutable;
582 *pxCreateInterp = Tcl_CreateInterp;
583 return TH_OK;
584 #endif
585 }
586
587 /*
588 ** Sets the "argv0", "argc", and "argv" script variables in the Tcl interpreter
589 ** based on the supplied command line arguments.
590 */
591 static int setTclArguments(
592 Tcl_Interp *pInterp,
593 int argc,
594 char **argv
595 ){
596 Tcl_Obj *objPtr;
597 Tcl_Obj *resultObjPtr;
598 Tcl_Obj *listPtr;
599 int rc = TCL_OK;
600 if( argc<=0 || !argv ){
601 return TCL_OK;
602 }
603 objPtr = Tcl_NewStringObj(argv[0], -1);
604 Tcl_IncrRefCount(objPtr);
605 resultObjPtr = Tcl_SetVar2Ex(pInterp, "argv0", NULL, objPtr,
606 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
607 Tcl_DecrRefCount(objPtr);
608 if( !resultObjPtr ){
609 return TCL_ERROR;
610 }
611 objPtr = Tcl_NewIntObj(argc - 1);
612 Tcl_IncrRefCount(objPtr);
613 resultObjPtr = Tcl_SetVar2Ex(pInterp, "argc", NULL, objPtr,
614 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
615 Tcl_DecrRefCount(objPtr);
616 if( !resultObjPtr ){
617 return TCL_ERROR;
618 }
619 listPtr = Tcl_NewListObj(0, NULL);
620 Tcl_IncrRefCount(listPtr);
621 if( argc>1 ){
622 while( --argc ){
623 objPtr = Tcl_NewStringObj(*++argv, -1);
624 Tcl_IncrRefCount(objPtr);
625 rc = Tcl_ListObjAppendElement(pInterp, listPtr, objPtr);
626 Tcl_DecrRefCount(objPtr);
627 if( rc!=TCL_OK ){
628 break;
629 }
630 }
631 }
632 if( rc==TCL_OK ){
633 resultObjPtr = Tcl_SetVar2Ex(pInterp, "argv", NULL, listPtr,
634 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
635 if( !resultObjPtr ){
636 rc = TCL_ERROR;
637 }
638 }
639 Tcl_DecrRefCount(listPtr);
640 return rc;
641 }
642
643 /*
644 ** Creates and initializes a Tcl interpreter for use with the specified TH1
645 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
646 ** by the caller.
647 */
@@ -650,11 +574,10 @@
650 void *pContext
651 ){
652 struct TclContext *tclContext = (struct TclContext *)pContext;
653 int argc;
654 char **argv;
655 char *argv0 = 0;
656 Tcl_Interp *tclInterp;
657 char *setup;
658
659 if ( !tclContext ){
660 Th_ErrorMessage(interp,
@@ -662,21 +585,16 @@
662 return TH_ERROR;
663 }
664 if ( tclContext->interp ){
665 return TH_OK;
666 }
667 if( loadTcl(interp, &tclContext->library, &tclContext->xFindExecutable,
668 &tclContext->xCreateInterp)!=TH_OK ){
669 return TH_ERROR;
670 }
671 argc = tclContext->argc;
672 argv = tclContext->argv;
673 if( argc>0 && argv ){
674 argv0 = argv[0];
675 }
676 tclContext->xFindExecutable(argv0);
677 tclInterp = tclContext->xCreateInterp();
678 if( !tclInterp ||
679 #if defined(USE_TCL_STUBS)
680 !Tcl_InitStubs(tclInterp, "8.4", 0) ||
681 #endif
682 Tcl_InterpDeleted(tclInterp) ){
@@ -687,17 +605,10 @@
687 tclContext->interp = tclInterp;
688 if( Tcl_Init(tclInterp)!=TCL_OK ){
689 Th_ErrorMessage(interp,
690 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
691 Tcl_DeleteInterp(tclInterp);
692 tclContext->interp = tclInterp = 0;
693 return TH_ERROR;
694 }
695 if( setTclArguments(tclInterp, argc, argv)!=TCL_OK ){
696 Th_ErrorMessage(interp,
697 "Tcl error setting arguments:", Tcl_GetStringResult(tclInterp), -1);
698 Tcl_DeleteInterp(tclInterp);
699 tclContext->interp = tclInterp = 0;
700 return TH_ERROR;
701 }
702 /* Add the TH1 integration commands to Tcl. */
703 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
704
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -113,27 +113,23 @@
113 # ifndef TCL_MINOR_OFFSET
114 # define TCL_MINOR_OFFSET (8)
115 # endif
116 # endif /* defined(__CYGWIN__) */
117 # endif /* defined(_WIN32) */
118 # ifndef TCL_INITSUBSYSTEMS_NAME
119 # define TCL_INITSUBSYSTEMS_NAME "_Tcl_InitSubsystems"
 
 
 
120 # endif
121 #endif /* defined(USE_TCL_STUBS) */
122
123 /*
124 ** The function types for Tcl_InitSubsystems are needed
125 ** when the Tcl library is being loaded dynamically by a stubs-enabled
126 ** application (i.e. the inverse of using a stubs-enabled package). These are
127 ** the only Tcl API functions that MUST be called prior to being able to call
128 ** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).
129 */
130 typedef Tcl_Interp *(tcl_InitSubsystemsProc) (int flags, ...);
 
131
132 /*
133 ** The function types for the "hook" functions to be called before and after a
134 ** TH1 command makes a call to evaluate a Tcl script. If the "pre" function
135 ** returns anything but TH_OK, then evaluation of the Tcl script is skipped and
@@ -187,12 +183,11 @@
183 */
184 struct TclContext {
185 int argc; /* Number of original arguments. */
186 char **argv; /* Full copy of the original arguments. */
187 void *library; /* The Tcl library module handle. */
188 tcl_InitSubsystemsProc *xInitSubsystems; /* Tcl_FindExecutable() pointer. */
 
189 Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
190 char *setup; /* The optional Tcl setup script. */
191 tcl_NotifyProc *xPreEval; /* Optional, called before Tcl_Eval*(). */
192 void *pPreContext; /* Optional, provided to xPreEval(). */
193 tcl_NotifyProc *xPostEval; /* Optional, called after Tcl_Eval*(). */
@@ -525,123 +520,52 @@
520 ** functions.
521 */
522 static int loadTcl(
523 Th_Interp *interp,
524 void **pLibrary,
525 tcl_InitSubsystemsProc **pxInitSubsystems
 
526 ){
527 #if defined(USE_TCL_STUBS)
528 char fileName[] = TCL_LIBRARY_NAME;
529 #endif
530 if( !pLibrary || !pxInitSubsystems ){
531 Th_ErrorMessage(interp,
532 "invalid Tcl loader argument(s)", (const char *)"", 0);
533 return TH_ERROR;
534 }
535 #if defined(USE_TCL_STUBS)
536 do {
537 void *library = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
538 if( library ){
539 tcl_InitSubsystemsProc *xInitSubsystems;
540 const char *procName = TCL_INITSUBSYSTEMS_NAME;
541 xInitSubsystems = (tcl_InitSubsystemsProc *)dlsym(library, procName + 1);
542 if( !xInitSubsystems ){
543 xInitSubsystems = (tcl_InitSubsystemsProc *)dlsym(library, procName);
544 }
545 if( !xInitSubsystems ){
546 Th_ErrorMessage(interp,
547 "could not locate Tcl_InitSubsystems", (const char *)"", 0);
 
 
 
 
 
 
 
 
 
 
 
 
548 dlclose(library);
549 return TH_ERROR;
550 }
551 *pLibrary = library;
552 *pxInitSubsystems = xInitSubsystems;
 
553 return TH_OK;
554 }
555 } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
556 Th_ErrorMessage(interp,
557 "could not load Tcl shared library \"" TCL_LIBRARY_NAME "\"",
558 (const char *)"", 0);
559 return TH_ERROR;
560 #else
561 *pLibrary = 0;
562 *pxInitSubsystems = Tcl_InitSubsystems;
 
563 return TH_OK;
564 #endif
565 }
566
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
567 /*
568 ** Creates and initializes a Tcl interpreter for use with the specified TH1
569 ** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
570 ** by the caller.
571 */
@@ -650,11 +574,10 @@
574 void *pContext
575 ){
576 struct TclContext *tclContext = (struct TclContext *)pContext;
577 int argc;
578 char **argv;
 
579 Tcl_Interp *tclInterp;
580 char *setup;
581
582 if ( !tclContext ){
583 Th_ErrorMessage(interp,
@@ -662,21 +585,16 @@
585 return TH_ERROR;
586 }
587 if ( tclContext->interp ){
588 return TH_OK;
589 }
590 if( loadTcl(interp, &tclContext->library, &tclContext->xInitSubsystems)!=TH_OK ){
 
591 return TH_ERROR;
592 }
593 argc = tclContext->argc;
594 argv = tclContext->argv;
595 tclInterp = tclContext->xInitSubsystems(TCL_INIT_CREATE_UTF8, argc, argv);
 
 
 
 
596 if( !tclInterp ||
597 #if defined(USE_TCL_STUBS)
598 !Tcl_InitStubs(tclInterp, "8.4", 0) ||
599 #endif
600 Tcl_InterpDeleted(tclInterp) ){
@@ -687,17 +605,10 @@
605 tclContext->interp = tclInterp;
606 if( Tcl_Init(tclInterp)!=TCL_OK ){
607 Th_ErrorMessage(interp,
608 "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
609 Tcl_DeleteInterp(tclInterp);
 
 
 
 
 
 
 
610 tclContext->interp = tclInterp = 0;
611 return TH_ERROR;
612 }
613 /* Add the TH1 integration commands to Tcl. */
614 Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
615

Keyboard Shortcuts

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