1996-09-27 06:29:02 -04:00
|
|
|
|
/*
|
|
|
|
|
* tkUnixInit.c --
|
|
|
|
|
*
|
|
|
|
|
* This file contains Unix-specific interpreter initialization
|
|
|
|
|
* functions.
|
|
|
|
|
*
|
1998-04-10 06:59:06 -04:00
|
|
|
|
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
|
1996-09-27 06:29:02 -04:00
|
|
|
|
*
|
|
|
|
|
* See the file "license.terms" for information on usage and redistribution
|
|
|
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
|
|
|
*
|
1998-04-10 06:59:06 -04:00
|
|
|
|
* SCCS: @(#) tkUnixInit.c 1.24 97/07/24 14:46:09
|
1996-09-27 06:29:02 -04:00
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
#include "tkInt.h"
|
|
|
|
|
#include "tkUnixInt.h"
|
|
|
|
|
|
|
|
|
|
#ifndef STk_CODE
|
|
|
|
|
/*
|
1998-04-10 06:59:06 -04:00
|
|
|
|
* The Init script (common to Windows and Unix platforms) is
|
|
|
|
|
* defined in tkInitScript.h
|
1996-09-27 06:29:02 -04:00
|
|
|
|
*/
|
1998-04-10 06:59:06 -04:00
|
|
|
|
#include "tkInitScript.h"
|
|
|
|
|
#endif
|
1996-09-27 06:29:02 -04:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
*----------------------------------------------------------------------
|
|
|
|
|
*
|
1998-04-10 06:59:06 -04:00
|
|
|
|
* TkpInit --
|
1996-09-27 06:29:02 -04:00
|
|
|
|
*
|
|
|
|
|
* Performs Unix-specific interpreter initialization related to the
|
|
|
|
|
* tk_library variable.
|
|
|
|
|
*
|
|
|
|
|
* Results:
|
|
|
|
|
* Returns a standard Tcl result. Leaves an error message or result
|
|
|
|
|
* in interp->result.
|
|
|
|
|
*
|
|
|
|
|
* Side effects:
|
|
|
|
|
* Sets "tk_library" Tcl variable, runs "tk.tcl" script.
|
|
|
|
|
*
|
|
|
|
|
*----------------------------------------------------------------------
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
int
|
1998-04-10 06:59:06 -04:00
|
|
|
|
TkpInit(interp)
|
1996-09-27 06:29:02 -04:00
|
|
|
|
Tcl_Interp *interp;
|
|
|
|
|
{
|
1998-04-10 06:59:06 -04:00
|
|
|
|
TkCreateXEventSource();
|
1998-09-30 07:11:02 -04:00
|
|
|
|
#ifdef STk_CODE
|
1998-04-10 06:59:06 -04:00
|
|
|
|
return TCL_OK;
|
1996-09-27 06:29:02 -04:00
|
|
|
|
#else
|
|
|
|
|
return Tcl_Eval(interp, initScript);
|
|
|
|
|
#endif
|
|
|
|
|
}
|
1998-04-10 06:59:06 -04:00
|
|
|
|
|
|
|
|
|
#ifndef STk_CODE
|
|
|
|
|
/*
|
|
|
|
|
*----------------------------------------------------------------------
|
|
|
|
|
*
|
|
|
|
|
* TkpGetAppName --
|
|
|
|
|
*
|
|
|
|
|
* Retrieves the name of the current application from a platform
|
|
|
|
|
* specific location. For Unix, the application name is the tail
|
|
|
|
|
* of the path contained in the tcl variable argv0.
|
|
|
|
|
*
|
|
|
|
|
* Results:
|
|
|
|
|
* Returns the application name in the given Tcl_DString.
|
|
|
|
|
*
|
|
|
|
|
* Side effects:
|
|
|
|
|
* None.
|
|
|
|
|
*
|
|
|
|
|
*----------------------------------------------------------------------
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
TkpGetAppName(interp, namePtr)
|
|
|
|
|
Tcl_Interp *interp;
|
|
|
|
|
Tcl_DString *namePtr; /* A previously initialized Tcl_DString. */
|
|
|
|
|
{
|
|
|
|
|
char *p, *name;
|
|
|
|
|
|
|
|
|
|
name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
|
|
|
|
|
if ((name == NULL) || (*name == 0)) {
|
|
|
|
|
name = "tk";
|
|
|
|
|
} else {
|
|
|
|
|
p = strrchr(name, '/');
|
|
|
|
|
if (p != NULL) {
|
|
|
|
|
name = p+1;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
Tcl_DStringAppend(namePtr, name, -1);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
*----------------------------------------------------------------------
|
|
|
|
|
*
|
|
|
|
|
* TkpDisplayWarning --
|
|
|
|
|
*
|
|
|
|
|
* This routines is called from Tk_Main to display warning
|
|
|
|
|
* messages that occur during startup.
|
|
|
|
|
*
|
|
|
|
|
* Results:
|
|
|
|
|
* None.
|
|
|
|
|
*
|
|
|
|
|
* Side effects:
|
|
|
|
|
* Generates messages on stdout.
|
|
|
|
|
*
|
|
|
|
|
*----------------------------------------------------------------------
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
void
|
|
|
|
|
TkpDisplayWarning(msg, title)
|
|
|
|
|
char *msg; /* Message to be displayed. */
|
|
|
|
|
char *title; /* Title of warning. */
|
|
|
|
|
{
|
|
|
|
|
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|
|
|
|
if (errChannel) {
|
|
|
|
|
Tcl_Write(errChannel, title, -1);
|
|
|
|
|
Tcl_Write(errChannel, ": ", 2);
|
|
|
|
|
Tcl_Write(errChannel, msg, -1);
|
|
|
|
|
Tcl_Write(errChannel, "\n", 1);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|