diff options
| -rw-r--r-- | generic/tkCanvPs.c | 413 | ||||
| -rw-r--r-- | generic/tkWindow.c | 81 |
2 files changed, 395 insertions, 99 deletions
diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index 9bad194..a0c5759 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -112,6 +112,319 @@ static Tk_ConfigSpec configSpecs[] = { }; /* + * The prolog data. Generated by str2c from prolog.ps + * This was split in small chunks by str2c because + * some C compiler have limitations on the size of static strings. + */ +static CONST char * CONST prolog[]= { + /* Start of part 1 (2000 characters) */ + "%%BeginProlog\n\ +50 dict begin\n\ +\n\ +% This is a standard prolog for Postscript generated by Tk's canvas\n\ +% widget.\n\ +% SCCS: @(#) prolog.ps 1.7 96/07/08 17:52:14\n\ +\n\ +% The definitions below just define all of the variables used in\n\ +% any of the procedures here. This is needed for obscure reasons\n\ +% explained on p. 716 of the Postscript manual (Section H.2.7,\n\ +% \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\ +\n\ +/baseline 0 def\n\ +/stipimage 0 def\n\ +/height 0 def\n\ +/justify 0 def\n\ +/lineLength 0 def\n\ +/spacing 0 def\n\ +/stipple 0 def\n\ +/strings 0 def\n\ +/xoffset 0 def\n\ +/yoffset 0 def\n\ +/tmpstip null def\n\ +\n\ +% Define the array ISOLatin1Encoding (which specifies how characters are\n\ +% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\ +% level 2 is supposed to define it, but level 1 doesn't).\n\ +\n\ +systemdict /ISOLatin1Encoding known not {\n\ + /ISOLatin1Encoding [\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\ + /quoteright\n\ + /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\ + /zero /one /two /three /four /five /six /seven\n\ + /eight /nine /colon /semicolon /less /equal /greater /question\n\ + /at /A /B /C /D /E /F /G\n\ + /H /I /J /K /L /M /N /O\n\ + /P /Q /R /S /T /U /V /W\n\ + /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\ + /quoteleft /a /b /c /d /e /f /g\n\ + /h /i /j /k /l /m /n /o\n\ + /p /q /r /s /t /u /v /w\n\ + /x /y /z /braceleft /bar /braceright /asciitilde /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\ + /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\ + /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\ + /dieresis /copyright /ordfem", + /* End of part 1 */ + + /* Start of part 2 (2000 characters) */ + "inine /guillemotleft /logicalnot /hyphen\n\ + /registered /macron\n\ + /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\ + /periodcentered\n\ + /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\ + /onehalf /threequarters /questiondown\n\ + /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\ + /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\ + /Idieresis\n\ + /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\ + /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\ + /germandbls\n\ + /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\ + /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\ + /idieresis\n\ + /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\ + /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\ + /ydieresis\n\ + ] def\n\ +} if\n\ +\n\ +% font ISOEncode font\n\ +% This procedure changes the encoding of a font from the default\n\ +% Postscript encoding to ISOLatin1. It's typically invoked just\n\ +% before invoking \"setfont\". The body of this procedure comes from\n\ +% Section 5.6.1 of the Postscript book.\n\ +\n\ +/ISOEncode {\n\ + dup length dict begin\n\ + {1 index /FID ne {def} {pop pop} ifelse} forall\n\ + /Encoding ISOLatin1Encoding def\n\ + currentdict\n\ + end\n\ +\n\ + % I'm not sure why it's necessary to use \"definefont\" on this new\n\ + % font, but it seems to be important; just use the name \"Temporary\"\n\ + % for the font.\n\ +\n\ + /Temporary exch definefont\n\ +} bind def\n\ +\n\ +% StrokeClip\n\ +%\n\ +% This procedure converts the current path into a clip area under\n\ +% the assumption of stroking. It's a bit tricky because some Postscript\n\ +% interpreters get errors during strokepath for dashed lines. If\n\ +% this happens then turn off dashes and try again.\n\ +\n\ +/StrokeClip {\n\ + {strokepath} stopped {\n\ + (This Postscript printer gets limitcheck overflows when) =\n\ + (stippling dashed lines; lines will be printed solid instead.) =\n\ + [] 0 setdash strokepath} if\n\ + clip\n\ +} bind def\n\ +\n\ +% d", + /* End of part 2 */ + + /* Start of part 3 (2000 characters) */ + "esiredSize EvenPixels closestSize\n\ +%\n\ +% The procedure below is used for stippling. Given the optimal size\n\ +% of a dot in a stipple pattern in the current user coordinate system,\n\ +% compute the closest size that is an exact multiple of the device's\n\ +% pixel size. This allows stipple patterns to be displayed without\n\ +% aliasing effects.\n\ +\n\ +/EvenPixels {\n\ + % Compute exact number of device pixels per stipple dot.\n\ + dup 0 matrix currentmatrix dtransform\n\ + dup mul exch dup mul add sqrt\n\ +\n\ + % Round to an integer, make sure the number is at least 1, and compute\n\ + % user coord distance corresponding to this.\n\ + dup round dup 1 lt {pop 1} if\n\ + exch div mul\n\ +} bind def\n\ +\n\ +% width height string StippleFill --\n\ +%\n\ +% Given a path already set up and a clipping region generated from\n\ +% it, this procedure will fill the clipping region with a stipple\n\ +% pattern. \"String\" contains a proper image description of the\n\ +% stipple pattern and \"width\" and \"height\" give its dimensions. Each\n\ +% stipple dot is assumed to be about one unit across in the current\n\ +% user coordinate system. This procedure trashes the graphics state.\n\ +\n\ +/StippleFill {\n\ + % The following code is needed to work around a NeWSprint bug.\n\ +\n\ + /tmpstip 1 index def\n\ +\n\ + % Change the scaling so that one user unit in user coordinates\n\ + % corresponds to the size of one stipple dot.\n\ + 1 EvenPixels dup scale\n\ +\n\ + % Compute the bounding box occupied by the path (which is now\n\ + % the clipping region), and round the lower coordinates down\n\ + % to the nearest starting point for the stipple pattern. Be\n\ + % careful about negative numbers, since the rounding works\n\ + % differently on them.\n\ +\n\ + pathbbox\n\ + 4 2 roll\n\ + 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\ + 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\ +\n\ + % Stack now: width height string y1 y2 x1 x2\n\ + % Below is a doubly-nested for loop to iterate across this area\n\ + % in units of the stipple pattern size, going up columns then\n\ + % acr", + /* End of part 3 */ + + /* Start of part 4 (2000 characters) */ + "oss rows, blasting out a stipple-pattern-sized rectangle at\n\ + % each position\n\ +\n\ + 6 index exch {\n\ + 2 index 5 index 3 index {\n\ + % Stack now: width height string y1 y2 x y\n\ +\n\ + gsave\n\ + 1 index exch translate\n\ + 5 index 5 index true matrix tmpstip imagemask\n\ + grestore\n\ + } for\n\ + pop\n\ + } for\n\ + pop pop pop pop pop\n\ +} bind def\n\ +\n\ +% -- AdjustColor --\n\ +% Given a color value already set for output by the caller, adjusts\n\ +% that value to a grayscale or mono value if requested by the CL\n\ +% variable.\n\ +\n\ +/AdjustColor {\n\ + CL 2 lt {\n\ + currentgray\n\ + CL 0 eq {\n\ + .5 lt {0} {1} ifelse\n\ + } if\n\ + setgray\n\ + } if\n\ +} bind def\n\ +\n\ +% x y strings spacing xoffset yoffset justify stipple DrawText --\n\ +% This procedure does all of the real work of drawing text. The\n\ +% color and font must already have been set by the caller, and the\n\ +% following arguments must be on the stack:\n\ +%\n\ +% x, y - Coordinates at which to draw text.\n\ +% strings - An array of strings, one for each line of the text item,\n\ +% in order from top to bottom.\n\ +% spacing - Spacing between lines.\n\ +% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\ +% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\ +% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\ +% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\ +% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\ +% stipple - Boolean value indicating whether or not text is to be\n\ +% drawn in stippled fashion. If text is stippled,\n\ +% procedure StippleText must have been defined to call\n\ +% StippleFill in the right way.\n\ +%\n\ +% Also, when this procedure is invoked, the color and font must already\n\ +% have been set for the text.\n\ +\n\ +/DrawText {\n\ + /stipple exch def\n\ + /justify exch def\n\ + /yoffset exch def\n\ + /xoffset exch def\n\ + /spacing exch def\n\ + /strings exch def\n\ +\n\ + % First scan through all of the text to find the widest line.\n\ +\n\ + /lineLength 0 def\n\ + strings {\n\ + stringwidth pop\n\ + dup lineLength gt {/lineLength exch def}", + /* End of part 4 */ + + /* Start of part 5 (1546 characters) */ + " {pop} ifelse\n\ + newpath\n\ + } forall\n\ +\n\ + % Compute the baseline offset and the actual font height.\n\ +\n\ + 0 0 moveto (TXygqPZ) false charpath\n\ + pathbbox dup /baseline exch def\n\ + exch pop exch sub /height exch def pop\n\ + newpath\n\ +\n\ + % Translate coordinates first so that the origin is at the upper-left\n\ + % corner of the text's bounding box. Remember that x and y for\n\ + % positioning are still on the stack.\n\ +\n\ + translate\n\ + lineLength xoffset mul\n\ + strings length 1 sub spacing mul height add yoffset mul translate\n\ +\n\ + % Now use the baseline and justification information to translate so\n\ + % that the origin is at the baseline and positioning point for the\n\ + % first line of text.\n\ +\n\ + justify lineLength mul baseline neg translate\n\ +\n\ + % Iterate over each of the lines to output it. For each line,\n\ + % compute its width again so it can be properly justified, then\n\ + % display it.\n\ +\n\ + strings {\n\ + dup stringwidth pop\n\ + justify neg mul 0 moveto\n\ + stipple {\n\ +\n\ + % The text is stippled, so turn it into a path and print\n\ + % by calling StippledText, which in turn calls StippleFill.\n\ + % Unfortunately, many Postscript interpreters will get\n\ + % overflow errors if we try to do the whole string at\n\ + % once, so do it a character at a time.\n\ +\n\ + gsave\n\ + /char (X) def\n\ + {\n\ + char 0 3 -1 roll put\n\ + currentpoint\n\ + gsave\n\ + char true charpath clip StippleText\n\ + grestore\n\ + char stringwidth translate\n\ + moveto\n\ + } forall\n\ + grestore\n\ + } {show} ifelse\n\ + 0 spacing neg translate\n\ + } forall\n\ +} bind def\n\ +\n\ +%%EndProlog\n\ +", + /* End of part 5 */ + + NULL /* End of data marker */ +}; + +/* * Forward declarations for procedures defined later in this file: */ @@ -164,6 +477,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_DString buffer; + CONST char * CONST *chunk; /* *---------------------------------------------------------------- @@ -443,14 +757,12 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL); /* - * Read a standard prolog file in a native way and insert it into - * the Postscript. + * Insert the prolog */ - - if (TkGetNativeProlog(canvasPtr->interp) != TCL_OK) { - result = TCL_ERROR; - goto cleanup; + for (chunk=prolog; *chunk; chunk++) { + Tcl_AppendResult(interp, *chunk, (char *) NULL); } + if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); Tcl_ResetResult(canvasPtr->interp); @@ -1072,92 +1384,3 @@ GetPostscriptPoints(interp, string, doublePtr) *doublePtr = d; return TCL_OK; } - -/* - *-------------------------------------------------------------- - * - * TkGetProlog -- - * - * Locate and load the postscript prolog. - * - * Results: - * A standard Tcl Result. If everything is OK the prolog - * will be located in the result string of the interpreter. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -int -TkGetProlog(interp) - Tcl_Interp *interp; /* Places the prolog in the result. */ -{ - char *libDir; - Tcl_Channel chan; - Tcl_DString buffer, buffer2; - char *prologPathParts[2]; - int bufferSize; - char *prologBuffer; - - libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY); - if (libDir == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find library directory: ", - "tk_library variable doesn't exist", (char *) NULL); - return TCL_ERROR; - } - Tcl_TranslateFileName(interp, libDir, &buffer); - prologPathParts[0] = buffer.string; - prologPathParts[1] = "prolog.ps"; - Tcl_DStringInit(&buffer2); - Tcl_JoinPath(2, prologPathParts, &buffer2); - Tcl_DStringFree(&buffer); - - /* - * Compute size of file by seeking to the end of the file. This will - * overallocate if we are performing CRLF translation. - */ - - chan = Tcl_OpenFileChannel(NULL, buffer2.string, "r", 0); - if (chan == NULL) { - /* - * We have to set the error message ourselves because the - * interp's result need to be reset. - */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't open \"", - buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL); - Tcl_DStringFree(&buffer2); - return TCL_ERROR; - } - - bufferSize = Tcl_Seek(chan, 0L, SEEK_END); - (void) Tcl_Seek(chan, 0L, SEEK_SET); - if (bufferSize < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error seeking to end of file \"", - buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL); - Tcl_Close(NULL, chan); - Tcl_DStringFree(&buffer2); - return TCL_ERROR; - - } - prologBuffer = (char *) ckalloc((unsigned) bufferSize+1); - bufferSize = Tcl_Read(chan, prologBuffer, bufferSize); - Tcl_Close(NULL, chan); - if (bufferSize < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error reading file \"", buffer2.string, - "\": ", Tcl_PosixError(interp), (char *) NULL); - Tcl_DStringFree(&buffer2); - return TCL_ERROR; - } - Tcl_DStringFree(&buffer2); - prologBuffer[bufferSize] = 0; - Tcl_AppendResult(interp, prologBuffer, (char *) NULL); - ckfree(prologBuffer); - - return TCL_OK; -} diff --git a/generic/tkWindow.c b/generic/tkWindow.c index fc9060a..510842b 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -2624,12 +2624,85 @@ Initialize(interp) rest = 0; /* - * If there is an "argv" variable, get its value, extract out - * relevant arguments from it, and rewrite the variable without - * the arguments that we used. + * We start by resetting the result because it might not be clean */ + Tcl_ResetResult(interp); + + if (Tcl_IsSafe(interp)) { + /* + * Get the clearance to start Tk and the "argv" parameters + * from the master. + */ + Tcl_DString ds; + + /* + * Step 1 : find the master and construct the interp name + * (could be a function if new APIs were ok). + * We could also construct the path while walking, but there + * is no API to get the name of an interp either. + */ + Tcl_Interp *master = interp; + + while (1) { + master = Tcl_GetMaster(master); + if (master == NULL) { + Tcl_DStringFree(&ds); + Tcl_AppendResult(interp, "NULL master", (char *) NULL); + return TCL_ERROR; + } + if (!Tcl_IsSafe(master)) { + /* Found the trusted master. */ + break; + } + } + /* + * Construct the name (rewalk...) + */ + if (Tcl_GetInterpPath(master, interp) != TCL_OK) { + Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", + (char *) NULL); + return TCL_ERROR; + } + /* + * Build the string to eval. + */ + Tcl_DStringInit(&ds); + Tcl_DStringAppendElement(&ds, "::safe::TkInit"); + Tcl_DStringAppendElement(&ds, Tcl_GetStringResult(master)); + + /* + * Step 2 : Eval in the master. The argument is the *reversed* + * interp path of the slave. + */ + + if (Tcl_Eval(master, Tcl_DStringValue(&ds)) != 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); + Tcl_AppendResult(interp, + "not allowed to start Tk by master's safe::TkInit", + (char *) NULL); + return TCL_ERROR; + } + Tcl_DStringFree(&ds); + /* + * Use the master's result as argv. + * Note: We don't use the Obj interfaces to avoid dealing with + * cross interp refcounting and changing the code below. + */ - p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY); + p = Tcl_GetStringResult(master); + } else { + /* + * If there is an "argv" variable, get its value, extract out + * relevant arguments from it, and rewrite the variable without + * the arguments that we used. + */ + + p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY); + } argv = NULL; if (p != NULL) { if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) { |