/* * tclTest.c -- * * This file contains C command procedures for a bunch of additional * Tcl commands that are used for testing out Tcl's C interfaces. * These commands are not normally included in Tcl applications; * they're only used for testing. * * Copyright (c) 1993 The Regents of the University of California. * All rights reserved. * * Permission is hereby granted, without written agreement and without * license or royalty fees, to use, copy, modify, and distribute this * software and its documentation for any purpose, provided that the * above copyright notice and the following two paragraphs appear in * all copies of this software. * * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. */ #ifndef lint static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkTest.c,v 1.6 93/08/26 14:38:22 ouster Exp $ SPRITE (Berkeley)"; #endif /* not lint */ #include "tk.h" #include "tkConfig.h" /* * The following variable is a special hack that allows applications * to be linked using the procedure "main" from the Tcl library. The * variable generates a reference to "main", which causes main to * be brought in from the library (and all of Tcl with it). */ extern int main(); int *tclDummyMainPtr = (int *) main; /* * Forward declarations for procedures defined later in this file: */ static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); /* *---------------------------------------------------------------------- * * Tcl_AppInit -- * * This procedure performs application-specific initialization. * Most applications, especially those that incorporate additional * packages, will have their own version of this procedure. * * Results: * Returns a standard Tcl completion code, and leaves an error * message in interp->result if an error occurs. * * Side effects: * Depends on the startup script. * *---------------------------------------------------------------------- */ int Tcl_AppInit(interp) Tcl_Interp *interp; /* Interpreter for application. */ { Tk_Window main; main = Tk_MainWindow(interp); if (main == NULL) { return TCL_ERROR; } /* * Call the init procedures for included packages. Each call should * look like this: * * if (Mod_Init(interp) == TCL_ERROR) { * return TCL_ERROR; * } * * where "Mod" is the name of the module. */ if (Tcl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Create additional commands for testing Tk. */ Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd, (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); /* * Specify a user-specific startup file to invoke if the application * is run interactively. Typically the startup file is "~/.apprc" * where "app" is the name of the application. If this line is deleted * then no user-specific startup file will be run under any conditions. */ tcl_RcFileName = "~/.wishrc"; return TCL_OK; } /* *---------------------------------------------------------------------- * * TestmakeexistCmd -- * * This procedure implements the "testmakeexist" command. It calls * Tk_MakeWindowExist on each of its arguments to force the windows * to be created. * * Results: * A standard Tcl result. * * Side effects: * Creates and deletes interpreters. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestmakeexistCmd(clientData, interp, argc, argv) ClientData clientData; /* Main window for application. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { Tk_Window main = (Tk_Window) clientData; int i; Tk_Window tkwin; for (i = 1; i < argc; i++) { tkwin = Tk_NameToWindow(interp, argv[i], main); if (tkwin == NULL) { return TCL_ERROR; } Tk_MakeWindowExist(tkwin); } return TCL_OK; }