Tk Source Code

    /*
     * Get the generic preamble. We only ever bother with the ASCII encoding;
     * the others just make life too complicated and never actually worked as
     * such.
     */

    result = Tcl_EvalEx(interp, "::tk::ensure_psenc_is_loaded", -1, 0);
    if (result != TCL_OK) {
	return result;
    }
    preambleObj = Tcl_GetVar2Ex(interp, "::tk::ps_preamble", NULL,
	    TCL_LEAVE_ERR_MSG);
    if (preambleObj == NULL) {
	return TCL_ERROR;

    TkCanvas *canvasPtr)		/* Information about canvas. */
{
    int result;
    Tcl_Interp *interp;
    int xOrigin, yOrigin, inset, width, height;
    int scrollX1, scrollX2, scrollY1, scrollY2;
    char *xScrollCmd, *yScrollCmd;
    Tcl_DString buf;

    /*
     * Save all the relevant values from the canvasPtr, because it might be
     * deleted as part of either of the two calls to Tcl_VarEval below.
     */

    interp = canvasPtr->interp;

    scrollY1 = canvasPtr->scrollY1;
    scrollY2 = canvasPtr->scrollY2;
    canvasPtr->flags &= ~UPDATE_SCROLLBARS;
    if (canvasPtr->xScrollCmd != NULL) {
	Tcl_Obj *fractions = ScrollFractions(xOrigin + inset,
		xOrigin + width - inset, scrollX1, scrollX2);

	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, xScrollCmd, -1);
	Tcl_DStringAppend(&buf, " ", -1);
	Tcl_DStringAppend(&buf, Tcl_GetString(fractions), -1);
	result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	Tcl_DecrRefCount(fractions);
	if (result != TCL_OK) {
	    Tcl_BackgroundException(interp, result);
	}
	Tcl_ResetResult(interp);
	Tcl_Release(xScrollCmd);
    }

    if (yScrollCmd != NULL) {
	Tcl_Obj *fractions = ScrollFractions(yOrigin + inset,
		yOrigin + height - inset, scrollY1, scrollY2);

	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, yScrollCmd, -1);
	Tcl_DStringAppend(&buf, " ", -1);
	Tcl_DStringAppend(&buf, Tcl_GetString(fractions), -1);
	result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	Tcl_DecrRefCount(fractions);
	if (result != TCL_OK) {
	    Tcl_BackgroundException(interp, result);
	}
	Tcl_ResetResult(interp);
	Tcl_Release(yScrollCmd);
    }

EntryUpdateScrollbar(
    Entry *entryPtr)			/* Information about widget. */
{
    char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
    int code;
    double first, last;
    Tcl_Interp *interp;
    Tcl_DString buf;

    if (entryPtr->scrollCmd == NULL) {
	return;
    }

    interp = entryPtr->interp;
    Tcl_Preserve(interp);
    EntryVisibleRange(entryPtr, &first, &last);
    Tcl_PrintDouble(NULL, first, firstStr);
    Tcl_PrintDouble(NULL, last, lastStr);
    Tcl_DStringInit(&buf);
    Tcl_DStringAppend(&buf, entryPtr->scrollCmd, -1);
    Tcl_DStringAppend(&buf, " ", -1);
    Tcl_DStringAppend(&buf, firstStr, -1);
    Tcl_DStringAppend(&buf, " ", -1);
    Tcl_DStringAppend(&buf, lastStr, -1);
    code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
    Tcl_DStringFree(&buf);
    if (code != TCL_OK) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (horizontal scrolling command executed by %s)",
		Tk_PathName(entryPtr->tkwin)));
	Tcl_BackgroundException(interp, code);
    }
    Tcl_ResetResult(interp);

ListboxUpdateVScrollbar(
    register Listbox *listPtr)	/* Information about widget. */
{
    char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
    double first, last;
    int result;
    Tcl_Interp *interp;
    Tcl_DString buf;

    if (listPtr->yScrollCmd == NULL) {
	return;
    }
    if (listPtr->nElements == 0) {
	first = 0.0;
	last = 1.0;

    /*
     * We must hold onto the interpreter from the listPtr because the data at
     * listPtr might be freed as a result of the Tcl_VarEval.
     */

    interp = listPtr->interp;
    Tcl_Preserve(interp);
    Tcl_DStringInit(&buf);
    Tcl_DStringAppend(&buf, listPtr->yScrollCmd, -1);
    Tcl_DStringAppend(&buf, " ", -1);
    Tcl_DStringAppend(&buf, firstStr, -1);
    Tcl_DStringAppend(&buf, " ", -1);
    Tcl_DStringAppend(&buf, lastStr, -1);
    result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
    Tcl_DStringFree(&buf);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (vertical scrolling command executed by listbox)");
	Tcl_BackgroundException(interp, result);
    }
    Tcl_Release(interp);
}

ListboxUpdateHScrollbar(
    register Listbox *listPtr)	/* Information about widget. */
{
    char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE];
    int result, windowWidth;
    double first, last;
    Tcl_Interp *interp;
    Tcl_DString buf;

    if (listPtr->xScrollCmd == NULL) {
	return;
    }

    windowWidth = Tk_Width(listPtr->tkwin)
	    - 2*(listPtr->inset + listPtr->selBorderWidth);

    /*
     * We must hold onto the interpreter because the data referred to at
     * listPtr might be freed as a result of the call to Tcl_VarEval.
     */

    interp = listPtr->interp;
    Tcl_Preserve(interp);
    Tcl_DStringInit(&buf);
    Tcl_DStringAppend(&buf, listPtr->xScrollCmd, -1);
    Tcl_DStringAppend(&buf, " ", -1);
    Tcl_DStringAppend(&buf, firstStr, -1);
    Tcl_DStringAppend(&buf, " ", -1);
    Tcl_DStringAppend(&buf, lastStr, -1);
    result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
    Tcl_DStringFree(&buf);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (horizontal scrolling command executed by listbox)");
	Tcl_BackgroundException(interp, result);
    }
    Tcl_Release(interp);
}

    Tcl_Preserve(mePtr);
    if (mePtr->type == TEAROFF_ENTRY) {
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "tk::TearOffMenu ", -1);
	Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
	result = Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
	Tcl_DStringFree(&ds);
    } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
	    && (mePtr->namePtr != NULL)) {
	Tcl_Obj *valuePtr;

	if (mePtr->entryFlags & ENTRY_SELECTED) {
	    valuePtr = mePtr->offValuePtr;

    tuple = Tcl_NewListObj(3, values);
    if (command == NULL) {
	Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple);
	Tcl_DecrRefCount(tuple);
	return 0;
    } else {
	int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree);
	Tcl_DString buf;
	int code;

	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, Tcl_GetString(command), -1);
	Tcl_DStringAppend(&buf, " ", -1);
	Tcl_DStringAppend(&buf, Tcl_GetString(tuple), -1);
	code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (segment dumping command executed by text)");
	    Tcl_BackgroundException(interp, code);
	}
	Tcl_DecrRefCount(tuple);
	return ((textPtr->flags & DESTROYED) ||
		TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch);
    }
}

/*

	return;
    }
    dInfoPtr->xScrollFirst = first;
    dInfoPtr->xScrollLast = last;
    if (textPtr->xScrollCmd != NULL) {
	char buf1[TCL_DOUBLE_SPACE+1];
	char buf2[TCL_DOUBLE_SPACE+1];
	Tcl_DString buf;

	buf1[0] = ' ';
	buf2[0] = ' ';
	Tcl_PrintDouble(NULL, first, buf1+1);
	Tcl_PrintDouble(NULL, last, buf2+1);
	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, textPtr->xScrollCmd, -1);
	Tcl_DStringAppend(&buf, buf1, -1);
	Tcl_DStringAppend(&buf, buf2, -1);
	code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (horizontal scrolling command executed by text)");
	    Tcl_BackgroundException(interp, code);
	}
    }
}

    }

    dInfoPtr->yScrollFirst = first;
    dInfoPtr->yScrollLast = last;
    if (textPtr->yScrollCmd != NULL) {
	char buf1[TCL_DOUBLE_SPACE+1];
	char buf2[TCL_DOUBLE_SPACE+1];
	Tcl_DString buf;

	buf1[0] = ' ';
	buf2[0] = ' ';
	Tcl_PrintDouble(NULL, first, buf1+1);
	Tcl_PrintDouble(NULL, last, buf2+1);
	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, textPtr->yScrollCmd, -1);
	Tcl_DStringAppend(&buf, buf1, -1);
	Tcl_DStringAppend(&buf, buf2, -1);
	code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (vertical scrolling command executed by text)");
	    Tcl_BackgroundException(interp, code);
	}
    }
}

	Tcl_DStringAppendElement(&ds, Tcl_GetString(Tcl_GetObjResult(master)));

	/*
	 * Step 2 : Eval in the master. The argument is the *reversed* interp
	 * path of the slave.
	 */

	code = Tcl_EvalEx(master, Tcl_DStringValue(&ds), -1, 0);
	if (code != TCL_OK) {
	    /*
	     * We might want to transfer the error message or not. We don't.
	     * (No API to do it and maybe security reasons).
	     */

	    Tcl_DStringFree(&ds);

    /*
     * Set the geometry of the main window, if requested. Put the requested
     * geometry into the "geometry" variable.
     */

    if (geometry != NULL) {
	Tcl_DString buf;

	Tcl_SetVar2(interp, "geometry", NULL, geometry, TCL_GLOBAL_ONLY);
	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, "wm geometry . ", -1);
	Tcl_DStringAppend(&buf, geometry, -1);
	code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (code != TCL_OK) {
	    goto done;
	}
	geometry = NULL;
    }

    /*

	 * to perform the search.  See the docs for that command for details
	 * on where it looks.
	 *
	 * Note that this entire search mechanism can be bypassed by defining
	 * an alternate [tkInit] command before calling Tk_Init().
	 */

	code = Tcl_EvalEx(interp,
"if {[namespace which -command tkInit] eq \"\"} {\n\
  proc tkInit {} {\n\
    global tk_library tk_version tk_patchLevel\n\
      rename tkInit {}\n\
    tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\
  }\n\
}\n\
tkInit", -1, 0);
    }
    if (code == TCL_OK) {
	/*
	 * Create exit handlers to delete all windows when the application or
	 * thread exits. The handler need to be invoked before other platform
	 * specific cleanups take place to avoid panics in finalization.
	 */

	theErr = AEGetParamPtr(event, keyDirectObject, typeFSRef, NULL, &file,
		size, NULL);
	if (theErr == noErr) {
	    Tcl_DString scriptName;

	    theErr = FSRefToDString(&file, &scriptName);
	    if (theErr == noErr) {
		tclErr = Tcl_FSEvalFileEx(interp, Tcl_DStringValue(&scriptName), NULL);
		Tcl_DStringFree(&scriptName);
	    } else {
		sprintf(errString, "AEDoScriptHandler: file not found");
		AEPutParamPtr(reply, keyErrorString, typeChar, errString,
			strlen(errString));
	    }
	}

	    Tcl_Obj *path = Tcl_GetObjResult(_eventInterp);
	    int len;

	    Tcl_GetStringFromObj(path, &len);
	    if (len) {
		Tcl_IncrRefCount(path);

		int code = Tcl_FSEvalFileEx(_eventInterp, path, NULL);

		if (code != TCL_OK) {
		    Tcl_BackgroundException(_eventInterp, code);
		}
		Tcl_DecrRefCount(path);
	    }
	}
	Tcl_ResetResult(_eventInterp);
    }
}

- (void) tkDemo: (id) sender
{
    if (_eventInterp) {
	Tcl_Obj *path = GetWidgetDemoPath(_eventInterp);

	if (path) {
	    Tcl_IncrRefCount(path);

	    int code = Tcl_FSEvalFileEx(_eventInterp, path, NULL);

	    if (code != TCL_OK) {
		Tcl_BackgroundException(_eventInterp, code);
	    }
	    Tcl_DecrRefCount(path);
	    Tcl_ResetResult(_eventInterp);
	}

    Rect r;
    WindowRef windowRef;
    CGrafPtr destPort, savePort;
    Boolean portChanged;
    MacDrawable *macDraw;
    SInt32 initialValue, minValue, maxValue;
    UInt16 numTicks;
    Tcl_DString buf;

#ifdef TK_MAC_DEBUG_SCALE
    TkMacOSXDbgMsg("TkpDisplayScale");
#endif
    scalePtr->flags &= ~REDRAW_PENDING;
    if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
	goto done;
    }

    /*
     * Invoke the scale's command if needed.
     */

    Tcl_Preserve((ClientData) scalePtr);
    if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
	Tcl_Preserve((ClientData) interp);
	sprintf(string, scalePtr->format, scalePtr->value);
	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, scalePtr->command, -1);
	Tcl_DStringAppend(&buf, " ", -1);
	Tcl_DStringAppend(&buf, string, -1);
	result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (result != TCL_OK) {
	    Tcl_AddErrorInfo(interp, "\n    (command executed by scale)");
	    Tcl_BackgroundException(interp, result);
	}
	Tcl_Release((ClientData) interp);
    }
    scalePtr->flags &= ~INVOKE_COMMAND;

    TkScale *scalePtr = (TkScale *) clientData;
    Tk_Window tkwin = scalePtr->tkwin;
    Tcl_Interp *interp = scalePtr->interp;
    Pixmap pixmap;
    int result;
    char string[PRINT_CHARS];
    XRectangle drawnArea;
    Tcl_DString buf;

    scalePtr->flags &= ~REDRAW_PENDING;
    if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
	goto done;
    }

    /*
     * Invoke the scale's command if needed.
     */

    Tcl_Preserve(scalePtr);
    if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
	Tcl_Preserve(interp);
	sprintf(string, scalePtr->format, scalePtr->value);
	Tcl_DStringInit(&buf);
	Tcl_DStringAppend(&buf, scalePtr->command, -1);

	Tcl_DStringAppend(&buf, " ", -1);
	Tcl_DStringAppend(&buf, string, -1);
	result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
	Tcl_DStringFree(&buf);
	if (result != TCL_OK) {
	    Tcl_AddErrorInfo(interp, "\n    (command executed by scale)");
	    Tcl_BackgroundException(interp, result);
	}
	Tcl_Release(interp);
    }
    scalePtr->flags &= ~INVOKE_COMMAND;