Tk Source Code

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TK
#define _TK

#include <tcl.h>
#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION < 5)
#	error Tk 8.5 must be compiled with tcl.h from Tcl 8.5
#endif

#ifndef _ANSI_ARGS_
#   ifndef NO_PROTOTYPES
#	define _ANSI_ARGS_(x)	x
#   else
#	define _ANSI_ARGS_(x)	()
#   endif
#endif

/*
 * For C++ compilers, use extern "C"
 */

#ifdef __cplusplus
extern "C" {

}

/*
 *----------------------------------------------------------------------
 *
 * TkCopyAndGlobalEval --
 *
 *	This function makes a copy of a script then calls Tcl_EvalEx to
 *	evaluate it. It's used in situations where the execution of a command
 *	may cause the original command string to be reallocated.
 *
 * Results:
 *	Returns the result of evaluating script, including both a standard Tcl
 *	completion code and a string in the interp's result.
 *

    Tcl_Channel consoleChannel;

    /*
     * Ensure that we are getting the matching version of Tcl. This is really
     * only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
        return;
    }

    consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
    if (*consoleInitPtr) {
	/* We've already initialized console channels in this thread. */
	return;

    if (mainWindow) {
	Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
		ConsoleEventProc, (ClientData) info);
	info->refCount++;
    }

    Tcl_Preserve((ClientData) consoleInterp);
    result = Tcl_EvalEx(consoleInterp, "source $tk_library/console.tcl",
	    -1, TCL_EVAL_GLOBAL);
    if (result == TCL_ERROR) {
	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(consoleInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
    }
    Tcl_Release((ClientData) consoleInterp);
    if (result == TCL_ERROR) {

			Tcl_NewStringObj("stdout", -1));
	    }
	    Tcl_ListObjAppendElement(NULL, cmd,
		    Tcl_NewStringObj(bytes, numBytes));

	    Tcl_DStringFree(&ds);
	    Tcl_IncrRefCount(cmd);
	    Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
	    Tcl_DecrRefCount(cmd);
	}
    }
    return toWrite;
}

/*

	}
	break;
    }

    Tcl_IncrRefCount(cmd);
    if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	Tcl_Preserve((ClientData) consoleInterp);
	result = Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(consoleInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
	Tcl_Release((ClientData) consoleInterp);
    } else {
	Tcl_AppendResult(interp, "no active console interp", NULL);
	result = TCL_ERROR;

	Tcl_AppendResult(interp, "no active master interp", NULL);
	return TCL_ERROR;
    }

    Tcl_Preserve((ClientData) otherInterp);
    switch ((enum option) index) {
    case OTHER_EVAL:
   	result = Tcl_EvalObjEx(otherInterp, objv[2], TCL_EVAL_GLOBAL);
	/*
	 * TODO: Should exceptions be filtered here?
	 */
	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(otherInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
	break;

    XEvent *eventPtr)
{
    if (eventPtr->type == DestroyNotify) {
	ConsoleInfo *info = (ConsoleInfo *) clientData;
	Tcl_Interp *consoleInterp = info->consoleInterp;

	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	    Tcl_EvalEx(consoleInterp, "tk::ConsoleExit", -1, TCL_EVAL_GLOBAL);
	}

	if (--info->refCount <= 0) {
	    ckfree((char *) info);
	}
    }
}

    Tcl_DString appName;

    /*
     * Ensure that we are getting the matching version of Tcl. This is really
     * only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	abort();
    }

#if defined(__WIN32__) && !defined(__WIN64__) && !defined(STATIC_BUILD)

    if (tclStubsPtr->reserved9) {
	/* We are running win32 Tk under Cygwin, so let's check

    Tk_Window tkwin,
    KeySym keySym)
{
    CBinding *cbindPtr;

    cbindPtr = (CBinding *) clientData;

    return Tcl_EvalEx(interp, cbindPtr->command, -1, TCL_EVAL_GLOBAL);
}

static void
CBindingFreeProc(
    ClientData clientData)
{
    CBinding *cbindPtr = (CBinding *) clientData;

    if (cbindPtr->delete != NULL) {
	Tcl_EvalEx(cbindPtr->interp, cbindPtr->delete, -1, TCL_EVAL_GLOBAL);
	ckfree((char *) cbindPtr->delete);
    }
    ckfree((char *) cbindPtr->command);
    ckfree((char *) cbindPtr);
}

/*

	 * creation script. The script must return the window's path name:
	 * look up that name to get back to the window token. Then register
	 * ourselves as the geometry manager for the window.
	 */

	if (dsPtr != NULL) {
	    Tcl_DStringAppend(dsPtr, before, (int) (string-before));
	    code = Tcl_EvalEx(textPtr->interp, Tcl_DStringValue(dsPtr), -1, TCL_EVAL_GLOBAL);
	    Tcl_DStringFree(dsPtr);
	} else {
	    code = Tcl_EvalEx(textPtr->interp, ewPtr->body.ew.create, -1, TCL_EVAL_GLOBAL);
	}
	if (code != TCL_OK) {
	createError:
	    Tcl_BackgroundError(textPtr->interp);
	    goto gotWindow;
	}
	Tcl_DStringInit(&name);

    ThreadSpecificData *tsdPtr;

    /*
     * Ensure that we are getting the matching version of Tcl. This is really
     * only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }

    /*
     * Ensure that our obj-types are registered with the Tcl runtime.
     */

	code = Tcl_VarEval(interp, "wm geometry . ", geometry, NULL);
	if (code != TCL_OK) {
	    goto done;
	}
	geometry = NULL;
    }

    if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Provide Tk and its stub table.
     */

 */

static void ThemeChangedProc(ClientData clientData)
{
    static char ThemeChangedScript[] = "ttk::ThemeChanged";
    StylePackageData *pkgPtr = clientData;

    if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL) != TCL_OK) {
	Tcl_BackgroundError(pkgPtr->interp);
    }
    pkgPtr->themeChangePending = 0;
}

/*
 * ThemeChanged --

    SRefCon handlerRefcon)
{
    Tcl_CmdInfo dummy;
    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;

    if (interp &&
	    Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){
	int code = Tcl_EvalEx(interp, "::tk::mac::OpenApplication", -1, TCL_EVAL_GLOBAL);
	if (code != TCL_OK) {
	    Tcl_BackgroundError(interp);
	}
    }
    return noErr;
}


    Tcl_CmdInfo dummy;
    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
    ProcessSerialNumber thePSN = {0, kCurrentProcess};
    OSStatus err = ChkErr(SetFrontProcess, &thePSN);

    if (interp && Tcl_GetCommandInfo(interp,
	    "::tk::mac::ReopenApplication", &dummy)) {
	int code = Tcl_EvalEx(interp, "::tk::mac::ReopenApplication", -1, TCL_EVAL_GLOBAL);
	if (code != TCL_OK){
	    Tcl_BackgroundError(interp);
	}
    }
    return err;
}


    SRefCon handlerRefcon)
{
    Tcl_CmdInfo dummy;
    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;

    if (interp &&
	    Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
	int code = Tcl_EvalEx(interp, "::tk::mac::ShowPreferences", -1, TCL_EVAL_GLOBAL);
	if (code != TCL_OK) {
	    Tcl_BackgroundError(interp);
	}
    }
    return noErr;
}


ReallyKillMe(
    Tcl_Event *eventPtr,
    int flags)
{
    Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
    Tcl_CmdInfo dummy;
    int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
    int code = Tcl_EvalEx(interp, quit ? "::tk::mac::Quit" : "exit", -1, TCL_EVAL_GLOBAL);

    if (code != TCL_OK) {
	/*
	 * Should be never reached...
	 */

	Tcl_BackgroundError(interp);

    protocol = (Atom) eventPtr->xclient.data.l[0];
    for (protPtr = wmPtr->protPtr; protPtr != NULL;
	    protPtr = protPtr->nextPtr) {
	if (protocol == protPtr->protocol) {
	    Tcl_Preserve(protPtr);
	    interp = protPtr->interp;
	    Tcl_Preserve(interp);
	    result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
	    if (result != TCL_OK) {
		Tcl_AddErrorInfo(interp, "\n    (command for \"");
		Tcl_AddErrorInfo(interp,
			Tk_GetAtomName((Tk_Window) winPtr, protocol));
		Tcl_AddErrorInfo(interp, "\" window manager protocol)");
		Tcl_BackgroundError(interp);
	    }

#
# This file is a Makefile for Tk.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.

# Current Tk version;  used in various names.

TCLVERSION		= @TCL_VERSION@

VERSION 		= @TK_VERSION@
MAJOR_VERSION		= @TK_MAJOR_VERSION@
MINOR_VERSION		= @TK_MINOR_VERSION@
PATCH_LEVEL		= @TK_PATCH_LEVEL@
LOCALES			= @LOCALES@

#----------------------------------------------------------------

	@if test "x$(TK_SHARED_BUILD)" = "x1"; then \
	    echo "Creating package index $(PKG_INDEX)"; \
	    rm -f "$(PKG_INDEX)"; \
	    (\
	    echo "if {[catch {package present Tcl 8.5.0}]} return";\
	    relative=`echo | awk '{ORS=" "; split("$(TK_PKG_DIR)",a,"/"); for (f in a) {print ".."}}'`;\
	    if test "x$(DLL_INSTALL_DIR)" != "x$(BIN_INSTALL_DIR)"; then \
	    echo "package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}$(TK_LIB_FILE)]] Tk]";\
	    else \
	    echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\
	    echo "	|| ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\
	    echo "    package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}.. bin $(TK_LIB_FILE)]] Tk]";\
	    echo "} else {";\
	    echo "    package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}.. bin tk${MAJOR_VERSION}${MINOR_VERSION}.dll]] Tk]";\
	    echo "}";\
	    fi \
	    ) > "$(PKG_INDEX)"; \
	    fi
	@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
	@@INSTALL_LIB@
	@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"

		|| (strcmp(riPtr->name, destName) != 0)) {
	    continue;
	}
	Tcl_Preserve((ClientData) riPtr);
	localInterp = riPtr->interp;
	Tcl_Preserve((ClientData) localInterp);
	if (firstArg == (argc-1)) {
	    result = Tcl_EvalEx(localInterp, argv[firstArg], -1, TCL_EVAL_GLOBAL);
	} else {
	    Tcl_DStringInit(&request);
	    Tcl_DStringAppend(&request, argv[firstArg], -1);
	    for (i = firstArg+1; i < argc; i++) {
		Tcl_DStringAppend(&request, " ", 1);
		Tcl_DStringAppend(&request, argv[i], -1);
	    }
	    result = Tcl_EvalEx(localInterp, Tcl_DStringValue(&request), -1, TCL_EVAL_GLOBAL);
	    Tcl_DStringFree(&request);
	}
	if (interp != localInterp) {
	    if (result == TCL_ERROR) {
		Tcl_Obj *errorObjPtr;

		/*

	     * We must protect the interpreter because the script may enter
	     * another event loop, which might call Tcl_DeleteInterp.
	     */

	    remoteInterp = riPtr->interp;
	    Tcl_Preserve((ClientData) remoteInterp);

	    result = Tcl_EvalEx(remoteInterp, script, -1, TCL_EVAL_GLOBAL);

	    /*
	     * The call to Tcl_Release may have released the interpreter which
	     * will cause the "send" command for that interpreter to be
	     * deleted. The command deletion callback will set the
	     * riPtr->interp field to NULL, hence the check below for NULL.
	     */

    protocolName = Tk_GetAtomName((Tk_Window) winPtr, protocol);
    for (protPtr = wmPtr->protPtr; protPtr != NULL;
	    protPtr = protPtr->nextPtr) {
	if (protocol == protPtr->protocol) {
	    Tcl_Preserve((ClientData) protPtr);
	    interp = protPtr->interp;
	    Tcl_Preserve((ClientData) interp);
	    result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
	    if (result != TCL_OK) {
		Tcl_AddErrorInfo(interp, "\n    (command for \"");
		Tcl_AddErrorInfo(interp, protocolName);
		Tcl_AddErrorInfo(interp,
			"\" window manager protocol)");
		Tcl_BackgroundError(interp);
	    }

# This file is a Makefile for Tk.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.



VERSION			= @TK_VERSION@
PATCH_LEVEL		= @TK_PATCH_LEVEL@

#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
# site (you can make these changes in either Makefile.in or
# Makefile, but changes to Makefile will get lost if you re-run

		echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
		$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
	    fi; \
	    done
	@echo "Creating package index $(PKG_INDEX)";
	@$(RM) $(PKG_INDEX);
	@(\
	echo "if {[catch {package present Tcl 8.5.0}]} return";\
	echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\
	echo "	|| ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\
	echo "    package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin libtk$(VERSION).dll]] Tk]";\
	echo "} else {";\
	echo "    package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin $(TK_DLL_FILE)]] Tk]";\
	echo "}";\
	) > $(PKG_INDEX);
	@for i in tkConfig.sh $(TK_LIB_FILE) $(TK_STUB_LIB_FILE); \
	    do \
	    if [ -f $$i ]; then \
		echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
		$(COPY) $$i "$(LIB_INSTALL_DIR)"; \

	    Tcl_PrintDouble(NULL, pos, valueString);
	    Tcl_DStringAppendElement(&cmdString, "moveto");
	    Tcl_DStringAppendElement(&cmdString, valueString);
	}

	interp = scrollPtr->info.interp;
	code = Tcl_EvalEx(interp, cmdString.string, -1, TCL_EVAL_GLOBAL);
	if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
	    Tcl_AddErrorInfo(interp, "\n    (scrollbar command)");
	    Tcl_BackgroundError(interp);
	}
	Tcl_DStringFree(&cmdString);

	Tcl_ServiceAll();

	     */

	    const char *name = Tk_GetAtomName((Tk_Window) winPtr, protocol);

	    Tcl_Preserve((ClientData) protPtr);
	    interp = protPtr->interp;
	    Tcl_Preserve((ClientData) interp);
	    result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
	    if (result != TCL_OK) {
		Tcl_AddErrorInfo(interp, "\n    (command for \"");
		Tcl_AddErrorInfo(interp, name);
		Tcl_AddErrorInfo(interp, "\" window manager protocol)");
		Tcl_BackgroundError(interp);
	    }
	    Tcl_Release((ClientData) interp);