summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-08-08 19:21:18 (GMT)
committerericm <ericm>2000-08-08 19:21:18 (GMT)
commit33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6 (patch)
tree2a6d14dee1938780ae6220656dce380c37b42e99
parentd6e970588203e0065e68d0d64c1bf8ebadc8397c (diff)
downloadtk-33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6.zip
tk-33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6.tar.gz
tk-33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6.tar.bz2
* tests/place.test: Extended test suite to test error returns from
[place]. * generic/tkInt.h: Replaced Tk_PlaceCmd prototype with Tk_PlaceObjCmd prototype. * generic/tkWindow.c: Updated [place] command entry to use new Tcl_Obj interface. * generic/tkPlace.c (Tk_PlaceObjCmd): Tcl_Obj'ified [place] command.
-rw-r--r--ChangeLog13
-rw-r--r--generic/tkInt.h7
-rw-r--r--generic/tkPlace.c625
-rw-r--r--generic/tkWindow.c4
-rw-r--r--tests/place.test95
5 files changed, 464 insertions, 280 deletions
diff --git a/ChangeLog b/ChangeLog
index 8433492..cf2376b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2000-08-08 Eric Melski <ericm@ajubasolutions.com>
+
+ * tests/place.test: Extended test suite to test error returns from
+ [place].
+
+ * generic/tkInt.h: Replaced Tk_PlaceCmd prototype with
+ Tk_PlaceObjCmd prototype.
+
+ * generic/tkWindow.c: Updated [place] command entry to use new
+ Tcl_Obj interface.
+
+ * generic/tkPlace.c (Tk_PlaceObjCmd): Tcl_Obj'ified [place] command.
+
2000-08-07 Eric Melski <ericm@ajubasolutions.com>
* generic/tkWindow.c: Updated [selection] command entry to use
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 38f36ef..de0c907 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.32 2000/08/07 21:49:16 ericm Exp $
+ * RCS: $Id: tkInt.h,v 1.33 2000/08/08 19:21:19 ericm Exp $
*/
#ifndef _TKINT
@@ -977,8 +977,9 @@ EXTERN int Tk_OptionObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Obj *CONST objv[]));
EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_PlaceObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_((
ClientData clientData,
Tcl_Interp *interp, int objc,
diff --git a/generic/tkPlace.c b/generic/tkPlace.c
index 6521f9e..9525bc5 100644
--- a/generic/tkPlace.c
+++ b/generic/tkPlace.c
@@ -10,12 +10,13 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkPlace.c,v 1.6 2000/05/29 01:42:34 hobbs Exp $
+ * RCS: @(#) $Id: tkPlace.c,v 1.7 2000/08/08 19:21:19 ericm Exp $
*/
#include "tkPort.h"
#include "tkInt.h"
+
/*
* Border modes for relative placement:
*
@@ -27,6 +28,12 @@
* master's actual window size.
*/
+#ifdef USE_WIDGET_CONFIG
+static char *borderModeStrings[] = {
+ "inside", "outside", "ignore", (char *) NULL
+};
+#endif /* USE_WIDGET_CONFIG */
+
typedef enum {BM_INSIDE, BM_OUTSIDE, BM_IGNORE} BorderMode;
/*
@@ -51,10 +58,18 @@ typedef struct Slave {
*/
int x, y; /* X and Y pixel coordinates for tkwin. */
- float relX, relY; /* X and Y coordinates relative to size of
+#ifdef USE_WIDGET_CONFIGURE
+ Tcl_Obj *xPtr, *yPtr; /* Tcl_Obj rep's of x, y coords, to keep
+ * pixel spec. information */
+#endif /* USE_WIDGET_CONFIGURE */
+ double relX, relY; /* X and Y coordinates relative to size of
* master. */
int width, height; /* Absolute dimensions for tkwin. */
- float relWidth, relHeight; /* Dimensions for tkwin relative to size of
+#ifdef USE_WIDGET_CONFIGURE
+ Tcl_Obj *widthPtr; /* Tcl_Obj rep of width, to keep pixel spec */
+ Tcl_Obj *heightPtr; /* Tcl_Obj rep of height, to keep pixel spec */
+#endif /* USE_WIDGET_CONFIGURE */
+ double relWidth, relHeight; /* Dimensions for tkwin relative to size of
* master. */
Tk_Anchor anchor; /* Which point on tkwin is placed at the
* given position. */
@@ -63,6 +78,35 @@ typedef struct Slave {
* definitions. */
} Slave;
+#ifdef USE_WIDGET_CONFIG
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_ANCHOR, "-anchor", NULL, NULL, "nw", -1,
+ Tk_Offset(Slave, anchor), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-bordermode", NULL, NULL, "inside", -1,
+ Tk_Offset(Slave, borderMode), 0, (ClientData) borderModeStrings, 0},
+ {TK_OPTION_PIXELS, "-height", NULL, NULL, "", Tk_Offset(Slave, heightPtr),
+ Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_WINDOW, "-in", NULL, NULL, "", -1, Tk_Offset(Slave, tkwin),
+ 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-relheight", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relHeight), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-relwidth", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relWidth), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-relx", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relX), 0, 0, 0},
+ {TK_OPTION_DOUBLE, "-rely", NULL, NULL, "0", -1,
+ Tk_Offset(Slave, relY), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-width", NULL, NULL, "", Tk_Offset(Slave, widthPtr),
+ Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-x", NULL, NULL, "", Tk_Offset(Slave, xPtr),
+ Tk_Offset(Slave, x), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-y", NULL, NULL, "", Tk_Offset(Slave, yPtr),
+ Tk_Offset(Slave, y), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+#endif /* USE_WIDGET_CONFIG */
+
/*
* Flag definitions for Slave structures:
*
@@ -121,7 +165,7 @@ static Tk_GeomMgr placerType = {
static void SlaveStructureProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
static int ConfigureSlave _ANSI_ARGS_((Tcl_Interp *interp,
- Slave *slavePtr, int argc, char **argv));
+ Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
static Slave * FindSlave _ANSI_ARGS_((Tk_Window tkwin));
static Master * FindMaster _ANSI_ARGS_((Tk_Window tkwin));
static void MasterStructureProc _ANSI_ARGS_((ClientData clientData,
@@ -132,7 +176,7 @@ static void UnlinkSlave _ANSI_ARGS_((Slave *slavePtr));
/*
*--------------------------------------------------------------
*
- * Tk_PlaceCmd --
+ * Tk_PlaceObjCmd --
*
* This procedure is invoked to process the "place" Tcl
* commands. See the user documentation for details on
@@ -148,33 +192,36 @@ static void UnlinkSlave _ANSI_ARGS_((Slave *slavePtr));
*/
int
-Tk_PlaceCmd(clientData, interp, argc, argv)
+Tk_PlaceObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tk_Window tkwin;
Slave *slavePtr;
Tcl_HashEntry *hPtr;
- size_t length;
- int c;
+ char *string;
TkDisplay *dispPtr;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option|pathName args", (char *) NULL);
+ static char *optionStrings[] = { "configure", "forget", "info", "slaves",
+ (char *) NULL };
+ enum options { PLACE_CONFIGURE, PLACE_FORGET, PLACE_INFO, PLACE_SLAVES };
+ int index;
+
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option|pathName args");
return TCL_ERROR;
}
- c = argv[1][0];
- length = strlen(argv[1]);
+ string = Tcl_GetString(objv[1]);
+
/*
* Handle special shortcut where window name is first argument.
*/
- if (c == '.') {
- tkwin = Tk_NameToWindow(interp, argv[1], (Tk_Window) clientData);
+ if (string[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, string, Tk_MainWindow(interp));
if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -191,7 +238,7 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
}
slavePtr = FindSlave(tkwin);
- return ConfigureSlave(interp, slavePtr, argc-2, argv+2);
+ return ConfigureSlave(interp, slavePtr, objc-2, objv+2);
}
/*
@@ -199,7 +246,8 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
* by possible additional arguments.
*/
- tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]),
+ Tk_MainWindow(interp));
if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -215,118 +263,130 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
dispPtr->placeInit = 1;
}
- if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
- if (argc < 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0],
- " configure pathName option value ?option value ...?\"",
- (char *) NULL);
- return TCL_ERROR;
- }
- slavePtr = FindSlave(tkwin);
- return ConfigureSlave(interp, slavePtr, argc-3, argv+3);
- } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " forget pathName\"", (char *) NULL);
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
- if (hPtr == NULL) {
- return TCL_OK;
- }
- slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
- if ((slavePtr->masterPtr != NULL) &&
- (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
- Tk_UnmaintainGeometry(slavePtr->tkwin,
- slavePtr->masterPtr->tkwin);
- }
- UnlinkSlave(slavePtr);
- Tcl_DeleteHashEntry(hPtr);
- Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
- (ClientData) slavePtr);
- Tk_ManageGeometry(tkwin, (Tk_GeomMgr *) NULL, (ClientData) NULL);
- Tk_UnmapWindow(tkwin);
- ckfree((char *) slavePtr);
- } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
- char buffer[32 + TCL_INTEGER_SPACE];
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " info pathName\"", (char *) NULL);
- return TCL_ERROR;
+ switch ((enum options) index) {
+ case PLACE_CONFIGURE: {
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "pathName option value ?option value ...?");
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ return ConfigureSlave(interp, slavePtr, objc-3, objv+3);
}
- hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
- if (hPtr == NULL) {
- return TCL_OK;
+
+ case PLACE_FORGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ if ((slavePtr->masterPtr != NULL) &&
+ (slavePtr->masterPtr->tkwin !=
+ Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ Tcl_DeleteHashEntry(hPtr);
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask,
+ SlaveStructureProc, (ClientData) slavePtr);
+ Tk_ManageGeometry(tkwin, (Tk_GeomMgr *) NULL, (ClientData) NULL);
+ Tk_UnmapWindow(tkwin);
+ ckfree((char *) slavePtr);
+ break;
}
- slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
- sprintf(buffer, "-x %d", slavePtr->x);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- sprintf(buffer, " -relx %.4g", slavePtr->relX);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- sprintf(buffer, " -y %d", slavePtr->y);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- sprintf(buffer, " -rely %.4g", slavePtr->relY);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- if (slavePtr->flags & CHILD_WIDTH) {
- sprintf(buffer, " -width %d", slavePtr->width);
+
+ case PLACE_INFO: {
+ char buffer[32 + TCL_INTEGER_SPACE];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ sprintf(buffer, "-x %d", slavePtr->x);
Tcl_AppendResult(interp, buffer, (char *) NULL);
- } else {
- Tcl_AppendResult(interp, " -width {}", (char *) NULL);
- }
- if (slavePtr->flags & CHILD_REL_WIDTH) {
- sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth);
+ sprintf(buffer, " -relx %.4g", slavePtr->relX);
Tcl_AppendResult(interp, buffer, (char *) NULL);
- } else {
- Tcl_AppendResult(interp, " -relwidth {}", (char *) NULL);
- }
- if (slavePtr->flags & CHILD_HEIGHT) {
- sprintf(buffer, " -height %d", slavePtr->height);
+ sprintf(buffer, " -y %d", slavePtr->y);
Tcl_AppendResult(interp, buffer, (char *) NULL);
- } else {
- Tcl_AppendResult(interp, " -height {}", (char *) NULL);
- }
- if (slavePtr->flags & CHILD_REL_HEIGHT) {
- sprintf(buffer, " -relheight %.4g", slavePtr->relHeight);
+ sprintf(buffer, " -rely %.4g", slavePtr->relY);
Tcl_AppendResult(interp, buffer, (char *) NULL);
- } else {
- Tcl_AppendResult(interp, " -relheight {}", (char *) NULL);
+ if (slavePtr->flags & CHILD_WIDTH) {
+ sprintf(buffer, " -width %d", slavePtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -width {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -relwidth {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ sprintf(buffer, " -height %d", slavePtr->height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -height {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ sprintf(buffer, " -relheight %.4g", slavePtr->relHeight);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -relheight {}", (char *) NULL);
+ }
+
+ Tcl_AppendResult(interp, " -anchor ",
+ Tk_NameOfAnchor(slavePtr->anchor),
+ (char *) NULL);
+ if (slavePtr->borderMode == BM_OUTSIDE) {
+ Tcl_AppendResult(interp, " -bordermode outside",
+ (char *) NULL);
+ } else if (slavePtr->borderMode == BM_IGNORE) {
+ Tcl_AppendResult(interp, " -bordermode ignore", (char *) NULL);
+ }
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin !=
+ Tk_Parent(slavePtr->tkwin))) {
+ Tcl_AppendResult(interp, " -in ",
+ Tk_PathName(slavePtr->masterPtr->tkwin),
+ (char *) NULL);
+ }
+ break;
}
- Tcl_AppendResult(interp, " -anchor ", Tk_NameOfAnchor(slavePtr->anchor),
- (char *) NULL);
- if (slavePtr->borderMode == BM_OUTSIDE) {
- Tcl_AppendResult(interp, " -bordermode outside", (char *) NULL);
- } else if (slavePtr->borderMode == BM_IGNORE) {
- Tcl_AppendResult(interp, " -bordermode ignore", (char *) NULL);
- }
- if ((slavePtr->masterPtr != NULL)
- && (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
- Tcl_AppendResult(interp, " -in ",
- Tk_PathName(slavePtr->masterPtr->tkwin), (char *) NULL);
- }
- } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " slaves pathName\"", (char *) NULL);
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin);
- if (hPtr != NULL) {
- Master *masterPtr;
- masterPtr = (Master *) Tcl_GetHashValue(hPtr);
- for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
- slavePtr = slavePtr->nextPtr) {
- Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ case PLACE_SLAVES: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pathName");
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin);
+ if (hPtr != NULL) {
+ Master *masterPtr;
+ masterPtr = (Master *) Tcl_GetHashValue(hPtr);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
}
+ break;
}
- } else {
- Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
- "\": must be configure, forget, info, or slaves",
- (char *) NULL);
- return TCL_ERROR;
}
+
return TCL_OK;
}
@@ -485,17 +545,24 @@ FindMaster(tkwin)
*/
static int
-ConfigureSlave(interp, slavePtr, argc, argv)
+ConfigureSlave(interp, slavePtr, objc, objv)
Tcl_Interp *interp; /* Used for error reporting. */
Slave *slavePtr; /* Pointer to current information
* about slave. */
- int argc; /* Number of config arguments. */
- char **argv; /* String values for arguments. */
+ int objc; /* Number of config arguments. */
+ Tcl_Obj *CONST objv[]; /* Object values for arguments. */
{
register Master *masterPtr;
- int c, result;
- size_t length;
- double d;
+ int result;
+ Tcl_Obj **objs;
+ static char *optionStrings[] = { "-anchor", "-bordermode", "-height",
+ "-in", "-relheight", "-relwidth",
+ "-relx", "-rely", "-width", "-x",
+ "-y", (char *) NULL };
+ enum options { PLACE_ANCHOR, PLACE_BORDERMODE, PLACE_HEIGHT, PLACE_IN,
+ PLACE_RELHEIGHT, PLACE_RELWIDTH, PLACE_RELX, PLACE_RELY,
+ PLACE_WIDTH, PLACE_X, PLACE_Y };
+ int index;
result = TCL_OK;
if (Tk_IsTopLevel(slavePtr->tkwin)) {
@@ -504,171 +571,207 @@ ConfigureSlave(interp, slavePtr, argc, argv)
(char *) NULL);
return TCL_ERROR;
}
- for ( ; argc > 0; argc -= 2, argv += 2) {
- if (argc < 2) {
- Tcl_AppendResult(interp, "extra option \"", argv[0],
- "\" (option with no value?)", (char *) NULL);
+ for (objs = (Tcl_Obj **)objv; objc > 0; objc -= 2, objs += 2) {
+
+ /*
+ * Verify that the option given is a legitimate one.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objs[0], optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Verify that there is a value for the option.
+ */
+
+ if (objc < 2) {
+ Tcl_AppendResult(interp, "value missing for option \"",
+ Tcl_GetString(objs[0]), "\"", (char *) NULL);
result = TCL_ERROR;
goto done;
}
- length = strlen(argv[0]);
- c = argv[0][1];
- if ((c == 'a') && (strncmp(argv[0], "-anchor", length) == 0)) {
- if (Tk_GetAnchor(interp, argv[1], &slavePtr->anchor) != TCL_OK) {
- result = TCL_ERROR;
- goto done;
- }
- } else if ((c == 'b')
- && (strncmp(argv[0], "-bordermode", length) == 0)) {
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'i') && (strncmp(argv[1], "ignore", length) == 0)
- && (length >= 2)) {
- slavePtr->borderMode = BM_IGNORE;
- } else if ((c == 'i') && (strncmp(argv[1], "inside", length) == 0)
- && (length >= 2)) {
- slavePtr->borderMode = BM_INSIDE;
- } else if ((c == 'o')
- && (strncmp(argv[1], "outside", length) == 0)) {
- slavePtr->borderMode = BM_OUTSIDE;
- } else {
- Tcl_AppendResult(interp, "bad border mode \"", argv[1],
- "\": must be ignore, inside, or outside",
- (char *) NULL);
- result = TCL_ERROR;
- goto done;
+
+ switch ((enum options) index) {
+ case PLACE_ANCHOR: {
+ if (Tk_GetAnchor(interp, Tcl_GetString(objs[1]),
+ &slavePtr->anchor) != TCL_OK) {
+ result = TCL_ERROR;
+ }
+ break;
}
- } else if ((c == 'h') && (strncmp(argv[0], "-height", length) == 0)) {
- if (argv[1][0] == 0) {
- slavePtr->flags &= ~CHILD_HEIGHT;
- } else {
- if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
- &slavePtr->height) != TCL_OK) {
+
+ case PLACE_BORDERMODE: {
+ static char *bordermodeStrings[] = { "ignore", "inside",
+ "outside",
+ (char *) NULL };
+ enum bordermodes { BORDERMODE_IGNORE, BORDERMODE_INSIDE,
+ BORDERMODE_OUTSIDE };
+ int borderIndex;
+ if (Tcl_GetIndexFromObj(interp, objs[1], bordermodeStrings,
+ "border mode", 0, &borderIndex) != TCL_OK) {
result = TCL_ERROR;
- goto done;
+ break;
}
- slavePtr->flags |= CHILD_HEIGHT;
+ switch ((enum bordermodes) borderIndex) {
+ case BORDERMODE_IGNORE:
+ slavePtr->borderMode = BM_IGNORE;
+ break;
+ case BORDERMODE_INSIDE:
+ slavePtr->borderMode = BM_INSIDE;
+ break;
+ case BORDERMODE_OUTSIDE:
+ slavePtr->borderMode = BM_OUTSIDE;
+ break;
+ }
+ break;
}
- } else if ((c == 'i') && (strncmp(argv[0], "-in", length) == 0)) {
- Tk_Window tkwin;
- Tk_Window ancestor;
-
- tkwin = Tk_NameToWindow(interp, argv[1], slavePtr->tkwin);
- if (tkwin == NULL) {
- result = TCL_ERROR;
- goto done;
+
+ case PLACE_HEIGHT: {
+ if (*(Tcl_GetString(objs[1])) == 0) {
+ slavePtr->flags &= ~CHILD_HEIGHT;
+ } else {
+ if (Tk_GetPixelsFromObj(interp, slavePtr->tkwin, objs[1],
+ &slavePtr->height) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ slavePtr->flags |= CHILD_HEIGHT;
+ }
+ break;
}
- /*
- * Make sure that the new master is either the logical parent
- * of the slave or a descendant of that window, and that the
- * master and slave aren't the same.
- */
-
- for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
- if (ancestor == Tk_Parent(slavePtr->tkwin)) {
+ case PLACE_IN: {
+ Tk_Window tkwin;
+ Tk_Window ancestor;
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[1]),
+ slavePtr->tkwin);
+ if (tkwin == NULL) {
+ result = TCL_ERROR;
break;
}
- if (Tk_IsTopLevel(ancestor)) {
+
+ /*
+ * Make sure that the new master is either the logical parent
+ * of the slave or a descendant of that window, and that the
+ * master and slave aren't the same.
+ */
+
+ for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(slavePtr->tkwin)) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to ",
+ Tk_PathName(tkwin), (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (slavePtr->tkwin == tkwin) {
Tcl_AppendResult(interp, "can't place ",
- Tk_PathName(slavePtr->tkwin), " relative to ",
- Tk_PathName(tkwin), (char *) NULL);
+ Tk_PathName(slavePtr->tkwin),
+ " relative to itself",
+ (char *) NULL);
result = TCL_ERROR;
goto done;
}
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin == tkwin)) {
+ /*
+ * Re-using same old master. Nothing to do.
+ */
+ } else {
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin
+ != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ slavePtr->masterPtr = FindMaster(tkwin);
+ slavePtr->nextPtr = slavePtr->masterPtr->slavePtr;
+ slavePtr->masterPtr->slavePtr = slavePtr;
+ }
+ break;
}
- if (slavePtr->tkwin == tkwin) {
- Tcl_AppendResult(interp, "can't place ",
- Tk_PathName(slavePtr->tkwin), " relative to itself",
- (char *) NULL);
- result = TCL_ERROR;
- goto done;
+
+ case PLACE_RELHEIGHT: {
+ if (*(Tcl_GetString(objs[1])) == 0) {
+ slavePtr->flags &= ~CHILD_REL_HEIGHT;
+ } else {
+ if (Tcl_GetDoubleFromObj(interp, objs[1],
+ &slavePtr->relHeight) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ slavePtr->flags |= CHILD_REL_HEIGHT;
+ }
+ break;
}
- if ((slavePtr->masterPtr != NULL)
- && (slavePtr->masterPtr->tkwin == tkwin)) {
- /*
- * Re-using same old master. Nothing to do.
- */
- } else {
- if ((slavePtr->masterPtr != NULL)
- && (slavePtr->masterPtr->tkwin
- != Tk_Parent(slavePtr->tkwin))) {
- Tk_UnmaintainGeometry(slavePtr->tkwin,
- slavePtr->masterPtr->tkwin);
+
+ case PLACE_RELWIDTH: {
+ if (*(Tcl_GetString(objs[1])) == 0) {
+ slavePtr->flags &= ~CHILD_REL_WIDTH;
+ } else {
+ if (Tcl_GetDoubleFromObj(interp, objs[1],
+ &slavePtr->relWidth) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ slavePtr->flags |= CHILD_REL_WIDTH;
}
- UnlinkSlave(slavePtr);
- slavePtr->masterPtr = FindMaster(tkwin);
- slavePtr->nextPtr = slavePtr->masterPtr->slavePtr;
- slavePtr->masterPtr->slavePtr = slavePtr;
+ break;
}
- } else if ((c == 'r') && (strncmp(argv[0], "-relheight", length) == 0)
- && (length >= 5)) {
- if (argv[1][0] == 0) {
- slavePtr->flags &= ~CHILD_REL_HEIGHT;
- } else {
- if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+
+ case PLACE_RELX: {
+ if (Tcl_GetDoubleFromObj(interp, objs[1],
+ &slavePtr->relX) != TCL_OK) {
result = TCL_ERROR;
- goto done;
}
- slavePtr->relHeight = (float) d;
- slavePtr->flags |= CHILD_REL_HEIGHT;
+ break;
}
- } else if ((c == 'r') && (strncmp(argv[0], "-relwidth", length) == 0)
- && (length >= 5)) {
- if (argv[1][0] == 0) {
- slavePtr->flags &= ~CHILD_REL_WIDTH;
- } else {
- if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+
+ case PLACE_RELY: {
+ if (Tcl_GetDoubleFromObj(interp, objs[1],
+ &slavePtr->relY) != TCL_OK) {
result = TCL_ERROR;
- goto done;
}
- slavePtr->relWidth = (float) d;
- slavePtr->flags |= CHILD_REL_WIDTH;
- }
- } else if ((c == 'r') && (strncmp(argv[0], "-relx", length) == 0)
- && (length >= 5)) {
- if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
- result = TCL_ERROR;
- goto done;
+ break;
}
- slavePtr->relX = (float) d;
- } else if ((c == 'r') && (strncmp(argv[0], "-rely", length) == 0)
- && (length >= 5)) {
- if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
- result = TCL_ERROR;
- goto done;
+
+ case PLACE_WIDTH: {
+ if (*(Tcl_GetString(objs[1])) == 0) {
+ slavePtr->flags &= ~CHILD_WIDTH;
+ } else {
+ if (Tk_GetPixelsFromObj(interp, slavePtr->tkwin, objs[1],
+ &slavePtr->width) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ slavePtr->flags |= CHILD_WIDTH;
+ }
+ break;
}
- slavePtr->relY = (float) d;
- } else if ((c == 'w') && (strncmp(argv[0], "-width", length) == 0)) {
- if (argv[1][0] == 0) {
- slavePtr->flags &= ~CHILD_WIDTH;
- } else {
- if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
- &slavePtr->width) != TCL_OK) {
+
+ case PLACE_X: {
+ if (Tk_GetPixelsFromObj(interp, slavePtr->tkwin, objs[1],
+ &slavePtr->x) != TCL_OK) {
result = TCL_ERROR;
- goto done;
}
- slavePtr->flags |= CHILD_WIDTH;
- }
- } else if ((c == 'x') && (strncmp(argv[0], "-x", length) == 0)) {
- if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
- &slavePtr->x) != TCL_OK) {
- result = TCL_ERROR;
- goto done;
+ break;
}
- } else if ((c == 'y') && (strncmp(argv[0], "-y", length) == 0)) {
- if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
- &slavePtr->y) != TCL_OK) {
- result = TCL_ERROR;
- goto done;
+
+ case PLACE_Y: {
+ if (Tk_GetPixelsFromObj(interp, slavePtr->tkwin, objs[1],
+ &slavePtr->y) != TCL_OK) {
+ result = TCL_ERROR;
+ }
+ break;
}
- } else {
- Tcl_AppendResult(interp, "unknown or ambiguous option \"",
- argv[0], "\": must be -anchor, -bordermode, -height, ",
- "-in, -relheight, -relwidth, -relx, -rely, -width, ",
- "-x, or -y", (char *) NULL);
- result = TCL_ERROR;
- goto done;
}
}
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 8c96940..09b24c5 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -12,7 +12,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.24 2000/08/07 21:49:16 ericm Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.25 2000/08/08 19:21:20 ericm Exp $
*/
#include "tkPort.h"
@@ -111,7 +111,7 @@ static TkCmd commands[] = {
{"lower", NULL, Tk_LowerObjCmd, 1, 1},
{"option", NULL, Tk_OptionObjCmd, 1, 1},
{"pack", Tk_PackCmd, NULL, 1, 1},
- {"place", Tk_PlaceCmd, NULL, 1, 1},
+ {"place", NULL, Tk_PlaceObjCmd, 1, 0},
{"raise", NULL, Tk_RaiseObjCmd, 1, 1},
{"selection", NULL, Tk_SelectionObjCmd, 0, 1},
{"tk", NULL, Tk_TkObjCmd, 0, 1},
diff --git a/tests/place.test b/tests/place.test
index ea4014b..86f663d 100644
--- a/tests/place.test
+++ b/tests/place.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: place.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
+# RCS: @(#) $Id: place.test,v 1.4 2000/08/08 19:21:20 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -216,21 +216,88 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} {
lappend result [winfo ismapped .t.f2]
} {1 0 42 32 0 1}
+test place-9.1 {PlaceObjCmd} {
+ list [catch {place} msg] $msg
+} [list 1 "wrong # args: should be \"place option|pathName args\""]
+test place-9.2 {PlaceObjCmd} {
+ list [catch {place foo} msg] $msg
+} [list 1 "wrong # args: should be \"place option|pathName args\""]
+test place-9.3 {PlaceObjCmd} {
+ catch {destroy .foo}
+ list [catch {place .foo bar} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test place-9.4 {PlaceObjCmd} {
+ catch {destroy .foo}
+ list [catch {place bar .foo} msg] $msg
+} [list 1 "bad window path name \".foo\""]
+test place-9.5 {PlaceObjCmd} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place badopt .foo} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "bad option \"badopt\": must be configure, forget, info, or slaves"]
+test place-9.6 {PlaceObjCmd, configure errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place configure .foo} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place configure pathName option value ?option value ...?\""]
+test place-9.7 {PlaceObjCmd, configure errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place configure .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place configure pathName option value ?option value ...?\""]
+test place-9.8 {PlaceObjCmd, forget errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place forget .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place forget pathName\""]
+test place-9.9 {PlaceObjCmd, info errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place info .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place info pathName\""]
+test place-9.10 {PlaceObjCmd, slaves errors} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place slaves .foo bar} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "wrong # args: should be \"place slaves pathName\""]
+
+test place-10.1 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place .foo -badopt} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "bad option \"-badopt\": must be -anchor, -bordermode, -height, -in, -relheight, -relwidth, -relx, -rely, -width, -x, or -y"]
+test place-10.2 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place .foo -anchor} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "value missing for option \"-anchor\""]
+test place-10.3 {ConfigureSlave} {
+ catch {destroy .foo}
+ frame .foo
+ set res [list [catch {place .foo -bordermode j} msg] $msg]
+ destroy .foo
+ set res
+} [list 1 "bad border mode \"j\": must be ignore, inside, or outside"]
+
+
catch {destroy .t}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-