Fossil SCM

Cleanup use of Tcl integration for launching the Tk diff viewer internally.

mistachkin 2014-02-04 20:30 trunk
Commit fe9990adc72f76d759f1df450965c4f33155fd60
Parent 8e110293edfa93c…
3 files changed +3 -2 +6 -3 +20 -8
~ src/diffcmd.c ~ src/th.h ~ src/th_tcl.c
M src/diffcmd.c
+3 -2
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -947,12 +947,13 @@
947947
 if( zTempFile ){
948948
 blob_write_to_file(&script, zTempFile);
949949
 fossil_print("To see diff, run: tclsh \"%s\"\n", zTempFile);
950950
 }else{
951951
 #if defined(FOSSIL_ENABLE_TCL)
952
- Th_FossilInit(TH_INIT_DEFAULT | TH_INIT_FORCE_TCL);
953
- if (runTclGui(g.interp, &g.tcl, blob_str(&script)) == TCL_OK){
952
+ Th_FossilInit(TH_INIT_DEFAULT);
953
+ if( evaluateTclWithEvents(
954
+ g.interp, &g.tcl, blob_str(&script), blob_size(&script), 1)==TCL_OK ){
954955
 blob_reset(&script);
955956
 return;
956957
 }
957958
 /* If evaluation of the script fails, the reason could be that Tk
958959
 * cannot be found by the built-in Tcl, or that Tcl cannot be
959960
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -947,12 +947,13 @@
947 if( zTempFile ){
948 blob_write_to_file(&script, zTempFile);
949 fossil_print("To see diff, run: tclsh \"%s\"\n", zTempFile);
950 }else{
951 #if defined(FOSSIL_ENABLE_TCL)
952 Th_FossilInit(TH_INIT_DEFAULT | TH_INIT_FORCE_TCL);
953 if (runTclGui(g.interp, &g.tcl, blob_str(&script)) == TCL_OK){
 
954 blob_reset(&script);
955 return;
956 }
957 /* If evaluation of the script fails, the reason could be that Tk
958 * cannot be found by the built-in Tcl, or that Tcl cannot be
959
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -947,12 +947,13 @@
947 if( zTempFile ){
948 blob_write_to_file(&script, zTempFile);
949 fossil_print("To see diff, run: tclsh \"%s\"\n", zTempFile);
950 }else{
951 #if defined(FOSSIL_ENABLE_TCL)
952 Th_FossilInit(TH_INIT_DEFAULT);
953 if( evaluateTclWithEvents(
954 g.interp, &g.tcl, blob_str(&script), blob_size(&script), 1)==TCL_OK ){
955 blob_reset(&script);
956 return;
957 }
958 /* If evaluation of the script fails, the reason could be that Tk
959 * cannot be found by the built-in Tcl, or that Tcl cannot be
960
M src/th.h
+6 -3
--- src/th.h
+++ src/th.h
@@ -157,13 +157,16 @@
157157
 int th_register_sqlite(Th_Interp *interp); /* th_sqlite.c */
158158
 int th_register_vfs(Th_Interp *interp); /* th_vfs.c */
159159
 int th_register_testvfs(Th_Interp *interp); /* th_testvfs.c */
160160
161161
 #ifdef FOSSIL_ENABLE_TCL
162
-int th_register_tcl(Th_Interp *interp, void *pContext); /* th_tcl.c */
163
-int unloadTcl(Th_Interp *interp, void *pContext); /* th_tcl.c */
164
-int runTclGui(Th_Interp *, void *, const char *); /* th_tcl.c */
162
+/*
163
+** Interfaces to the full Tcl core library from "th_tcl.c".
164
+*/
165
+int th_register_tcl(Th_Interp *, void *);
166
+int unloadTcl(Th_Interp *, void *);
167
+int evaluateTclWithEvents(Th_Interp *, void *, const char *, int, int);
165168
 #endif
166169
167170
 /*
168171
 ** General purpose hash table from th_lang.c.
169172
 */
170173
--- src/th.h
+++ src/th.h
@@ -157,13 +157,16 @@
157 int th_register_sqlite(Th_Interp *interp); /* th_sqlite.c */
158 int th_register_vfs(Th_Interp *interp); /* th_vfs.c */
159 int th_register_testvfs(Th_Interp *interp); /* th_testvfs.c */
160
161 #ifdef FOSSIL_ENABLE_TCL
162 int th_register_tcl(Th_Interp *interp, void *pContext); /* th_tcl.c */
163 int unloadTcl(Th_Interp *interp, void *pContext); /* th_tcl.c */
164 int runTclGui(Th_Interp *, void *, const char *); /* th_tcl.c */
 
 
 
165 #endif
166
167 /*
168 ** General purpose hash table from th_lang.c.
169 */
170
--- src/th.h
+++ src/th.h
@@ -157,13 +157,16 @@
157 int th_register_sqlite(Th_Interp *interp); /* th_sqlite.c */
158 int th_register_vfs(Th_Interp *interp); /* th_vfs.c */
159 int th_register_testvfs(Th_Interp *interp); /* th_testvfs.c */
160
161 #ifdef FOSSIL_ENABLE_TCL
162 /*
163 ** Interfaces to the full Tcl core library from "th_tcl.c".
164 */
165 int th_register_tcl(Th_Interp *, void *);
166 int unloadTcl(Th_Interp *, void *);
167 int evaluateTclWithEvents(Th_Interp *, void *, const char *, int, int);
168 #endif
169
170 /*
171 ** General purpose hash table from th_lang.c.
172 */
173
M src/th_tcl.c
+20 -8
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -768,25 +768,37 @@
768768
 Tcl_DecrRefCount(listPtr);
769769
 return rc;
770770
 }
771771
772772
 /*
773
-** Run a Tcl script. If the script succeeds, start the main loop until
774
-** there is no more work to be done or the script calls "exit".
773
+** Evaluate a Tcl script, creating the Tcl interpreter if necessary. If the
774
+** Tcl script succeeds, start a Tcl event loop until there are no more events
775
+** remaining to process -OR- the script calls [exit]. If the bWait argument
776
+** is zero, only process events that are already in the queue; otherwise,
777
+** process events until the script terminates the Tcl event loop.
775778
 */
776
-int runTclGui(Th_Interp *interp, void *pContext, const char *script){
779
+int evaluateTclWithEvents(
780
+ Th_Interp *interp,
781
+ void *pContext,
782
+ const char *zScript,
783
+ int nScript,
784
+ int bWait
785
+){
777786
 struct TclContext *tclContext = (struct TclContext *)pContext;
787
+ Tcl_Interp *tclInterp;
778788
 int rc;
789
+ int flags = TCL_ALL_EVENTS;
779790
780791
 if( createTclInterp(interp, pContext)!=TH_OK ){
781792
 return TH_ERROR;
782793
 }
783
- rc = Tcl_EvalEx(tclContext->interp, script, -1, TCL_EVAL_GLOBAL);
784
- if (rc == TCL_OK){
785
- while (Tcl_DoOneEvent(0)) {
786
- /* do nothing */
787
- }
794
+ tclInterp = tclContext->interp;
795
+ rc = Tcl_EvalEx(tclInterp, zScript, nScript, TCL_EVAL_GLOBAL);
796
+ if( rc!=TCL_OK ) return rc;
797
+ if( !bWait ) flags |= TCL_DONT_WAIT;
798
+ while( Tcl_DoOneEvent(flags) ){
799
+ /* do nothing */
788800
 }
789801
 return rc;
790802
 }
791803
792804
 /*
793805
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -768,25 +768,37 @@
768 Tcl_DecrRefCount(listPtr);
769 return rc;
770 }
771
772 /*
773 ** Run a Tcl script. If the script succeeds, start the main loop until
774 ** there is no more work to be done or the script calls "exit".
 
 
 
775 */
776 int runTclGui(Th_Interp *interp, void *pContext, const char *script){
 
 
 
 
 
 
777 struct TclContext *tclContext = (struct TclContext *)pContext;
 
778 int rc;
 
779
780 if( createTclInterp(interp, pContext)!=TH_OK ){
781 return TH_ERROR;
782 }
783 rc = Tcl_EvalEx(tclContext->interp, script, -1, TCL_EVAL_GLOBAL);
784 if (rc == TCL_OK){
785 while (Tcl_DoOneEvent(0)) {
786 /* do nothing */
787 }
 
788 }
789 return rc;
790 }
791
792 /*
793
--- src/th_tcl.c
+++ src/th_tcl.c
@@ -768,25 +768,37 @@
768 Tcl_DecrRefCount(listPtr);
769 return rc;
770 }
771
772 /*
773 ** Evaluate a Tcl script, creating the Tcl interpreter if necessary. If the
774 ** Tcl script succeeds, start a Tcl event loop until there are no more events
775 ** remaining to process -OR- the script calls [exit]. If the bWait argument
776 ** is zero, only process events that are already in the queue; otherwise,
777 ** process events until the script terminates the Tcl event loop.
778 */
779 int evaluateTclWithEvents(
780 Th_Interp *interp,
781 void *pContext,
782 const char *zScript,
783 int nScript,
784 int bWait
785 ){
786 struct TclContext *tclContext = (struct TclContext *)pContext;
787 Tcl_Interp *tclInterp;
788 int rc;
789 int flags = TCL_ALL_EVENTS;
790
791 if( createTclInterp(interp, pContext)!=TH_OK ){
792 return TH_ERROR;
793 }
794 tclInterp = tclContext->interp;
795 rc = Tcl_EvalEx(tclInterp, zScript, nScript, TCL_EVAL_GLOBAL);
796 if( rc!=TCL_OK ) return rc;
797 if( !bWait ) flags |= TCL_DONT_WAIT;
798 while( Tcl_DoOneEvent(flags) ){
799 /* do nothing */
800 }
801 return rc;
802 }
803
804 /*
805

Keyboard Shortcuts

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