summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tkCanvPs.c413
-rw-r--r--generic/tkWindow.c81
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) {