summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tkBusy.c56
-rw-r--r--generic/tkCmds.c529
-rw-r--r--generic/tkInt.h21
-rw-r--r--generic/tkUtil.c85
-rw-r--r--generic/tkWindow.c138
6 files changed, 504 insertions, 332 deletions
diff --git a/ChangeLog b/ChangeLog
index 06f7c3b..9d0deb3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,11 @@
2008-12-10 Daniel Steffen <das@users.sourceforge.net>
- * macosx/tkMacOSXInit.c (TkpInit): unconditionally show Tk console
+ * generic/tkInt.h: Turn [tk] into an ensemble (thoyts, steffen)
+ * generic/tkBusy.c:
+ * generic/tkCmds.c:
+ * generic/tkWindow.c:
+
+ * macosx/tkMacOSXInit.c (TkpInit): Unconditionally show Tk console
if TK_CONSOLE env var is set.
2008-12-09 Don Porter <dgp@users.sourceforge.net>
diff --git a/generic/tkBusy.c b/generic/tkBusy.c
index 46c647c..4a6c5cb 100644
--- a/generic/tkBusy.c
+++ b/generic/tkBusy.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: tkBusy.c,v 1.5 2008/10/30 23:18:59 nijtmans Exp $
+ * RCS: @(#) $Id: tkBusy.c,v 1.6 2008/12/10 00:34:51 das Exp $
*/
#include "tkInt.h"
@@ -799,8 +799,8 @@ Tk_BusyObjCmd(
BUSY_STATUS
};
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "options ?arg arg ...?");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "options ?arg arg ...?");
return TCL_ERROR;
}
@@ -808,31 +808,31 @@ Tk_BusyObjCmd(
* [tk busy <window>] command shortcut.
*/
- if (Tcl_GetString(objv[2])[0] == '.') {
- if (objc%2 != 1) {
- Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?");
+ if (Tcl_GetString(objv[1])[0] == '.') {
+ if (objc%2 == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?option value ...?");
return TCL_ERROR;
}
- return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3);
+ return HoldBusy(busyTablePtr, interp, objv[1], objc-2, objv+2);
}
- if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case BUSY_CGET:
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 3, objv, "window option");
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window option");
return TCL_ERROR;
}
- busyPtr = GetBusy(interp, busyTablePtr, objv[3]);
+ busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
if (busyPtr == NULL) {
return TCL_ERROR;
}
Tcl_Preserve(busyPtr);
objPtr = Tk_GetOptionValue(interp, (char *) busyPtr,
- busyPtr->optionTable, objv[4], busyPtr->tkBusy);
+ busyPtr->optionTable, objv[3], busyPtr->tkBusy);
if (objPtr == NULL) {
result = TCL_ERROR;
} else {
@@ -842,18 +842,18 @@ Tk_BusyObjCmd(
return result;
case BUSY_CONFIGURE:
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "window ?option? ?value ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?option? ?value ...?");
return TCL_ERROR;
}
- busyPtr = GetBusy(interp, busyTablePtr, objv[3]);
+ busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
if (busyPtr == NULL) {
return TCL_ERROR;
}
Tcl_Preserve(busyPtr);
- if (objc <= 5) {
+ if (objc <= 4) {
objPtr = Tk_GetOptionInfo(interp, (char *) busyPtr,
- busyPtr->optionTable, (objc == 5) ? objv[4] : NULL,
+ busyPtr->optionTable, (objc == 4) ? objv[3] : NULL,
busyPtr->tkBusy);
if (objPtr == NULL) {
result = TCL_ERROR;
@@ -861,7 +861,7 @@ Tk_BusyObjCmd(
Tcl_SetObjResult(interp, objPtr);
}
} else {
- result = ConfigureBusy(interp, busyPtr, objc-4, objv+4);
+ result = ConfigureBusy(interp, busyPtr, objc-3, objv+3);
}
Tcl_Release(busyPtr);
return result;
@@ -869,7 +869,7 @@ Tk_BusyObjCmd(
case BUSY_CURRENT: {
Tcl_HashEntry *hPtr;
Tcl_HashSearch cursor;
- const char *pattern = (objc == 4 ? Tcl_GetString(objv[3]) : NULL);
+ const char *pattern = (objc == 3 ? Tcl_GetString(objv[2]) : NULL);
objPtr = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(busyTablePtr, &cursor); hPtr != NULL;
@@ -886,11 +886,11 @@ Tk_BusyObjCmd(
}
case BUSY_FORGET:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "window");
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
return TCL_ERROR;
}
- busyPtr = GetBusy(interp, busyTablePtr, objv[3]);
+ busyPtr = GetBusy(interp, busyTablePtr, objv[2]);
if (busyPtr == NULL) {
return TCL_ERROR;
}
@@ -899,19 +899,19 @@ Tk_BusyObjCmd(
return TCL_OK;
case BUSY_HOLD:
- if (objc < 4 || objc%2 == 1) {
- Tcl_WrongNumArgs(interp, 3, objv, "window ?option value ...?");
+ if (objc < 3 || objc%2 != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?");
return TCL_ERROR;
}
- return HoldBusy(busyTablePtr, interp, objv[3], objc-4, objv+4);
+ return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3);
case BUSY_STATUS:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 3, objv, "window");
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- GetBusy(interp, busyTablePtr, objv[3]) != NULL));
+ GetBusy(interp, busyTablePtr, objv[2]) != NULL));
return TCL_OK;
}
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index 6038f17..49d1f38 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.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: tkCmds.c,v 1.47 2008/10/30 23:18:59 nijtmans Exp $
+ * RCS: @(#) $Id: tkCmds.c,v 1.48 2008/12/10 00:34:51 das Exp $
*/
#include "tkInt.h"
@@ -36,6 +36,35 @@ static void WaitVisibilityProc(ClientData clientData,
XEvent *eventPtr);
static void WaitWindowProc(ClientData clientData,
XEvent *eventPtr);
+static int AppnameCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int CaretCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int InactiveCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int ScalingCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int UseinputmethodsCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+static int WindowingsystemCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+
+/*
+ * Table of tk subcommand names and implementations.
+ */
+
+static const TkEnsemble tkCmdMap[] = {
+ {"appname", AppnameCmd },
+ {"busy", Tk_BusyObjCmd },
+ {"caret", CaretCmd },
+ {"inactive", InactiveCmd },
+ {"scaling", ScalingCmd },
+ {"useinputmethods", UseinputmethodsCmd },
+ {"windowingsystem", WindowingsystemCmd },
+ {NULL}
+};
/*
*----------------------------------------------------------------------
@@ -587,12 +616,36 @@ Tk_RaiseObjCmd(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitTkCmd --
+ *
+ * Set up the tk ensemble.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TkInitTkCmd(Tcl_Interp *interp, ClientData clientData)
+{
+ TkMakeEnsemble(interp, "::", "tk", clientData, tkCmdMap);
+ return TCL_OK;
+}
+
+/*
*----------------------------------------------------------------------
*
- * Tk_TkObjCmd --
+ * AppnameCmd, CaretCmd, ScalingCmd, UseinputmethodsCmd,
+ * WindowingsystemCmd, InactiveCmd --
*
- * This function is invoked to process the "tk" Tcl command. See the user
- * documentation for details on what it does.
+ * These functions are invoked to process the "tk" ensemble subcommands.
+ * See the user documentation for details on what they do.
*
* Results:
* A standard Tcl result.
@@ -604,286 +657,300 @@ Tk_RaiseObjCmd(
*/
int
-Tk_TkObjCmd(
+AppnameCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int index;
Tk_Window tkwin = clientData;
- static const char *const optionStrings[] = {
- "appname", "busy", "caret", "inactive", "scaling", "useinputmethods",
- "windowingsystem", NULL
+ TkWindow *winPtr;
+ char *string;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "appname not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) tkwin;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?newName?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ string = Tcl_GetString(objv[1]);
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
+ }
+ Tcl_AppendResult(interp, winPtr->nameUid, NULL);
+ return TCL_OK;
+}
+
+int
+CaretCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window tkwin = clientData;
+ int index;
+ Tcl_Obj *objPtr;
+ TkCaret *caretPtr;
+ Tk_Window window;
+ static const char *const caretStrings[] = {
+ "-x", "-y", "-height", NULL
};
- enum options {
- TK_APPNAME, TK_BUSY, TK_CARET, TK_INACTIVE, TK_SCALING, TK_USE_IM,
- TK_WINDOWINGSYSTEM
+ enum caretOptions {
+ TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT
};
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
+ if ((objc < 2) || ((objc > 3) && !!(objc & 1))) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "window ?-x x? ?-y y? ?-height height?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
- &index) != TCL_OK) {
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin);
+ if (window == NULL) {
return TCL_ERROR;
}
+ caretPtr = &(((TkWindow *) window)->dispPtr->caret);
+ if (objc == 2) {
+ /*
+ * Return all the current values
+ */
- switch ((enum options) index) {
- case TK_APPNAME: {
- TkWindow *winPtr;
- char *string;
-
- if (Tcl_IsSafe(interp)) {
- Tcl_SetResult(interp,
- "appname not accessible in a safe interpreter",
- TCL_STATIC);
- return TCL_ERROR;
- }
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-height", 7));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->height));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-x", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->x));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("-y", 2));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewIntObj(caretPtr->y));
+ Tcl_SetObjResult(interp, objPtr);
+ } else if (objc == 3) {
+ int value;
- winPtr = (TkWindow *) tkwin;
+ /*
+ * Return the current value of the selected option
+ */
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
+ if (Tcl_GetIndexFromObj(interp, objv[2], caretStrings,
+ "caret option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
- if (objc == 3) {
- string = Tcl_GetString(objv[2]);
- winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
- }
- Tcl_AppendResult(interp, winPtr->nameUid, NULL);
- break;
- }
- case TK_BUSY:
- return Tk_BusyObjCmd(clientData, interp, objc, objv);
- case TK_CARET: {
- Tcl_Obj *objPtr;
- TkCaret *caretPtr;
- Tk_Window window;
- static const char *const caretStrings[] = {
- "-x", "-y", "-height", NULL
- };
- enum caretOptions {
- TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT
- };
-
- if ((objc < 3) || ((objc > 4) && !(objc & 1))) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "window ?-x x? ?-y y? ?-height height?");
- return TCL_ERROR;
+ if (index == TK_CARET_X) {
+ value = caretPtr->x;
+ } else if (index == TK_CARET_Y) {
+ value = caretPtr->y;
+ } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
+ value = caretPtr->height;
}
- window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
- if (window == NULL) {
- return TCL_ERROR;
- }
- caretPtr = &(((TkWindow *) window)->dispPtr->caret);
- if (objc == 3) {
- /*
- * Return all the current values
- */
-
- objPtr = Tcl_NewObj();
- Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewStringObj("-height", 7));
- Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewIntObj(caretPtr->height));
- Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewStringObj("-x", 2));
- Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewIntObj(caretPtr->x));
- Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewStringObj("-y", 2));
- Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewIntObj(caretPtr->y));
- Tcl_SetObjResult(interp, objPtr);
- } else if (objc == 4) {
- int value;
-
- /*
- * Return the current value of the selected option
- */
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ } else {
+ int i, value, x = 0, y = 0, height = -1;
- if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings,
- "caret option", 0, &index) != TCL_OK) {
+ for (i = 2; i < objc; i += 2) {
+ if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
+ "caret option", 0, &index) != TCL_OK) ||
+ Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) {
return TCL_ERROR;
}
if (index == TK_CARET_X) {
- value = caretPtr->x;
+ x = value;
} else if (index == TK_CARET_Y) {
- value = caretPtr->y;
+ y = value;
} else /* if (index == TK_CARET_HEIGHT) -- last case */ {
- value = caretPtr->height;
+ height = value;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
- } else {
- int i, value, x = 0, y = 0, height = -1;
-
- for (i = 3; i < objc; i += 2) {
- if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
- "caret option", 0, &index) != TCL_OK) ||
- Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) {
- return TCL_ERROR;
- }
- if (index == TK_CARET_X) {
- x = value;
- } else if (index == TK_CARET_Y) {
- y = value;
- } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
- height = value;
- }
- }
- if (height < 0) {
- height = Tk_Height(window);
- }
- Tk_SetCaretPos(window, x, y, height);
}
- break;
+ if (height < 0) {
+ height = Tk_Height(window);
+ }
+ Tk_SetCaretPos(window, x, y, height);
}
- case TK_SCALING: {
- Screen *screenPtr;
- int skip, width, height;
- double d;
+ return TCL_OK;
+}
- if (Tcl_IsSafe(interp)) {
- Tcl_SetResult(interp,
- "scaling not accessible in a safe interpreter",
- TCL_STATIC);
- return TCL_ERROR;
- }
+int
+ScalingCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window tkwin = clientData;
+ Screen *screenPtr;
+ int skip, width, height;
+ double d;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "scaling not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
- skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
- if (skip < 0) {
+ skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ screenPtr = Tk_Screen(tkwin);
+ if (objc - skip == 1) {
+ d = 25.4 / 72;
+ d *= WidthOfScreen(screenPtr);
+ d /= WidthMMOfScreen(screenPtr);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d));
+ } else if (objc - skip == 2) {
+ if (Tcl_GetDoubleFromObj(interp, objv[1+skip], &d) != TCL_OK) {
return TCL_ERROR;
}
- screenPtr = Tk_Screen(tkwin);
- if (objc - skip == 2) {
- d = 25.4 / 72;
- d *= WidthOfScreen(screenPtr);
- d /= WidthMMOfScreen(screenPtr);
- Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d));
- } else if (objc - skip == 3) {
- if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
- return TCL_ERROR;
- }
- d = (25.4 / 72) / d;
- width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
- if (width <= 0) {
- width = 1;
- }
- height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
- if (height <= 0) {
- height = 1;
- }
- WidthMMOfScreen(screenPtr) = width;
- HeightMMOfScreen(screenPtr) = height;
- } else {
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-displayof window? ?factor?");
- return TCL_ERROR;
+ d = (25.4 / 72) / d;
+ width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
+ if (width <= 0) {
+ width = 1;
}
- break;
+ height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
+ if (height <= 0) {
+ height = 1;
+ }
+ WidthMMOfScreen(screenPtr) = width;
+ HeightMMOfScreen(screenPtr) = height;
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-displayof window? ?factor?");
+ return TCL_ERROR;
}
- case TK_USE_IM: {
- TkDisplay *dispPtr;
- int skip;
+ return TCL_OK;
+}
- if (Tcl_IsSafe(interp)) {
- Tcl_SetResult(interp,
- "useinputmethods not accessible in a safe interpreter",
- TCL_STATIC);
- return TCL_ERROR;
- }
+int
+UseinputmethodsCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window tkwin = clientData;
+ TkDisplay *dispPtr;
+ int skip;
- skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
- if (skip < 0) {
- return TCL_ERROR;
- }
- dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if ((objc - skip) == 3) {
- /*
- * In the case where TK_USE_INPUT_METHODS is not defined, this
- * will be ignored and we will always return 0. That will indicate
- * to the user that input methods are just not available.
- */
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "useinputmethods not accessible in a safe interpreter",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
- int boolVal;
+ skip = TkGetDisplayOf(interp, objc-1, objv+1, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if ((objc - skip) == 2) {
+ /*
+ * In the case where TK_USE_INPUT_METHODS is not defined, this
+ * will be ignored and we will always return 0. That will indicate
+ * to the user that input methods are just not available.
+ */
- if (Tcl_GetBooleanFromObj(interp, objv[2+skip],
- &boolVal) != TCL_OK) {
- return TCL_ERROR;
- }
-#ifdef TK_USE_INPUT_METHODS
- if (boolVal) {
- dispPtr->flags |= TK_DISPLAY_USE_IM;
- } else {
- dispPtr->flags &= ~TK_DISPLAY_USE_IM;
- }
-#endif /* TK_USE_INPUT_METHODS */
- } else if ((objc - skip) != 2) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-displayof window? ?boolean?");
+ int boolVal;
+
+ if (Tcl_GetBooleanFromObj(interp, objv[1+skip],
+ &boolVal) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_USE_IM));
- break;
+#ifdef TK_USE_INPUT_METHODS
+ if (boolVal) {
+ dispPtr->flags |= TK_DISPLAY_USE_IM;
+ } else {
+ dispPtr->flags &= ~TK_DISPLAY_USE_IM;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ } else if ((objc - skip) != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-displayof window? ?boolean?");
+ return TCL_ERROR;
}
- case TK_WINDOWINGSYSTEM: {
- const char *windowingsystem;
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_USE_IM));
+ return TCL_OK;
+}
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
- }
+int
+WindowingsystemCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *windowingsystem;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
#if defined(WIN32)
- windowingsystem = "win32";
+ windowingsystem = "win32";
#elif defined(MAC_OSX_TK)
- windowingsystem = "aqua";
+ windowingsystem = "aqua";
#else
- windowingsystem = "x11";
+ windowingsystem = "x11";
#endif
- Tcl_SetObjResult(interp, Tcl_NewStringObj(windowingsystem, -1));
- break;
- }
- case TK_INACTIVE: {
- int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(windowingsystem, -1));
+ return TCL_OK;
+}
- if (skip < 0) {
- return TCL_ERROR;
- }
- if (objc - skip == 2) {
- long inactive;
+int
+InactiveCmd(
+ ClientData clientData, /* Main window associated with interpreter. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tk_Window tkwin = clientData;
+ int skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin);
- inactive = (Tcl_IsSafe(interp) ? -1 :
- Tk_GetUserInactiveTime(Tk_Display(tkwin)));
- Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip == 1) {
+ long inactive;
- } else if (objc - skip == 3) {
- char *string;
+ inactive = (Tcl_IsSafe(interp) ? -1 :
+ Tk_GetUserInactiveTime(Tk_Display(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
- string = Tcl_GetString(objv[objc-1]);
- if (strcmp(string, "reset") != 0) {
- Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1);
+ } else if (objc - skip == 2) {
+ char *string;
- Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL);
- Tcl_SetObjResult(interp, msg);
- return TCL_ERROR;
- }
- if (Tcl_IsSafe(interp)) {
- Tcl_SetResult(interp,
- "resetting the user inactivity timer "
- "is not allowed in a safe interpreter", TCL_STATIC);
- return TCL_ERROR;
- }
- Tk_ResetUserInactiveTime(Tk_Display(tkwin));
- Tcl_ResetResult(interp);
- } else {
- Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? ?reset?");
+ string = Tcl_GetString(objv[objc-1]);
+ if (strcmp(string, "reset") != 0) {
+ Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1);
+
+ Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL);
+ Tcl_SetObjResult(interp, msg);
return TCL_ERROR;
}
- break;
- }
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetResult(interp,
+ "resetting the user inactivity timer "
+ "is not allowed in a safe interpreter", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tk_ResetUserInactiveTime(Tk_Display(tkwin));
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?reset?");
+ return TCL_ERROR;
}
return TCL_OK;
}
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 3ab1d77..7131bb7 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -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: tkInt.h,v 1.96 2008/11/27 23:47:09 ferrieux Exp $
+ * RCS: $Id: tkInt.h,v 1.97 2008/12/10 00:34:51 das Exp $
*/
#ifndef _TKINT
@@ -854,6 +854,17 @@ typedef struct TkWindow {
} TkWindow;
/*
+ * The following structure is used with TkMakeEnsemble to create
+ * ensemble commands and optionally to create sub-ensembles.
+ */
+
+typedef struct TkEnsemble {
+ const char *name;
+ Tcl_ObjCmdProc *proc;
+ const struct TkEnsemble *subensemble;
+} TkEnsemble;
+
+/*
* The following structure is used as a two way map between integers and
* strings, usually to map between an internal C representation and the
* strings used in Tcl.
@@ -1123,9 +1134,6 @@ MODULE_SCOPE int Tk_SpinboxObjCmd(ClientData clientData,
MODULE_SCOPE int Tk_TextObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int Tk_TkObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int Tk_TkwaitObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -1256,6 +1264,11 @@ MODULE_SCOPE void TkUnderlineAngledTextLayout(Display *display,
int x, int y, double angle, int underline);
MODULE_SCOPE int TkIntersectAngledTextLayout(Tk_TextLayout layout,
int x,int y, int width, int height, double angle);
+MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp,
+ const char *namespace, const char *name,
+ ClientData clientData, const TkEnsemble *map);
+MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp,
+ ClientData clientData);
/*
* Unsupported commands.
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 84a448a..4007ae8 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkUtil.c,v 1.24 2008/11/08 18:44:40 dkf Exp $
+ * RCS: @(#) $Id: tkUtil.c,v 1.25 2008/12/10 00:34:51 das Exp $
*/
#include "tkInt.h"
@@ -978,6 +978,89 @@ TkFindStateNumObj(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TkMakeEnsemble --
+ *
+ * Create an ensemble from a table of implementation commands.
+ * This may be called recursively to create sub-ensembles.
+ *
+ * Results:
+ * Handle for the ensemble, or NULL if creation of it fails.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TkMakeEnsemble(
+ Tcl_Interp *interp,
+ const char *namespace,
+ const char *name,
+ ClientData clientData,
+ const TkEnsemble map[])
+{
+ Tcl_Namespace *namespacePtr = NULL;
+ Tcl_Command ensemble = NULL;
+ Tcl_Obj *dictObj = NULL;
+ Tcl_DString ds;
+ int i;
+
+ if (map == NULL) {
+ return NULL;
+ }
+
+ Tcl_DStringInit(&ds);
+
+ namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0);
+ if (namespacePtr == NULL) {
+ namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL);
+ if (namespacePtr == NULL) {
+ Tcl_Panic("failed to create namespace \"%s\"", namespace);
+ }
+ }
+
+ ensemble = Tcl_FindEnsemble(interp, Tcl_NewStringObj(name,-1), 0);
+ if (ensemble == NULL) {
+ ensemble = Tcl_CreateEnsemble(interp, name,
+ namespacePtr, TCL_ENSEMBLE_PREFIX);
+ if (ensemble == NULL) {
+ Tcl_Panic("failed to create ensemble \"%s\"", name);
+ }
+ }
+
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, namespace, -1);
+ if (!(strlen(namespace) == 2 && namespace[1] == ':')) {
+ Tcl_DStringAppend(&ds, "::", -1);
+ }
+ Tcl_DStringAppend(&ds, name, -1);
+
+ dictObj = Tcl_NewObj();
+ for (i = 0; map[i].name != NULL ; ++i) {
+ Tcl_Obj *nameObj, *fqdnObj;
+
+ nameObj = Tcl_NewStringObj(map[i].name, -1);
+ fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_AppendStringsToObj(fqdnObj, "::", map[i].name, NULL);
+ Tcl_DictObjPut(NULL, dictObj, nameObj, fqdnObj);
+ if (map[i].proc) {
+ Tcl_CreateObjCommand(interp, Tcl_GetString(fqdnObj),
+ map[i].proc, clientData, NULL);
+ } else {
+ TkMakeEnsemble(interp, Tcl_DStringValue(&ds),
+ map[i].name, clientData, map[i].subensemble);
+ }
+ }
+
+ if (ensemble) {
+ Tcl_SetEnsembleMappingDict(interp, ensemble, dictObj);
+ }
+
+ Tcl_DStringFree(&ds);
+ return ensemble;
+}
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 09d2f2b..597b329 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.100 2008/12/07 16:34:55 das Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.101 2008/12/10 00:34:51 das Exp $
*/
#include "tkInt.h"
@@ -94,11 +94,12 @@ static XSetWindowAttributes defAtts= {
* The following structure defines all of the commands supported by Tk, and
* the C functions that execute them.
*/
-
+typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData);
typedef struct {
const char *name; /* Name of command. */
Tcl_CmdProc *cmdProc; /* Command's string-based function. */
Tcl_ObjCmdProc *objProc; /* Command's object-based function. */
+ TkInitProc *initProc; /* Command's initialization function */
int isSafe; /* If !0, this command will be exposed in a
* safe interpreter. Otherwise it will be
* hidden in a safe interpreter. */
@@ -112,72 +113,72 @@ static TkCmd commands[] = {
* Commands that are part of the intrinsics:
*/
- {"bell", NULL, Tk_BellObjCmd, 0, 1},
- {"bind", NULL, Tk_BindObjCmd, 1, 1},
- {"bindtags", NULL, Tk_BindtagsObjCmd, 1, 1},
- {"clipboard", NULL, Tk_ClipboardObjCmd, 0, 1},
- {"destroy", NULL, Tk_DestroyObjCmd, 1, 1},
- {"event", NULL, Tk_EventObjCmd, 1, 1},
- {"focus", NULL, Tk_FocusObjCmd, 1, 1},
- {"font", NULL, Tk_FontObjCmd, 1, 1},
- {"grab", NULL, Tk_GrabObjCmd, 0, 1},
- {"grid", NULL, Tk_GridObjCmd, 1, 1},
- {"image", NULL, Tk_ImageObjCmd, 1, 1},
- {"lower", NULL, Tk_LowerObjCmd, 1, 1},
- {"option", NULL, Tk_OptionObjCmd, 1, 1},
- {"pack", NULL, Tk_PackObjCmd, 1, 1},
- {"place", NULL, Tk_PlaceObjCmd, 1, 0},
- {"raise", NULL, Tk_RaiseObjCmd, 1, 1},
- {"selection", NULL, Tk_SelectionObjCmd, 0, 1},
- {"tk", NULL, Tk_TkObjCmd, 1, 1},
- {"tkwait", NULL, Tk_TkwaitObjCmd, 1, 1},
- {"update", NULL, Tk_UpdateObjCmd, 1, 1},
- {"winfo", NULL, Tk_WinfoObjCmd, 1, 1},
- {"wm", NULL, Tk_WmObjCmd, 0, 1},
+ {"bell", NULL, Tk_BellObjCmd, NULL, 0, 1},
+ {"bind", NULL, Tk_BindObjCmd, NULL, 1, 1},
+ {"bindtags", NULL, Tk_BindtagsObjCmd, NULL, 1, 1},
+ {"clipboard", NULL, Tk_ClipboardObjCmd, NULL, 0, 1},
+ {"destroy", NULL, Tk_DestroyObjCmd, NULL, 1, 1},
+ {"event", NULL, Tk_EventObjCmd, NULL, 1, 1},
+ {"focus", NULL, Tk_FocusObjCmd, NULL, 1, 1},
+ {"font", NULL, Tk_FontObjCmd, NULL, 1, 1},
+ {"grab", NULL, Tk_GrabObjCmd, NULL, 0, 1},
+ {"grid", NULL, Tk_GridObjCmd, NULL, 1, 1},
+ {"image", NULL, Tk_ImageObjCmd, NULL, 1, 1},
+ {"lower", NULL, Tk_LowerObjCmd, NULL, 1, 1},
+ {"option", NULL, Tk_OptionObjCmd, NULL, 1, 1},
+ {"pack", NULL, Tk_PackObjCmd, NULL, 1, 1},
+ {"place", NULL, Tk_PlaceObjCmd, NULL, 1, 0},
+ {"raise", NULL, Tk_RaiseObjCmd, NULL, 1, 1},
+ {"selection", NULL, Tk_SelectionObjCmd, NULL, 0, 1},
+ {"tk", NULL, NULL, TkInitTkCmd, 1, 1},
+ {"tkwait", NULL, Tk_TkwaitObjCmd, NULL, 1, 1},
+ {"update", NULL, Tk_UpdateObjCmd, NULL, 1, 1},
+ {"winfo", NULL, Tk_WinfoObjCmd, NULL, 1, 1},
+ {"wm", NULL, Tk_WmObjCmd, NULL, 0, 1},
/*
* Default widget class commands.
*/
- {"button", NULL, Tk_ButtonObjCmd, 1, 0},
- {"canvas", NULL, Tk_CanvasObjCmd, 1, 1},
- {"checkbutton", NULL, Tk_CheckbuttonObjCmd, 1, 0},
- {"entry", NULL, Tk_EntryObjCmd, 1, 0},
- {"frame", NULL, Tk_FrameObjCmd, 1, 0},
- {"label", NULL, Tk_LabelObjCmd, 1, 0},
- {"labelframe", NULL, Tk_LabelframeObjCmd, 1, 0},
- {"listbox", NULL, Tk_ListboxObjCmd, 1, 0},
- {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0},
- {"message", NULL, Tk_MessageObjCmd, 1, 0},
- {"panedwindow", NULL, Tk_PanedWindowObjCmd, 1, 0},
- {"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0},
- {"scale", NULL, Tk_ScaleObjCmd, 1, 0},
- {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1},
- {"spinbox", NULL, Tk_SpinboxObjCmd, 1, 0},
- {"text", NULL, Tk_TextObjCmd, 1, 1},
- {"toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
+ {"button", NULL, Tk_ButtonObjCmd, NULL, 1, 0},
+ {"canvas", NULL, Tk_CanvasObjCmd, NULL, 1, 1},
+ {"checkbutton", NULL, Tk_CheckbuttonObjCmd, NULL, 1, 0},
+ {"entry", NULL, Tk_EntryObjCmd, NULL, 1, 0},
+ {"frame", NULL, Tk_FrameObjCmd, NULL, 1, 0},
+ {"label", NULL, Tk_LabelObjCmd, NULL, 1, 0},
+ {"labelframe", NULL, Tk_LabelframeObjCmd, NULL, 1, 0},
+ {"listbox", NULL, Tk_ListboxObjCmd, NULL, 1, 0},
+ {"menubutton", NULL, Tk_MenubuttonObjCmd, NULL, 1, 0},
+ {"message", NULL, Tk_MessageObjCmd, NULL, 1, 0},
+ {"panedwindow", NULL, Tk_PanedWindowObjCmd, NULL, 1, 0},
+ {"radiobutton", NULL, Tk_RadiobuttonObjCmd, NULL, 1, 0},
+ {"scale", NULL, Tk_ScaleObjCmd, NULL, 1, 0},
+ {"scrollbar", Tk_ScrollbarCmd,NULL, NULL, 1, 1},
+ {"spinbox", NULL, Tk_SpinboxObjCmd, NULL, 1, 0},
+ {"text", NULL, Tk_TextObjCmd, NULL, 1, 1},
+ {"toplevel", NULL, Tk_ToplevelObjCmd, NULL, 0, 0},
/*
* Classic widget class commands.
*/
- {"::tk::button", NULL, Tk_ButtonObjCmd, 1, 0},
- {"::tk::canvas", NULL, Tk_CanvasObjCmd, 1, 1},
- {"::tk::checkbutton",NULL, Tk_CheckbuttonObjCmd, 1, 0},
- {"::tk::entry", NULL, Tk_EntryObjCmd, 1, 0},
- {"::tk::frame", NULL, Tk_FrameObjCmd, 1, 0},
- {"::tk::label", NULL, Tk_LabelObjCmd, 1, 0},
- {"::tk::labelframe",NULL, Tk_LabelframeObjCmd, 1, 0},
- {"::tk::listbox", NULL, Tk_ListboxObjCmd, 1, 0},
- {"::tk::menubutton",NULL, Tk_MenubuttonObjCmd, 1, 0},
- {"::tk::message", NULL, Tk_MessageObjCmd, 1, 0},
- {"::tk::panedwindow",NULL, Tk_PanedWindowObjCmd, 1, 0},
- {"::tk::radiobutton",NULL, Tk_RadiobuttonObjCmd, 1, 0},
- {"::tk::scale", NULL, Tk_ScaleObjCmd, 1, 0},
- {"::tk::scrollbar", Tk_ScrollbarCmd, NULL, 1, 1},
- {"::tk::spinbox", NULL, Tk_SpinboxObjCmd, 1, 0},
- {"::tk::text", NULL, Tk_TextObjCmd, 1, 1},
- {"::tk::toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
+ {"::tk::button", NULL, Tk_ButtonObjCmd, NULL, 1, 0},
+ {"::tk::canvas", NULL, Tk_CanvasObjCmd, NULL, 1, 1},
+ {"::tk::checkbutton",NULL, Tk_CheckbuttonObjCmd, NULL, 1, 0},
+ {"::tk::entry", NULL, Tk_EntryObjCmd, NULL, 1, 0},
+ {"::tk::frame", NULL, Tk_FrameObjCmd, NULL, 1, 0},
+ {"::tk::label", NULL, Tk_LabelObjCmd, NULL, 1, 0},
+ {"::tk::labelframe",NULL, Tk_LabelframeObjCmd, NULL, 1, 0},
+ {"::tk::listbox", NULL, Tk_ListboxObjCmd, NULL, 1, 0},
+ {"::tk::menubutton",NULL, Tk_MenubuttonObjCmd, NULL, 1, 0},
+ {"::tk::message", NULL, Tk_MessageObjCmd, NULL, 1, 0},
+ {"::tk::panedwindow",NULL, Tk_PanedWindowObjCmd, NULL, 1, 0},
+ {"::tk::radiobutton",NULL, Tk_RadiobuttonObjCmd, NULL, 1, 0},
+ {"::tk::scale", NULL, Tk_ScaleObjCmd, NULL, 1, 0},
+ {"::tk::scrollbar", Tk_ScrollbarCmd,NULL, NULL, 1, 1},
+ {"::tk::spinbox", NULL, Tk_SpinboxObjCmd, NULL, 1, 0},
+ {"::tk::text", NULL, Tk_TextObjCmd, NULL, 1, 1},
+ {"::tk::toplevel", NULL, Tk_ToplevelObjCmd, NULL, 0, 0},
/*
* Standard dialog support. Note that the Unix/X11 platform implements
@@ -185,11 +186,11 @@ static TkCmd commands[] = {
*/
#if defined(__WIN32__) || defined(MAC_OSX_TK)
- {"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, 0, 1},
- {"tk_chooseDirectory", NULL, Tk_ChooseDirectoryObjCmd,0,1},
- {"tk_getOpenFile", NULL, Tk_GetOpenFileObjCmd, 0, 1},
- {"tk_getSaveFile", NULL, Tk_GetSaveFileObjCmd, 0, 1},
- {"tk_messageBox", NULL, Tk_MessageBoxObjCmd, 0, 1},
+ {"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, NULL, 0, 1},
+ {"tk_chooseDirectory", NULL, Tk_ChooseDirectoryObjCmd,NULL, 0,1},
+ {"tk_getOpenFile", NULL, Tk_GetOpenFileObjCmd, NULL, 0, 1},
+ {"tk_getSaveFile", NULL, Tk_GetSaveFileObjCmd, NULL, 0, 1},
+ {"tk_messageBox", NULL, Tk_MessageBoxObjCmd, NULL, 0, 1},
#endif
/*
@@ -198,9 +199,9 @@ static TkCmd commands[] = {
#if defined(MAC_OSX_TK)
{"::tk::unsupported::MacWindowStyle",
- NULL, TkUnsupported1ObjCmd, 1, 1},
+ NULL, TkUnsupported1ObjCmd, NULL, 1, 1},
#endif
- {NULL, NULL, NULL, 0, 0}
+ {NULL, NULL, NULL, NULL, 0, 0}
};
/*
@@ -947,7 +948,8 @@ TkCreateMainWindow(
isSafe = Tcl_IsSafe(interp);
for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
- if ((cmdPtr->cmdProc == NULL) && (cmdPtr->objProc == NULL)) {
+ if ((cmdPtr->cmdProc == NULL) && (cmdPtr->objProc == NULL)
+ && (cmdPtr->initProc == NULL)) {
Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs");
}
if (cmdPtr->passMainWindow) {
@@ -955,7 +957,9 @@ TkCreateMainWindow(
} else {
clientData = NULL;
}
- if (cmdPtr->cmdProc != NULL) {
+ if (cmdPtr->initProc != NULL) {
+ cmdPtr->initProc(interp, clientData);
+ } else if (cmdPtr->cmdProc != NULL) {
Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
clientData, NULL);
} else {