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;
}
