plugin updates

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) {