Simplify the postscript generation.

4 files changed, 213 insertions, 193 deletions

diff --git a/ChangeLog b/ChangeLog
index 47302fe..abbae49 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2010-01-03  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tkFont.c (Tk_TextLayoutToPostscript):	Simplified the code to
+	* generic/tkCanvPs.c (TkCanvPostscriptCmd):	generate the preamble
+	* library/mkpsenc.tcl:				for PS generation and
+	also simplify the code to output text following the observation that
+	it effectively only produces ASCII anyway, even when it might have the
+	option to do otherwise in theory.
+
 2010-01-03  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
 	* library/tearoff.tcl: tearoff menus should be transient and use the
diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c
index d397b9a..33bc89d 100644
--- a/generic/tkCanvPs.c
+++ b/generic/tkCanvPs.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkCanvPs.c,v 1.27 2009/05/01 15:04:03 dkf Exp $
+ * RCS: @(#) $Id: tkCanvPs.c,v 1.28 2010/01/03 16:24:13 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -178,7 +178,7 @@ TkCanvPostscriptCmd(
     Tcl_HashSearch search;
     Tcl_HashEntry *hPtr;
     Tcl_DString buffer;
-    static const char *psenccmd = "::tk::ensure_psenc_is_loaded";
+    Tcl_Obj *preambleObj;
     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
@@ -186,14 +186,28 @@ TkCanvPostscriptCmd(
 				 * only to stop compiler warnings. */
 
     /*
-     * Initialize the data structure describing Postscript generation, then
-     * process all the arguments to fill the data structure in.
+     * Get the generic preamble. We only ever bother with the ASCII encoding;
+     * the others just make life too complicated and never actually worked as
+     * such.
      */
 
-    result = Tcl_EvalEx(interp, psenccmd, -1, TCL_EVAL_GLOBAL);
+    result = Tcl_Eval(interp, "::tk::ensure_psenc_is_loaded");
     if (result != TCL_OK) {
 	return result;
     }
+    preambleObj = Tcl_GetVar2Ex(interp, "::tk::ps_preamble", NULL,
+	    TCL_LEAVE_ERR_MSG);
+    if (preambleObj == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_IncrRefCount(preambleObj);
+    Tcl_ResetResult(interp);
+
+    /*
+     * Initialize the data structure describing Postscript generation, then
+     * process all the arguments to fill the data structure in.
+     */
+
     oldInfoPtr = canvasPtr->psInfo;
     canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr;
     psInfo.x = canvasPtr->xOrigin;
@@ -460,8 +474,7 @@ TkCanvPostscriptCmd(
 	 * Insert the prolog
 	 */
 
-	Tcl_AppendResult(interp, Tcl_GetVar(interp, "::tk::ps_preamable",
-		TCL_GLOBAL_ONLY), NULL);
+	Tcl_AppendResult(interp, Tcl_GetString(preambleObj), NULL);
 
 	if (psInfo.chan != NULL) {
 	    Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
@@ -602,6 +615,7 @@ TkCanvPostscriptCmd(
     }
     Tcl_DeleteHashTable(&psInfo.fontTable);
     canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
+    Tcl_DecrRefCount(preambleObj);
     return result;
 }
 
diff --git a/generic/tkFont.c b/generic/tkFont.c
index 749f64b..76895e3 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.c
@@ -10,13 +10,13 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkFont.c,v 1.62 2010/01/02 22:52:38 dkf Exp $
+ * RCS: @(#) $Id: tkFont.c,v 1.63 2010/01/03 16:24:13 dkf Exp $
  */
 
 #include "tkInt.h"
 #include "tkFont.h"
 
-#define ROUND16(x) ((short)((x) + 0.5))
+#define ROUND16(x)	((short)((x) + 0.5))
 
 /*
  * The following structure is used to keep track of all the fonts that exist
@@ -417,9 +417,8 @@ TkFontPkgFree(
     TkFontInfo *fiPtr = mainPtr->fontInfoPtr;
     Tcl_HashEntry *hPtr, *searchPtr;
     Tcl_HashSearch search;
-    int fontsLeft;
+    int fontsLeft = 0;
 
-    fontsLeft = 0;
     for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
 	    searchPtr != NULL;
 	    searchPtr = Tcl_NextHashEntry(&search)) {
@@ -440,7 +439,7 @@ TkFontPkgFree(
 
     hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
     while (hPtr != NULL) {
-	ckfree((char *) Tcl_GetHashValue(hPtr));
+	ckfree(Tcl_GetHashValue(hPtr));
 	hPtr = Tcl_NextHashEntry(&search);
     }
     Tcl_DeleteHashTable(&fiPtr->namedTable);
@@ -476,7 +475,7 @@ Tk_FontObjCmd(
 {
     int index;
     Tk_Window tkwin = clientData;
-    TkFontInfo *fiPtr;
+    TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
     static const char *const optionStrings[] = {
 	"actual",	"configure",	"create",	"delete",
 	"families",	"measure",	"metrics",	"names",
@@ -487,8 +486,6 @@ Tk_FontObjCmd(
 	FONT_FAMILIES,	FONT_MEASURE,	FONT_METRICS,	FONT_NAMES
     };
 
-    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
-
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
 	return TCL_ERROR;
@@ -640,13 +637,12 @@ Tk_FontObjCmd(
 	return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
     }
     case FONT_CREATE: {
-	int skip, i;
+	int skip = 3, i;
 	const char *name;
 	char buf[16 + TCL_INTEGER_SPACE];
 	TkFontAttributes fa;
 	Tcl_HashEntry *namedHashPtr;
 
-	skip = 3;
 	if (objc < 3) {
 	    name = NULL;
 	} else {
@@ -701,9 +697,8 @@ Tk_FontObjCmd(
 	return result;
     }
     case FONT_FAMILIES: {
-	int skip;
+	int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
 
-	skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
 	if (skip < 0) {
 	    return TCL_ERROR;
 	}
@@ -726,7 +721,8 @@ Tk_FontObjCmd(
 	    }
 	}
 	if (objc - skip != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "font ?-displayof window? text");
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "font ?-displayof window? text");
 	    return TCL_ERROR;
 	}
 	tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
@@ -844,9 +840,8 @@ UpdateDependentFonts(
     Tcl_HashEntry *cacheHashPtr;
     Tcl_HashSearch search;
     TkFont *fontPtr;
-    NamedFont *nfPtr;
+    NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr);
 
-    nfPtr = Tcl_GetHashValue(namedHashPtr);
     if (nfPtr->refCount == 0) {
 	/*
 	 * Well nobody's using this named font, so don't have to tell any
@@ -948,15 +943,12 @@ TkCreateNamedFont(
     const char *name,		/* Name for the new named font. */
     TkFontAttributes *faPtr)	/* Attributes for the new named font. */
 {
-    TkFontInfo *fiPtr;
+    TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
     Tcl_HashEntry *namedHashPtr;
     int isNew;
     NamedFont *nfPtr;
 
-    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
-
     namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &isNew);
-
     if (!isNew) {
 	nfPtr = Tcl_GetHashValue(namedHashPtr);
 	if (nfPtr->deletePending == 0) {
@@ -1005,12 +997,10 @@ TkDeleteNamedFont(
     Tk_Window tkwin,		/* A window associated with interp. */
     const char *name)		/* Name for the new named font. */
 {
-    TkFontInfo *fiPtr;
+    TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
     NamedFont *nfPtr;
     Tcl_HashEntry *namedHashPtr;
 
-    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
-
     namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name);
     if (namedHashPtr == NULL) {
 	if (interp) {
@@ -1061,7 +1051,7 @@ Tk_GetFont(
     Tk_Font tkfont;
     Tcl_Obj *strPtr;
 
-    strPtr = Tcl_NewStringObj((char *) string, -1);
+    strPtr = Tcl_NewStringObj(string, -1);
     Tcl_IncrRefCount(strPtr);
     tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
     Tcl_DecrRefCount(strPtr);
@@ -1097,19 +1087,17 @@ Tk_AllocFontFromObj(
     Tcl_Obj *objPtr)		/* Object describing font, as: named font,
 				 * native format, or parseable string. */
 {
-    TkFontInfo *fiPtr;
+    TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
     Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
     TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
     int isNew, descent;
     NamedFont *nfPtr;
 
-    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
     if (objPtr->typePtr != &tkFontObjType) {
 	SetFontFromAny(interp, objPtr);
     }
 
     oldFontPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
     if (oldFontPtr != NULL) {
 	if (oldFontPtr->resourceRefCount == 0) {
 	    /*
@@ -1277,7 +1265,8 @@ Tk_AllocFontFromObj(
 
 Tk_Font
 Tk_GetFontFromObj(
-    Tk_Window tkwin,		/* The window that the font will be used in. */
+    Tk_Window tkwin,		/* The window that the font will be used
+				 * in. */
     Tcl_Obj *objPtr)		/* The object from which to get the font. */
 {
     TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
@@ -1289,7 +1278,6 @@ Tk_GetFontFromObj(
     }
 
     fontPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
     if (fontPtr != NULL) {
 	if (fontPtr->resourceRefCount == 0) {
 	    /*
@@ -1393,9 +1381,8 @@ const char *
 Tk_NameOfFont(
     Tk_Font tkfont)		/* Font whose name is desired. */
 {
-    TkFont *fontPtr;
+    TkFont *fontPtr = (TkFont *) tkfont;
 
-    fontPtr = (TkFont *) tkfont;
     return fontPtr->cacheHashPtr->key.string;
 }
 
@@ -1420,13 +1407,12 @@ void
 Tk_FreeFont(
     Tk_Font tkfont)		/* Font to be released. */
 {
-    TkFont *fontPtr, *prevPtr;
+    TkFont *fontPtr = (TkFont *) tkfont, *prevPtr;
     NamedFont *nfPtr;
 
-    if (tkfont == NULL) {
+    if (fontPtr == NULL) {
 	return;
     }
-    fontPtr = (TkFont *) tkfont;
     fontPtr->resourceRefCount--;
     if (fontPtr->resourceRefCount > 0) {
 	return;
@@ -1591,9 +1577,8 @@ Tk_FontId(
     Tk_Font tkfont)		/* Font that is going to be selected into
 				 * GC. */
 {
-    TkFont *fontPtr;
+    TkFont *fontPtr = (TkFont *) tkfont;
 
-    fontPtr = (TkFont *) tkfont;
     return fontPtr->fid;
 }
 
@@ -1665,13 +1650,12 @@ Tk_PostscriptFontName(
 				 * which the name of the Postscript font that
 				 * corresponds to tkfont will be appended. */
 {
-    TkFont *fontPtr;
+    TkFont *fontPtr = (TkFont *) tkfont;
     Tk_Uid family, weightString, slantString;
     char *src, *dest;
     int upper, len;
 
     len = Tcl_DStringLength(dsPtr);
-    fontPtr = (TkFont *) tkfont;
 
     /*
      * Convert the case-insensitive Tk_Font family name to the case-sensitive
@@ -1897,11 +1881,9 @@ TkUnderlineCharsInContext(
     int lastByte)		/* Index of first byte after the last
 				 * character. */
 {
-    TkFont *fontPtr;
+    TkFont *fontPtr = (TkFont *) tkfont;
     int startX, endX;
 
-    fontPtr = (TkFont *) tkfont;
-
     TkpMeasureCharsInContext(tkfont, string, numBytes, 0, firstByte, -1, 0,
 	    &startX);
     TkpMeasureCharsInContext(tkfont, string, numBytes, 0, lastByte, -1, 0,
@@ -1960,7 +1942,7 @@ Tk_ComputeTextLayout(
     int *widthPtr,		/* Filled with width of string. */
     int *heightPtr)		/* Filled with height of string. */
 {
-    TkFont *fontPtr;
+    TkFont *fontPtr = (TkFont *) tkfont;
     const char *start, *end, *special;
     int n, y, bytesThisChunk, maxChunks, curLine, layoutHeight;
     int baseline, height, curX, newX, maxWidth, *lineLengths;
@@ -1971,7 +1953,6 @@ Tk_ComputeTextLayout(
 
     Tcl_DStringInit(&lineBuffer);
 
-    fontPtr = (TkFont *) tkfont;
     if ((fontPtr == NULL) || (string == NULL)) {
 	if (widthPtr != NULL) {
 	    *widthPtr = 0;
@@ -2280,7 +2261,8 @@ void
 Tk_DrawTextLayout(
     Display *display,		/* Display on which to draw. */
     Drawable drawable,		/* Window or pixmap in which to draw. */
-    GC gc,			/* Graphics context to use for drawing text. */
+    GC gc,			/* Graphics context to use for drawing
+				 * text. */
     Tk_TextLayout layout,	/* Layout information, from a previous call to
 				 * Tk_ComputeTextLayout(). */
     int x, int y,		/* Upper-left hand corner of rectangle in
@@ -2337,7 +2319,8 @@ void
 TkDrawAngledTextLayout(
     Display *display,		/* Display on which to draw. */
     Drawable drawable,		/* Window or pixmap in which to draw. */
-    GC gc,			/* Graphics context to use for drawing text. */
+    GC gc,			/* Graphics context to use for drawing
+				 * text. */
     Tk_TextLayout layout,	/* Layout information, from a previous call to
 				 * Tk_ComputeTextLayout(). */
     int x, int y,		/* Upper-left hand corner of rectangle in
@@ -2454,7 +2437,8 @@ void
 TkUnderlineAngledTextLayout(
     Display *display,		/* Display on which to draw. */
     Drawable drawable,		/* Window or pixmap in which to draw. */
-    GC gc,			/* Graphics context to use for drawing text. */
+    GC gc,			/* Graphics context to use for drawing
+				 * text. */
     Tk_TextLayout layout,	/* Layout information, from a previous call to
 				 * Tk_ComputeTextLayout(). */
     int x, int y,		/* Upper-left hand corner of rectangle in
@@ -2552,7 +2536,7 @@ Tk_PointToChar(
 				 * to the upper-left corner of the text
 				 * layout. */
 {
-    TextLayout *layoutPtr;
+    TextLayout *layoutPtr = (TextLayout *) layout;
     LayoutChunk *chunkPtr, *lastPtr;
     TkFont *fontPtr;
     int i, n, dummy, baseline, pos, numChars;
@@ -2570,7 +2554,6 @@ Tk_PointToChar(
      * Find which line contains the point.
      */
 
-    layoutPtr = (TextLayout *) layout;
     fontPtr = (TkFont *) layoutPtr->tkfont;
     lastPtr = chunkPtr = layoutPtr->chunks;
     numChars = 0;
@@ -2700,7 +2683,7 @@ Tk_CharBbox(
 				 * bounding box for the character specified by
 				 * index, if non-NULL. */
 {
-    TextLayout *layoutPtr;
+    TextLayout *layoutPtr = (TextLayout *) layout;
     LayoutChunk *chunkPtr;
     int i, x = 0, w;
     Tk_Font tkfont;
@@ -2711,7 +2694,6 @@ Tk_CharBbox(
 	return 0;
     }
 
-    layoutPtr = (TextLayout *) layout;
     chunkPtr = layoutPtr->chunks;
     tkfont = layoutPtr->tkfont;
     fontPtr = (TkFont *) tkfont;
@@ -2812,11 +2794,10 @@ Tk_DistanceToTextLayout(
 				 * (in pixels). */
 {
     int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
+    TextLayout *layoutPtr = (TextLayout *) layout;
     LayoutChunk *chunkPtr;
-    TextLayout *layoutPtr;
     TkFont *fontPtr;
 
-    layoutPtr = (TextLayout *) layout;
     fontPtr = (TkFont *) layoutPtr->tkfont;
     ascent = fontPtr->fm.ascent;
     descent = fontPtr->fm.descent;
@@ -2900,7 +2881,7 @@ Tk_IntersectTextLayout(
 				 * rectangular area, in pixels. */
 {
     int result, i, x1, y1, x2, y2;
-    TextLayout *layoutPtr;
+    TextLayout *layoutPtr = (TextLayout *) layout;
     LayoutChunk *chunkPtr;
     TkFont *fontPtr;
     int left, top, right, bottom;
@@ -2912,7 +2893,6 @@ Tk_IntersectTextLayout(
      * and see if they were all inside or all outside.
      */
 
-    layoutPtr = (TextLayout *) layout;
     chunkPtr = layoutPtr->chunks;
     fontPtr = (TkFont *) layoutPtr->tkfont;
 
@@ -3006,9 +2986,7 @@ static inline int
 sign(
     double value)
 {
-    if (value < 0.0) return -1;
-    if (value > 0.0) return 1;
-    return 0;
+    return (value < 0.0) ? -1 : (value > 0.0) ? 1 : 0;
 }
 
 static inline int
@@ -3149,6 +3127,7 @@ TkIntersectAngledTextLayout(
 
     for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) {
 	double cx[4], cy[4];
+
 	if (chunkPtr->start[0] == '\n') {
 	    /*
 	     * Newline characters are not counted when computing area
@@ -3199,6 +3178,7 @@ TkIntersectAngledTextLayout(
 
 	for (j=0 ; j<4 ; j++) {
 	    int k = (j+1) % 4;
+
 	    if (    SidesIntersect(rx[j],ry[j], rx[k],ry[k], x1,y1, x2,y1) ||
 		    SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y1, x2,y2) ||
 		    SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y2, x1,y2) ||
@@ -3258,16 +3238,14 @@ Tk_TextLayoutToPostscript(
     Tcl_Interp *interp,		/* Filled with Postscript code. */
     Tk_TextLayout layout)	/* The layout to be rendered. */
 {
+    TextLayout *layoutPtr = (TextLayout *) layout;
 #define MAXUSE 128
-    char buf[MAXUSE+30], uindex[5] = "\0\0\0\0", one_char[5];
+    char buf[MAXUSE+30];
     LayoutChunk *chunkPtr;
-    int i, j, used, c, baseline, charsize;
+    int i, j, used, baseline, charsize;
     Tcl_UniChar ch;
-    const char *p, *last_p, *glyphname;
-    TextLayout *layoutPtr;
-    int bytecount=0;
+    const char *p, *glyphname;
 
-    layoutPtr = (TextLayout *) layout;
     chunkPtr = layoutPtr->chunks;
     baseline = chunkPtr->y;
     used = 0;
@@ -3291,54 +3269,66 @@ Tk_TextLayoutToPostscript(
 	    p = chunkPtr->start;
 	    for (j = 0; j < chunkPtr->numDisplayChars; j++) {
 		/*
-		 * INTL: For now we just treat the characters as binary data
-		 * and display the lower byte. Eventually this should be
-		 * revised to handle international postscript fonts.
+		 * INTL: We only handle symbols that have an encoding as a
+		 * flyph from the standard set defined by Adobe. The rest get
+		 * punted. Eventually this should be revised to handle more
+		 * sophsticiated international postscript fonts.
 		 */
 
-		last_p = p;
-		p += (charsize = Tcl_UtfToUniChar(p,&ch));
-		Tcl_UtfToExternal(interp, NULL, last_p, charsize, 0, NULL,
-			one_char, 4, NULL, &bytecount, NULL);
-		if (bytecount == 1) {
-		    c = UCHAR(one_char[0]);
-		    /* c = UCHAR( ch & 0xFF) */;
-		    if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
-			    || (c >= UCHAR(0x7f))) {
-			/*
-			 * Tricky point: the "03" is necessary in the sprintf
-			 * below, so that a full three digits of octal are
-			 * always generated. Without the "03", a number
-			 * following this sequence could be interpreted by
-			 * Postscript as part of this sequence.
-			 */
+		charsize = Tcl_UtfToUniChar(p, &ch);
+		p += charsize;
 
-			sprintf(buf + used, "\\%03o", c);
-			used += 4;
-		    } else {
-			buf[used++] = c;
-		    }
+		if ((ch == '(') || (ch == ')') || (ch == '\\')
+			|| (ch < 0x20)) {
+		    /*
+		     * Tricky point: the "03" is necessary in the sprintf
+		     * below, so that a full three digits of octal are always
+		     * generated. Without the "03", a number following this
+		     * sequence could be interpreted by Postscript as part of
+		     * this sequence.
+		     */
+
+		    sprintf(buf + used, "\\%03o", ch);
+		    used += 4;
+		} else if (ch <= 0x7f) {
+		    /*
+		     * Normal ASCII character.
+		     */
+
+		    buf[used++] = ch;
 		} else {
+		    char uindex[5];
+
 		    /*
-		     * This character doesn't belong to system character set.
-		     * So, we must use full glyph name.
+		     * This character doesn't belong to the ASCII character
+		     * set, so we use the full glyph name.
 		     */
 
 		    sprintf(uindex, "%04X", ch);	/* endianness? */
-		    glyphname = Tcl_GetVar2(interp,"::tk::psglyphs",uindex,0);
+		    glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex,
+			    0);
 		    if (glyphname) {
-			if (used > 0 && buf [used-1] == '(') {
-			    --used;
+			if (used > 0 && buf[used-1] == '(') {
+			    used--;
 			} else {
 			    buf[used++] = ')';
 			}
 			buf[used++] = '/';
-			while ((*glyphname) && (used < (MAXUSE+27))) {
-			    buf[used++] = *glyphname++ ;
+			while ((*glyphname) && (used < MAXUSE+27)) {
+			    buf[used++] = *glyphname++;
 			}
 			buf[used++] = '(';
-		    }
+		    } else {
+			/*
+			 * No known mapping for the character into the space
+			 * of PostScript glyphs. Ignore it. :-(
+			 */
 
+#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT
+			fprintf(stderr, "Warning: no mapping to PostScript "
+				"glyphs for \\u%04x\n", ch);
+#endif
+		    }
 		}
 		if (used >= MAXUSE) {
 		    buf[used] = '\0';
diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl
index 07c5217..e3c5f46 100644
--- a/library/mkpsenc.tcl
+++ b/library/mkpsenc.tcl
@@ -3,17 +3,19 @@
 # This file generates the postscript prolog used by Tk.
 
 namespace eval ::tk {
-    # Creates Postscript encoding vector for given encoding
+    # Creates Postscript encoding vector for ISO-8859-1 (could theoretically
+    # handle any 8-bit encoding, but Tk never generates characters outside
+    # ASCII).
     #
-    proc CreatePostscriptEncoding {encoding} {
+    proc CreatePostscriptEncoding {} {
 	variable psglyphs
 	# Now check for known. Even if it is known, it can be other than we
 	# need. GhostScript seems to be happy with such approach
-	set result "/CurrentEncoding \[\n"
+	set result "\[\n"
 	for {set i 0} {$i<256} {incr i 8} {
 	    for {set j 0} {$j<8} {incr j} {
-		set enc [encoding convertfrom $encoding \
-			     [format %c [expr {$i+$j}]]]
+		set enc [encoding convertfrom "iso8859-1" \
+			[format %c [expr {$i+$j}]]]
 		catch {
 		    set hexcode {}
 		    set hexcode [format %04X [scan $enc %c]]
@@ -26,7 +28,7 @@ namespace eval ::tk {
 	    }
 	    append result "\n"
 	}
-	append result "\] def\n"
+	append result "\]"
 	return $result
     }
 
@@ -1088,64 +1090,69 @@ namespace eval ::tk {
 	FB4B afii57700
     }
 
-    proc ps_literal {string} {
-	variable ps_preamable ;# sic
-	foreach line [split $string \n] {
-	    set line [string trim $line]
-	    if {$line eq ""} continue
-	    append ps_preamable $line \n
+    variable ps_preamble {}
+
+    namespace eval ps {
+	namespace ensemble create
+	namespace export {[a-z]*}
+	proc literal {string} {
+	    upvar 0 ::tk::ps_preamble preamble
+	    foreach line [split $string \n] {
+		set line [string trim $line]
+		if {$line eq ""} continue
+		append preamble $line \n
+	    }
+	    return
 	}
-	return
-    }
-    proc ps_variable {name value} {
-	variable ps_preamable
-	append ps_preamable "/$name $value def\n"
-	return
-    }
-    proc ps_function {name body} {
-	variable ps_preamable
-	append ps_preamable "/$name \{"
-	foreach line [split $body \n] {
-	    set line [string trim $line]
-	    # Strip blank lines and comments from the bodies of functions
-	    if {$line eq "" } continue
-	    if {[string match {[%#]*} $line]} continue
-	    append ps_preamable $line " "
+	proc variable {name value} {
+	    upvar 0 ::tk::ps_preamble preamble
+	    append preamble "/$name $value def\n"
+	    return
+	}
+	proc function {name body} {
+	    upvar 0 ::tk::ps_preamble preamble
+	    append preamble "/$name \{"
+	    foreach line [split $body \n] {
+		set line [string trim $line]
+		# Strip blank lines and comments from the bodies of functions
+		if {$line eq "" } continue
+		if {[string match {[%#]*} $line]} continue
+		append preamble $line " "
+	    }
+	    append preamble "\} bind def\n"
+	    return
 	}
-	append ps_preamable "\} bind def\n"
-	return
     }
 
-    # Precalculate entire prolog when this file is loaded (to speed things up)
-    ps_literal {
+    ps literal {
 	%%BeginProlog
 	% This is a standard prolog for Postscript generated by Tk's canvas
 	% widget.
-	% RCS: @(#) $Id: mkpsenc.tcl,v 1.6 2009/05/01 15:21:02 dkf Exp $
+	% RCS: @(#) $Id: mkpsenc.tcl,v 1.7 2010/01/03 16:24:13 dkf Exp $
     }
-    ps_literal [CreatePostscriptEncoding [encoding system]]
-    ps_literal {50 dict begin}
+    ps variable CurrentEncoding [CreatePostscriptEncoding]
+    ps literal {50 dict begin}
 
     # The definitions below just define all of the variables used in any of
-    # the procedures here. This is needed for obscure reasons explained on p.
-    # 716 of the Postscript manual (Section H.2.7, "Initializing Variables,"
-    # in the section on Encapsulated Postscript).
-    ps_variable baseline 0
-    ps_variable stipimage 0
-    ps_variable height 0
-    ps_variable justify 0
-    ps_variable lineLength 0
-    ps_variable spacing 0
-    ps_variable stipple 0
-    ps_variable strings 0
-    ps_variable xoffset 0
-    ps_variable yoffset 0
-    ps_variable tmpstip null
-    ps_variable baselineSampler "( TXygqPZ)"
+    # the procedures here. This is needed for obscure reasons explained on
+    # p. 716 of the Postscript manual (Section H.2.7, "Initializing
+    # Variables," in the section on Encapsulated Postscript).
+    ps variable baseline 0
+    ps variable stipimage 0
+    ps variable height 0
+    ps variable justify 0
+    ps variable lineLength 0
+    ps variable spacing 0
+    ps variable stipple 0
+    ps variable strings 0
+    ps variable xoffset 0
+    ps variable yoffset 0
+    ps variable tmpstip null
+    ps variable baselineSampler "( TXygqPZ)"
     # Put an extra-tall character in; done this way to avoid encoding trouble
-    ps_literal {baselineSampler 0 196 put}
+    ps literal {baselineSampler 0 196 put}
 
-    ps_function cstringshow {
+    ps function cstringshow {
 	{
 	    dup type /stringtype eq
 	    { show } { glyphshow }
@@ -1153,12 +1160,13 @@ namespace eval ::tk {
 	} forall
     }
 
-    ps_function cstringwidth {
+    ps function cstringwidth {
 	0 exch 0 exch
 	{
 	    dup type /stringtype eq
 	    { stringwidth } { 
-		currentfont /Encoding get exch 1 exch put (\001) stringwidth 
+		currentfont /Encoding get exch 1 exch put (\001)
+		stringwidth 
 	    }
 	    ifelse 
 	    exch 3 1 roll add 3 1 roll add exch
@@ -1166,11 +1174,12 @@ namespace eval ::tk {
     }
 
     # font ISOEncode font
+    #
     # This procedure changes the encoding of a font from the default
     # Postscript encoding to current system encoding. It's typically invoked
     # just before invoking "setfont". The body of this procedure comes from
     # Section 5.6.1 of the Postscript book.
-    ps_function ISOEncode {
+    ps function ISOEncode {
 	dup length dict begin
 	{1 index /FID ne {def} {pop pop} ifelse} forall
 	/Encoding CurrentEncoding def
@@ -1188,7 +1197,7 @@ namespace eval ::tk {
     # assumption of stroking. It's a bit tricky because some Postscript
     # interpreters get errors during strokepath for dashed lines. If this
     # happens then turn off dashes and try again.
-    ps_function StrokeClip {
+    ps function StrokeClip {
 	{strokepath} stopped {
 	    (This Postscript printer gets limitcheck overflows when) =
 	    (stippling dashed lines;  lines will be printed solid instead.) =
@@ -1200,14 +1209,15 @@ namespace eval ::tk {
     #
     # The procedure below is used for stippling. Given the optimal size of a
     # dot in a stipple pattern in the current user coordinate system, compute
-    # the closest size that is an exact multiple of the device's pixel size.
-    # This allows stipple patterns to be displayed without aliasing effects.
-    ps_function EvenPixels {
+    # the closest size that is an exact multiple of the device's pixel
+    # size. This allows stipple patterns to be displayed without aliasing
+    # effects.
+    ps function EvenPixels {
 	% Compute exact number of device pixels per stipple dot.
 	dup 0 matrix currentmatrix dtransform
 	dup mul exch dup mul add sqrt
-	% Round to an integer, make sure the number is at least 1, and compute
-	% user coord distance corresponding to this.
+	% Round to an integer, make sure the number is at least 1, and
+	% compute user coord distance corresponding to this.
 	dup round dup 1 lt {pop 1} if
 	exch div mul
     }
@@ -1220,7 +1230,7 @@ namespace eval ::tk {
     # "width" and "height" give its dimensions. Each stipple dot is assumed to
     # be about one unit across in the current user coordinate system. This
     # procedure trashes the graphics state.
-    ps_function StippleFill {
+    ps function StippleFill {
 	% The following code is needed to work around a NeWSprint bug.
 	/tmpstip 1 index def
 	% Change the scaling so that one user unit in user coordinates
@@ -1256,7 +1266,7 @@ namespace eval ::tk {
     #
     # Given a color value already set for output by the caller, adjusts that
     # value to a grayscale or mono value if requested by the CL variable.
-    ps_function AdjustColor {
+    ps function AdjustColor {
 	CL 2 lt {
 	    currentgray
 	    CL 0 eq {
@@ -1273,21 +1283,21 @@ namespace eval ::tk {
     # arguments must be on the stack:
     #
     # x, y -	Coordinates at which to draw text.
-    # strings -	An array of strings, one for each line of the text item, in
+    # strings - An array of strings, one for each line of the text item, in
     #		order from top to bottom.
     # spacing -	Spacing between lines.
-    # xoffset -	Horizontal offset for text bbox relative to x and y: 0 for
+    # xoffset - Horizontal offset for text bbox relative to x and y: 0 for
     #		nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.
-    # yoffset -	Vertical offset for text bbox relative to x and y: 0 for
+    # yoffset - Vertical offset for text bbox relative to x and y: 0 for
     #		nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.
-    # justify -	0 for left justification, 0.5 for center, 1 for right justify.
-    # stipple -	Boolean value indicating whether or not text is to be drawn in
-    #		stippled fashion. If text is stippled, procedure StippleText
+    # justify - 0 for left justification, 0.5 for center, 1 for right justify.
+    # stipple - Boolean value indicating whether or not text is to be drawn in
+    #		stippled fashion. If text is stippled, function StippleText
     #		must have been defined to call StippleFill in the right way.
     #
     # Also, when this procedure is invoked, the color and font must already
     # have been set for the text.
-    ps_function DrawText {
+    ps function DrawText {
 	/stipple exch def
 	/justify exch def
 	/yoffset exch def
@@ -1306,16 +1316,17 @@ namespace eval ::tk {
 	pathbbox dup /baseline exch def
 	exch pop exch sub /height exch def pop
 	newpath
-	% Translate and rotate coordinates first so that the origin is at the
-	% upper-left corner of the text's bounding box. Remember that angle
-	% for rotating, and x and y for positioning are still on the stack.
+	% Translate and rotate coordinates first so that the origin is at
+	% the upper-left corner of the text's bounding box. Remember that
+	% angle for rotating, and x and y for positioning are still on the
+	% stack.
 	translate
 	rotate
 	lineLength xoffset mul
 	strings length 1 sub spacing mul height add yoffset mul translate
-	% Now use the baseline and justification information to translate so
-	% that the origin is at the baseline and positioning point for the
-	% first line of text.
+	% Now use the baseline and justification information to translate
+	% so that the origin is at the baseline and positioning point for
+	% the first line of text.
 	justify lineLength mul baseline neg translate
 	% Iterate over each of the lines to output it.  For each line,
 	% compute its width again so it can be properly justified, then
@@ -1325,10 +1336,10 @@ namespace eval ::tk {
 	    justify neg mul 0 moveto
 	    stipple {
 		% The text is stippled, so turn it into a path and print
-		% by calling StippledText, which in turn calls StippleFill.
-		% Unfortunately, many Postscript interpreters will get
-		% overflow errors if we try to do the whole string at
-		% once, so do it a character at a time.
+		% by calling StippledText, which in turn calls
+		% StippleFill. Unfortunately, many Postscript interpreters
+		% will get overflow errors if we try to do the whole
+		% string at once, so do it a character at a time.
 		gsave
 		/char (X) def
 		{
@@ -1360,13 +1371,13 @@ namespace eval ::tk {
 	} forall
     }
 
-    # Define the "TkPhoto" function variants, which are modified versions of
-    # the original "transparentimage" function posted by ian@five-d.com (Ian
-    # Kemmish) to comp.lang.postscript. For a monochrome colorLevel this is a
-    # slightly different version that uses the imagemask command instead of
-    # image.
+    # Define the "TkPhoto" function variants, which are modified versions
+    # of the original "transparentimage" function posted by ian@five-d.com
+    # (Ian Kemmish) to comp.lang.postscript. For a monochrome colorLevel
+    # this is a slightly different version that uses the imagemask command
+    # instead of image.
 
-    ps_function TkPhotoColor {
+    ps function TkPhotoColor {
 	gsave
 	32 dict begin
 	/tinteger exch def
@@ -1433,7 +1444,7 @@ namespace eval ::tk {
 	end
 	grestore
     }
-    ps_function TkPhotoMono {
+    ps function TkPhotoMono {
 	gsave
 	32 dict begin
 	/dummyInteger exch def
@@ -1471,11 +1482,7 @@ namespace eval ::tk {
 	grestore
     }
 
-    ps_literal %%EndProlog
-
-    rename ps_function {}
-    rename ps_literal {}
-    rename ps_variable {}
+    ps literal %%EndProlog
 }
 
 proc tk::ensure_psenc_is_loaded {} {