From 70c757308f946798fec899da683637d347f81742 Mon Sep 17 00:00:00 2001
From: dkf <dkf@noemail.net>
Date: Tue, 22 Nov 2005 11:56:11 +0000
Subject: Fix [Bug 1151523] by making the code conform to the docs.
FossilOrigin-Name: 2271325789e55d181443edef897c0d786f822334
---
ChangeLog | 4 ++++
generic/tkFont.c | 37 ++++++++++++++++++++++---------------
2 files changed, 26 insertions(+), 15 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index b8032fa..33b1077 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2005-11-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+ * generic/tkFont.c (ParseFontNameObj, ConfigAttributesObj): Allow
+ these functions to work with a NULL interp by making them check when
+ generating error messages. [Bug 1151523]
+
* unix/tkUnixSelect.c (SelCvtToX, SelCvtFromX): Backport of fixes for
* generic/tkSelect.c (TkSelDefaultSelection): "spaces in atom names"
* tests/select.test (select-9.5): problems. [Bug 1353414]
diff --git a/generic/tkFont.c b/generic/tkFont.c
index 23f28dc..b75009c 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.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: tkFont.c,v 1.21 2002/09/02 19:13:47 hobbs Exp $
+ * RCS: @(#) $Id: tkFont.c,v 1.21.2.1 2005/11/22 11:56:12 dkf Exp $
*/
#include "tkPort.h"
@@ -956,7 +956,8 @@ CreateNamedFont(interp, tkwin, name, faPtr)
Tk_Font
Tk_GetFont(interp, tkwin, string)
- Tcl_Interp *interp; /* Interp for database and error return. */
+ Tcl_Interp *interp; /* Interp for database and error return, or
+ * NULL for no error messages. */
Tk_Window tkwin; /* For display on which font will be used. */
CONST char *string; /* String describing font, as: named font,
* native format, or parseable string. */
@@ -982,7 +983,7 @@ Tk_GetFont(interp, tkwin, string)
* Results:
* The return value is token for the font, or NULL if an error
* prevented the font from being created. If NULL is returned, an
- * error message will be left in interp's result object.
+ * error message will be left in interp's result object (if non-NULL).
*
* Side effects:
* The font is added to an internal database with a reference
@@ -2864,7 +2865,7 @@ Tk_TextLayoutToPostscript(interp, layout)
*
* Results:
* A standard Tcl return value. If TCL_ERROR is returned, an
- * error message will be left in interp's result object.
+ * error message will be left in interp's result object (if non-NULL).
*
* Side effects:
* The fields of the font attributes structure get filled in with
@@ -2878,7 +2879,7 @@ Tk_TextLayoutToPostscript(interp, layout)
static int
ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
- Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Interp *interp; /* Interp for error return, or NULL. */
Tk_Window tkwin; /* For display on which font will be used. */
int objc; /* Number of elements in argv. */
Tcl_Obj *CONST objv[]; /* Command line options. */
@@ -2906,9 +2907,11 @@ ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
* for "-xyz" is missing.
*/
- Tcl_AppendResult(interp, "value for \"",
- Tcl_GetString(optionPtr), "\" option missing",
- (char *) NULL);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetString(optionPtr), "\" option missing",
+ (char *) NULL);
+ }
return TCL_ERROR;
}
@@ -3077,8 +3080,8 @@ GetAttributeInfoObj(interp, faPtr, objPtr)
static int
ParseFontNameObj(interp, tkwin, objPtr, faPtr)
- Tcl_Interp *interp; /* Interp for error return. Must not be
- * NULL. */
+ Tcl_Interp *interp; /* Interp for error return, or NULL if no
+ * error messages are to be generated. */
Tk_Window tkwin; /* For display on which font is used. */
Tcl_Obj *objPtr; /* Parseable font description object. */
TkFontAttributes *faPtr; /* Filled with attributes parsed from font
@@ -3126,7 +3129,7 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
* have encountered an XLFD on Windows or Mac.
*/
- xlfd:
+ xlfd:
result = TkFontParseXLFD(string, faPtr, NULL);
if (result == TCL_OK) {
return TCL_OK;
@@ -3140,8 +3143,10 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
|| (objc < 1)) {
- Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
- (char *) NULL);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
+ (char *) NULL);
+ }
return TCL_ERROR;
}
@@ -3186,8 +3191,10 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
* Unknown style.
*/
- Tcl_AppendResult(interp, "unknown font style \"",
- Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "unknown font style \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ }
return TCL_ERROR;
}
return TCL_OK;
--
cgit v0.12