static void LostSelection( ClientData clientData) /* Pointer to LostCommand structure. */ { LostCommand *lostPtr = clientData; Tcl_Interp *interp = lostPtr->interp; Tcl_InterpState savedState; int code; Tcl_Preserve(interp); /* * Execute the command. Save the interpreter's result, if any, and restore * it after executing the command. */ savedState = Tcl_SaveInterpState(interp, TCL_OK); Tcl_ResetResult(interp); code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundException(interp, code); } (void) Tcl_RestoreInterpState(interp, savedState); /* * Free the storage for the command, since we're done with it now. */ Tcl_DecrRefCount(lostPtr->cmdObj); ckfree(lostPtr); Tcl_Release(interp); }
int TkBackgroundEvalObjv( Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int flags) { Tcl_InterpState state; int n, r = TCL_OK; /* * Record the state of the interpreter. */ Tcl_Preserve(interp); state = Tcl_SaveInterpState(interp, TCL_OK); /* * Evaluate the command and handle any error. */ for (n = 0; n < objc; ++n) { Tcl_IncrRefCount(objv[n]); } r = Tcl_EvalObjv(interp, objc, objv, flags); for (n = 0; n < objc; ++n) { Tcl_DecrRefCount(objv[n]); } if (r == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (background event handler)"); Tcl_BackgroundException(interp, r); } /* * Restore the state of the interpreter. */ (void) Tcl_RestoreInterpState(interp, state); Tcl_Release(interp); return r; }
static int RectOvalToPostscript( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tk_Canvas canvas, /* Information about overall canvas. */ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */ int prepass) /* 1 means this is a prepass to collect font * information; 0 means final Postscript is * being created. */ { Tcl_Obj *pathObj, *psObj; RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; double y1, y2; XColor *color; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]); /* * Generate a string that creates a path for the rectangle or oval. This * is the only part of the function's code that is type-specific. */ if (rectOvalPtr->header.typePtr == &tkRectangleType) { pathObj = Tcl_ObjPrintf( "%.15g %.15g moveto " "%.15g 0 rlineto " "0 %.15g rlineto " "%.15g 0 rlineto " "closepath\n", rectOvalPtr->bbox[0], y1, rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1, rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]); } else { pathObj = Tcl_ObjPrintf( "matrix currentmatrix\n" "%.15g %.15g translate " "%.15g %.15g scale " "1 0 moveto 0 0 1 0 360 arc\n" "setmatrix\n", (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2, (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2); } if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; } color = rectOvalPtr->outline.color; fillColor = rectOvalPtr->fillColor; fillStipple = rectOvalPtr->fillStipple; if (Canvas(canvas)->currentItemPtr == itemPtr) { if (rectOvalPtr->outline.activeColor!=NULL) { color = rectOvalPtr->outline.activeColor; } if (rectOvalPtr->activeFillColor!=NULL) { fillColor = rectOvalPtr->activeFillColor; } if (rectOvalPtr->activeFillStipple!=None) { fillStipple = rectOvalPtr->activeFillStipple; } } else if (state == TK_STATE_DISABLED) { if (rectOvalPtr->outline.disabledColor!=NULL) { color = rectOvalPtr->outline.disabledColor; } if (rectOvalPtr->disabledFillColor!=NULL) { fillColor = rectOvalPtr->disabledFillColor; } if (rectOvalPtr->disabledFillStipple!=None) { fillStipple = rectOvalPtr->disabledFillStipple; } } /* * Make our working space. */ psObj = Tcl_NewObj(); interpState = Tcl_SaveInterpState(interp, TCL_OK); /* * First draw the filled area of the rectangle. */ if (fillColor != NULL) { Tcl_AppendObjToObj(psObj, pathObj); Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { goto error; } Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (fillStipple != None) { Tcl_AppendToObj(psObj, "clip ", -1); Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { goto error; } Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (color != NULL) { Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { Tcl_AppendToObj(psObj, "fill\n", -1); } } /* * Now draw the outline, if there is one. */ if (color != NULL) { Tcl_AppendObjToObj(psObj, pathObj); Tcl_AppendToObj(psObj, "0 setlinejoin 2 setlinecap\n", -1); Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &rectOvalPtr->outline)!= TCL_OK) { goto error; } Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } /* * Plug the accumulated postscript back into the result. */ (void) Tcl_RestoreInterpState(interp, interpState); Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); Tcl_DecrRefCount(psObj); Tcl_DecrRefCount(pathObj); return TCL_OK; error: Tcl_DiscardInterpState(interpState); Tcl_DecrRefCount(psObj); Tcl_DecrRefCount(pathObj); return TCL_ERROR; }
static int HandleTclCommand( ClientData clientData, /* Information about command to execute. */ int offset, /* Return selection bytes starting at this * offset. */ char *buffer, /* Place to store converted selection. */ int maxBytes) /* Maximum # of bytes to store at buffer. */ { CommandInfo *cmdInfoPtr = clientData; int length; Tcl_Obj *command; const char *string; Tcl_Interp *interp = cmdInfoPtr->interp; Tcl_InterpState savedState; int extraBytes, charOffset, count, numChars, code; const char *p; /* * We must also protect the interpreter and the command from being deleted * too soon. */ Tcl_Preserve(clientData); Tcl_Preserve(interp); /* * Compute the proper byte offset in the case where the last chunk split a * character. */ if (offset == cmdInfoPtr->byteOffset) { charOffset = cmdInfoPtr->charOffset; extraBytes = strlen(cmdInfoPtr->buffer); if (extraBytes > 0) { strcpy(buffer, cmdInfoPtr->buffer); maxBytes -= extraBytes; buffer += extraBytes; } } else { cmdInfoPtr->byteOffset = 0; cmdInfoPtr->charOffset = 0; extraBytes = 0; charOffset = 0; } /* * First, generate a command by taking the command string and appending * the offset and maximum # of bytes. */ command = Tcl_ObjPrintf("%s %d %d", cmdInfoPtr->command, charOffset, maxBytes); Tcl_IncrRefCount(command); /* * Execute the command. Be sure to restore the state of the interpreter * after executing the command. */ savedState = Tcl_SaveInterpState(interp, TCL_OK); code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(command); if (code == TCL_OK) { /* * TODO: This assumes that bytes are characters; that's not true! */ string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); count = (length > maxBytes) ? maxBytes : length; memcpy(buffer, string, (size_t) count); buffer[count] = '\0'; /* * Update the partial character information for the next retrieval if * the command has not been deleted. */ if (cmdInfoPtr->interp != NULL) { if (length <= maxBytes) { cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1); cmdInfoPtr->buffer[0] = '\0'; } else { p = string; string += count; numChars = 0; while (p < string) { p = Tcl_UtfNext(p); numChars++; } cmdInfoPtr->charOffset += numChars; length = p - string; if (length > 0) { strncpy(cmdInfoPtr->buffer, string, (size_t) length); } cmdInfoPtr->buffer[length] = '\0'; } cmdInfoPtr->byteOffset += count + extraBytes; } count += extraBytes; } else { /* * Something went wrong. Log errors as background errors, and silently * drop everything else. */ if (code == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (command handling selection)"); Tcl_BackgroundException(interp, code); } count = -1; } (void) Tcl_RestoreInterpState(interp, savedState); Tcl_Release(clientData); Tcl_Release(interp); return count; }
static int CanvasPsWindow( Tcl_Interp *interp, /* Leave Postscript or error message here. */ Tk_Window tkwin, /* window to be printed */ Tk_Canvas canvas, /* Information about overall canvas. */ double x, double y, /* origin of window. */ int width, int height) /* width/height of window. */ { XImage *ximage; int result; #ifdef X_GetImage Tk_ErrorHandler handle; #endif Tcl_Obj *cmdObj, *psObj; Tcl_InterpState interpState = Tcl_SaveInterpState(interp, TCL_OK); /* * Locate the subwindow within the wider window. */ psObj = Tcl_ObjPrintf( "\n%%%% %s item (%s, %d x %d)\n" /* Comment */ "%.15g %.15g translate\n", /* Position */ Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y); /* * First try if the widget has its own "postscript" command. If it exists, * this will produce much better postscript than when a pixmap is used. */ Tcl_ResetResult(interp); cmdObj = Tcl_ObjPrintf("%s postscript -prolog 0", Tk_PathName(tkwin)); Tcl_IncrRefCount(cmdObj); result = Tcl_EvalObjEx(interp, cmdObj, 0); Tcl_DecrRefCount(cmdObj); if (result == TCL_OK) { Tcl_AppendPrintfToObj(psObj, "50 dict begin\nsave\ngsave\n" "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d 0 rlineto closepath\n" "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n", height, width, height, width); Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); Tcl_AppendToObj(psObj, "\nrestore\nend\n\n\n", -1); goto done; } /* * If the window is off the screen it will generate a BadMatch/XError. We * catch any BadMatch errors here */ #ifdef X_GetImage handle = Tk_CreateErrorHandler(Tk_Display(tkwin), BadMatch, X_GetImage, -1, xerrorhandler, tkwin); #endif /* * Generate an XImage from the window. We can then read pixel values out * of the XImage. */ ximage = XGetImage(Tk_Display(tkwin), Tk_WindowId(tkwin), 0, 0, (unsigned) width, (unsigned) height, AllPlanes, ZPixmap); #ifdef X_GetImage Tk_DeleteErrorHandler(handle); #endif if (ximage == NULL) { result = TCL_OK; } else { Tcl_ResetResult(interp); result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, ximage, 0, 0, width, height); Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); XDestroyImage(ximage); } /* * Plug the accumulated postscript back into the result. */ done: if (result == TCL_OK) { (void) Tcl_RestoreInterpState(interp, interpState); Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); } else { Tcl_DiscardInterpState(interpState); } Tcl_DecrRefCount(psObj); return result; }
static int TextToPostscript( Tcl_Interp *interp, /* Leave Postscript or error message here. */ Tk_Canvas canvas, /* Information about overall canvas. */ Tk_Item *itemPtr, /* Item for which Postscript is wanted. */ int prepass) /* 1 means this is a prepass to collect font * information; 0 means final Postscript is * being created. */ { TextItem *textPtr = (TextItem *) itemPtr; double x, y; Tk_FontMetrics fm; const char *justify; XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; Tcl_Obj *psObj; Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; } color = textPtr->color; stipple = textPtr->stipple; if (state == TK_STATE_HIDDEN || textPtr->color == NULL || textPtr->text == NULL || *textPtr->text == 0) { return TCL_OK; } else if (Canvas(canvas)->currentItemPtr == itemPtr) { if (textPtr->activeColor != NULL) { color = textPtr->activeColor; } if (textPtr->activeStipple != None) { stipple = textPtr->activeStipple; } } else if (state == TK_STATE_DISABLED) { if (textPtr->disabledColor != NULL) { color = textPtr->disabledColor; } if (textPtr->disabledStipple != None) { stipple = textPtr->disabledStipple; } } /* * Make our working space. */ psObj = Tcl_NewObj(); interpState = Tcl_SaveInterpState(interp, TCL_OK); /* * Generate postscript. */ Tcl_ResetResult(interp); if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) { goto error; } Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (prepass != 0) { goto done; } Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { goto error; } Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (stipple != None) { Tcl_ResetResult(interp); Tk_CanvasPsStipple(interp, canvas, stipple); Tcl_AppendPrintfToObj(psObj, "/StippleText {\n %s} bind def\n", Tcl_GetString(Tcl_GetObjResult(interp))); } x = 0; y = 0; justify = NULL; /* lint. */ switch (textPtr->anchor) { case TK_ANCHOR_NW: x = 0; y = 0; break; case TK_ANCHOR_N: x = 1; y = 0; break; case TK_ANCHOR_NE: x = 2; y = 0; break; case TK_ANCHOR_E: x = 2; y = 1; break; case TK_ANCHOR_SE: x = 2; y = 2; break; case TK_ANCHOR_S: x = 1; y = 2; break; case TK_ANCHOR_SW: x = 0; y = 2; break; case TK_ANCHOR_W: x = 0; y = 1; break; case TK_ANCHOR_CENTER: x = 1; y = 1; break; } switch (textPtr->justify) { case TK_JUSTIFY_LEFT: justify = "0"; break; case TK_JUSTIFY_CENTER: justify = "0.5"; break; case TK_JUSTIFY_RIGHT: justify = "1"; break; } Tk_GetFontMetrics(textPtr->tkfont, &fm); Tcl_AppendPrintfToObj(psObj, "%.15g %.15g %.15g [\n", textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); Tcl_ResetResult(interp); Tk_TextLayoutToPostscript(interp, textPtr->textLayout); Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); Tcl_AppendPrintfToObj(psObj, "] %d %g %g %s %s DrawText\n", fm.linespace, x / -2.0, y / 2.0, justify, ((stipple == None) ? "false" : "true")); /* * Plug the accumulated postscript back into the result. */ done: (void) Tcl_RestoreInterpState(interp, interpState); Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); Tcl_DecrRefCount(psObj); return TCL_OK; error: Tcl_DiscardInterpState(interpState); Tcl_DecrRefCount(psObj); return TCL_ERROR; }
static int ExecuteCallback( TransformChannelData *dataPtr, /* Transformation with the callback. */ Tcl_Interp *interp, /* Current interpreter, possibly NULL. */ unsigned char *op, /* Operation invoking the callback. */ unsigned char *buf, /* Buffer to give to the script. */ int bufLen, /* And its length. */ int transmit, /* Flag, determines whether the result of the * callback is sent to the underlying channel * or not. */ int preserve) /* Flag. If true the procedure will preserve * the result state of all accessed * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ int resLen; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command); Tcl_Interp *eval = dataPtr->interp; Tcl_Preserve(eval); /* * Step 1, create the complete command to execute. Do this by appending * operation and buffer to operate upon to a copy of the callback * definition. We *cannot* create a list containing 3 objects and then use * 'Tcl_EvalObjv', because the command may contain additional prefixed * arguments. Feather's curried commands would come in handy here. */ if (preserve == P_PRESERVE) { state = Tcl_SaveInterpState(eval, res); } Tcl_IncrRefCount(command); Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1)); /* * Use a byte-array to prevent the misinterpretation of binary data coming * through as UTF while at the tcl level. */ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen)); /* * Step 2, execute the command at the global level of the interpreter used * to create the transformation. Destroy the command afterward. If an * error occured and the current interpreter is defined and not equal to * the interpreter for the callback, then copy the error message into * current interpreter. Don't copy if in preservation mode. */ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(command); command = NULL; if ((res != TCL_OK) && (interp != NULL) && (eval != interp) && (preserve == P_NO_PRESERVE)) { Tcl_SetObjResult(interp, Tcl_GetObjResult(eval)); Tcl_Release(eval); return res; } /* * Step 3, transmit a possible conversion result to the underlying * channel, or ourselves. */ switch (transmit) { case TRANSMIT_DONT: /* nothing to do */ break; case TRANSMIT_DOWN: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; case TRANSMIT_SELF: if (dataPtr->self == NULL) { break; } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; case TRANSMIT_NUM: /* * Interpret result as integer number. */ resObj = Tcl_GetObjResult(eval); TclGetIntFromObj(eval, resObj, &dataPtr->maxRead); break; } Tcl_ResetResult(eval); if (preserve == P_PRESERVE) { (void) Tcl_RestoreInterpState(eval, state); } Tcl_Release(eval); return res; }