summaryrefslogtreecommitdiffstats
path: root/generic/tkCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkCmds.c')
-rw-r--r--generic/tkCmds.c953
1 files changed, 536 insertions, 417 deletions
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index a86ef84..4e9494b 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -34,6 +34,42 @@ 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);
+
+#if defined(__WIN32__) || defined(MAC_OSX_TK)
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+#else
+#define tkFontchooserEnsemble NULL
+#endif
+
+/*
+ * Table of tk subcommand names and implementations.
+ */
+
+static const TkEnsemble tkCmdMap[] = {
+ {"appname", AppnameCmd, NULL },
+ {"busy", Tk_BusyObjCmd, NULL },
+ {"caret", CaretCmd, NULL },
+ {"inactive", InactiveCmd, NULL },
+ {"scaling", ScalingCmd, NULL },
+ {"useinputmethods", UseinputmethodsCmd, NULL },
+ {"windowingsystem", WindowingsystemCmd, NULL },
+ {"fontchooser", NULL, tkFontchooserEnsemble},
+ {NULL, NULL, NULL}
+};
/*
*----------------------------------------------------------------------
@@ -59,11 +95,11 @@ Tk_BellObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *bellOptions[] = {
+ static const char *const bellOptions[] = {
"-displayof", "-nice", NULL
};
enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = clientData;
int i, index, nice = 0;
if (objc > 4) {
@@ -124,10 +160,10 @@ Tk_BindObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = clientData;
TkWindow *winPtr;
ClientData object;
- char *string;
+ const char *string;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?");
@@ -148,7 +184,7 @@ Tk_BindObjCmd(
}
object = (ClientData) winPtr->pathName;
} else {
- winPtr = (TkWindow *) clientData;
+ winPtr = clientData;
object = (ClientData) Tk_GetUid(string);
}
@@ -162,9 +198,8 @@ Tk_BindObjCmd(
if (objc == 4) {
int append = 0;
unsigned long mask;
- char *sequence, *script;
- sequence = Tcl_GetString(objv[2]);
- script = Tcl_GetString(objv[3]);
+ const char *sequence = Tcl_GetString(objv[2]);
+ const char *script = Tcl_GetString(objv[3]);
/*
* If the script is null, just delete the binding.
@@ -198,7 +233,7 @@ Tk_BindObjCmd(
Tcl_ResetResult(interp);
return TCL_OK;
}
- Tcl_SetResult(interp, (char *) command, TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
} else {
Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
}
@@ -232,7 +267,7 @@ TkBindEventProc(
ClientData objects[MAX_OBJS], *objPtr;
TkWindow *topLevPtr;
int i, count;
- char *p;
+ const char *p;
Tcl_HashEntry *hPtr;
if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
@@ -247,11 +282,10 @@ TkBindEventProc(
*/
if (winPtr->numTags > MAX_OBJS) {
- objPtr = (ClientData *) ckalloc((unsigned)
- (winPtr->numTags * sizeof(ClientData)));
+ objPtr = ckalloc(winPtr->numTags * sizeof(ClientData));
}
for (i = 0; i < winPtr->numTags; i++) {
- p = (char *) winPtr->tagPtr[i];
+ p = winPtr->tagPtr[i];
if (*p == '.') {
hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
if (hPtr != NULL) {
@@ -282,7 +316,7 @@ TkBindEventProc(
Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
count, objPtr);
if (objPtr != objects) {
- ckfree((char *) objPtr);
+ ckfree(objPtr);
}
}
@@ -310,10 +344,10 @@ Tk_BindtagsObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = clientData;
TkWindow *winPtr, *winPtr2;
int i, length;
- char *p;
+ const char *p;
Tcl_Obj *listPtr, **tags;
if ((objc < 2) || (objc > 3)) {
@@ -327,30 +361,28 @@ Tk_BindtagsObjCmd(
}
if (objc == 2) {
listPtr = Tcl_NewObj();
- Tcl_IncrRefCount(listPtr);
if (winPtr->numTags == 0) {
- Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_ListObjAppendElement(NULL, listPtr,
Tcl_NewStringObj(winPtr->pathName, -1));
- Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_ListObjAppendElement(NULL, listPtr,
Tcl_NewStringObj(winPtr->classUid, -1));
winPtr2 = winPtr;
while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) {
winPtr2 = winPtr2->parentPtr;
}
if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
- Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_ListObjAppendElement(NULL, listPtr,
Tcl_NewStringObj(winPtr2->pathName, -1));
}
- Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_ListObjAppendElement(NULL, listPtr,
Tcl_NewStringObj("all", -1));
} else {
for (i = 0; i < winPtr->numTags; i++) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1));
+ Tcl_ListObjAppendElement(NULL, listPtr,
+ Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1));
}
}
Tcl_SetObjResult(interp, listPtr);
- Tcl_DecrRefCount(listPtr);
return TCL_OK;
}
if (winPtr->tagPtr != NULL) {
@@ -364,8 +396,7 @@ Tk_BindtagsObjCmd(
}
winPtr->numTags = length;
- winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
- (length * sizeof(ClientData)));
+ winPtr->tagPtr = ckalloc(length * sizeof(ClientData));
for (i = 0; i < length; i++) {
p = Tcl_GetString(tags[i]);
if (p[0] == '.') {
@@ -378,7 +409,7 @@ Tk_BindtagsObjCmd(
* is one.
*/
- copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
+ copy = ckalloc(strlen(p) + 1);
strcpy(copy, p);
winPtr->tagPtr[i] = (ClientData) copy;
} else {
@@ -411,10 +442,10 @@ TkFreeBindingTags(
TkWindow *winPtr) /* Window whose tags are to be released. */
{
int i;
- char *p;
+ const char *p;
for (i = 0; i < winPtr->numTags; i++) {
- p = (char *) (winPtr->tagPtr[i]);
+ p = winPtr->tagPtr[i];
if (*p == '.') {
/*
* Names starting with "." are malloced rather than Uids, so they
@@ -424,7 +455,7 @@ TkFreeBindingTags(
ckfree(p);
}
}
- ckfree((char *) winPtr->tagPtr);
+ ckfree(winPtr->tagPtr);
winPtr->numTags = 0;
winPtr->tagPtr = NULL;
}
@@ -454,7 +485,7 @@ Tk_DestroyObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tk_Window window;
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = clientData;
int i;
for (i = 1; i < objc; i++) {
@@ -501,7 +532,7 @@ Tk_LowerObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window mainwin = clientData;
Tk_Window tkwin, other;
if ((objc != 2) && (objc != 3)) {
@@ -522,9 +553,15 @@ Tk_LowerObjCmd(
}
}
if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
- Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
- "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
- "\"", NULL);
+ if (other) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't lower \"%s\" below \"%s\"",
+ Tcl_GetString(objv[1]), Tcl_GetString(objv[2])));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't lower \"%s\" to bottom", Tcl_GetString(objv[1])));
+ }
+ Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -555,7 +592,7 @@ Tk_RaiseObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window mainwin = clientData;
Tk_Window tkwin, other;
if ((objc != 2) && (objc != 3)) {
@@ -576,21 +613,56 @@ Tk_RaiseObjCmd(
}
}
if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
- Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
- "\" above \"", (other ? Tcl_GetString(objv[2]) : ""),
- "\"", NULL);
+ if (other) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't raise \"%s\" above \"%s\"",
+ Tcl_GetString(objv[1]), Tcl_GetString(objv[2])));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't raise \"%s\" to top", Tcl_GetString(objv[1])));
+ }
+ Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * 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);
+#if defined(__WIN32__) || defined(MAC_OSX_TK)
+ TkInitFontchooser(interp, clientData);
+#endif
+ 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.
@@ -602,286 +674,299 @@ 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. */
{
+ Tk_Window tkwin = clientData;
+ TkWindow *winPtr;
+ const char *string;
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "appname not accessible in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "APPLICATION", NULL);
+ 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_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1));
+ 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;
- Tk_Window tkwin;
- static const char *optionStrings[] = {
- "appname", "caret", "scaling", "useinputmethods",
- "windowingsystem", "inactive", NULL
+ Tcl_Obj *objPtr;
+ TkCaret *caretPtr;
+ Tk_Window window;
+ static const char *const caretStrings[] = {
+ "-x", "-y", "-height", NULL
};
- enum options {
- TK_APPNAME, TK_CARET, TK_SCALING, TK_USE_IM,
- TK_WINDOWINGSYSTEM, TK_INACTIVE
+ enum caretOptions {
+ TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT
};
- tkwin = (Tk_Window) clientData;
-
- 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_CARET: {
- Tcl_Obj *objPtr;
- TkCaret *caretPtr;
- Tk_Window window;
- static const char *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;
- }
- Tcl_SetIntObj(Tcl_GetObjResult(interp), 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);
+ height = value;
}
- 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_SetObjResult(interp, Tcl_NewStringObj(
+ "scaling not accessible in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL);
+ 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_SetDoubleObj(Tcl_GetObjResult(interp), 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_SetObjResult(interp, Tcl_NewStringObj(
+ "useinputmethods not accessible in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "INPUT_METHODS", NULL);
+ 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_SetBooleanObj(Tcl_GetObjResult(interp),
- (int) (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_SetStringObj(Tcl_GetObjResult(interp), 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) {
+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);
+
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip == 1) {
+ long inactive;
+
+ inactive = (Tcl_IsSafe(interp) ? -1 :
+ Tk_GetUserInactiveTime(Tk_Display(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
+ } else if (objc - skip == 2) {
+ const char *string;
+
+ string = Tcl_GetString(objv[objc-1]);
+ if (strcmp(string, "reset") != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be reset", string));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
+ string, NULL);
return TCL_ERROR;
}
- if (objc - skip == 2) {
- long inactive;
-
- inactive = (Tcl_IsSafe(interp) ? -1 :
- Tk_GetUserInactiveTime(Tk_Display(tkwin)));
- Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive));
-
- } else if (objc - skip == 3) {
- char *string;
-
- 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;
- }
- 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?");
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "resetting the user inactivity timer "
+ "is not allowed in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "INACTIVITY_TIMER", NULL);
return TCL_ERROR;
}
- break;
- }
+ Tk_ResetUserInactiveTime(Tk_Display(tkwin));
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?reset?");
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -911,9 +996,10 @@ Tk_TkwaitObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = clientData;
int done, index;
- static const char *optionStrings[] = {
+ int code = TCL_OK;
+ static const char *const optionStrings[] = {
"variable", "visibility", "window", NULL
};
enum options {
@@ -934,16 +1020,20 @@ Tk_TkwaitObjCmd(
case TKWAIT_VARIABLE:
if (Tcl_TraceVar(interp, Tcl_GetString(objv[2]),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- WaitVariableProc, (ClientData) &done) != TCL_OK) {
+ WaitVariableProc, &done) != TCL_OK) {
return TCL_ERROR;
}
done = 0;
while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
Tcl_DoOneEvent(0);
}
Tcl_UntraceVar(interp, Tcl_GetString(objv[2]),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- WaitVariableProc, (ClientData) &done);
+ WaitVariableProc, &done);
break;
case TKWAIT_VISIBILITY: {
@@ -955,25 +1045,31 @@ Tk_TkwaitObjCmd(
}
Tk_CreateEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
- WaitVisibilityProc, (ClientData) &done);
+ WaitVisibilityProc, &done);
done = 0;
while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
Tcl_DoOneEvent(0);
}
- if (done != 1) {
+ if ((done != 0) && (done != 1)) {
/*
* Note that we do not delete the event handler because it was
* deleted automatically when the window was destroyed.
*/
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]),
- "\" was deleted before its visibility changed", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" was deleted before its visibility changed",
+ Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL);
return TCL_ERROR;
}
Tk_DeleteEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
- WaitVisibilityProc, (ClientData) &done);
+ WaitVisibilityProc, &done);
break;
}
@@ -985,28 +1081,40 @@ Tk_TkwaitObjCmd(
return TCL_ERROR;
}
Tk_CreateEventHandler(window, StructureNotifyMask,
- WaitWindowProc, (ClientData) &done);
+ WaitWindowProc, &done);
done = 0;
while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
Tcl_DoOneEvent(0);
}
/*
- * Note: there's no need to delete the event handler. It was deleted
- * automatically when the window was destroyed.
+ * Note: normally there's no need to delete the event handler. It was
+ * deleted automatically when the window was destroyed; however, if
+ * the wait operation was canceled, we need to delete it.
*/
+ if (done == 0) {
+ Tk_DeleteEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, &done);
+ }
break;
}
}
/*
* Clear out the interpreter's result, since it may have been set by event
- * handlers.
+ * handlers. This is skipped if an error occurred above, such as the wait
+ * operation being canceled.
*/
+ if (code == TCL_OK)
Tcl_ResetResult(interp);
- return TCL_OK;
+
+ return code;
}
/* ARGSUSED */
@@ -1018,7 +1126,7 @@ WaitVariableProc(
const char *name2, /* Second part of variable name. */
int flags) /* Information about what happened. */
{
- int *donePtr = (int *) clientData;
+ int *donePtr = clientData;
*donePtr = 1;
return NULL;
@@ -1030,12 +1138,11 @@ WaitVisibilityProc(
ClientData clientData, /* Pointer to integer to set to 1. */
XEvent *eventPtr) /* Information about event (not used). */
{
- int *donePtr = (int *) clientData;
+ int *donePtr = clientData;
if (eventPtr->type == VisibilityNotify) {
*donePtr = 1;
- }
- if (eventPtr->type == DestroyNotify) {
+ } else if (eventPtr->type == DestroyNotify) {
*donePtr = 2;
}
}
@@ -1045,7 +1152,7 @@ WaitWindowProc(
ClientData clientData, /* Pointer to integer to set to 1. */
XEvent *eventPtr) /* Information about event. */
{
- int *donePtr = (int *) clientData;
+ int *donePtr = clientData;
if (eventPtr->type == DestroyNotify) {
*donePtr = 1;
@@ -1077,9 +1184,10 @@ Tk_UpdateObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *updateOptions[] = {"idletasks", NULL};
+ static const char *const updateOptions[] = {"idletasks", NULL};
int flags, index;
TkDisplay *dispPtr;
+ int code = TCL_OK;
if (objc == 1) {
flags = TCL_DONT_WAIT;
@@ -1104,12 +1212,35 @@ Tk_UpdateObjCmd(
while (1) {
while (Tcl_DoOneEvent(flags) != 0) {
- /* Empty loop body */
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
}
+
+ /*
+ * If event processing was canceled proceed no further.
+ */
+
+ if (code == TCL_ERROR)
+ break;
+
for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
XSync(dispPtr->display, False);
}
+
+ /*
+ * Check again if event processing has been canceled because the inner
+ * loop (above) may not have checked (i.e. no events were processed and
+ * the loop body was skipped).
+ */
+
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+
if (Tcl_DoOneEvent(flags) == 0) {
break;
}
@@ -1117,11 +1248,14 @@ Tk_UpdateObjCmd(
/*
* Must clear the interpreter's result because event handlers could have
- * executed commands.
+ * executed commands. This is skipped if an error occurred above, such as
+ * the wait operation being canceled.
*/
+ if (code == TCL_OK)
Tcl_ResetResult(interp);
- return TCL_OK;
+
+ return code;
}
/*
@@ -1149,10 +1283,9 @@ Tk_WinfoObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int index, x, y, width, height, useX, useY, class, skip;
- char *string;
+ const char *string;
TkWindow *winPtr;
- Tk_Window tkwin;
- Tcl_Obj *resultPtr;
+ Tk_Window tkwin = clientData;
static const TkStateMap visualMap[] = {
{PseudoColor, "pseudocolor"},
@@ -1163,7 +1296,7 @@ Tk_WinfoObjCmd(
{StaticGray, "staticgray"},
{-1, NULL}
};
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"cells", "children", "class", "colormapfull",
"depth", "geometry", "height", "id",
"ismapped", "manager", "name", "parent",
@@ -1202,8 +1335,6 @@ Tk_WinfoObjCmd(
WIN_VISUALSAVAILABLE
};
- tkwin = (Tk_Window) clientData;
-
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
return TCL_ERROR;
@@ -1225,14 +1356,14 @@ Tk_WinfoObjCmd(
}
}
winPtr = (TkWindow *) tkwin;
- resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
case WIN_CELLS:
- Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(Tk_Visual(tkwin)->map_entries));
break;
case WIN_CHILDREN: {
- Tcl_Obj *strPtr;
+ Tcl_Obj *strPtr, *resultPtr = Tcl_NewObj();
winPtr = winPtr->childList;
for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
@@ -1241,57 +1372,50 @@ Tk_WinfoObjCmd(
Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
}
+ Tcl_SetObjResult(interp, resultPtr);
break;
}
case WIN_CLASS:
- Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Class(tkwin), -1));
break;
case WIN_COLORMAPFULL:
- Tcl_SetBooleanObj(resultPtr,
- TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(TkpCmapStressed(tkwin,Tk_Colormap(tkwin))));
break;
case WIN_DEPTH:
- Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Depth(tkwin)));
break;
- case WIN_GEOMETRY: {
- char buf[16 + TCL_INTEGER_SPACE * 4];
-
- sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
- Tk_X(tkwin), Tk_Y(tkwin));
- Tcl_SetStringObj(resultPtr, buf, -1);
+ case WIN_GEOMETRY:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d+%d+%d",
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_X(tkwin), Tk_Y(tkwin)));
break;
- }
case WIN_HEIGHT:
- Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Height(tkwin)));
break;
case WIN_ID: {
char buf[TCL_INTEGER_SPACE];
Tk_MakeWindowExist(tkwin);
TkpPrintWindowId(buf, Tk_WindowId(tkwin));
-
- /*
- * interp result may have changed, refetch it
- */
-
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetStringObj(resultPtr, buf, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
break;
}
case WIN_ISMAPPED:
- Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tk_IsMapped(tkwin)));
break;
case WIN_MANAGER:
if (winPtr->geomMgrPtr != NULL) {
- Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(winPtr->geomMgrPtr->name, -1));
}
break;
case WIN_NAME:
- Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Name(tkwin), -1));
break;
case WIN_PARENT:
if (winPtr->parentPtr != NULL) {
- Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(winPtr->parentPtr->pathName, -1));
}
break;
case WIN_POINTERX:
@@ -1315,54 +1439,58 @@ Tk_WinfoObjCmd(
TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
}
if (useX & useY) {
- char buf[TCL_INTEGER_SPACE * 2];
+ Tcl_Obj *xyObj[2];
- sprintf(buf, "%d %d", x, y);
- Tcl_SetStringObj(resultPtr, buf, -1);
+ xyObj[0] = Tcl_NewIntObj(x);
+ xyObj[1] = Tcl_NewIntObj(y);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(2, xyObj));
} else if (useX) {
- Tcl_SetIntObj(resultPtr, x);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
} else {
- Tcl_SetIntObj(resultPtr, y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
}
break;
case WIN_REQHEIGHT:
- Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqHeight(tkwin)));
break;
case WIN_REQWIDTH:
- Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqWidth(tkwin)));
break;
case WIN_ROOTX:
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_SetIntObj(resultPtr, x);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
break;
case WIN_ROOTY:
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_SetIntObj(resultPtr, y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
break;
- case WIN_SCREEN: {
- char buf[TCL_INTEGER_SPACE];
-
- sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
- Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin),".",buf, NULL);
+ case WIN_SCREEN:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s.%d",
+ Tk_DisplayName(tkwin), Tk_ScreenNumber(tkwin)));
break;
- }
case WIN_SCREENCELLS:
- Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(CellsOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENDEPTH:
- Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENHEIGHT:
- Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(HeightOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENWIDTH:
- Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(WidthOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENMMHEIGHT:
- Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(HeightMMOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENMMWIDTH:
- Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(WidthMMOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENVISUAL:
class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
@@ -1373,7 +1501,7 @@ Tk_WinfoObjCmd(
case WIN_TOPLEVEL:
winPtr = GetTopHierarchy(tkwin);
if (winPtr != NULL) {
- Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->pathName, -1));
}
break;
case WIN_VIEWABLE: {
@@ -1389,7 +1517,7 @@ Tk_WinfoObjCmd(
}
}
- Tcl_SetBooleanObj(resultPtr, viewable);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(viewable));
break;
}
case WIN_VISUAL:
@@ -1400,40 +1528,36 @@ Tk_WinfoObjCmd(
if (string == NULL) {
string = "unknown";
}
- Tcl_SetStringObj(resultPtr, string, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(string, -1));
break;
- case WIN_VISUALID: {
- char buf[TCL_INTEGER_SPACE];
-
- sprintf(buf, "0x%x",
- (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
- Tcl_SetStringObj(resultPtr, buf, -1);
+ case WIN_VISUALID:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned)
+ XVisualIDFromVisual(Tk_Visual(tkwin))));
break;
- }
case WIN_VROOTHEIGHT:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, height);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(height));
break;
case WIN_VROOTWIDTH:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, width);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(width));
break;
case WIN_VROOTX:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, x);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
break;
case WIN_VROOTY:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetIntObj(resultPtr, y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
break;
case WIN_WIDTH:
- Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Width(tkwin)));
break;
case WIN_X:
- Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_X(tkwin)));
break;
case WIN_Y:
- Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Y(tkwin)));
break;
/*
@@ -1451,7 +1575,8 @@ Tk_WinfoObjCmd(
}
objv += skip;
string = Tcl_GetString(objv[2]);
- Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
+ Tcl_SetObjResult(interp,
+ Tcl_NewLongObj((long) Tk_InternAtom(tkwin, string)));
break;
case WIN_ATOMNAME: {
const char *name;
@@ -1471,12 +1596,13 @@ Tk_WinfoObjCmd(
}
name = Tk_GetAtomName(tkwin, (Atom) id);
if (strcmp(name, "?bad atom?") == 0) {
- string = Tcl_GetString(objv[2]);
- Tcl_AppendStringsToObj(resultPtr,
- "no atom exists with id \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no atom exists with id \"%s\"", Tcl_GetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM",
+ Tcl_GetString(objv[2]), NULL);
return TCL_ERROR;
}
- Tcl_SetStringObj(resultPtr, name, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
break;
}
case WIN_CONTAINING:
@@ -1500,12 +1626,10 @@ Tk_WinfoObjCmd(
}
tkwin = Tk_CoordsToWindow(x, y, tkwin);
if (tkwin != NULL) {
- Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1));
}
break;
- case WIN_INTERPS: {
- int result;
-
+ case WIN_INTERPS:
skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
if (skip < 0) {
return TCL_ERROR;
@@ -1514,9 +1638,7 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
return TCL_ERROR;
}
- result = TkGetInterpNames(interp, tkwin);
- return result;
- }
+ return TkGetInterpNames(interp, tkwin);
case WIN_PATHNAME: {
Window id;
@@ -1532,11 +1654,13 @@ Tk_WinfoObjCmd(
if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
return TCL_ERROR;
}
- winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id);
+ winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id);
if ((winPtr == NULL) ||
(winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
- Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
- "\" doesn't exist in this application", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window id \"%s\" doesn't exist in this application",
+ string));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, NULL);
return TCL_ERROR;
}
@@ -1548,7 +1672,7 @@ Tk_WinfoObjCmd(
tkwin = (Tk_Window) winPtr;
if (Tk_PathName(tkwin) != NULL) {
- Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1));
}
break;
}
@@ -1567,13 +1691,12 @@ Tk_WinfoObjCmd(
string = Tcl_GetString(objv[2]);
winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
Tcl_ResetResult(interp);
- resultPtr = Tcl_GetObjResult(interp);
alive = 1;
if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
alive = 0;
}
- Tcl_SetBooleanObj(resultPtr, alive);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(alive));
break;
}
case WIN_FPIXELS: {
@@ -1583,9 +1706,7 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "window number");
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
@@ -1594,7 +1715,7 @@ Tk_WinfoObjCmd(
}
pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
/ WidthMMOfScreen(Tk_Screen(tkwin));
- Tcl_SetDoubleObj(resultPtr, pixels);
+ Tcl_SetObjResult(interp, Tcl_NewDoubleObj(pixels));
break;
}
case WIN_PIXELS: {
@@ -1604,47 +1725,40 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "window number");
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
string = Tcl_GetString(objv[3]);
if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetIntObj(resultPtr, pixels);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pixels));
break;
}
case WIN_RGB: {
XColor *colorPtr;
- char buf[TCL_INTEGER_SPACE * 3];
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
- string = Tcl_GetString(objv[3]);
- colorPtr = Tk_GetColor(interp, tkwin, string);
+ colorPtr = Tk_GetColor(interp, tkwin, Tcl_GetString(objv[3]));
if (colorPtr == NULL) {
return TCL_ERROR;
}
- sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
- colorPtr->blue);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d",
+ colorPtr->red, colorPtr->green, colorPtr->blue));
Tk_FreeColor(colorPtr);
- Tcl_SetStringObj(resultPtr, buf, -1);
break;
}
case WIN_VISUALSAVAILABLE: {
XVisualInfo template, *visInfoPtr;
int count, i;
int includeVisualId;
- Tcl_Obj *strPtr;
+ Tcl_Obj *strPtr, *resultPtr;
char buf[16 + TCL_INTEGER_SPACE];
char visualIdString[TCL_INTEGER_SPACE];
@@ -1658,9 +1772,7 @@ Tk_WinfoObjCmd(
return TCL_ERROR;
}
- string = Tcl_GetString(objv[2]);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
- if (tkwin == NULL) {
+ if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) {
return TCL_ERROR;
}
@@ -1668,10 +1780,12 @@ Tk_WinfoObjCmd(
visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
&template, &count);
if (visInfoPtr == NULL) {
- Tcl_SetStringObj(resultPtr,
- "can't find any visuals for screen", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't find any visuals for screen", -1));
+ Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", NULL);
return TCL_ERROR;
}
+ resultPtr = Tcl_NewObj();
for (i = 0; i < count; i++) {
string = TkFindStateString(visualMap, visInfoPtr[i].class);
if (string == NULL) {
@@ -1681,12 +1795,13 @@ Tk_WinfoObjCmd(
}
if (includeVisualId) {
sprintf(visualIdString, " 0x%x",
- (unsigned int) visInfoPtr[i].visualid);
+ (unsigned) visInfoPtr[i].visualid);
strcat(buf, visualIdString);
}
strPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
+ Tcl_SetObjResult(interp, resultPtr);
XFree((char *) visInfoPtr);
break;
}
@@ -1723,7 +1838,7 @@ Tk_WmObjCmd(
Tk_Window tkwin;
TkWindow *winPtr;
- static const char *optionStrings[] = {
+ static const char *const optionStrings[] = {
"aspect", "client", "command", "deiconify",
"focusmodel", "frame", "geometry", "grid",
"group", "iconbitmap", "iconify", "iconmask",
@@ -1762,8 +1877,8 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ dispPtr->flags & TK_DISPLAY_WM_TRACING));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
@@ -1788,8 +1903,10 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (!(winPtr->flags & TK_TOP_LEVEL)) {
- Tcl_AppendResult(interp, "window \"", winPtr->pathName,
- "\" isn't a top-level window", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window \"%s\" isn't a top-level window", winPtr->pathName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName,
+ NULL);
return TCL_ERROR;
}
@@ -1903,7 +2020,7 @@ Tk_WmObjCmd(
updateGeom:
if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
- Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
return TCL_OK;
@@ -1950,7 +2067,7 @@ TkGetDisplayOf(
* unmodified if "-displayof" argument was not
* present. */
{
- char *string;
+ const char *string;
int length;
if (objc < 1) {
@@ -1960,8 +2077,9 @@ TkGetDisplayOf(
if ((length >= 2) &&
(strncmp(string, "-displayof", (unsigned) length) == 0)) {
if (objc < 2) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "value for \"-displayof\" missing", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value for \"-displayof\" missing", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL);
return -1;
}
*tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr);
@@ -1999,8 +2117,9 @@ TkDeadAppCmd(
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
- Tcl_AppendResult(interp, "can't invoke \"", argv[0],
- "\" command: application has been destroyed", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't invoke \"%s\" command: application has been destroyed",
+ argv[0]));
return TCL_ERROR;
}