source: tol/tolbase/generic/tolbase.c @ e09b3c6

1941-docker-image-to-testdevel
Last change on this file since e09b3c6 was e09b3c6, checked in by Jorge Pérez <josp.jorge@…>, 11 years ago

en windows tol.dll no se enlaza con tolbase.exe ya que la carga de los simbolos desde una dll en windows es siempre global

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7231 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 5.1 KB
Line 
1/*
2 * tkAppInit.c --
3 *
4 *      Provides a default version of the Tcl_AppInit procedure for
5 *      use in wish and similar Tk-based applications.
6 *
7 * Copyright (c) 1993 The Regents of the University of California.
8 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 */
13
14#include "tk.h"
15#include "locale.h"
16#ifdef WIN32
17#include <windows.h>
18#else
19#include "tol/tol_init.h"
20#endif
21
22// Tcl_SetStartupScript
23#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5
24//#include "tclIntDecls.h"
25#endif
26
27static int g_argc = 0;
28static char **g_argv = NULL;
29
30static
31void SetupArgv( Tcl_Interp *interp )
32{
33  Tcl_Obj *argvPtr = Tcl_NewListObj(0, NULL);
34  int i;
35  for( i = 1; i < g_argc; i++ )
36    {
37      Tcl_DString ds;
38      Tcl_ExternalToUtfDString(NULL, g_argv[i], -1, &ds);
39      Tcl_ListObjAppendElement(NULL, argvPtr,
40                               Tcl_NewStringObj(Tcl_DStringValue(&ds),
41                                                Tcl_DStringLength(&ds)));
42      Tcl_DStringFree(&ds);
43    }
44    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
45    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(g_argc-1), TCL_GLOBAL_ONLY);
46}
47
48#ifdef TK_TEST
49extern int              Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
50#endif /* TK_TEST */
51
52/*
53 *----------------------------------------------------------------------
54 *
55 * main --
56 *
57 *      This is the main program for the application.
58 *
59 * Results:
60 *      None: Tk_Main never returns here, so this procedure never
61 *      returns either.
62 *
63 * Side effects:
64 *      Whatever the application does.
65 *
66 *----------------------------------------------------------------------
67 */
68
69#ifdef WIN32
70#pragma comment(linker, "/SUBSYSTEM:windows /ENTRY:mainCRTStartup")
71#endif
72
73int
74main(argc, argv)
75    int argc;                   /* Number of command-line arguments. */
76    char **argv;                /* Values of command-line arguments. */
77{
78    /*
79     * The following #if block allows you to change the AppInit
80     * function by using a #define of TCL_LOCAL_APPINIT instead
81     * of rewriting this entire file.  The #if checks for that
82     * #define and uses Tcl_AppInit if it doesn't exist.
83     */
84   
85#ifndef TK_LOCAL_APPINIT
86#define TK_LOCAL_APPINIT Tcl_AppInit   
87#endif
88    extern int TK_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
89
90    //HWND hwnd = GetConsoleWindow();
91    //ShowWindow(hwnd, 0);
92   
93    /*
94     * The following #if block allows you to change how Tcl finds the startup
95     * script, prime the library or encoding paths, fiddle with the argv,
96     * etc., without needing to rewrite Tk_Main()
97     */
98   
99#ifdef TK_LOCAL_MAIN_HOOK
100    extern int TK_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
101    TK_LOCAL_MAIN_HOOK(&argc, &argv);
102#endif
103
104#ifndef WIN32
105    const char * version = TOLVersion();
106#endif
107    Tk_Main(argc, argv, TK_LOCAL_APPINIT);
108    return 0;                   /* Needed only to prevent compiler warning. */
109}
110
111/*
112 *----------------------------------------------------------------------
113 *
114 * Tcl_AppInit --
115 *
116 *      This procedure performs application-specific initialization.
117 *      Most applications, especially those that incorporate additional
118 *      packages, will have their own version of this procedure.
119 *
120 * Results:
121 *      Returns a standard Tcl completion code, and leaves an error
122 *      message in the interp's result if an error occurs.
123 *
124 * Side effects:
125 *      Depends on the startup script.
126 *
127 *----------------------------------------------------------------------
128 */
129
130int
131Tcl_AppInit(interp)
132    Tcl_Interp *interp;         /* Interpreter for application. */
133{
134    if (Tcl_Init(interp) == TCL_ERROR) {
135        return TCL_ERROR;
136    }
137    if (Tk_Init(interp) == TCL_ERROR) {
138        return TCL_ERROR;
139    }
140    // Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
141
142
143    /*
144     * Call the init procedures for included packages.  Each call should
145     * look like this:
146     *
147     * if (Mod_Init(interp) == TCL_ERROR) {
148     *     return TCL_ERROR;
149     * }
150     *
151     * where "Mod" is the name of the module.
152     */
153
154    /*
155     * Call Tcl_CreateCommand for application-specific commands, if
156     * they weren't already created by the init procedures called above.
157     */
158
159    /*
160     * Specify a user-specific startup file to invoke if the application
161     * is run interactively.  Typically the startup file is "~/.apprc"
162     * where "app" is the name of the application.  If this line is deleted
163     * then no user-specific startup file will be run under any conditions.
164     */
165
166#if defined(WIN32)
167    SetupArgv( interp );
168    Tcl_VarEval( interp, "lappend", " auto_path", " [file join",
169                 " [file dir [file dir ", Tcl_GetNameOfExecutable(),
170                 " ] ] lib ]", NULL );
171    if ( !Tcl_PkgRequire( interp, "TolbaseApp", TOLBASE_VERSION, 1) )
172      {
173        printf( "%s\n", Tcl_GetStringResult( interp ) );
174        Tcl_Exit( -1 );
175      }
176    //Tcl_PkgRequire( interp, "TolbaseApp", TOLBASE_VERSION, 1);
177#else
178    const char* exeName = Tcl_GetNameOfExecutable();
179    Tcl_VarEval( interp, "file join",
180                 " [ file dir ", Tcl_GetNameOfExecutable(),
181                 " ] tolbase.tcl", NULL );
182    Tcl_Obj *objPath = Tcl_GetObjResult( interp );
183    Tcl_SetStartupScript( Tcl_GetObjResult( interp ), NULL );
184#endif
185    return TCL_OK;
186}
Note: See TracBrowser for help on using the repository browser.