diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-07-27 10:14:55 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-07-27 10:14:55 (GMT) |
commit | 42f0b713dd28f3d56226621b9016969cd5804a57 (patch) | |
tree | 655fa3c3fc4e843ec5d197c996d7bad878324d30 | |
parent | f60c7ff513bcaaa89a54871e150893a286ba6701 (diff) | |
download | tk-42f0b713dd28f3d56226621b9016969cd5804a57.zip tk-42f0b713dd28f3d56226621b9016969cd5804a57.tar.gz tk-42f0b713dd28f3d56226621b9016969cd5804a57.tar.bz2 |
Postscript generation now uses Tcl_Objs more extensively; still nasty in places.
-rw-r--r-- | generic/tkCanvArc.c | 120 | ||||
-rw-r--r-- | generic/tkCanvBmap.c | 65 | ||||
-rw-r--r-- | generic/tkCanvImg.c | 14 | ||||
-rw-r--r-- | generic/tkCanvLine.c | 111 | ||||
-rw-r--r-- | generic/tkCanvPoly.c | 80 | ||||
-rw-r--r-- | generic/tkCanvPs.c | 414 | ||||
-rw-r--r-- | generic/tkCanvText.c | 57 | ||||
-rw-r--r-- | generic/tkCanvUtil.c | 98 | ||||
-rw-r--r-- | generic/tkCanvWind.c | 65 |
9 files changed, 640 insertions, 384 deletions
diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index 434ca66..d32c717 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.c @@ -1818,13 +1818,14 @@ ArcToPostscript( * being created. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; - char buffer[400]; double y1, y2, ang1, ang2; XColor *color; Pixmap stipple; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]); @@ -1871,37 +1872,51 @@ ArcToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * If the arc is filled, output Postscript for the interior region of the * arc. */ if (arcPtr->fillGC != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - if (arcPtr->style == CHORD_STYLE) { - sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); - } else { - sprintf(buffer, - "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); + + if (arcPtr->style != CHORD_STYLE) { + Tcl_AppendToObj(psObj, "0 0 moveto ", -1); } - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", + ang1, ang2); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->outline.gc != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1910,57 +1925,86 @@ ArcToPostscript( */ if (arcPtr->outline.gc != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 0 1 %.15g %.15g", ang1, ang2); - Tcl_AppendResult(interp, buffer, - " arc\nsetmatrix\n0 setlinecap\n", NULL); - if (Tk_CanvasPsOutline(canvas, itemPtr, &(arcPtr->outline)) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc\nsetmatrix\n0 setlinecap\n", + ang1, ang2); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsOutline(canvas, itemPtr, &arcPtr->outline) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->style != ARC_STYLE) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); if (arcPtr->style == CHORD_STYLE) { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS); } else { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS); - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); - if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsStipple(interp, canvas, stipple) !=TCL_OK){ + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, PIE_OUTLINE2_PTS); } - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } } + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index bf58779..65c4b59 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.c @@ -850,11 +850,12 @@ BitmapToPostscript( double x, y; int width, height, rowsAtOnce, rowsThisTime; int curRow; - char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4]; XColor *fgColor; XColor *bgColor; Pixmap bitmap; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -910,18 +911,29 @@ BitmapToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Color the background, if there is one. */ if (bgColor != NULL) { - sprintf(buffer, - "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n", - x, y, width, height, -width, "0 rlineto closepath"); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto " + "%d 0 rlineto closepath\n", + x, y, width, height, -width); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, bgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "fill\n", -1); } /* @@ -932,38 +944,61 @@ BitmapToPostscript( */ if (fgColor != NULL) { + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (width > 60000) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't generate Postscript for bitmaps more than 60000" " pixels wide", -1)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); - return TCL_ERROR; + goto error; } + rowsAtOnce = 60000/width; if (rowsAtOnce < 1) { rowsAtOnce = 1; } - sprintf(buffer, "%.15g %.15g translate\n", x, y+height); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y+height); + for (curRow = 0; curRow < height; curRow += rowsAtOnce) { rowsThisTime = rowsAtOnce; if (rowsThisTime > (height - curRow)) { rowsThisTime = height - curRow; } - sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n", + + Tcl_AppendPrintfToObj(psObj, + "0 -%.15g translate\n%d %d true matrix {\n", (double) rowsThisTime, width, rowsThisTime); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_ResetResult(interp); if (Tk_CanvasPsBitmap(interp, canvas, bitmap, 0, curRow, width, rowsThisTime) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "\n} imagemask\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "\n} imagemask\n", -1); } } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c index 172f26d..899741a 100644 --- a/generic/tkCanvImg.c +++ b/generic/tkCanvImg.c @@ -695,14 +695,12 @@ ImageToPostscript( { ImageItem *imgPtr = (ImageItem *) itemPtr; Tk_Window canvasWin = Tk_CanvasTkwin(canvas); - - char buffer[256]; double x, y; int width, height; Tk_Image image; Tk_State state = itemPtr->state; - if(state == TK_STATE_NULL) { + if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; } @@ -746,8 +744,14 @@ ImageToPostscript( } if (!prepass) { - sprintf(buffer, "%.15g %.15g", x, y); - Tcl_AppendResult(interp, buffer, " translate\n", NULL); + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y); } return Tk_PostscriptImage(image, interp, canvasWin, diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index d631c64..ce51759 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.c @@ -75,7 +75,7 @@ typedef struct LineItem { static int ArrowheadPostscript(Tcl_Interp *interp, Tk_Canvas canvas, LineItem *linePtr, - double *arrowPtr); + double *arrowPtr, Tcl_Obj *psObj); static void ComputeLineBbox(Tk_Canvas canvas, LineItem *linePtr); static int ConfigureLine(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, @@ -2259,13 +2259,13 @@ LineToPostscript( * being created. */ { LineItem *linePtr = (LineItem *) itemPtr; - char buffer[64 + TCL_INTEGER_SPACE]; - const char *style; - + int style; double width; 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; @@ -2300,30 +2300,50 @@ LineToPostscript( return TCL_OK; } + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Check if we're just doing a "pixel". + */ + if (linePtr->numPoints == 1) { - sprintf(buffer, "%.15g %.15g translate %.15g %.15g", + Tcl_AppendToObj(psObj, "matrix currentmatrix\n", -1); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate %.15g %.15g", linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]), width/2.0, width/2.0); - Tcl_AppendResult(interp, "matrix currentmatrix\n", buffer, - " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", NULL); + Tcl_AppendToObj(psObj, + " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } + /* * Generate a path for the line's center-line (do this differently for * straight lines and smoothed lines). */ + Tcl_ResetResult(interp); if ((!linePtr->smooth) || (linePtr->numPoints < 3)) { Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints); } else if ((stipple == None) && linePtr->smooth->postscriptProc) { @@ -2355,29 +2375,34 @@ LineToPostscript( ckfree(pointPtr); } } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Set other line-drawing parameters and stroke out the line. */ - style = "0 setlinecap\n"; if (linePtr->capStyle == CapRound) { - style = "1 setlinecap\n"; + style = 1; } else if (linePtr->capStyle == CapProjecting) { - style = "2 setlinecap\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); - style = "0 setlinejoin\n"; + Tcl_AppendPrintfToObj(psObj, "%d setlinecap\n", style); if (linePtr->joinStyle == JoinRound) { - style = "1 setlinejoin\n"; + style = 1; } else if (linePtr->joinStyle == JoinBevel) { - style = "2 setlinejoin\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin\n", style); + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &linePtr->outline) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Output polygons for the arrowheads, if there are any. @@ -2385,23 +2410,37 @@ LineToPostscript( if (linePtr->firstArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->firstArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->firstArrowPtr, psObj) != TCL_OK) { + goto error; } } if (linePtr->lastArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->lastArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->lastArrowPtr, psObj) != TCL_OK) { + goto error; } } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2416,7 +2455,7 @@ LineToPostscript( * The return value is a standard Tcl result. If an error occurs in * generating Postscript then an error message is left in the interp's * result, replacing whatever used to be there. If no error occurs, then - * Postscript for the arrowhead is appended to the result. + * Postscript for the arrowhead is appended to the given object. * * Side effects: * None. @@ -2426,12 +2465,14 @@ LineToPostscript( static int ArrowheadPostscript( - Tcl_Interp *interp, /* Leave Postscript or error message here. */ + Tcl_Interp *interp, /* Leave error message here; non-error results + * will be discarded by caller. */ Tk_Canvas canvas, /* Information about overall canvas. */ LineItem *linePtr, /* Line item for which Postscript is being * generated. */ - double *arrowPtr) /* Pointer to first of five points describing + double *arrowPtr, /* Pointer to first of five points describing * arrowhead polygon. */ + Tcl_Obj *psObj) /* Append postscript to this object. */ { Pixmap stipple; Tk_State state = linePtr->header.state; @@ -2451,14 +2492,20 @@ ArrowheadPostscript( } } + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } return TCL_OK; } diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c index da47a3f..7e2834d 100644 --- a/generic/tkCanvPoly.c +++ b/generic/tkCanvPoly.c @@ -1801,13 +1801,15 @@ PolygonToPostscript( * being created. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - const char *style; + int style; XColor *color; XColor *fillColor; Pixmap stipple; Pixmap fillStipple; Tk_State state = itemPtr->state; double width; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (polyPtr->numPoints < 2 || polyPtr->coordPtr == NULL) { return TCL_OK; @@ -1854,9 +1856,17 @@ PolygonToPostscript( fillStipple = polyPtr->disabledFillStipple; } } + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + if (polyPtr->numPoints == 2) { if (color == NULL) { - return TCL_OK; + goto done; } /* @@ -1864,7 +1874,7 @@ PolygonToPostscript( * tiny to be used directly...) */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + Tcl_AppendPrintfToObj(psObj, "matrix currentmatrix\n" /* save state */ "%.15g %.15g translate " /* go to drawing location */ "%.15g %.15g scale " /* scale the drawing */ @@ -1873,24 +1883,30 @@ PolygonToPostscript( "setmatrix\n", /* restore state */ polyPtr->coordPtr[0], Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]), - width/2.0, width/2.0)); + width/2.0, width/2.0); /* * Color it in. */ + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } /* @@ -1898,6 +1914,7 @@ PolygonToPostscript( */ if (fillColor != NULL && polyPtr->numPoints > 3) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1906,18 +1923,24 @@ PolygonToPostscript( polyPtr->numPoints, polyPtr->splineSteps); } if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "eoclip ", NULL); + Tcl_AppendToObj(psObj, "eoclip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "eofill\n", NULL); + Tcl_AppendToObj(psObj, "eofill\n", -1); } } @@ -1926,6 +1949,7 @@ PolygonToPostscript( */ if (color != NULL) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1933,20 +1957,38 @@ PolygonToPostscript( polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints, polyPtr->splineSteps); } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (polyPtr->joinStyle == JoinRound) { - style = "1"; + style = 1; } else if (polyPtr->joinStyle == JoinBevel) { - style = "2"; + style = 2; } else { - style = "0"; + style = 0; } - Tcl_AppendResult(interp, style, " setlinejoin 1 setlinecap\n", NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin 1 setlinecap\n", style); + + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, &polyPtr->outline) != TCL_OK){ - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index 95bbb29..b6e9a33 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -134,6 +134,10 @@ static const Tk_ConfigSpec configSpecs[] = { static int GetPostscriptPoints(Tcl_Interp *interp, char *string, double *doublePtr); +static void PostscriptBitmap(Tk_Window tkwin, Pixmap bitmap, + int startX, int startY, int width, int height, + Tcl_Obj *psObj); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); /* *-------------------------------------------------------------- @@ -169,7 +173,6 @@ TkCanvPostscriptCmd( int written; Tk_Item *itemPtr; #define STRING_LENGTH 400 - char string[STRING_LENGTH+1]; const char *p; time_t now; size_t length; @@ -178,6 +181,7 @@ TkCanvPostscriptCmd( Tcl_HashEntry *hPtr; Tcl_DString buffer; Tcl_Obj *preambleObj; + Tcl_Obj *psObj; int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be * marked up, measured in canvas units from * the positioning point on the page (reflects @@ -201,6 +205,7 @@ TkCanvPostscriptCmd( } Tcl_IncrRefCount(preambleObj); Tcl_ResetResult(interp); + psObj = Tcl_NewObj(); /* * Initialize the data structure describing Postscript generation, then @@ -430,24 +435,27 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", - "%%Creator: Tk Canvas Widget\n", NULL); + Tcl_AppendToObj(psObj, + "%!PS-Adobe-3.0 EPSF-3.0\n" + "%%Creator: Tk Canvas Widget\n", -1); + #ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ - Tcl_AppendResult(interp, "%%For: ", - (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%For: %s\n", (pwPtr ? pwPtr->pw_gecos : "Unknown")); endpwent(); } #endif /* HAVE_PW_GECOS */ - Tcl_AppendResult(interp, "%%Title: Window ", Tk_PathName(tkwin), "\n", - NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%Title: Window %s\n", Tk_PathName(tkwin)); time(&now); - Tcl_AppendResult(interp, "%%CreationDate: ", - ctime(&now), NULL); /* INTL: Native. */ + Tcl_AppendPrintfToObj(psObj, + "%%%%CreationDate: %s", ctime(&now)); /* INTL: Native. */ if (!psInfo.rotate) { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX + psInfo.scale*deltaX), (int) (psInfo.pageY + psInfo.scale*deltaY), (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) @@ -455,58 +463,61 @@ TkCanvPostscriptCmd( (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) + 1.0)); } else { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX - psInfo.scale*(deltaY+psInfo.height)), (int) (psInfo.pageY + psInfo.scale*deltaX), (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + 1.0)); } - Tcl_AppendResult(interp, "%%BoundingBox: ", string, "\n", NULL); - Tcl_AppendResult(interp, "%%Pages: 1\n", - "%%DocumentData: Clean7Bit\n", NULL); - Tcl_AppendResult(interp, "%%Orientation: ", - psInfo.rotate ? "Landscape\n" : "Portrait\n", NULL); - p = "%%DocumentNeededResources: font "; + Tcl_AppendPrintfToObj(psObj, + "%%%%Pages: 1\n" + "%%%%DocumentData: Clean7Bit\n" + "%%%%Orientation: %s\n", + psInfo.rotate ? "Landscape" : "Portrait"); + p = "%%%%DocumentNeededResources: font %s\n"; for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, p, - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); - p = "%%+ font "; + Tcl_AppendPrintfToObj(psObj, p, + Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + p = "%%%%+ font %s\n"; } - Tcl_AppendResult(interp, "%%EndComments\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndComments\n\n", -1); /* * Insert the prolog */ - Tcl_AppendResult(interp, Tcl_GetString(preambleObj), NULL); + Tcl_AppendObjToObj(psObj, preambleObj); if (psInfo.chan != NULL) { - written = Tcl_WriteObj(psInfo.chan, Tcl_GetObjResult(interp)); - Tcl_ResetResult(interp); + written = Tcl_WriteObj(psInfo.chan, psObj); if (written == -1) { channelWriteFailed: - Tcl_AppendResult(interp, - "problem writing postscript data to channel: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "problem writing postscript data to channel: %s", + Tcl_PosixError(interp))); result = TCL_ERROR; goto cleanup; } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } /* * Document setup: set the color level and include fonts. */ - sprintf(string, "/CL %d def\n", psInfo.colorLevel); - Tcl_AppendResult(interp, "%%BeginSetup\n", string, NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%BeginSetup\n/CL %d def\n", psInfo.colorLevel); for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, "%%IncludeResource: font ", - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%IncludeResource: font %s\n", + (char *) Tcl_GetHashKey(&psInfo.fontTable, hPtr)); } - Tcl_AppendResult(interp, "%%EndSetup\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndSetup\n\n", -1); /* * Page setup: move to page positioning point, rotate if needed, set @@ -514,18 +525,19 @@ TkCanvPostscriptCmd( * region. */ - Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", NULL); - sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendToObj(psObj, "%%Page: 1 1\nsave\n", -1); + Tcl_AppendPrintfToObj(psObj, + "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); if (psInfo.rotate) { - Tcl_AppendResult(interp, "90 rotate\n", NULL); + Tcl_AppendToObj(psObj, "90 rotate\n", -1); } - sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, - "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", + Tcl_AppendPrintfToObj(psObj, + "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); + Tcl_AppendPrintfToObj(psObj, + "%d %d translate\n", deltaX - psInfo.x, deltaY); + Tcl_AppendPrintfToObj(psObj, + "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g " + "lineto closepath clip newpath\n", psInfo.x, Tk_PostscriptY((double)psInfo.y, (Tk_PostscriptInfo)psInfoPtr), psInfo.x2, Tk_PostscriptY((double)psInfo.y, @@ -534,14 +546,13 @@ TkCanvPostscriptCmd( (Tk_PostscriptInfo)psInfoPtr), psInfo.x, Tk_PostscriptY((double)psInfo.y2, (Tk_PostscriptInfo)psInfoPtr)); - Tcl_AppendResult(interp, string, - " lineto closepath clip newpath\n", NULL); - } - if (psInfo.chan != NULL) { - written = Tcl_WriteObj(psInfo.chan, Tcl_GetObjResult(interp)); - Tcl_ResetResult(interp); - if (written == -1) { - goto channelWriteFailed; + if (psInfo.chan != NULL) { + written = Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } } @@ -563,7 +574,8 @@ TkCanvPostscriptCmd( if (itemPtr->state == TK_STATE_HIDDEN) { continue; } - Tcl_AppendResult(interp, "gsave\n", NULL); + + Tcl_ResetResult(interp); result = itemPtr->typePtr->postscriptProc(interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { @@ -572,13 +584,18 @@ TkCanvPostscriptCmd( itemPtr->id)); goto cleanup; } - Tcl_AppendResult(interp, "grestore\n", NULL); + + Tcl_AppendToObj(psObj, "gsave\n", -1); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "grestore\n", -1); + if (psInfo.chan != NULL) { - written = Tcl_WriteObj(psInfo.chan, Tcl_GetObjResult(interp)); - Tcl_ResetResult(interp); + written = Tcl_WriteObj(psInfo.chan, psObj); if (written == -1) { goto channelWriteFailed; } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } } @@ -588,17 +605,25 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "restore showpage\n\n", - "%%Trailer\nend\n%%EOF\n", NULL); - } - if (psInfo.chan != NULL) { - Tcl_WriteObj(psInfo.chan, Tcl_GetObjResult(interp)); - Tcl_ResetResult(interp); - if (written == -1) { - goto channelWriteFailed; + Tcl_AppendToObj(psObj, + "restore showpage\n\n" + "%%Trailer\n" + "end\n" + "%%EOF\n", -1); + + if (psInfo.chan != NULL) { + Tcl_WriteObj(psInfo.chan, psObj); + if (written == -1) { + goto channelWriteFailed; + } } } + if (psInfo.chan == NULL) { + Tcl_SetObjResult(interp, psObj); + psObj = Tcl_NewObj(); + } + /* * Clean up psInfo to release malloc'ed stuff. */ @@ -637,9 +662,23 @@ TkCanvPostscriptCmd( Tcl_DeleteHashTable(&psInfo.fontTable); canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; Tcl_DecrRefCount(preambleObj); + Tcl_DecrRefCount(psObj); return result; } +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *-------------------------------------------------------------- * @@ -668,9 +707,7 @@ Tk_PostscriptColor( XColor *colorPtr) /* Information about color. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - int tmp; double red, green, blue; - char string[200]; if (psInfoPtr->prepass) { return TCL_OK; @@ -682,12 +719,12 @@ Tk_PostscriptColor( */ if (psInfoPtr->colorVar != NULL) { - const char *cmdString; - - cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + const char *cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, Tk_NameOfColor(colorPtr), 0); + if (cmdString != NULL) { - Tcl_AppendResult(interp, cmdString, "\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%s\n", cmdString); return TCL_OK; } } @@ -704,15 +741,12 @@ Tk_PostscriptColor( * per color, but most diplays use at least 8 bits. */ - tmp = colorPtr->red; - red = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->green; - green = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->blue; - blue = ((double) (tmp >> 8))/255.0; - sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", + red = ((double) (((int) colorPtr->red) >> 8))/255.0; + green = ((double) (((int) colorPtr->green) >> 8))/255.0; + blue = ((double) (((int) colorPtr->blue) >> 8))/255.0; + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%.3f %.3f %.3f setrgbcolor AdjustColor\n", red, green, blue); - Tcl_AppendResult(interp, string, NULL); return TCL_OK; } @@ -746,9 +780,9 @@ Tk_PostscriptFont( * be printed. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; + const char *fontname; /* * First, look up the font's name in the font map, if there is one. If @@ -764,14 +798,12 @@ Tk_PostscriptFont( Tcl_Obj *list = Tcl_GetVar2Ex(interp, psInfoPtr->fontVar, name, 0); if (list != NULL) { - const char *fontname; - if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK || objc != 2 - || Tcl_GetString(objv[0])[0] == '\0' + || (fontname = Tcl_GetString(objv[0]))[0] == '\0' + || strchr(fontname, ' ') != NULL || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK || size <= 0) { - Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad font map entry for \"%s\": \"%s\"", name, Tcl_GetString(list))); @@ -780,15 +812,10 @@ Tk_PostscriptFont( return TCL_ERROR; } - fontname = Tcl_GetString(objv[0]); - sprintf(pointString, "%d", (int) size); - - Tcl_AppendResult(interp, "/", fontname, " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(fontname, "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, (int) size, + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontname, &i); return TCL_OK; } @@ -800,13 +827,11 @@ Tk_PostscriptFont( Tcl_DStringInit(&ds); points = Tk_PostscriptFontName(tkfont, &ds); - sprintf(pointString, "%d", TkFontGetPoints(psInfoPtr->tkwin, points)); - Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + fontname = Tcl_DStringValue(&ds); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, TkFontGetPoints(psInfoPtr->tkwin, points), + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); Tcl_DStringFree(&ds); @@ -844,18 +869,32 @@ Tk_PostscriptBitmap( int width, int height) /* Height of rectangular region. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + PostscriptBitmap(tkwin, bitmap, startX, startY, width, height, + GetPostscriptBuffer(interp)); + return TCL_OK; +} + +static void +PostscriptBitmap( + Tk_Window tkwin, + Pixmap bitmap, /* Bitmap for which to generate Postscript. */ + int startX, int startY, /* Coordinates of upper-left corner of + * rectangular region to output. */ + int width, int height, /* Height of rectangular region. */ + Tcl_Obj *psObj) /* Where to append the postscript. */ +{ XImage *imagePtr; int charsInLine, x, y, lastX, lastY, value, mask; unsigned int totalWidth, totalHeight; - char string[100]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; - if (psInfoPtr->prepass) { - return TCL_OK; - } - /* * The following call should probably be a call to Tk_SizeOfBitmap * instead, but it seems that we are occasionally invoked by custom item @@ -869,7 +908,8 @@ Tk_PostscriptBitmap( (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); - Tcl_AppendResult(interp, "<", NULL); + + Tcl_AppendToObj(psObj, "<", -1); mask = 0x80; value = 0; charsInLine = 0; @@ -882,28 +922,26 @@ Tk_PostscriptBitmap( } mask >>= 1; if (mask == 0) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; if (charsInLine >= 60) { - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); charsInLine = 0; } } } if (mask != 0x80) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; } } - Tcl_AppendResult(interp, ">", NULL); + Tcl_AppendToObj(psObj, ">", -1); + XDestroyImage(imagePtr); - return TCL_OK; } /* @@ -938,10 +976,10 @@ Tk_PostscriptStipple( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int width, height; - char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -958,13 +996,11 @@ Tk_PostscriptStipple( XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, (unsigned *) &height, &dummyBorderwidth, &dummyDepth); - sprintf(string, "%d %d ", width, height); - Tcl_AppendResult(interp, string, NULL); - if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, - width, height) != TCL_OK) { - return TCL_ERROR; - } - Tcl_AppendResult(interp, " StippleFill\n", NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%d %d ", width, height); + PostscriptBitmap(tkwin, bitmap, 0, 0, width, height, psObj); + Tcl_AppendToObj(psObj, " StippleFill\n", -1); return TCL_OK; } @@ -1024,19 +1060,19 @@ Tk_PostscriptPath( int numPoints) /* Number of points at *coordPtr. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[200]; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return; } - sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g moveto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); for (numPoints--, coordPtr += 2; numPoints > 0; numPoints--, coordPtr += 2) { - sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); } } @@ -1222,15 +1258,15 @@ TkPostscriptImage( int width, int height) /* Width and height of area */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[256]; int xx, yy, band, maxRows; double red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; int level = psInfoPtr->colorLevel; Colormap cmap; int i, ncolors; Visual *visual; TkColormapData cdata; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1325,6 +1361,7 @@ TkPostscriptImage( } maxRows = 60000 / bytesPerLine; + psObj = GetPostscriptBuffer(interp); for (band = height-1; band >= 0; band -= maxRows) { int rows = (band >= maxRows) ? maxRows : band + 1; @@ -1332,16 +1369,13 @@ TkPostscriptImage( switch (level) { case 0: - sprintf(buffer, "%d %d 1 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 1 matrix {\n<", width, rows); break; case 1: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; default: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; } for (yy = band; yy > band - rows; yy--) { @@ -1363,22 +1397,20 @@ TkPostscriptImage( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - mask=0x80; - data=0x00; + mask = 0x80; + data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); - mask=0x80; - data=0x00; + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; } break; } @@ -1391,13 +1423,13 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx ++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 * + Tcl_AppendPrintfToObj(psObj, "%02X", + (int) floor(0.5 + 255.0 * (0.30 * red + 0.59 * green + 0.11 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1410,15 +1442,14 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", (int) floor(0.5 + 255.0 * red), (int) floor(0.5 + 255.0 * green), (int) floor(0.5 + 255.0 * blue)); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1426,13 +1457,11 @@ TkPostscriptImage( } switch (level) { case 0: case 1: - sprintf(buffer, ">\n} image\n"); break; + Tcl_AppendToObj(psObj, ">\n} image\n", -1); break; default: - sprintf(buffer, ">\n} false 3 colorimage\n"); break; + Tcl_AppendToObj(psObj, ">\n} false 3 colorimage\n", -1); break; } - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 %d translate\n", rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "0 %d translate\n", rows); } ckfree(cdata.colors); return TCL_OK; @@ -1468,15 +1497,15 @@ Tk_PostscriptPhoto( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int colorLevel = psInfoPtr->colorLevel; - const char *displayOperation; + const char *displayOperation, *decode; unsigned char *pixelPtr; - char buffer[256], cspace[40], decode[40]; int bpc, xx, yy, lineLen, alpha; float red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; unsigned char opaque = 255; unsigned char *alphaPtr; int alphaOffset, alphaPitch, alphaIncr; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1520,35 +1549,32 @@ Tk_PostscriptPhoto( * Set up the postscript code except for the image-data stream. */ + psObj = GetPostscriptBuffer(interp); switch (colorLevel) { case 0: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[1 0]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "1 0"; bpc = 1; break; case 1: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[0 1]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "0 1"; bpc = 8; break; default: - strcpy(cspace, "/DeviceRGB"); - strcpy(decode, "[0 1 0 1 0 1]"); + Tcl_AppendToObj(psObj, "/DeviceRGB setcolorspace\n\n", -1); + decode = "0 1 0 1 0 1"; bpc = 8; break; } - - Tcl_AppendResult(interp, cspace, " setcolorspace\n\n", NULL); - - sprintf(buffer, " /Width %d\n /Height %d\n /BitsPerComponent %d\n", - width, height, bpc); - Tcl_AppendResult(interp, "<<\n /ImageType 1\n", buffer, - " /DataSource currentfile /ASCIIHexDecode filter\n", NULL); - - sprintf(buffer, " /ImageMatrix [1 0 0 -1 0 %d]\n", height); - Tcl_AppendResult(interp, buffer, " /Decode ", decode, "\n>>\n1 ", - displayOperation, "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "<<\n /ImageType 1\n" + " /Width %d\n /Height %d\n /BitsPerComponent %d\n" + " /DataSource currentfile\n /ASCIIHexDecode filter\n" + " /ImageMatrix [1 0 0 -1 0 %d]\n /Decode [%s]\n>>\n" + "1 %s\n", + width, height, bpc, height, decode, displayOperation); /* * Check the PhotoImageBlock information. We assume that: @@ -1608,20 +1634,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1649,20 +1673,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1677,12 +1699,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1699,13 +1720,12 @@ Tk_PostscriptPhoto( green = pixelPtr[blockPtr->offset[1]]; blue = pixelPtr[blockPtr->offset[2]]; - sprintf(buffer, "%02X", (int) floor(0.5 + + Tcl_AppendPrintfToObj(psObj, "%02X", (int) floor(0.5 + ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1719,12 +1739,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1737,22 +1756,25 @@ Tk_PostscriptPhoto( pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + (xx * blockPtr->pixelSize); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", pixelPtr[blockPtr->offset[0]], pixelPtr[blockPtr->offset[1]], pixelPtr[blockPtr->offset[2]]); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; } } - Tcl_AppendResult(interp, ">\n", NULL); + /* + * The end-of-data marker. + */ + + Tcl_AppendToObj(psObj, ">\n", -1); return TCL_OK; } diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index cda9b1c..d972d48 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -1544,6 +1544,8 @@ TextToPostscript( 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; @@ -1569,26 +1571,40 @@ TextToPostscript( } } + /* + * 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) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (prepass != 0) { - return TCL_OK; + goto done; } + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "/StippleText {\n ", NULL); + Tcl_ResetResult(interp); Tk_CanvasPsStipple(interp, canvas, stipple); - Tcl_AppendResult(interp, "} bind def\n", NULL); + Tcl_AppendPrintfToObj(psObj, "/StippleText {\n %s} bind def\n", + Tcl_GetString(Tcl_GetObjResult(interp))); } - Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%.15g %.15g %.15g [\n", - textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); - - Tk_TextLayoutToPostscript(interp, textPtr->textLayout); - x = 0; y = 0; justify = NULL; /* lint. */ switch (textPtr->anchor) { case TK_ANCHOR_NW: x = 0; y = 0; break; @@ -1608,12 +1624,31 @@ TextToPostscript( } Tk_GetFontMetrics(textPtr->tkfont, &fm); - Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), + + 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_AppendResult(interp, Tcl_GetString(psObj), NULL); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index 711d7aa..120afd2 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -49,9 +49,23 @@ static int DashConvert(char *l, const char *p, int n, double width); static void TranslateAndAppendCoords(TkCanvas *canvPtr, double x, double y, XPoint *outArr, int numOut); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); #define ABS(a) ((a>=0)?(a):(-(a))) +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *---------------------------------------------------------------------- * @@ -1364,15 +1378,16 @@ Tk_CanvasPsOutline( Tk_Item *item, Tk_Outline *outline) { - char string[41], pattern[11]; + char pattern[11]; int i; - char *ptr, *str = string, *lptr = pattern; + char *ptr, *lptr = pattern; Tcl_Interp *interp = Canvas(canvas)->interp; double width = outline->width; Tk_Dash *dash = &outline->dash; XColor *color = outline->color; Pixmap stipple = outline->stipple; Tk_State state = item->state; + Tcl_Obj *psObj = GetPostscriptBuffer(interp); if (state == TK_STATE_NULL) { state = Canvas(canvas)->canvas_state; @@ -1383,7 +1398,7 @@ Tk_CanvasPsOutline( width = outline->activeWidth; } if (outline->activeDash.number > 0) { - dash = &(outline->activeDash); + dash = &outline->activeDash; } if (outline->activeColor != NULL) { color = outline->activeColor; @@ -1396,7 +1411,7 @@ Tk_CanvasPsOutline( width = outline->disabledWidth; } if (outline->disabledDash.number > 0) { - dash = &(outline->disabledDash); + dash = &outline->disabledDash; } if (outline->disabledColor != NULL) { color = outline->disabledColor; @@ -1405,66 +1420,65 @@ Tk_CanvasPsOutline( stipple = outline->disabledStipple; } } - sprintf(string, "%.15g setlinewidth\n", width); - Tcl_AppendResult(interp, string, NULL); - if (dash->number > 10) { - str = ckalloc(1 + 4*dash->number); - } else if (dash->number < -5) { - str = ckalloc(1 - 8*dash->number); - lptr = ckalloc(1 - 2*dash->number); - } + Tcl_AppendPrintfToObj(psObj, "%.15g setlinewidth\n", width); + ptr = ((unsigned) ABS(dash->number) > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; + Tcl_AppendToObj(psObj, "[", -1); if (dash->number > 0) { - char *ptr0 = ptr; + Tcl_Obj *converted; + char *p = ptr; - sprintf(str, "[%d", *ptr++ & 0xff); - i = dash->number-1; - while (i--) { - sprintf(str+strlen(str), " %d", *ptr++ & 0xff); + converted = Tcl_ObjPrintf("%d", *p++ & 0xff); + for (i = dash->number-1 ; i>=0 ; i--) { + Tcl_AppendPrintfToObj(converted, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - if (dash->number&1) { - Tcl_AppendResult(interp, " ", str+1, NULL); + Tcl_AppendObjToObj(psObj, converted); + if (dash->number & 1) { + Tcl_AppendToObj(psObj, " ", -1); + Tcl_AppendObjToObj(psObj, converted); } - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - ptr = ptr0; + Tcl_DecrRefCount(converted); + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else if (dash->number < 0) { - if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) { - char *lptr0 = lptr; + if (dash->number < -5) { + lptr = ckalloc(1 - 2*dash->number); + } + i = DashConvert(lptr, ptr, -dash->number, width); + if (i > 0) { + char *p = lptr; - sprintf(str, "[%d", *lptr++ & 0xff); - while (--i) { - sprintf(str+strlen(str), " %d", *lptr++ & 0xff); + Tcl_AppendPrintfToObj(psObj, "%d", *p++ & 0xff); + for (; --i>0 ;) { + Tcl_AppendPrintfToObj(psObj, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - lptr = lptr0; + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); + } + if (lptr != pattern) { + ckfree(lptr); } } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); - } - if (str != string) { - ckfree(str); - } - if (lptr != pattern) { - ckfree(lptr); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); } + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { return TCL_ERROR; } + + /* + * Note that psObj might hold an invalid reference now. + */ + if (stipple != None) { - Tcl_AppendResult(interp, "StrokeClip ", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "StrokeClip ", -1); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "stroke\n", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "stroke\n", -1); } return TCL_OK; diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index ef4cc03..7ca7c9d 100644 --- a/generic/tkCanvWind.c +++ b/generic/tkCanvWind.c @@ -826,45 +826,44 @@ CanvasPsWindow( double x, double y, /* origin of window. */ int width, int height) /* width/height of window. */ { - char buffer[256]; XImage *ximage; int result; - Tcl_DString buffer1, buffer2; #ifdef X_GetImage Tk_ErrorHandler handle; #endif + Tcl_Obj *cmdObj, *psObj; + Tcl_InterpState interpState = Tcl_SaveInterpState(interp, TCL_OK); - sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n", + /* + * 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); - Tcl_AppendResult(interp, buffer, NULL); /* * 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_DStringInit(&buffer1); - Tcl_DStringInit(&buffer2); - Tcl_DStringGetResult(interp, &buffer2); - sprintf(buffer, "%s postscript -prolog 0", Tk_PathName(tkwin)); - result = Tcl_Eval(interp, buffer); - Tcl_DStringGetResult(interp, &buffer1); - Tcl_DStringResult(interp, &buffer2); - Tcl_DStringFree(&buffer2); + 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_AppendResult(interp, "50 dict begin\nsave\ngsave\n", NULL); - sprintf(buffer, "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d", - height, width, height, width); - Tcl_AppendResult(interp, buffer, NULL); - Tcl_AppendResult(interp, " 0 rlineto closepath\n", + 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", - Tcl_DStringValue(&buffer1), "\nrestore\nend\n\n\n", NULL); - Tcl_DStringFree(&buffer1); - - return result; + height, width, height, width); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "\nrestore\nend\n\n\n", -1); + goto done; } - Tcl_DStringFree(&buffer1); /* * If the window is off the screen it will generate a BadMatch/XError. We @@ -889,13 +888,27 @@ CanvasPsWindow( #endif if (ximage == NULL) { - return TCL_OK; + 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); } - result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, ximage, - 0, 0, width, height); + /* + * Plug the accumulated postscript back into the result. + */ - XDestroyImage(ximage); + done: + if (result == TCL_OK) { + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL); + } else { + Tcl_DiscardInterpState(interpState); + } + Tcl_DecrRefCount(psObj); return result; } |