/* -*- mode: C -*- Time-stamp: "2005-06-09 17:35:28 jemarch" * * File: ferret.c * Author: Jose E. Marchesi * Date: Sat May 22 17:29:07 2004 * * Ferret main file. * */ #include #include #include ferret_globals_t ferret_globals; /* Ferret global data */ /*- * Routine: main * Purpose: * Ferret entry function. * * Initialize Ferret. * Initialize the Tcl/Tk system. * Give control to the Tk event loop. * Return to the operating system. * * Conditions: * None * Returns: * 0 in the case of success * | An <>0 error code * */ int main (int argc, char *argv[]) { /* Create a Tcl interpreter */ ferret_globals.master_tcl_interpreter = Tcl_CreateInterp (); /* * Initialize Ferret * */ ferret_globals.projects = ferret_project_list_create (); /* Read and shoot up the Ferret Tcl subsystem */ if (ferret_init_tk (ferret_globals.master_tcl_interpreter) == TCL_ERROR) { /* Print the error message */ ferret_string_t error_message; error_message = ferret_string_new (); ferret_string_append_string (error_message, "tcl: ", -1); ferret_string_append_integer (error_message, ferret_globals.master_tcl_interpreter->errorLine, -1); ferret_string_append_string (error_message, ": ", -1); ferret_string_append_string (error_message, (char *) Tcl_GetStringResult (ferret_globals.master_tcl_interpreter), -1); ferret_panic (error_message); /* Return an error code to the operating system */ return 1; } /* Ok, from the tk loop. Destroy the interpreter */ Tcl_DeleteInterp (ferret_globals.master_tcl_interpreter); /* Return to the operating system with a success code */ return(0); } /* End of routine main */ /*- * Routine: ferret_init_tk * Purpose: * Initialize the Tk system. * Read and shoot up the Ferret GUI. * Conditions: * Must be only called by Tk_Main (it expect a * correctly created Tcl interpreter as the * argument) * Returns: * TCL_OK * | TCL_ERROR * */ int ferret_init_tk (Tcl_Interp *interp) { /* * Initialize Tcl packages and extensions * */ /* Tcl itself */ if (Tcl_Init (interp) == TCL_ERROR) { /* Return fail */ return TCL_ERROR; } /* The Tk extension */ if (Tk_Init (interp) == TCL_ERROR) { /* Return fail */ return TCL_ERROR; } /* * Define the Ferret commands. */ ferret_tcl_init (); /* * Set the Tcl library finding paths via * the Tcl `auto_path' variable, in order to * find the Tcl Ferret scripts */ if (ferret_set_autopath (interp) == TCL_ERROR) { /* Return fail */ return TCL_ERROR; } /* * Set some Tcl global variables. */ if (ferret_set_globals (interp) == TCL_ERROR) { /* Return fail */ return TCL_ERROR; } /* Shoot up the Ferret GUI */ if (ferret_setup_GUI (interp) == TCL_ERROR) { /* Was troubles starting the GUI */ /* Return fail */ return TCL_ERROR; } /* Make an event loop and stay in it */ Tk_MainLoop (); /* All was ok */ return TCL_OK; } /* End of routine ferret_init_tk */ /*- * Routine: ferret_setup_GUI * Purpose: * Shoot up the Ferret graphical user interface, * reading the Tcl scripts in which it is coded. * Conditions: * INTERP must be a correctly initialized Tcl interpreter. * The Tk library must be initialized with Tk_Init. * The Tcl packages defined by the GUI must be accessible * via a correct setting of the `auto_path' variable. * The current Tcl procedure scope must be the global one. * Returns: * None * */ int ferret_setup_GUI (Tcl_Interp *interp) { ferret_string_t file_name; /* * Eval the `ferret.tcl' Tcl script * * We should not use a constant string there, due that the * `Tcl_Eval' procedure seems to modify the string passed as * argument. So an error may be signaled if the string is stored in * read-only memory (circunstance that likely will happen if a * strign constant is used). So a Tcl dynamic string is used * instead (ie. a Ferret string). */ /* Tcl_DStringInit (&file_name); */ file_name = ferret_string_new (); /* Construct the path to the Ferret `ferret.tcl' script */ ferret_string_append_string (file_name, FERRET_TCL_SCRIPTS_PATH, -1); /* The main Ferret Tcl script */ ferret_string_append_string (file_name, "/ferret.tcl", -1); /* Eval it with INTERP */ if (Tcl_EvalFile (interp, ferret_string_value (file_name)) == TCL_ERROR) { /* Return fail to `ferret_setup_GUI' */ return TCL_ERROR; } /* Free memory */ ferret_string_free (file_name); /* All was fine. Return success */ return TCL_OK; } /* End of routine ferret_setup_GUI */ /*- * Routine: ferret_set_autopath * Purpose: * Set up the Tcl `auto_path' variable with * the location of the Ferret Tcl scripts. * Conditions: * INTERP must be a correctly initialized Tcl interpreter. * The current Tcl procedure scope must be the global one. * Returns: * TCL_OK * | TCL_ERROR * */ int ferret_set_autopath (Tcl_Interp *interp) { /* Add the scripts path to the `auto_path' Tcl variable */ Tcl_SetVar (interp, "auto_path", FERRET_TCL_SCRIPTS_PATH, TCL_LIST_ELEMENT | TCL_APPEND_VALUE); /* Add the erdm datamodel path to the `auto_path' Tcl variable */ { ferret_string_t erdm_path; erdm_path = ferret_string_new (); ferret_string_append_string (erdm_path, FERRET_TCL_SCRIPTS_PATH, -1); ferret_string_append_string (erdm_path, "/erdm", -1); Tcl_SetVar (interp, "auto_path", ferret_string_value (erdm_path), TCL_LIST_ELEMENT | TCL_APPEND_VALUE); ferret_string_free (erdm_path); } /* All was ok. Return a success value to ferret_init_tk */ return TCL_OK; } /* End of routine ferret_set_autopath */ /*- * Routine: ferret_set_globals * Purpose: * Set some Tcl global variables. * * `images_path' * `scripts_path' * * Conditions: * INTERP must be a correctly initialized Tcl interpreter. * Returns: * TCL_OK | TCL_ERROR * */ int ferret_set_globals (Tcl_Interp *interp) { /* * Set the `images_path' Tcl variable */ Tcl_SetVar (interp, "images_path", FERRET_TCL_IMAGES_PATH, 0); /* * Set the `scripts_path' Tcl variable */ Tcl_SetVar (interp, "scripts_path", FERRET_TCL_SCRIPTS_PATH, 0); } /* End of routine ferret_set_globals */