Tk Source Code

    int screenIndex)		/* Index of new screen. */
{
    Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d",
	    dispName, screenIndex);
    int code;

    Tcl_IncrRefCount(cmdObj);
    code = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (changing screen in event binding)");
	Tcl_BackgroundException(interp, code);
    }
    Tcl_DecrRefCount(cmdObj);
}

    Tcl_Channel consoleChannel;

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

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

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

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

    Tcl_Preserve(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(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;
}

/*

    default:
	CLANG_ASSERT(0);
    }

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

	Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL);
	return TCL_ERROR;
    }

    Tcl_Preserve(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));

    XEvent *eventPtr)
{
    if (eventPtr->type == DestroyNotify) {
	ConsoleInfo *info = 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(info);
	}
    }
}

    InteractiveState is;

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

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

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

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

	 * 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) {
	    Tcl_BackgroundException(textPtr->interp, code);
	    goto gotWindow;
	}
	nameObj = Tcl_GetObjResult(textPtr->interp);
	Tcl_IncrRefCount(nameObj);

    ThreadSpecificData *tsdPtr;

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

    if (Tcl_InitStubs(interp, "8.6", 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.6", 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_BackgroundException(interp, code);
	}
    }
    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_BackgroundException(interp, code);
	}
    }
    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_BackgroundException(interp, code);
	}
    }
    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_BackgroundException(interp, code);

    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_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (command for \"%s\" window manager protocol)",
			Tk_GetAtomName((Tk_Window) winPtr, protocol)));
		Tcl_BackgroundError(interp);
	    }
	    Tcl_Release(interp);

		else true; \
		fi; \
	    done;
	@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.6.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(riPtr);
	localInterp = riPtr->interp;
	Tcl_Preserve(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(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(protPtr);
	    interp = protPtr->interp;
	    Tcl_Preserve(interp);
	    result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
	    if (result != TCL_OK) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (command for \"%s\" window manager protocol)",
			protocolName));
		Tcl_BackgroundException(interp, result);
	    }
	    Tcl_Release(interp);

		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.6.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_BackgroundException(interp, code);
	}
	Tcl_DStringFree(&cmdString);

	Tcl_ServiceAll();

	     */

	    const char *name = Tk_GetAtomName((Tk_Window) winPtr, 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_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (command for \"%s\" window manager protocol)",
			name));
		Tcl_BackgroundException(interp, result);
	    }
	    Tcl_Release(interp);