Update of /cvsroot/q-lang/q/modules/tk
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv27613/modules/tk
Modified Files:
tk.c
Log Message:
compatibility with newer Tcl/Tk versions
Index: tk.c
===================================================================
RCS file: /cvsroot/q-lang/q/modules/tk/tk.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** tk.c 27 Feb 2006 07:22:59 -0000 1.11
--- tk.c 10 May 2015 16:25:30 -0000 1.12
***************
*** 472,476 ****
}
! static void set_result(char *s)
{
tld_result = malloc(strlen(s)+1);
--- 472,487 ----
}
! static const char *get_result(Tcl_Interp* interp)
! {
! return Tcl_GetStringResult(interp);
! }
!
! static int check_result(Tcl_Interp* interp)
! {
! const char *res = Tcl_GetStringResult(interp);
! return res && *res;
! }
!
! static void set_result(const char *s)
{
tld_result = malloc(strlen(s)+1);
***************
*** 488,493 ****
strcpy(cmd, s);
status = Tcl_Eval(tld_interp, cmd);
! if (tld_interp && tld_interp->result && *tld_interp->result)
! set_result(tld_interp->result);
else if (status == TCL_BREAK)
set_result("invoked \"break\" outside of a loop");
--- 499,504 ----
strcpy(cmd, s);
status = Tcl_Eval(tld_interp, cmd);
! if (tld_interp && check_result(tld_interp))
! set_result(get_result(tld_interp));
else if (status == TCL_BREAK)
set_result("invoked \"break\" outside of a loop");
***************
*** 517,522 ****
#endif
if (Tcl_Init(tld_interp) != TCL_OK) {
! if (tld_interp->result && *tld_interp->result)
! set_result(tld_interp->result);
else
set_result("error initializing Tcl");
--- 528,533 ----
#endif
if (Tcl_Init(tld_interp) != TCL_OK) {
! if (check_result(tld_interp))
! set_result(get_result(tld_interp));
else
set_result("error initializing Tcl");
***************
*** 534,539 ****
Tcl_SetVar2(tld_interp, "env", "DISPLAY", getenv("DISPLAY"), TCL_GLOBAL_ONLY);
if (Tk_Init(tld_interp) != TCL_OK) {
! if (tld_interp->result && *tld_interp->result)
! set_result(tld_interp->result);
else
set_result("error initializing Tk");
--- 545,550 ----
Tcl_SetVar2(tld_interp, "env", "DISPLAY", getenv("DISPLAY"), TCL_GLOBAL_ONLY);
if (Tk_Init(tld_interp) != TCL_OK) {
! if (check_result(tld_interp))
! set_result(get_result(tld_interp));
else
set_result("error initializing Tk");
|
