summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tkBind.c100
-rw-r--r--generic/tkCanvas.c65
-rw-r--r--generic/tkFont.c155
-rw-r--r--generic/tkGrid.c70
-rw-r--r--generic/tkImgBmap.c155
-rw-r--r--generic/tkImgPhoto.c175
-rw-r--r--generic/tkInt.h2
-rw-r--r--generic/tkPack.c59
-rw-r--r--generic/tkPlace.c52
-rw-r--r--generic/tkRectOval.c70
-rw-r--r--generic/tkText.c51
-rw-r--r--generic/tkTextImage.c8
-rw-r--r--generic/tkTextMark.c18
-rw-r--r--generic/tkTextTag.c23
-rw-r--r--generic/tkTextWind.c8
-rw-r--r--generic/tkTrig.c34
-rw-r--r--generic/tkUtil.c57
-rw-r--r--generic/tkVisual.c12
18 files changed, 596 insertions, 518 deletions
diff --git a/generic/tkBind.c b/generic/tkBind.c
index 93a6a52..58e91c4 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -620,7 +620,7 @@ static PatSeq * FindSequence(Tcl_Interp *interp,
static void GetAllVirtualEvents(Tcl_Interp *interp,
VirtualEventTable *vetPtr);
static char * GetField(char *p, char *copy, int size);
-static void GetPatternString(PatSeq *psPtr, Tcl_DString *dsPtr);
+static Tcl_Obj * GetPatternObj(PatSeq *psPtr);
static int GetVirtualEvent(Tcl_Interp *interp,
VirtualEventTable *vetPtr, Tcl_Obj *virtName);
static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp,
@@ -1094,13 +1094,14 @@ Tk_GetAllBindings(
{
PatSeq *psPtr;
Tcl_HashEntry *hPtr;
- Tcl_DString ds;
+ Tcl_Obj *resultObj;
hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
if (hPtr == NULL) {
return;
}
- Tcl_DStringInit(&ds);
+
+ resultObj = Tcl_NewObj();
for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL;
psPtr = psPtr->nextObjPtr) {
/*
@@ -1108,11 +1109,9 @@ Tk_GetAllBindings(
* its sequence.
*/
- Tcl_DStringSetLength(&ds, 0);
- GetPatternString(psPtr, &ds);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr));
}
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, resultObj);
}
/*
@@ -1223,7 +1222,8 @@ Tk_BindEvent(
PatSeq *vMatchDetailList, *vMatchNoDetailList;
int flags, oldScreen;
Tcl_Interp *interp;
- Tcl_DString scripts, savedResult;
+ Tcl_DString scripts;
+ Tcl_InterpState interpState;
Detail detail;
char *p, *end;
TkWindow *winPtr = (TkWindow *) tkwin;
@@ -1453,14 +1453,13 @@ Tk_BindEvent(
*/
interp = bindPtr->interp;
- Tcl_DStringInit(&savedResult);
/*
* Save information about the current screen, then invoke a script if the
* screen has changed.
*/
- Tcl_DStringGetResult(interp, &savedResult);
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
screenPtr = &bindInfoPtr->screenInfo;
oldDispPtr = screenPtr->curDispPtr;
oldScreen = screenPtr->curScreenIndex;
@@ -1475,7 +1474,7 @@ Tk_BindEvent(
end = p + Tcl_DStringLength(&scripts);
/*
- * Be carefule when dereferencing screenPtr or bindInfoPtr. If we evaluate
+ * Be careful when dereferencing screenPtr or bindInfoPtr. If we evaluate
* something that destroys ".", bindInfoPtr would have been freed, but we
* can tell that by first checking to see if winPtr->mainPtr == NULL.
*/
@@ -1523,7 +1522,7 @@ Tk_BindEvent(
screenPtr->curScreenIndex = oldScreen;
ChangeScreen(interp, oldDispPtr->name, oldScreen);
}
- Tcl_DStringResult(interp, &savedResult);
+ (void) Tcl_RestoreInterpState(interp, interpState);
Tcl_DStringFree(&scripts);
Tcl_Release(bindInfoPtr);
@@ -2771,10 +2770,10 @@ GetVirtualEvent(
Tcl_Obj *virtName) /* String describing virtual event. */
{
Tcl_HashEntry *vhPtr;
- Tcl_DString ds;
int iPhys;
PhysicalsOwned *poPtr;
Tk_Uid virtUid;
+ Tcl_Obj *resultObj;
virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName));
if (virtUid == NULL) {
@@ -2786,15 +2785,13 @@ GetVirtualEvent(
return TCL_OK;
}
- Tcl_DStringInit(&ds);
-
+ resultObj = Tcl_NewObj();
poPtr = Tcl_GetHashValue(vhPtr);
for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
- Tcl_DStringSetLength(&ds, 0);
- GetPatternString(poPtr->patSeqs[iPhys], &ds);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ GetPatternObj(poPtr->patSeqs[iPhys]));
}
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -2824,20 +2821,15 @@ GetAllVirtualEvents(
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
+ Tcl_Obj *resultObj;
+ resultObj = Tcl_NewObj();
hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, "<<", 2);
- Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
- Tcl_DStringAppend(&ds, ">>", 2);
- Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+ "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr)));
}
-
- Tcl_DStringFree(&ds);
+ Tcl_SetObjResult(interp, resultObj);
}
/*
@@ -4050,31 +4042,30 @@ GetField(
/*
*---------------------------------------------------------------------------
*
- * GetPatternString --
+ * GetPatternObj --
*
* Produce a string version of the given event, for displaying to the
* user.
*
* Results:
- * The string is left in dsPtr.
+ * The string is returned as a Tcl_Obj.
*
* Side effects:
- * It is the caller's responsibility to initialize the DString before and
- * to free it after calling this function.
+ * It is the caller's responsibility to arrange for the object to be
+ * released; it starts with a refCount of zero.
*
*---------------------------------------------------------------------------
*/
-static void
-GetPatternString(
- PatSeq *psPtr,
- Tcl_DString *dsPtr)
+static Tcl_Obj *
+GetPatternObj(
+ PatSeq *psPtr)
{
Pattern *patPtr;
- char c, buffer[TCL_INTEGER_SPACE];
int patsLeft, needMods;
const ModInfo *modPtr;
const EventInfo *eiPtr;
+ Tcl_Obj *patternObj = Tcl_NewObj();
/*
* The order of the patterns in the sequence is backwards from the order
@@ -4094,8 +4085,9 @@ GetPatternString(
&& isprint(UCHAR(patPtr->detail.keySym))
&& (patPtr->detail.keySym != '<')
&& (patPtr->detail.keySym != ' ')) {
- c = (char) patPtr->detail.keySym;
- Tcl_DStringAppend(dsPtr, &c, 1);
+ char c = (char) patPtr->detail.keySym;
+
+ Tcl_AppendToObj(patternObj, &c, 1);
continue;
}
@@ -4104,9 +4096,7 @@ GetPatternString(
*/
if (patPtr->eventType == VirtualEvent) {
- Tcl_DStringAppend(dsPtr, "<<", 2);
- Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
- Tcl_DStringAppend(dsPtr, ">>", 2);
+ Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name);
continue;
}
@@ -4116,7 +4106,7 @@ GetPatternString(
* or button detail.
*/
- Tcl_DStringAppend(dsPtr, "<", 1);
+ Tcl_AppendToObj(patternObj, "<", 1);
if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
&& (memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) {
@@ -4130,12 +4120,12 @@ GetPatternString(
(memcmp(patPtr, patPtr-1, sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
- Tcl_DStringAppend(dsPtr, "Quadruple-", 10);
+ Tcl_AppendToObj(patternObj, "Quadruple-", 10);
} else {
- Tcl_DStringAppend(dsPtr, "Triple-", 7);
+ Tcl_AppendToObj(patternObj, "Triple-", 7);
}
} else {
- Tcl_DStringAppend(dsPtr, "Double-", 7);
+ Tcl_AppendToObj(patternObj, "Double-", 7);
}
}
@@ -4143,16 +4133,15 @@ GetPatternString(
needMods != 0; modPtr++) {
if (modPtr->mask & needMods) {
needMods &= ~modPtr->mask;
- Tcl_DStringAppend(dsPtr, modPtr->name, -1);
- Tcl_DStringAppend(dsPtr, "-", 1);
+ Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name);
}
}
for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
if (eiPtr->type == patPtr->eventType) {
- Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
+ Tcl_AppendToObj(patternObj, eiPtr->name, -1);
if (patPtr->detail.clientData != 0) {
- Tcl_DStringAppend(dsPtr, "-", 1);
+ Tcl_AppendToObj(patternObj, "-", 1);
}
break;
}
@@ -4164,16 +4153,17 @@ GetPatternString(
const char *string = TkKeysymToString(patPtr->detail.keySym);
if (string != NULL) {
- Tcl_DStringAppend(dsPtr, string, -1);
+ Tcl_AppendToObj(patternObj, string, -1);
}
} else {
- sprintf(buffer, "%d", patPtr->detail.button);
- Tcl_DStringAppend(dsPtr, buffer, -1);
+ Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button);
}
}
- Tcl_DStringAppend(dsPtr, ">", 1);
+ Tcl_AppendToObj(patternObj, ">", 1);
}
+
+ return patternObj;
}
/*
diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c
index c696d65..97518f9 100644
--- a/generic/tkCanvas.c
+++ b/generic/tkCanvas.c
@@ -269,7 +269,7 @@ static int ConfigureCanvas(Tcl_Interp *interp,
Tcl_Obj *const *argv, int flags);
static void DestroyCanvas(char *memPtr);
static void DisplayCanvas(ClientData clientData);
-static void DoItem(Tcl_Interp *interp,
+static void DoItem(Tcl_Obj *accumObj,
Tk_Item *itemPtr, Tk_Uid tag);
static void EventuallyRedrawItem(TkCanvas *canvasPtr,
Tk_Item *itemPtr);
@@ -333,10 +333,10 @@ static const Tk_ClassProcs canvasClass = {
#ifdef USE_OLD_TAG_SEARCH
#define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \
- (itemPtr) = StartTagSearch(canvasPtr,(objPtr),&search)
+ itemPtr = StartTagSearch(canvasPtr,(objPtr),&search)
#define FOR_EVERY_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \
- for ((itemPtr) = StartTagSearch(canvasPtr, (objPtr), &search); \
- (itemPtr) != NULL; (itemPtr) = NextItem(&search))
+ for (itemPtr = StartTagSearch(canvasPtr, (objPtr), &search); \
+ itemPtr != NULL; itemPtr = NextItem(&search))
#define FIND_ITEMS(objPtr, n) \
FindItems(interp, canvasPtr, objc, objv, (objPtr), (n))
#define RELINK_ITEMS(objPtr, itemPtr) \
@@ -1504,9 +1504,13 @@ CanvasWidgetCmd(
FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done);
if (itemPtr != NULL) {
int i;
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
for (i = 0; i < itemPtr->numTags; i++) {
- Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(itemPtr->tagPtr[i], -1));
}
+ Tcl_SetObjResult(interp, resultObj);
}
break;
case CANV_ICURSOR: {
@@ -4162,23 +4166,23 @@ TagSearchNext(
* DoItem --
*
* This is a utility function called by FindItems. It either adds
- * itemPtr's id to the result forming in interp, or it adds a new tag to
+ * itemPtr's id to the list being constructed, or it adds a new tag to
* itemPtr, depending on the value of tag.
*
* Results:
* None.
*
* Side effects:
- * If tag is NULL then itemPtr's id is added as a list element to the
- * interp's result; otherwise tag is added to itemPtr's list of tags.
+ * If tag is NULL then itemPtr's id is added as an element to the
+ * supplied object; otherwise tag is added to itemPtr's list of tags.
*
*--------------------------------------------------------------
*/
static void
DoItem(
- Tcl_Interp *interp, /* Interpreter in which to (possibly) record
- * item id. */
+ Tcl_Obj *accumObj, /* Object in which to (possibly) record item
+ * id. */
Tk_Item *itemPtr, /* Item to (possibly) modify. */
Tk_Uid tag) /* Tag to add to those already present for
* item, or NULL. */
@@ -4191,10 +4195,7 @@ DoItem(
*/
if (tag == NULL) {
- char msg[TCL_INTEGER_SPACE];
-
- sprintf(msg, "%d", itemPtr->id);
- Tcl_AppendElement(interp, msg);
+ Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewIntObj(itemPtr->id));
return;
}
@@ -4281,6 +4282,7 @@ FindItems(
Tk_Item *itemPtr;
Tk_Uid uid;
int index, result;
+ Tcl_Obj *resultObj;
static const char *const optionStrings[] = {
"above", "all", "below", "closest",
"enclosed", "overlapping", "withtag", NULL
@@ -4312,7 +4314,9 @@ FindItems(
lastPtr = itemPtr;
}
if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
- DoItem(interp, lastPtr->nextPtr, uid);
+ resultObj = Tcl_NewObj();
+ DoItem(resultObj, lastPtr->nextPtr, uid);
+ Tcl_SetObjResult(interp, resultObj);
}
break;
}
@@ -4322,10 +4326,12 @@ FindItems(
return TCL_ERROR;
}
+ resultObj = Tcl_NewObj();
for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
itemPtr = itemPtr->nextPtr) {
- DoItem(interp, itemPtr, uid);
+ DoItem(resultObj, itemPtr, uid);
}
+ Tcl_SetObjResult(interp, resultObj);
break;
case CANV_BELOW:
@@ -4335,10 +4341,10 @@ FindItems(
}
FIRST_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr,
return TCL_ERROR);
- if (itemPtr != NULL) {
- if (itemPtr->prevPtr != NULL) {
- DoItem(interp, itemPtr->prevPtr, uid);
- }
+ if ((itemPtr != NULL) && (itemPtr->prevPtr != NULL)) {
+ resultObj = Tcl_NewObj();
+ DoItem(resultObj, itemPtr->prevPtr, uid);
+ Tcl_SetObjResult(interp, resultObj);
}
break;
case CANV_CLOSEST: {
@@ -4428,7 +4434,9 @@ FindItems(
itemPtr = canvasPtr->firstItemPtr;
}
if (itemPtr == startPtr) {
- DoItem(interp, closestPtr, uid);
+ resultObj = Tcl_NewObj();
+ DoItem(resultObj, closestPtr, uid);
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
if (itemPtr->state == TK_STATE_HIDDEN ||
@@ -4466,10 +4474,16 @@ FindItems(
Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId");
return TCL_ERROR;
}
+ resultObj = Tcl_NewObj();
FOR_EVERY_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr,
- return TCL_ERROR) {
- DoItem(interp, itemPtr, uid);
+ goto badWithTagSearch) {
+ DoItem(resultObj, itemPtr, uid);
}
+ Tcl_SetObjResult(interp, resultObj);
+ return TCL_OK;
+ badWithTagSearch:
+ Tcl_DecrRefCount(resultObj);
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -4514,6 +4528,7 @@ FindArea(
double rect[4], tmp;
int x1, y1, x2, y2;
Tk_Item *itemPtr;
+ Tcl_Obj *resultObj;
if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[0],
&rect[0]) != TCL_OK)
@@ -4541,6 +4556,7 @@ FindArea(
y1 = (int) (rect[1] - 1.0);
x2 = (int) (rect[2] + 1.0);
y2 = (int) (rect[3] + 1.0);
+ resultObj = Tcl_NewObj();
for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
itemPtr = itemPtr->nextPtr) {
if (itemPtr->state == TK_STATE_HIDDEN ||
@@ -4553,9 +4569,10 @@ FindArea(
continue;
}
if (ItemOverlap(canvasPtr, itemPtr, rect) >= enclosed) {
- DoItem(interp, itemPtr, uid);
+ DoItem(resultObj, itemPtr, uid);
}
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
diff --git a/generic/tkFont.c b/generic/tkFont.c
index 2e400b8..2e1ad01 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.c
@@ -3241,121 +3241,92 @@ Tk_TextLayoutToPostscript(
Tk_TextLayout layout) /* The layout to be rendered. */
{
TextLayout *layoutPtr = (TextLayout *) layout;
-#define MAXUSE 128
- char buf[MAXUSE+30];
- LayoutChunk *chunkPtr;
- int i, j, used, baseline, charsize;
- Tcl_UniChar ch;
+ LayoutChunk *chunkPtr = layoutPtr->chunks;
+ int baseline = chunkPtr->y;
+ Tcl_Obj *psObj = Tcl_NewObj();
+ int i, j, len;
const char *p, *glyphname;
+ char uindex[5], c, *ps;
+ Tcl_UniChar ch;
- chunkPtr = layoutPtr->chunks;
- baseline = chunkPtr->y;
- used = 0;
- buf[used++] = '[';
- buf[used++] = '(';
- for (i = 0; i < layoutPtr->numChunks; i++) {
+ Tcl_AppendToObj(psObj, "[(", -1);
+ for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) {
if (baseline != chunkPtr->y) {
- buf[used++] = ')';
- buf[used++] = ']';
- buf[used++] = '\n';
- buf[used++] = '[';
- buf[used++] = '(';
+ Tcl_AppendToObj(psObj, ")]\n[(", -1);
baseline = chunkPtr->y;
}
if (chunkPtr->numDisplayChars <= 0) {
if (chunkPtr->start[0] == '\t') {
- buf[used++] = '\\';
- buf[used++] = 't';
+ Tcl_AppendToObj(psObj, "\\t", -1);
}
- } else {
- p = chunkPtr->start;
- for (j = 0; j < chunkPtr->numDisplayChars; j++) {
+ continue;
+ }
+
+ for (p=chunkPtr->start, j=0; j<chunkPtr->numDisplayChars; j++) {
+ /*
+ * INTL: We only handle symbols that have an encoding as a glyph
+ * from the standard set defined by Adobe. The rest get punted.
+ * Eventually this should be revised to handle more sophsticiated
+ * international postscript fonts.
+ */
+
+ p += Tcl_UtfToUniChar(p, &ch);
+ if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) {
/*
- * 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.
+ * 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;
-
- 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.
- */
+ Tcl_AppendPrintfToObj(psObj, "\\%03o", ch);
+ continue;
+ } else if (ch <= 0x7f) {
+ /*
+ * Normal ASCII character.
+ */
- sprintf(buf + used, "\\%03o", ch);
- used += 4;
- } else if (ch <= 0x7f) {
- /*
- * Normal ASCII character.
- */
+ c = (char) ch;
+ Tcl_AppendToObj(psObj, &c, 1);
+ continue;
+ }
- buf[used++] = (char) ch;
- } else {
- char uindex[5];
+ /*
+ * 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);
+ if (glyphname) {
+ ps = Tcl_GetStringFromObj(psObj, &len);
+ if (ps[len-1] == '(') {
/*
- * This character doesn't belong to the ASCII character
- * set, so we use the full glyph name.
+ * In-place edit. Ewww!
*/
- sprintf(uindex, "%04X", ch); /* endianness? */
- glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex,
- 0);
- if (glyphname) {
- if (used > 0 && buf[used-1] == '(') {
- used--;
- } else {
- buf[used++] = ')';
- }
- buf[used++] = '/';
- 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. :-(
- */
+ ps[len-1] = '/';
+ } else {
+ Tcl_AppendToObj(psObj, ")/", -1);
+ }
+ Tcl_AppendToObj(psObj, glyphname, -1);
+ Tcl_AppendToObj(psObj, "(", -1);
+ } 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);
+ fprintf(stderr, "Warning: no mapping to PostScript "
+ "glyphs for \\u%04x\n", ch);
#endif
- }
- }
- if (used >= MAXUSE) {
- buf[used] = '\0';
- Tcl_AppendResult(interp, buf, NULL);
- used = 0;
- }
}
}
- if (used >= MAXUSE) {
- /*
- * If there are a whole bunch of returns or tabs in a row, then
- * buf[] could get filled up.
- */
-
- buf[used] = '\0';
- Tcl_AppendResult(interp, buf, NULL);
- used = 0;
- }
- chunkPtr++;
}
- buf[used++] = ')';
- buf[used++] = ']';
- buf[used++] = '\n';
- buf[used] = '\0';
- Tcl_AppendResult(interp, buf, NULL);
+ Tcl_AppendToObj(psObj, ")]\n", -1);
+ Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL);
+ Tcl_DecrRefCount(psObj);
}
/*
diff --git a/generic/tkGrid.c b/generic/tkGrid.c
index 8714969..6c5bbc1 100644
--- a/generic/tkGrid.c
+++ b/generic/tkGrid.c
@@ -301,7 +301,7 @@ static int SetSlaveColumn(Tcl_Interp *interp, Gridder *slavePtr,
int column, int numCols);
static int SetSlaveRow(Tcl_Interp *interp, Gridder *slavePtr,
int row, int numRows);
-static void StickyToString(int flags, char *result);
+static Tcl_Obj * StickyToObj(int flags);
static int StringToSticky(const char *string);
static void Unlink(Gridder *gridPtr);
@@ -722,7 +722,7 @@ GridInfoCommand(
{
register Gridder *slavePtr;
Tk_Window slave;
- char buffer[64 + TCL_INTEGER_SPACE * 4];
+ Tcl_Obj *infoObj;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window");
@@ -737,18 +737,24 @@ GridInfoCommand(
return TCL_OK;
}
- Tcl_AppendElement(interp, "-in");
- Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
- sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d",
- slavePtr->column, slavePtr->row,
- slavePtr->numCols, slavePtr->numRows);
- Tcl_AppendResult(interp, buffer, NULL);
- TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
- TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY);
- TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX);
- TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY);
- StickyToString(slavePtr->sticky, buffer);
- Tcl_AppendResult(interp, " -sticky ", buffer, NULL);
+ infoObj = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1),
+ TkNewWindowObj(slavePtr->masterPtr->tkwin));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-column", -1),
+ Tcl_NewIntObj(slavePtr->column));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-row", -1),
+ Tcl_NewIntObj(slavePtr->row));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-columnspan", -1),
+ Tcl_NewIntObj(slavePtr->numCols));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-rowspan", -1),
+ Tcl_NewIntObj(slavePtr->numRows));
+ TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft, slavePtr->padX);
+ TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-sticky", -1),
+ StickyToObj(slavePtr->sticky));
+ Tcl_SetObjResult(interp, infoObj);
return TCL_OK;
}
@@ -1018,7 +1024,7 @@ GridRowColumnConfigureCommand(
}
if (Tcl_GetIntFromObj(interp, lObjv[0], &slot) != TCL_OK) {
Tcl_AppendResult(interp,
- " (when retreiving options only integer indices are "
+ " (when retrieving options only integer indices are "
"allowed)", NULL);
Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL);
Tcl_DecrRefCount(listCopy);
@@ -3516,13 +3522,13 @@ ConfigureSlaves(
/*
*----------------------------------------------------------------------
*
- * StickyToString
+ * StickyToObj
*
* Converts the internal boolean combination of "sticky" bits onto a Tcl
* list element containing zero or more of n, s, e, or w.
*
* Results:
- * A string is placed into the "result" pointer.
+ * A new object is returned that holds the sticky representation.
*
* Side effects:
* none.
@@ -3530,30 +3536,26 @@ ConfigureSlaves(
*----------------------------------------------------------------------
*/
-static void
-StickyToString(
- int flags, /* The sticky flags. */
- char *result) /* Where to put the result. */
+static Tcl_Obj *
+StickyToObj(
+ int flags) /* The sticky flags. */
{
int count = 0;
+ char buffer[4];
- if (flags&STICK_NORTH) {
- result[count++] = 'n';
+ if (flags & STICK_NORTH) {
+ buffer[count++] = 'n';
}
- if (flags&STICK_EAST) {
- result[count++] = 'e';
+ if (flags & STICK_EAST) {
+ buffer[count++] = 'e';
}
- if (flags&STICK_SOUTH) {
- result[count++] = 's';
+ if (flags & STICK_SOUTH) {
+ buffer[count++] = 's';
}
- if (flags&STICK_WEST) {
- result[count++] = 'w';
- }
- if (count) {
- result[count] = '\0';
- } else {
- sprintf(result, "{}");
+ if (flags & STICK_WEST) {
+ buffer[count++] = 'w';
}
+ return Tcl_NewStringObj(buffer, count);
}
/*
diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c
index 56ad066..f2558db 100644
--- a/generic/tkImgBmap.c
+++ b/generic/tkImgBmap.c
@@ -152,7 +152,7 @@ static void ImgBmapConfigureInstance(BitmapInstance *instancePtr);
static int ImgBmapConfigureMaster(BitmapMaster *masterPtr,
int argc, Tcl_Obj *const objv[], int flags);
static int NextBitmapWord(ParseInfo *parseInfoPtr);
-
+
/*
*----------------------------------------------------------------------
*
@@ -207,7 +207,7 @@ ImgBmapCreate(
*clientDataPtr = masterPtr;
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -242,7 +242,7 @@ ImgBmapConfigureMaster(
const char **argv = ckalloc((objc+1) * sizeof(char *));
for (dummy1 = 0; dummy1 < objc; dummy1++) {
- argv[dummy1]=Tcl_GetString(objv[dummy1]);
+ argv[dummy1] = Tcl_GetString(objv[dummy1]);
}
argv[objc] = NULL;
@@ -315,7 +315,7 @@ ImgBmapConfigureMaster(
masterPtr->height, masterPtr->width, masterPtr->height);
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -450,7 +450,7 @@ ImgBmapConfigureInstance(
masterPtr->tkMaster)));
Tcl_BackgroundError(masterPtr->interp);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -477,7 +477,7 @@ char *
TkGetBitmapData(
Tcl_Interp *interp, /* For reporting errors, or NULL. */
const char *string, /* String describing bitmap. May be NULL. */
- const char *fileName, /* Name of file containing bitmap description.
+ const char *fileName, /* Name of file containing bitmap description.
* Used only if string is NULL. Must not be
* NULL if string is NULL. */
int *widthPtr, int *heightPtr,
@@ -660,7 +660,7 @@ TkGetBitmapData(
}
return NULL;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -730,7 +730,7 @@ NextBitmapWord(
parseInfoPtr->word[parseInfoPtr->wordLength] = 0;
return TCL_OK;
}
-
+
/*
*--------------------------------------------------------------
*
@@ -793,7 +793,7 @@ ImgBmapCmd(
return TCL_OK;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -864,7 +864,7 @@ ImgBmapGet(
return instancePtr;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -924,7 +924,7 @@ ImgBmapDisplay(
XSetClipOrigin(display, instancePtr->gc, 0, 0);
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -987,7 +987,7 @@ ImgBmapFree(
}
ckfree(instancePtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1028,7 +1028,7 @@ ImgBmapDelete(
Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0);
ckfree(masterPtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1058,7 +1058,7 @@ ImgBmapCmdDeletedProc(
Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1089,8 +1089,7 @@ GetByte(
return buffer;
}
}
-
-
+
/*
*----------------------------------------------------------------------
*
@@ -1112,28 +1111,22 @@ GetByte(
* 3. The postscript coordinate system has been scaled so that the
* entire bitmap is one unit squared.
*
- * Some postscript implementations cannot handle bitmap strings longer
- * than about 60k characters. If the bitmap data is that big or bigger,
- * then we render it by splitting it into several smaller bitmaps.
- *
* Results:
- * Returns TCL_OK on success. Returns TCL_ERROR and leaves and error
- * message in interp->result if there is a problem.
+ * None.
*
* Side effects:
- * Postscript code is appended to interp->result.
+ * Postscript code is appended to psObj.
*
*----------------------------------------------------------------------
*/
-static int
+static void
ImgBmapPsImagemask(
- Tcl_Interp *interp, /* Append postscript to this interpreter */
+ Tcl_Obj *psObj, /* Append postscript to this buffer. */
int width, int height, /* Width and height of the bitmap in pixels */
- char *data) /* Data for the bitmap */
+ char *data) /* Data for the bitmap. */
{
int i, j, nBytePerRow;
- char buffer[200];
/*
* The bit order of bitmaps in Tk is the opposite of the bit order that
@@ -1162,32 +1155,22 @@ ImgBmapPsImagemask(
15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255,
};
- if (width*height > 60000) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unable to generate postscript for bitmaps larger than 60000"
- " pixels", -1));
- Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OUTSIZE", NULL);
- return TCL_ERROR;
- }
-
- sprintf(buffer, "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n",
+ Tcl_AppendPrintfToObj(psObj,
+ "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n",
width, height, width, -height, height);
- Tcl_AppendResult(interp, buffer, NULL);
- nBytePerRow = (width+7)/8;
- for(i=0; i<height; i++){
- for(j=0; j<nBytePerRow; j++){
- sprintf(buffer, " %02x",
+ nBytePerRow = (width + 7) / 8;
+ for (i=0; i<height; i++) {
+ for (j=0; j<nBytePerRow; j++) {
+ Tcl_AppendPrintfToObj(psObj, " %02x",
bit_reverse[0xff & data[i*nBytePerRow + j]]);
- Tcl_AppendResult(interp, buffer, NULL);
}
- Tcl_AppendResult(interp, "\n", NULL);
+ Tcl_AppendToObj(psObj, "\n", -1);
}
- Tcl_AppendResult(interp, ">} imagemask \n", NULL);
- return TCL_OK;
+ Tcl_AppendToObj(psObj, ">} imagemask \n", -1);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1196,7 +1179,6 @@ ImgBmapPsImagemask(
* This procedure generates postscript for rendering a bitmap image.
*
* Results:
-
* On success, this routine writes postscript code into interp->result
* and returns TCL_OK TCL_ERROR is returned and an error message is left
* in interp->result if anything goes wrong.
@@ -1217,7 +1199,8 @@ ImgBmapPostscript(
int prepass)
{
BitmapMaster *masterPtr = clientData;
- char buffer[200];
+ Tcl_InterpState interpState;
+ Tcl_Obj *psObj;
if (prepass) {
return TCL_OK;
@@ -1227,11 +1210,32 @@ ImgBmapPostscript(
* There is nothing to do for bitmaps with zero width or height.
*/
- if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<= 0){
+ if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0){
return TCL_OK;
}
/*
+ * Some postscript implementations cannot handle bitmap strings longer
+ * than about 60k characters. If the bitmap data is that big or bigger,
+ * we bail out.
+ */
+
+ if (masterPtr->width*masterPtr->height > 60000) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to generate postscript for bitmaps larger than 60000"
+ " pixels", -1));
+ Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OUTSIZE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
* Translate the origin of the coordinate system to be the lower-left
* corner of the bitmap and adjust the scale of the coordinate system so
* that entire bitmap covers one square unit of the page. The calling
@@ -1240,13 +1244,11 @@ ImgBmapPostscript(
* necessary here.
*/
- if (x!=0 || y!=0) {
- sprintf(buffer, "%d %d moveto\n", x, y);
- Tcl_AppendResult(interp, buffer, NULL);
+ if (x != 0 || y != 0) {
+ Tcl_AppendPrintfToObj(psObj, "%d %d moveto\n", x, y);
}
- if (width!=1 || height!=1) {
- sprintf(buffer, "%d %d scale\n", width, height);
- Tcl_AppendResult(interp, buffer, NULL);
+ if (width != 1 || height != 1) {
+ Tcl_AppendPrintfToObj(psObj, "%d %d scale\n", width, height);
}
/*
@@ -1262,16 +1264,19 @@ ImgBmapPostscript(
TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid,
&color);
+ Tcl_ResetResult(interp);
if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
- return TCL_ERROR;
+ goto error;
}
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
if (masterPtr->maskData == NULL) {
- Tcl_AppendResult(interp,
- "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto ",
- "closepath fill\n", NULL);
- } else if (ImgBmapPsImagemask(interp, masterPtr->width,
- masterPtr->height, masterPtr->maskData) != TCL_OK) {
- return TCL_ERROR;
+ Tcl_AppendToObj(psObj,
+ "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto "
+ "closepath fill\n", -1);
+ } else {
+ ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height,
+ masterPtr->maskData);
}
}
@@ -1284,17 +1289,31 @@ ImgBmapPostscript(
TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid,
&color);
+ Tcl_ResetResult(interp);
if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) {
- return TCL_ERROR;
- }
- if (ImgBmapPsImagemask(interp, masterPtr->width, masterPtr->height,
- masterPtr->data) != TCL_OK) {
- return TCL_ERROR;
+ goto error;
}
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
+ ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height,
+ masterPtr->data);
}
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL);
+ Tcl_DecrRefCount(psObj);
return TCL_OK;
-}
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ return TCL_ERROR;
+}
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 3eff18d..3f25984 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -504,7 +504,7 @@ ImgPhotoCmd(
* TODO: Modifying result is bad!
*/
- Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
masterPtr->dataString);
} else {
Tcl_AppendResult(interp, " {}", NULL);
@@ -518,7 +518,7 @@ ImgPhotoCmd(
* TODO: Modifying result is bad!
*/
- Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
masterPtr->format);
} else {
Tcl_AppendResult(interp, " {}", NULL);
@@ -1467,10 +1467,16 @@ ParseSubcommandOptions(
int objc, /* Number of arguments in objv[]. */
Tcl_Obj *const objv[]) /* Arguments to be parsed. */
{
+ static const char *const compositingRules[] = {
+ "overlay", "set", /* Note that these must match the
+ * TK_PHOTO_COMPOSITE_* constants. */
+ NULL
+ };
int index, c, bit, currentBit, length;
int values[4], numValues, maxValues, argIndex;
- const char *option;
+ const char *option, *expandedOption, *needed;
const char *const *listPtr;
+ Tcl_Obj *msgObj;
for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) {
/*
@@ -1478,7 +1484,7 @@ ParseSubcommandOptions(
* optPtr->name.
*/
- option = Tcl_GetStringFromObj(objv[index], &length);
+ expandedOption = option = Tcl_GetStringFromObj(objv[index], &length);
if (option[0] != '-') {
if (optPtr->name == NULL) {
optPtr->name = objv[index];
@@ -1497,9 +1503,9 @@ ParseSubcommandOptions(
for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
if ((c == *listPtr[0])
&& (strncmp(option, *listPtr, (size_t) length) == 0)) {
+ expandedOption = *listPtr;
if (bit != 0) {
- bit = 0; /* An ambiguous option. */
- break;
+ goto unknownOrAmbiguousOption;
}
bit = currentBit;
}
@@ -1512,24 +1518,7 @@ ParseSubcommandOptions(
*/
if ((allowedOptions & bit) == 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unrecognized option \"",
- Tcl_GetString(objv[index]), "\": must be ", NULL);
- bit = 1;
- for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
- if ((allowedOptions & bit) != 0) {
- if ((allowedOptions & (bit - 1)) != 0) {
- Tcl_AppendResult(interp, ", ", NULL);
- if ((allowedOptions & ~((bit << 1) - 1)) == 0) {
- Tcl_AppendResult(interp, "or ", NULL);
- }
- }
- Tcl_AppendResult(interp, *listPtr, NULL);
- }
- bit <<= 1;
- }
- Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_OPTION", NULL);
- return TCL_ERROR;
+ goto unknownOrAmbiguousOption;
}
/*
@@ -1542,18 +1531,13 @@ ParseSubcommandOptions(
* The -background option takes a single XColor value.
*/
- if (index + 1 < objc) {
- *optIndexPtr = ++index;
- optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
- Tk_GetUid(Tcl_GetString(objv[index])));
- if (!optPtr->background) {
- return TCL_ERROR;
- }
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "the \"-background\" option requires a value", -1));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE",
- NULL);
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
+ }
+ *optIndexPtr = ++index;
+ optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
+ Tk_GetUid(Tcl_GetString(objv[index])));
+ if (!optPtr->background) {
return TCL_ERROR;
}
} else if (bit == OPT_FORMAT) {
@@ -1562,50 +1546,31 @@ ParseSubcommandOptions(
* parsing this is outside the scope of this function.
*/
- if (index + 1 < objc) {
- *optIndexPtr = ++index;
- optPtr->format = objv[index];
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "the \"-format\" option requires a value", -1));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE",
- NULL);
- return TCL_ERROR;
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
}
+ *optIndexPtr = ++index;
+ optPtr->format = objv[index];
} else if (bit == OPT_COMPOSITE) {
/*
* The -compositingrule option takes a single value from a
* well-known set.
*/
- if (index + 1 < objc) {
- /*
- * Note that these must match the TK_PHOTO_COMPOSITE_*
- * constants.
- */
-
- static const char *const compositingRules[] = {
- "overlay", "set", NULL
- };
-
- index++;
- if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules,
- "compositing rule", 0, &optPtr->compositingRule)
- != TCL_OK) {
- return TCL_ERROR;
- }
- *optIndexPtr = index;
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "the \"-compositingrule\" option requires a value",
- -1));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE",
- NULL);
+ if (index + 1 >= objc) {
+ goto oneValueRequired;
+ }
+ index++;
+ if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules,
+ "compositing rule", 0, &optPtr->compositingRule)
+ != TCL_OK) {
return TCL_ERROR;
}
+ *optIndexPtr = index;
} else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) {
const char *val;
- maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2;
+
+ maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2;
argIndex = index + 1;
for (numValues = 0; numValues < maxValues; ++numValues) {
if (argIndex >= objc) {
@@ -1625,12 +1590,7 @@ ParseSubcommandOptions(
}
if (numValues == 0) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "the \"%s\" option requires one %s integer values",
- option, (maxValues == 2) ? "or two": "to four"));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE",
- NULL);
- return TCL_ERROR;
+ goto manyValuesRequired;
}
*optIndexPtr = (index += numValues);
@@ -1654,11 +1614,8 @@ ParseSubcommandOptions(
case OPT_FROM:
if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
&& ((values[2] < 0) || (values[3] < 0)))) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "value(s) for the -from option must be"
- " non-negative", -1));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_FROM", NULL);
- return TCL_ERROR;
+ needed = "non-negative";
+ goto numberOutOfRange;
}
if (numValues <= 2) {
optPtr->fromX = values[0];
@@ -1679,11 +1636,8 @@ ParseSubcommandOptions(
case OPT_TO:
if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
&& ((values[2] < 0) || (values[3] < 0)))) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "value(s) for the -to option must be non-negative",
- -1));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_TO", NULL);
- return TCL_ERROR;
+ needed = "non-negative";
+ goto numberOutOfRange;
}
if (numValues <= 2) {
optPtr->toX = values[0];
@@ -1699,11 +1653,8 @@ ParseSubcommandOptions(
break;
case OPT_ZOOM:
if ((values[0] <= 0) || (values[1] <= 0)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "value(s) for the -zoom option must be positive",
- -1));
- Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_ZOOM", NULL);
- return TCL_ERROR;
+ needed = "positive";
+ goto numberOutOfRange;
}
optPtr->zoomX = values[0];
optPtr->zoomY = values[1];
@@ -1717,8 +1668,50 @@ ParseSubcommandOptions(
optPtr->options |= bit;
}
-
return TCL_OK;
+
+ /*
+ * Exception generation.
+ */
+
+ oneValueRequired:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "the \"%s\" option requires a value", expandedOption));
+ Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+
+ manyValuesRequired:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "the \"%s\" option requires one %s integer values",
+ expandedOption, (maxValues == 2) ? "or two": "to four"));
+ Tcl_SetErrorCode(interp, "TK", "PHOTO", "MISSING_VALUE", NULL);
+ return TCL_ERROR;
+
+ numberOutOfRange:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value(s) for the %s option must be %s", expandedOption, needed));
+ Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_VALUE", NULL);
+ return TCL_ERROR;
+
+ unknownOrAmbiguousOption:
+ msgObj = Tcl_ObjPrintf("unrecognized option \"%s\": must be ", option);
+ bit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if (allowedOptions & bit) {
+ if (allowedOptions & (bit - 1)) {
+ if (allowedOptions & ~((bit << 1) - 1)) {
+ Tcl_AppendToObj(msgObj, ", ", -1);
+ } else {
+ Tcl_AppendToObj(msgObj, ", or ", -1);
+ }
+ }
+ Tcl_AppendToObj(msgObj, *listPtr, -1);
+ }
+ bit <<= 1;
+ }
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "PHOTO", "BAD_OPTION", NULL);
+ return TCL_ERROR;
}
/*
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 88e0c25..833dd0c 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -1168,7 +1168,7 @@ MODULE_SCOPE void TkpBuildRegionFromAlphaData(TkRegion region,
unsigned x, unsigned y, unsigned width,
unsigned height, unsigned char *dataPtr,
unsigned pixelStride, unsigned lineStride);
-MODULE_SCOPE void TkPrintPadAmount(Tcl_Interp *interp,
+MODULE_SCOPE void TkAppendPadAmount(Tcl_Obj *bufferObj,
const char *buffer, int pad1, int pad2);
MODULE_SCOPE int TkParsePadAmount(Tcl_Interp *interp,
Tk_Window tkwin, Tcl_Obj *objPtr,
diff --git a/generic/tkPack.c b/generic/tkPack.c
index 4fada47..c600f34 100644
--- a/generic/tkPack.c
+++ b/generic/tkPack.c
@@ -133,11 +133,11 @@ static int YExpansion(Packer *slavePtr, int cavityHeight);
/*
*------------------------------------------------------------------------
*
- * TkPrintPadAmount --
+ * TkAppendPadAmount --
*
* This function generates a text value that describes one of the -padx,
* -pady, -ipadx, or -ipady configuration options. The text value
- * generated is appended to the interpreter result.
+ * generated is appended to the given Tcl_Obj.
*
* Results:
* None.
@@ -149,23 +149,25 @@ static int YExpansion(Packer *slavePtr, int cavityHeight);
*/
void
-TkPrintPadAmount(
- Tcl_Interp *interp, /* The interpreter into which the result is
+TkAppendPadAmount(
+ Tcl_Obj *bufferObj, /* The interpreter into which the result is
* written. */
const char *switchName, /* One of "padx", "pady", "ipadx" or
* "ipady" */
int halfSpace, /* The left or top padding amount */
int allSpace) /* The total amount of padding */
{
- char buffer[60 + 2*TCL_INTEGER_SPACE];
+ Tcl_Obj *padding[2];
if (halfSpace*2 == allSpace) {
- sprintf(buffer, " -%.10s %d", switchName, halfSpace);
+ Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1),
+ Tcl_NewIntObj(halfSpace));
} else {
- sprintf(buffer, " -%.10s {%d %d}", switchName, halfSpace,
- allSpace - halfSpace);
+ padding[0] = Tcl_NewIntObj(halfSpace);
+ padding[1] = Tcl_NewIntObj(allSpace - halfSpace);
+ Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1),
+ Tcl_NewListObj(2, padding));
}
- Tcl_AppendResult(interp, buffer, NULL);
}
/*
@@ -328,6 +330,7 @@ Tk_PackObjCmd(
case PACK_INFO: {
register Packer *slavePtr;
Tk_Window slave;
+ Tcl_Obj *infoObj;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "window");
@@ -343,31 +346,39 @@ Tk_PackObjCmd(
Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL);
return TCL_ERROR;
}
- Tcl_AppendElement(interp, "-in");
- Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
- Tcl_AppendElement(interp, "-anchor");
- Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor));
- Tcl_AppendResult(interp, " -expand ",
- (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ", NULL);
+
+ infoObj = Tcl_NewObj();
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1),
+ TkNewWindowObj(slavePtr->masterPtr->tkwin));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-anchor", -1),
+ Tcl_NewStringObj(Tk_NameOfAnchor(slavePtr->anchor), -1));
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-expand", -1),
+ Tcl_NewBooleanObj(slavePtr->flags & EXPAND));
switch (slavePtr->flags & (FILLX|FILLY)) {
case 0:
- Tcl_AppendResult(interp, "none", NULL);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("none", -1));
break;
case FILLX:
- Tcl_AppendResult(interp, "x", NULL);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("x", -1));
break;
case FILLY:
- Tcl_AppendResult(interp, "y", NULL);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("y", -1));
break;
case FILLX|FILLY:
- Tcl_AppendResult(interp, "both", NULL);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1),
+ Tcl_NewStringObj("both", -1));
break;
}
- TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
- TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY);
- TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX);
- TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY);
- Tcl_AppendResult(interp, " -side ", sideNames[slavePtr->side], NULL);
+ TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
+ TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY);
+ TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft,slavePtr->padX);
+ TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY);
+ Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-side", -1),
+ Tcl_NewStringObj(sideNames[slavePtr->side], -1));
+ Tcl_SetObjResult(interp, infoObj);
break;
}
case PACK_PROPAGATE: {
diff --git a/generic/tkPlace.c b/generic/tkPlace.c
index 8fe2bd1..caa7cc1 100644
--- a/generic/tkPlace.c
+++ b/generic/tkPlace.c
@@ -343,7 +343,7 @@ Tk_PlaceObjCmd(
for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
slavePtr = slavePtr->nextPtr) {
- Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_ListObjAppendElement(NULL, listPtr,
TkNewWindowObj(slavePtr->tkwin));
}
Tcl_SetObjResult(interp, listPtr);
@@ -775,54 +775,50 @@ PlaceInfoCommand(
Tcl_Interp *interp, /* Interp into which to place result. */
Tk_Window tkwin) /* Token for the window to get info on. */
{
- char buffer[32 + TCL_INTEGER_SPACE];
Slave *slavePtr;
+ Tcl_Obj *infoObj;
slavePtr = FindSlave(tkwin);
if (slavePtr == NULL) {
return TCL_OK;
}
+ infoObj = Tcl_NewObj();
if (slavePtr->masterPtr != NULL) {
- Tcl_AppendElement(interp, "-in");
- Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
+ Tcl_AppendToObj(infoObj, "-in", -1);
+ Tcl_ListObjAppendElement(NULL, infoObj,
+ TkNewWindowObj(slavePtr->masterPtr->tkwin));
+ Tcl_AppendToObj(infoObj, " ", -1);
}
- sprintf(buffer, " -x %d", slavePtr->x);
- Tcl_AppendResult(interp, buffer, NULL);
- sprintf(buffer, " -relx %.4g", slavePtr->relX);
- Tcl_AppendResult(interp, buffer, NULL);
- sprintf(buffer, " -y %d", slavePtr->y);
- Tcl_AppendResult(interp, buffer, NULL);
- sprintf(buffer, " -rely %.4g", slavePtr->relY);
- Tcl_AppendResult(interp, buffer, NULL);
+ Tcl_AppendPrintfToObj(infoObj,
+ "-x %d -relx %.4g -y %d -rely %.4g",
+ slavePtr->x, slavePtr->relX, slavePtr->y, slavePtr->relY);
if (slavePtr->flags & CHILD_WIDTH) {
- sprintf(buffer, " -width %d", slavePtr->width);
- Tcl_AppendResult(interp, buffer, NULL);
+ Tcl_AppendPrintfToObj(infoObj, " -width %d", slavePtr->width);
} else {
- Tcl_AppendResult(interp, " -width {}", NULL);
+ Tcl_AppendToObj(infoObj, " -width {}", -1);
}
if (slavePtr->flags & CHILD_REL_WIDTH) {
- sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth);
- Tcl_AppendResult(interp, buffer, NULL);
+ Tcl_AppendPrintfToObj(infoObj,
+ " -relwidth %.4g", slavePtr->relWidth);
} else {
- Tcl_AppendResult(interp, " -relwidth {}", NULL);
+ Tcl_AppendToObj(infoObj, " -relwidth {}", -1);
}
if (slavePtr->flags & CHILD_HEIGHT) {
- sprintf(buffer, " -height %d", slavePtr->height);
- Tcl_AppendResult(interp, buffer, NULL);
+ Tcl_AppendPrintfToObj(infoObj, " -height %d", slavePtr->height);
} else {
- Tcl_AppendResult(interp, " -height {}", NULL);
+ Tcl_AppendToObj(infoObj, " -height {}", -1);
}
if (slavePtr->flags & CHILD_REL_HEIGHT) {
- sprintf(buffer, " -relheight %.4g", slavePtr->relHeight);
- Tcl_AppendResult(interp, buffer, NULL);
+ Tcl_AppendPrintfToObj(infoObj,
+ " -relheight %.4g", slavePtr->relHeight);
} else {
- Tcl_AppendResult(interp, " -relheight {}", NULL);
+ Tcl_AppendToObj(infoObj, " -relheight {}", -1);
}
- Tcl_AppendElement(interp, "-anchor");
- Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor));
- Tcl_AppendElement(interp, "-bordermode");
- Tcl_AppendElement(interp, borderModeStrings[slavePtr->borderMode]);
+ Tcl_AppendPrintfToObj(infoObj, " -anchor %s -bordermode %s",
+ Tk_NameOfAnchor(slavePtr->anchor),
+ borderModeStrings[slavePtr->borderMode]);
+ Tcl_SetObjResult(interp, infoObj);
return TCL_OK;
}
diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c
index 2dadf29..c233c6c 100644
--- a/generic/tkRectOval.c
+++ b/generic/tkRectOval.c
@@ -1291,13 +1291,14 @@ RectOvalToPostscript(
* information; 0 means final Postscript is
* being created. */
{
- char pathCmd[500];
+ Tcl_Obj *pathObj, *psObj;
RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
double y1, y2;
XColor *color;
XColor *fillColor;
Pixmap fillStipple;
Tk_State state = itemPtr->state;
+ Tcl_InterpState interpState;
y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]);
y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]);
@@ -1308,12 +1309,23 @@ RectOvalToPostscript(
*/
if (rectOvalPtr->header.typePtr == &tkRectangleType) {
- sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n",
+ pathObj = Tcl_ObjPrintf(
+ "%.15g %.15g moveto "
+ "%.15g 0 rlineto "
+ "0 %.15g rlineto "
+ "%.15g 0 rlineto "
+ "closepath\n",
rectOvalPtr->bbox[0], y1,
- rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1,
+ rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0],
+ y2-y1,
rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]);
} else {
- sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n",
+ pathObj = Tcl_ObjPrintf(
+ "matrix currentmatrix\n"
+ "%.15g %.15g translate "
+ "%.15g %.15g scale "
+ "1 0 moveto 0 0 1 0 360 arc\n"
+ "setmatrix\n",
(rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2,
(rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2);
}
@@ -1347,24 +1359,38 @@ RectOvalToPostscript(
}
/*
+ * Make our working space.
+ */
+
+ psObj = Tcl_NewObj();
+ interpState = Tcl_SaveInterpState(interp, TCL_OK);
+
+ /*
* First draw the filled area of the rectangle.
*/
if (fillColor != NULL) {
- Tcl_AppendResult(interp, pathCmd, NULL);
+ Tcl_AppendObjToObj(psObj, pathObj);
+
+ Tcl_ResetResult(interp);
if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
- return TCL_ERROR;
+ goto error;
}
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
+
if (fillStipple != None) {
- Tcl_AppendResult(interp, "clip ", NULL);
+ Tcl_AppendToObj(psObj, "clip ", -1);
+
+ Tcl_ResetResult(interp);
if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) {
- return TCL_ERROR;
+ goto error;
}
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
if (color != NULL) {
- Tcl_AppendResult(interp, "grestore gsave\n", NULL);
+ Tcl_AppendToObj(psObj, "grestore gsave\n", -1);
}
} else {
- Tcl_AppendResult(interp, "fill\n", NULL);
+ Tcl_AppendToObj(psObj, "fill\n", -1);
}
}
@@ -1373,14 +1399,32 @@ RectOvalToPostscript(
*/
if (color != NULL) {
- Tcl_AppendResult(interp, pathCmd, "0 setlinejoin 2 setlinecap\n",
- NULL);
+ Tcl_AppendObjToObj(psObj, pathObj);
+ Tcl_AppendToObj(psObj, "0 setlinejoin 2 setlinecap\n", -1);
+
+ Tcl_ResetResult(interp);
if (Tk_CanvasPsOutline(canvas, itemPtr,
&rectOvalPtr->outline)!= TCL_OK) {
- return TCL_ERROR;
+ goto error;
}
+ Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
}
+
+ /*
+ * Plug the accumulated postscript back into the result.
+ */
+
+ (void) Tcl_RestoreInterpState(interp, interpState);
+ Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL);
+ Tcl_DecrRefCount(psObj);
+ Tcl_DecrRefCount(pathObj);
return TCL_OK;
+
+ error:
+ Tcl_DiscardInterpState(interpState);
+ Tcl_DecrRefCount(psObj);
+ Tcl_DecrRefCount(pathObj);
+ return TCL_ERROR;
}
/*
diff --git a/generic/tkText.c b/generic/tkText.c
index 7978793..28fa6cd 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -1679,17 +1679,21 @@ TextPeerCmd(
objc-2, objv+2);
case PEER_NAMES: {
TkText *tPtr = textPtr->sharedTextPtr->peers;
+ Tcl_Obj *peersObj;
if (objc > 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_ERROR;
}
+ peersObj = Tcl_NewObj();
while (tPtr != NULL) {
if (tPtr != textPtr) {
- Tcl_AppendElement(interp, Tk_PathName(tPtr->tkwin));
+ Tcl_ListObjAppendElement(NULL, peersObj,
+ TkNewWindowObj(tPtr->tkwin));
}
tPtr = tPtr->next;
}
+ Tcl_SetObjResult(interp, peersObj);
}
}
@@ -4838,6 +4842,7 @@ DumpLine(
command, &index, what);
}
}
+
offset += currentSize;
if (lineChanged) {
TkTextSegment *newSegPtr;
@@ -4855,9 +4860,7 @@ DumpLine(
linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree,
textPtr, lineno);
newSegPtr = linePtr->segPtr;
- if (segPtr == newSegPtr) {
- segPtr = segPtr->nextPtr;
- } else {
+ if (segPtr != newSegPtr) {
while ((newOffset < endByte) && (newOffset < offset)
&& (newSegPtr != NULL)) {
newOffset += currentSize;
@@ -4879,11 +4882,9 @@ DumpLine(
}
}
segPtr = newSegPtr;
- if (segPtr != NULL) {
- segPtr = segPtr->nextPtr;
- }
}
- } else {
+ }
+ if (segPtr != NULL) {
segPtr = segPtr->nextPtr;
}
}
@@ -4922,31 +4923,25 @@ DumpSegment(
int what) /* Look for TK_DUMP_INDEX bit. */
{
char buffer[TK_POS_CHARS];
+ Tcl_Obj *values[3], *tuple;
TkTextPrintIndex(textPtr, index, buffer);
+ values[0] = Tcl_NewStringObj(key, -1);
+ values[1] = Tcl_NewStringObj(value, -1);
+ values[2] = Tcl_NewStringObj(buffer, -1);
+ tuple = Tcl_NewListObj(3, values);
if (command == NULL) {
- Tcl_AppendElement(interp, key);
- Tcl_AppendElement(interp, value);
- Tcl_AppendElement(interp, buffer);
+ Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple);
+ Tcl_DecrRefCount(tuple);
return 0;
} else {
- const char *argv[4];
- char *list;
int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree);
- argv[0] = key;
- argv[1] = value;
- argv[2] = buffer;
- argv[3] = NULL;
- list = Tcl_Merge(3, argv);
- Tcl_VarEval(interp, Tcl_GetString(command), " ", list, NULL);
- ckfree(list);
- if ((textPtr->flags & DESTROYED) ||
- TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch) {
- return 1;
- } else {
- return 0;
- }
+ Tcl_VarEval(interp, Tcl_GetString(command), " ", Tcl_GetString(tuple),
+ NULL);
+ Tcl_DecrRefCount(tuple);
+ return ((textPtr->flags & DESTROYED) ||
+ TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch);
}
}
@@ -6715,9 +6710,7 @@ TkpTesttextCmd(
TkTextSetMark(textPtr, "insert", &index);
TkTextPrintIndex(textPtr, &index, buf);
- sprintf(buf + strlen(buf), " %d", index.byteIndex);
- Tcl_AppendResult(interp, buf, NULL);
-
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s %d", buf, index.byteIndex));
return TCL_OK;
}
diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c
index 0bb8f41..1770cb6 100644
--- a/generic/tkTextImage.c
+++ b/generic/tkTextImage.c
@@ -277,16 +277,20 @@ TkTextImageCmd(
case CMD_NAMES: {
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
+ Tcl_Obj *resultObj;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_ERROR;
}
+ resultObj = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable,
&search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_AppendElement(interp,
- Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr),
+ -1));
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
default:
diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c
index 52df787..77cf2c5 100644
--- a/generic/tkTextMark.c
+++ b/generic/tkTextMark.c
@@ -179,19 +179,27 @@ TkTextMarkCmd(
TkBTreeLinkSegment(markPtr, &index);
break;
}
- case MARK_NAMES:
+ case MARK_NAMES: {
+ Tcl_Obj *resultObj;
+
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_ERROR;
}
- Tcl_AppendElement(interp, "insert");
- Tcl_AppendElement(interp, "current");
+ resultObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ "insert", -1));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ "current", -1));
for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->markTable,
&search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_AppendElement(interp,
- Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr),
+ -1));
}
+ Tcl_SetObjResult(interp, resultObj);
break;
+ }
case MARK_NEXT:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "index");
diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c
index b3160b8..19ea5f3 100644
--- a/generic/tkTextTag.c
+++ b/generic/tkTextTag.c
@@ -641,6 +641,7 @@ TkTextTagCmd(
TkTextIndex last;
TkTextSearch tSearch;
char position[TK_POS_CHARS];
+ Tcl_Obj *resultObj;
if ((objc != 5) && (objc != 6)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
@@ -709,11 +710,15 @@ TkTextTagCmd(
if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) {
return TCL_OK;
}
+ resultObj = Tcl_NewObj();
TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
- Tcl_AppendElement(interp, position);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position, -1));
TkBTreeNextTag(&tSearch);
TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
- Tcl_AppendElement(interp, position);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position, -1));
+ Tcl_SetObjResult(interp, resultObj);
break;
}
case TAG_PREVRANGE: {
@@ -721,6 +726,7 @@ TkTextTagCmd(
TkTextSearch tSearch;
char position1[TK_POS_CHARS];
char position2[TK_POS_CHARS];
+ Tcl_Obj *resultObj;
if ((objc != 5) && (objc != 6)) {
Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
@@ -768,8 +774,7 @@ TkTextTagCmd(
TkTextPrintIndex(textPtr, &index2, position1);
TkTextPrintIndex(textPtr, &index1, position2);
- Tcl_AppendElement(interp, position1);
- Tcl_AppendElement(interp, position2);
+ goto gotPrevIndexPair;
}
return TCL_OK;
}
@@ -819,8 +824,14 @@ TkTextTagCmd(
}
}
}
- Tcl_AppendElement(interp, position1);
- Tcl_AppendElement(interp, position2);
+
+ gotPrevIndexPair:
+ resultObj = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position1, -1));
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(position2, -1));
+ Tcl_SetObjResult(interp, resultObj);
break;
}
case TAG_RAISE: {
diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c
index d9dcecf..d2998da 100644
--- a/generic/tkTextWind.c
+++ b/generic/tkTextWind.c
@@ -335,16 +335,20 @@ TkTextWindowCmd(
case WIND_NAMES: {
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
+ Tcl_Obj *resultObj;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 3, objv, NULL);
return TCL_ERROR;
}
+ resultObj = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->windowTable,
&search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_AppendElement(interp,
- Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr));
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr),
+ -1));
}
+ Tcl_SetObjResult(interp, resultObj);
break;
}
}
diff --git a/generic/tkTrig.c b/generic/tkTrig.c
index d999062..5f4d267 100644
--- a/generic/tkTrig.c
+++ b/generic/tkTrig.c
@@ -1376,6 +1376,7 @@ TkMakeBezierPostscript(
int numCoords = numPoints*2;
double control[8];
char buffer[200];
+ Tcl_Obj *psObj;
/*
* If the curve is a closed one then generate a special spline that spans
@@ -1394,7 +1395,9 @@ TkMakeBezierPostscript(
control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
- sprintf(buffer, "%.15g %.15g moveto\n%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ psObj = Tcl_ObjPrintf(
+ "%.15g %.15g moveto\n"
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
control[0], Tk_CanvasPsY(canvas, control[1]),
control[2], Tk_CanvasPsY(canvas, control[3]),
control[4], Tk_CanvasPsY(canvas, control[5]),
@@ -1403,10 +1406,9 @@ TkMakeBezierPostscript(
closed = 0;
control[6] = pointPtr[0];
control[7] = pointPtr[1];
- sprintf(buffer, "%.15g %.15g moveto\n",
+ psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n",
control[6], Tk_CanvasPsY(canvas, control[7]));
}
- Tcl_AppendResult(interp, buffer, NULL);
/*
* Cycle through all the remaining points in the curve, generating a curve
@@ -1432,12 +1434,15 @@ TkMakeBezierPostscript(
control[4] = 0.333*control[6] + 0.667*pointPtr[0];
control[5] = 0.333*control[7] + 0.667*pointPtr[1];
- sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
control[2], Tk_CanvasPsY(canvas, control[3]),
control[4], Tk_CanvasPsY(canvas, control[5]),
control[6], Tk_CanvasPsY(canvas, control[7]));
- Tcl_AppendResult(interp, buffer, NULL);
}
+
+ Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL);
+ Tcl_DecrRefCount(psObj);
}
/*
@@ -1473,14 +1478,14 @@ TkMakeRawCurvePostscript(
int i;
double *segPtr;
char buffer[200];
+ Tcl_Obj *psObj;
/*
* Put the first point into the path.
*/
- sprintf(buffer, "%.15g %.15g moveto\n",
+ psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n",
pointPtr[0], Tk_CanvasPsY(canvas, pointPtr[1]));
- Tcl_AppendResult(interp, buffer, NULL);
/*
* Loop through all the remaining points in the curve, generating a
@@ -1495,19 +1500,19 @@ TkMakeRawCurvePostscript(
* neighbouring knots, so this segment is just a straight line.
*/
- sprintf(buffer, "%.15g %.15g lineto\n",
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n",
segPtr[6], Tk_CanvasPsY(canvas, segPtr[7]));
} else {
/*
* This is a generic Bezier curve segment.
*/
- sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
segPtr[2], Tk_CanvasPsY(canvas, segPtr[3]),
segPtr[4], Tk_CanvasPsY(canvas, segPtr[5]),
segPtr[6], Tk_CanvasPsY(canvas, segPtr[7]));
}
- Tcl_AppendResult(interp, buffer, NULL);
}
/*
@@ -1532,20 +1537,23 @@ TkMakeRawCurvePostscript(
* Straight line.
*/
- sprintf(buffer, "%.15g %.15g lineto\n",
+ Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n",
control[6], Tk_CanvasPsY(canvas, control[7]));
} else {
/*
* Bezier curve segment.
*/
- sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ Tcl_AppendPrintfToObj(psObj,
+ "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
control[2], Tk_CanvasPsY(canvas, control[3]),
control[4], Tk_CanvasPsY(canvas, control[5]),
control[6], Tk_CanvasPsY(canvas, control[7]));
}
- Tcl_AppendResult(interp, buffer, NULL);
}
+
+ Tcl_AppendResult(interp, Tcl_GetString(psObj), NULL);
+ Tcl_DecrRefCount(psObj);
}
/*
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 6095054..a8d2884 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -56,6 +56,7 @@ TkStateParseProc(
int c;
int flags = PTR2INT(clientData);
size_t length;
+ Tcl_Obj *msgObj;
register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
@@ -84,19 +85,19 @@ TkStateParseProc(
return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad %s value \"%s\": must be normal",
- ((flags & 4) ? "-default" : "state"), value));
+ msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal",
+ ((flags & 4) ? "-default" : "state"), value);
if (flags & 1) {
- Tcl_AppendResult(interp, ", active", NULL);
+ Tcl_AppendToObj(msgObj, ", active", -1);
}
if (flags & 2) {
- Tcl_AppendResult(interp, ", hidden", NULL);
+ Tcl_AppendToObj(msgObj, ", hidden", -1);
}
if (flags & 3) {
- Tcl_AppendResult(interp, ",", NULL);
+ Tcl_AppendToObj(msgObj, ",", -1);
}
- Tcl_AppendResult(interp, " or disabled", NULL);
+ Tcl_AppendToObj(msgObj, " or disabled", -1);
+ Tcl_SetObjResult(interp, msgObj);
Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL);
*statePtr = TK_STATE_NORMAL;
return TCL_ERROR;
@@ -269,6 +270,7 @@ TkOffsetParseProc(
Tk_TSOffset tsoffset;
const char *q, *p;
int result;
+ Tcl_Obj *msgObj;
if ((value == NULL) || (*value == 0)) {
tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
@@ -380,15 +382,15 @@ TkOffsetParseProc(
return TCL_OK;
badTSOffset:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad offset \"%s\": expected \"x,y\"", value));
+ msgObj = Tcl_ObjPrintf("bad offset \"%s\": expected \"x,y\"", value);
if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) {
- Tcl_AppendResult(interp, ", \"#x,y\"", NULL);
+ Tcl_AppendToObj(msgObj, ", \"#x,y\"", -1);
}
if (PTR2INT(clientData) & TK_OFFSET_INDEX) {
- Tcl_AppendResult(interp, ", <index>", NULL);
+ Tcl_AppendToObj(msgObj, ", <index>", -1);
}
- Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL);
+ Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1);
+ Tcl_SetObjResult(interp, msgObj);
Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL);
return TCL_ERROR;
}
@@ -929,16 +931,17 @@ TkFindStateNum(
*/
if (interp != NULL) {
+ Tcl_Obj *msgObj;
+
mPtr = mapPtr;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad %s value \"%s\": must be %s",
- option, strKey, mPtr->strKey));
- Tcl_SetErrorCode(interp, "TK", "VALUE", option, NULL);
+ msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be %s",
+ option, strKey, mPtr->strKey);
for (mPtr++; mPtr->strKey != NULL; mPtr++) {
- Tcl_AppendResult(interp,
- ((mPtr[1].strKey != NULL) ? ", " : ", or "),
- mPtr->strKey, NULL);
+ Tcl_AppendPrintfToObj(msgObj, ",%s %s",
+ ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey);
}
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", option, strKey, NULL);
}
return mPtr->numKey;
}
@@ -987,17 +990,19 @@ TkFindStateNumObj(
*/
if (interp != NULL) {
+ Tcl_Obj *msgObj;
+
mPtr = mapPtr;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ msgObj = Tcl_ObjPrintf(
"bad %s value \"%s\": must be %s",
- Tcl_GetString(optionPtr), key, mPtr->strKey));
- Tcl_SetErrorCode(interp, "TK", "VALUE", Tcl_GetString(optionPtr),
- NULL);
+ Tcl_GetString(optionPtr), key, mPtr->strKey);
for (mPtr++; mPtr->strKey != NULL; mPtr++) {
- Tcl_AppendResult(interp,
- ((mPtr[1].strKey != NULL) ? ", " : ", or "),
- mPtr->strKey, NULL);
+ Tcl_AppendPrintfToObj(msgObj, ",%s %s",
+ ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey);
}
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", Tcl_GetString(optionPtr),
+ key, NULL);
}
return mPtr->numKey;
}
diff --git a/generic/tkVisual.c b/generic/tkVisual.c
index 5f03f39..8b0c155 100644
--- a/generic/tkVisual.c
+++ b/generic/tkVisual.c
@@ -202,14 +202,16 @@ Tk_GetVisual(
}
}
if (template.class == -1) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ Tcl_Obj *msgObj = Tcl_ObjPrintf(
"unknown or ambiguous visual name \"%s\": class must be ",
- string));
- Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUAL", NULL);
+ string);
+
for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
- Tcl_AppendResult(interp, dictPtr->name, ", ", NULL);
+ Tcl_AppendPrintfToObj(msgObj, "%s, ", dictPtr->name);
}
- Tcl_AppendResult(interp, "or default", NULL);
+ Tcl_AppendToObj(msgObj, "or default", -1);
+ Tcl_SetObjResult(interp, msgObj);
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "VISUAL", string, NULL);
return NULL;
}
while (isspace(UCHAR(*p))) {
generated by cgit v0.12 at 2024-11-08 03:07:39 (GMT)