From 16b9be5313ada51ee31c48018912217deb5f09c5 Mon Sep 17 00:00:00 2001
From: ericm <ericm>
Date: Fri, 24 Mar 2000 23:13:18 +0000
Subject: * tests/xmfbox.test: Updated tests.
* generic/tkWindow.c:
* generic/tkInt.h: Updated Tcl_OptionCmd -> Tcl_OptionObjCmd
* generic/tkOption.c: Tcl_Obj'ectified the "option" command.
---
generic/tkInt.h | 7 ++-
generic/tkOption.c | 169 +++++++++++++++++++++++++++++------------------------
generic/tkWindow.c | 4 +-
tests/xmfbox.test | 35 +++++------
4 files changed, 117 insertions(+), 98 deletions(-)
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 3532475..4e3b2f8 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.21 2000/01/21 03:54:41 hobbs Exp $
+ * RCS: $Id: tkInt.h,v 1.22 2000/03/24 23:13:18 ericm Exp $
*/
#ifndef _TKINT
@@ -956,8 +956,9 @@ EXTERN int Tk_MessageBoxObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Obj *CONST objv[]));
EXTERN int Tk_MessageCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_OptionCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_OptionObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ 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,
diff --git a/generic/tkOption.c b/generic/tkOption.c
index 689723e..f35534f 100644
--- a/generic/tkOption.c
+++ b/generic/tkOption.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: tkOption.c,v 1.3 1999/04/16 01:51:20 stanton Exp $
+ * RCS: @(#) $Id: tkOption.c,v 1.4 2000/03/24 23:13:18 ericm Exp $
*/
#include "tkPort.h"
@@ -454,7 +454,7 @@ Tk_GetOption(tkwin, name, className)
/*
*--------------------------------------------------------------
*
- * Tk_OptionCmd --
+ * Tk_OptionObjCmd --
*
* This procedure is invoked to process the "option" Tcl command.
* See the user documentation for details on what it does.
@@ -469,100 +469,117 @@ Tk_GetOption(tkwin, name, className)
*/
int
-Tk_OptionCmd(clientData, interp, argc, argv)
+Tk_OptionObjCmd(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 Tcl_Obj arguments. */
+ Tcl_Obj *CONST objv[]; /* Tcl_Obj arguments. */
{
Tk_Window tkwin = (Tk_Window) clientData;
- size_t length;
- char c;
+ int index, result;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " cmd arg ?arg ...?\"", (char *) NULL);
+ static char *optionCmds[] = {
+ "add", "clear", "get", "readfile", NULL
+ };
+
+ enum optionVals {
+ OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cmd arg ?arg ...?");
return TCL_ERROR;
}
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)) {
- int priority;
-
- if ((argc != 4) && (argc != 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " add pattern value ?priority?\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (argc == 4) {
- priority = TK_INTERACTIVE_PRIO;
- } else {
- priority = ParsePriority(interp, argv[4]);
- if (priority < 0) {
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], optionCmds, "option", 0,
+ &index);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ result = TCL_OK;
+ switch ((enum optionVals) index) {
+ case OPTION_ADD: {
+ int priority;
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pattern value ?priority?");
return TCL_ERROR;
}
+
+ if (objc == 4) {
+ priority = TK_INTERACTIVE_PRIO;
+ } else {
+ priority = ParsePriority(interp, Tcl_GetString(objv[4]));
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_AddOption(tkwin, Tcl_GetString(objv[2]),
+ Tcl_GetString(objv[3]), priority);
+ break;
}
- Tk_AddOption(tkwin, argv[2], argv[3], priority);
- return TCL_OK;
- } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
- TkMainInfo *mainPtr;
-
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " clear\"", (char *) NULL);
- return TCL_ERROR;
- }
- mainPtr = ((TkWindow *) tkwin)->mainPtr;
- if (mainPtr->optionRootPtr != NULL) {
- ClearOptionTree(mainPtr->optionRootPtr);
- mainPtr->optionRootPtr = NULL;
- }
- tsdPtr->cachedWindow = NULL;
- return TCL_OK;
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
- Tk_Window window;
- Tk_Uid value;
-
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " get window name class\"", (char *) NULL);
- return TCL_ERROR;
- }
- window = Tk_NameToWindow(interp, argv[2], tkwin);
- if (window == NULL) {
- return TCL_ERROR;
- }
- value = Tk_GetOption(window, argv[3], argv[4]);
- if (value != NULL) {
- Tcl_SetResult(interp, value, TCL_STATIC);
+
+ case OPTION_CLEAR: {
+ TkMainInfo *mainPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+ mainPtr = ((TkWindow *) tkwin)->mainPtr;
+ if (mainPtr->optionRootPtr != NULL) {
+ ClearOptionTree(mainPtr->optionRootPtr);
+ mainPtr->optionRootPtr = NULL;
+ }
+ tsdPtr->cachedWindow = NULL;
+ break;
}
- return TCL_OK;
- } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) {
- int priority;
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " readfile fileName ?priority?\"",
- (char *) NULL);
- return TCL_ERROR;
+ case OPTION_GET: {
+ Tk_Window window;
+ Tk_Uid value;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window name class");
+ return TCL_ERROR;
+ }
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ value = Tk_GetOption(window, Tcl_GetString(objv[3]),
+ Tcl_GetString(objv[4]));
+ if (value != NULL) {
+ Tcl_SetResult(interp, value, TCL_STATIC);
+ }
+ break;
}
- if (argc == 4) {
- priority = ParsePriority(interp, argv[3]);
- if (priority < 0) {
+
+ case OPTION_READFILE: {
+ int priority;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?priority?");
return TCL_ERROR;
}
- } else {
- priority = TK_INTERACTIVE_PRIO;
+
+ if (objc == 4) {
+ priority = ParsePriority(interp, Tcl_GetString(objv[3]));
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ } else {
+ priority = TK_INTERACTIVE_PRIO;
+ }
+ result = ReadOptionFile(interp, tkwin, Tcl_GetString(objv[2]),
+ priority);
+ break;
}
- return ReadOptionFile(interp, tkwin, argv[2], priority);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be add, clear, get, or readfile", (char *) NULL);
- return TCL_ERROR;
}
+ return result;
}
/*
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 04dc7ee..f486234 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.15 2000/03/07 00:09:09 ericm Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.16 2000/03/24 23:13:18 ericm Exp $
*/
#include "tkPort.h"
@@ -109,7 +109,7 @@ static TkCmd commands[] = {
{"grid", Tk_GridCmd, NULL, 1, 1},
{"image", NULL, Tk_ImageObjCmd, 1, 1},
{"lower", NULL, Tk_LowerObjCmd, 1, 1},
- {"option", Tk_OptionCmd, NULL, 1, 1},
+ {"option", NULL, Tk_OptionObjCmd, 1, 1},
{"pack", Tk_PackCmd, NULL, 1, 1},
{"place", Tk_PlaceCmd, NULL, 1, 1},
{"raise", NULL, Tk_RaiseObjCmd, 1, 1},
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
index 29ebf18..52ed35d 100644
--- a/tests/xmfbox.test
+++ b/tests/xmfbox.test
@@ -9,7 +9,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: xmfbox.test,v 1.3 1999/11/12 23:55:16 wart Exp $
+# RCS: @(#) $Id: xmfbox.test,v 1.4 2000/03/24 23:13:19 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -80,8 +80,8 @@ test xmfbox-2.1 {tkMotifFDialog_InterpFilter, ~ in dir names} {unixOnly} {
cleanup
file mkdir ./~nosuchuser1
set x [tkMotifFDialog_Create foo open {}]
- $foo(fEnt) delete 0 end
- $foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
set kk [tkMotifFDialog_InterpFilter $x]
} [list $testPWD/~nosuchuser1 *]
@@ -89,8 +89,8 @@ test xmfbox-2.2 {tkMotifFDialog_InterpFilter, ~ in file names} {unixOnly} {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tkMotifFDialog_Create foo open {}]
- $foo(fEnt) delete 0 end
- $foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
set kk [tkMotifFDialog_InterpFilter $x]
} [list $testPWD ./~nosuchuser1]
@@ -98,18 +98,18 @@ test xmfbox-2.3 {tkMotifFDialog_Update, ~ in file names} {unixOnly} {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tkMotifFDialog_Create foo open {}]
- $foo(fEnt) delete 0 end
- $foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
tkMotifFDialog_InterpFilter $x
tkMotifFDialog_Update $x
- $foo(fList) get end
+ $::tk::dialog::file::foo(fList) get end
} ~nosuchuser1
test xmfbox-2.4 {tkMotifFDialog_LoadFile, ~ in file names} {unixOnly} {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tkMotifFDialog_Create foo open {}]
- set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
expr {$i >= 0}
} 1
@@ -117,23 +117,24 @@ test xmfbox-2.5 {tkMotifFDialog_BrowseFList, ~ in file names} {unixOnly} {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tkMotifFDialog_Create foo open {}]
- set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
- $foo(fList) selection clear 0 end
- $foo(fList) selection set $i
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
+ $::tk::dialog::file::foo(fList) selection clear 0 end
+ $::tk::dialog::file::foo(fList) selection set $i
tkMotifFDialog_BrowseFList $x
- $foo(sEnt) get
+ $::tk::dialog::file::foo(sEnt) get
} $testPWD/~nosuchuser1
test xmfbox-2.5 {tkMotifFDialog_ActivateFList, ~ in file names} {unixOnly} {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tkMotifFDialog_Create foo open {}]
- set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
- $foo(fList) selection clear 0 end
- $foo(fList) selection set $i
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
+ $::tk::dialog::file::foo(fList) selection clear 0 end
+ $::tk::dialog::file::foo(fList) selection set $i
tkMotifFDialog_BrowseFList $x
tkMotifFDialog_ActivateFList $x
- list $foo(selectPath) $foo(selectFile) $tkPriv(selectFilePath)
+ list $::tk::dialog::file::foo(selectPath) \
+ $::tk::dialog::file::foo(selectFile) $tkPriv(selectFilePath)
} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1]
# cleanup
--
cgit v0.12