From 16b9be5313ada51ee31c48018912217deb5f09c5 Mon Sep 17 00:00:00 2001 From: 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