Implemented TIP #264 - Tk_Interp

6 files changed, 66 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index d98e78b..18d5f08 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2006-10-08  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* generic/tkWindow.c:  Implemented tip #264 - Tk_Interp function.
+	* doc/WindowId.3:      Documented Tk_Interp.
+	* generic/tk.decls:    Added to the stubs interface and 
+	* generic/tkDecls.h:   regenerated.
+	* generic/tkStubsInit.c:
+
 2006-10-05  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* unix/tkUnixFont.c (Ucs2beToUtfProc, UtfToUcs2beProc):
diff --git a/doc/WindowId.3 b/doc/WindowId.3
index c34fff3..58a8315 100644
--- a/doc/WindowId.3
+++ b/doc/WindowId.3
@@ -5,13 +5,18 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: WindowId.3,v 1.8 2004/03/25 12:12:36 vincentdarley Exp $
+'\" RCS: @(#) $Id: WindowId.3,v 1.9 2006/10/08 21:47:11 patthoyts Exp $
 '\" 
 .so man.macros
 .TH Tk_WindowId 3 "8.4" Tk "Tk Library Procedures"
 .BS
 .SH NAME
-Tk_WindowId, Tk_Parent, Tk_Display, Tk_DisplayName, Tk_ScreenNumber, Tk_Screen, Tk_X, Tk_Y, Tk_Width, Tk_Height, Tk_Changes, Tk_Attributes, Tk_IsContainer, Tk_IsEmbedded, Tk_IsMapped, Tk_IsTopLevel, Tk_ReqWidth, Tk_ReqHeight, Tk_MinReqWidth, Tk_MinReqHeight, Tk_InternalBorderLeft, Tk_InternalBorderRight, Tk_InternalBorderTop, Tk_InternalBorderBottom, Tk_Visual, Tk_Depth, Tk_Colormap  \- retrieve information from Tk's local data structure
+Tk_WindowId, Tk_Parent, Tk_Display, Tk_DisplayName, Tk_ScreenNumber,
+Tk_Screen, Tk_X, Tk_Y, Tk_Width, Tk_Height, Tk_Changes, Tk_Attributes,
+Tk_IsContainer, Tk_IsEmbedded, Tk_IsMapped, Tk_IsTopLevel,
+Tk_ReqWidth, Tk_ReqHeight, Tk_MinReqWidth, Tk_MinReqHeight,
+Tk_InternalBorderLeft, Tk_InternalBorderRight, Tk_InternalBorderTop,
+Tk_InternalBorderBottom, Tk_Visual, Tk_Depth, Tk_Colormap, Tk_Interp  \- retrieve information from Tk's local data structure
 .SH SYNOPSIS
 .nf
 \fB#include <tk.h>\fR
@@ -96,6 +101,9 @@ int
 .sp
 Colormap
 \fBTk_Colormap\fR(\fItkwin\fR)
+.sp
+Tcl_Interp *
+\fBTk_Interp\fR(\fItkwin\fR)
 .SH ARGUMENTS
 .AS Tk_Window tkwin
 .AP Tk_Window tkwin in
@@ -118,6 +126,9 @@ yet.
 \fItkwin\fR.  The parent is the token that was specified when
 \fItkwin\fR was created, or NULL for main windows.
 .PP
+\fBTk_Interp\fR returns the Tcl interpreter associated with a
+\fItkwin\fR or NULL if there is an error.
+.PP
 \fBTk_Display\fR returns a pointer to the Xlib display structure
 corresponding to \fItkwin\fR.  \fBTk_DisplayName\fR returns an
 ASCII string identifying \fItkwin\fR's display.  \fBTk_ScreenNumber\fR
diff --git a/generic/tk.decls b/generic/tk.decls
index 98dfcd9..74786b2 100644
--- a/generic/tk.decls
+++ b/generic/tk.decls
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tk.decls,v 1.28 2006/02/09 19:08:51 das Exp $
+# RCS: @(#) $Id: tk.decls,v 1.29 2006/10/08 21:47:11 patthoyts Exp $
 
 library tk
 
@@ -1270,6 +1270,11 @@ declare 270 generic {
     void Tk_ResetUserInactiveTime(Display *dpy)
 }
 
+# TIP #264
+declare 271 generic {
+    Tcl_Interp * Tk_Interp (Tk_Window tkwin)
+}
+
 # Define the platform specific public Tk interface.  These functions are
 # only available on the designated platform.
 
diff --git a/generic/tkDecls.h b/generic/tkDecls.h
index a7cbebd..6d80d84 100644
--- a/generic/tkDecls.h
+++ b/generic/tkDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkDecls.h,v 1.26 2005/05/29 06:47:04 das Exp $
+ * RCS: @(#) $Id: tkDecls.h,v 1.27 2006/10/08 21:47:12 patthoyts Exp $
  */
 
 #ifndef _TKDECLS
@@ -1745,6 +1745,11 @@ EXTERN long		Tk_GetUserInactiveTime _ANSI_ARGS_((Display * dpy));
 /* 270 */
 EXTERN void		Tk_ResetUserInactiveTime _ANSI_ARGS_((Display * dpy));
 #endif
+#ifndef Tk_Interp_TCL_DECLARED
+#define Tk_Interp_TCL_DECLARED
+/* 271 */
+EXTERN Tcl_Interp *	Tk_Interp _ANSI_ARGS_((Tk_Window tkwin));
+#endif
 
 typedef struct TkStubHooks {
     struct TkPlatStubs *tkPlatStubs;
@@ -2028,6 +2033,7 @@ typedef struct TkStubs {
     int (*tk_PhotoSetSize) _ANSI_ARGS_((Tcl_Interp * interp, Tk_PhotoHandle handle, int width, int height)); /* 268 */
     long (*tk_GetUserInactiveTime) _ANSI_ARGS_((Display * dpy)); /* 269 */
     void (*tk_ResetUserInactiveTime) _ANSI_ARGS_((Display * dpy)); /* 270 */
+    Tcl_Interp * (*tk_Interp) _ANSI_ARGS_((Tk_Window tkwin)); /* 271 */
 } TkStubs;
 
 #ifdef __cplusplus
@@ -3122,6 +3128,10 @@ extern TkStubs *tkStubsPtr;
 #define Tk_ResetUserInactiveTime \
 	(tkStubsPtr->tk_ResetUserInactiveTime) /* 270 */
 #endif
+#ifndef Tk_Interp
+#define Tk_Interp \
+	(tkStubsPtr->tk_Interp) /* 271 */
+#endif
 
 #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
 
diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c
index a8f2ba2..61a280a 100644
--- a/generic/tkStubInit.c
+++ b/generic/tkStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkStubInit.c,v 1.55 2005/12/09 00:48:54 das Exp $
+ * RCS: @(#) $Id: tkStubInit.c,v 1.56 2006/10/08 21:47:12 patthoyts Exp $
  */
 
 #include "tkInt.h"
@@ -938,6 +938,7 @@ TkStubs tkStubs = {
     Tk_PhotoSetSize, /* 268 */
     Tk_GetUserInactiveTime, /* 269 */
     Tk_ResetUserInactiveTime, /* 270 */
+    Tk_Interp, /* 271 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index b73ea91..25624f9 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWindow.c,v 1.77 2006/09/22 19:02:07 andreas_kupries Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.78 2006/10/08 21:47:12 patthoyts Exp $
  */
 
 #include "tkPort.h"
@@ -2382,6 +2382,31 @@ Tk_DisplayName(tkwin)
 /*
  *----------------------------------------------------------------------
  *
+ * Tk_Interp --
+ *
+ *	Get the Tcl interpreter from a Tk window.
+ *
+ * Results:
+ *	A pointer to the interpreter or NULL.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tk_Interp(Tk_Window tkwin)
+{
+    if (tkwin != NULL && ((TkWindow *)tkwin)->mainPtr != NULL) {
+	return ((TkWindow *)tkwin)->mainPtr->interp;
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * UnlinkWindow --
  *
  *	This function removes a window from the childList of its parent.