diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tkBusy.c | 56 | ||||
| -rw-r--r-- | generic/tkCmds.c | 529 | ||||
| -rw-r--r-- | generic/tkInt.h | 21 | ||||
| -rw-r--r-- | generic/tkUtil.c | 85 | ||||
| -rw-r--r-- | generic/tkWindow.c | 138 |
6 files changed, 504 insertions, 332 deletions
@@ -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 { |