(1) For symmetry reasons option -tags has also been added to embedded window support.

(2) Refactorization of functionality for the supprt of -tags.
(3) Option -tags has been added to the documentation.

6 files changed, 190 insertions, 101 deletions

diff --git a/doc/text.n b/doc/text.n
index 01a6cce..8c7663f 100644
--- a/doc/text.n
+++ b/doc/text.n
@@ -1293,7 +1293,8 @@ for a screen distance.
 Specifies a set of tags to apply to the embedded image. \fITagList\fR consists
 of a list of tag names, which replace any existing tags for the embedded image.
 \fITagList\fR may be an empty list. Note that it is not possible to add or
-remove the special selection tag \fBsel\fR, it will be ignored with this option.
+remove the special selection tag \fBsel\fR, it will be left untouched with this
+option.
 .SH "EXTRA FUNCTIONS"
 .SS "MERGE RANGE"
 .TP
@@ -2171,6 +2172,14 @@ of text segments that each end with a newline. The newline is part of the
 value. Note that soft hyphens (Unicode point U+00AD) do not belong to this
 result.
 .TP
+\fB\-tags \fItagList\fR
+.
+Specifies a set of tags to apply to the embedded window. \fITagList\fR consists
+of a list of tag names, which replace any existing tags for the embedded window.
+\fITagList\fR may be an empty list. Note that it is not possible to add or
+remove the special selection tag \fBsel\fR, it will be left untouched with this
+option.
+.TP
 \fB\-window\fR
 .
 Include information about embedded windows in the dump results. The value of a
diff --git a/generic/tkText.h b/generic/tkText.h
index 9dbf56d..dc8ba82 100644
--- a/generic/tkText.h
+++ b/generic/tkText.h
@@ -1904,8 +1904,8 @@ MODULE_SCOPE void	TkTextInspectUndoMarkItem(const TkSharedText *sharedTextPtr,
 MODULE_SCOPE bool	TkTextTagChangedUndoRedo(const TkSharedText *sharedTextPtr, TkText *textPtr,
 			    const TkTextIndex *index1Ptr, const TkTextIndex *index2Ptr,
 			    const TkTextTag *tagPtr, bool affectsDisplayGeometry);
-MODULE_SCOPE bool	TkTextTagAddRemove(TkText *textPtr, const TkTextIndex *index1Ptr,
-			    const TkTextIndex *index2Ptr, TkTextTag *tagPtr, bool add);
+MODULE_SCOPE void	TkTextReplaceTags(TkText *textPtr, TkTextSegment *segPtr,
+			    Tcl_Obj *tagListPtr);
 MODULE_SCOPE void	TkTextFindTags(Tcl_Interp *interp, TkText *textPtr, const TkTextSegment *segPtr,
 			    bool discardSelection);
 MODULE_SCOPE bool	TkTextDeleteTag(TkText *textPtr, TkTextTag *tagPtr, Tcl_HashEntry *hPtr);
diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c
index 72141c2..cd673d9 100644
--- a/generic/tkTextImage.c
+++ b/generic/tkTextImage.c
@@ -444,7 +444,6 @@ TkTextImageCmd(
 	    if (!objPtr) {
 		return TCL_ERROR;
 	    }
-
 	    Tcl_ListObjGetElements(NULL, objPtr, &objn, &objs);
 	    for (i = 0; i < objn; ++i) {
 		Tcl_Obj **objv;
@@ -701,7 +700,6 @@ EmbImageConfigure(
     Tk_Image image;
     char *name;
     int width, i;
-    TkSharedText *sharedTextPtr = textPtr->sharedTextPtr;
     TkTextEmbImage *img = &eiPtr->body.ei;
 
     if (maskPtr) {
@@ -713,91 +711,9 @@ EmbImageConfigure(
 	return TCL_ERROR;
     }
 
-    for (i = 0; i < objc; i += 2) {
+    for (i = 0; i + 1 < objc; i += 2) {
 	if (MatchTagsOption(Tcl_GetString(objv[i]))) {
-	    TkTextTagSet *newTagInfoPtr;
-	    TkTextTagSet *oldTagInfoPtr;
-	    TkTextTag *tagArrBuf[128];
-	    TkTextTag **tagArrPtr = tagArrBuf;
-	    TkTextTag *tagPtr;
-	    TkTextIndex index[2];
-	    bool altered = false;
-	    bool anyChanges = false;
-	    Tcl_Obj **objs;
-	    int objn = 0, k;
-	    unsigned j;
-
-	    Tcl_ListObjGetElements(NULL, objv[i + 1], &objn, &objs);
-	    TkTextIndexClear(&index[0], textPtr);
-	    TkTextIndexSetSegment(&index[0], eiPtr);
-	    TkTextIndexForwBytes(textPtr, &index[0], 1, &index[1]);
-	    TkTextTagSetIncrRefCount(oldTagInfoPtr = eiPtr->tagInfoPtr);
-
-	    if (objn > (int) (sizeof(tagArrBuf)/sizeof(tagArrBuf[0]))) {
-		tagArrPtr = malloc(objn*sizeof(tagArrPtr[0]));
-	    }
-
-	    for (k = 0; k < objn; ++k) {
-		tagArrPtr[k] = TkTextCreateTag(textPtr, Tcl_GetString(objs[k]), NULL);
-	    }
-
-	    newTagInfoPtr = TkTextTagSetResize(NULL, sharedTextPtr->tagInfoSize);
-
-	    for (k = 0; k < objn; ++k) {
-		newTagInfoPtr = TkTextTagSetAddToThis(newTagInfoPtr, tagArrPtr[k]->index);
-	    }
-
-	    /*
-	     * Remove the deleted tags, but ignore the "sel" tag.
-	     */
-
-	    for (j = TkTextTagSetFindFirst(oldTagInfoPtr);
-		    j != TK_TEXT_TAG_SET_NPOS;
-		    j = TkTextTagSetFindNext(oldTagInfoPtr, j)) {
-		if (!TkTextTagSetTest(newTagInfoPtr, j)) {
-		    tagPtr = sharedTextPtr->tagLookup[j];
-		    if (tagPtr != textPtr->selTagPtr
-			    && TkTextTagAddRemove(textPtr, &index[0], &index[1], tagPtr, false)) {
-			anyChanges = true;
-			if (tagPtr->undo) {
-			    altered = true;
-			}
-		    }
-		}
-	    }
-
-	    /*
-	     * Add new tags, but ignore the "sel" tag.
-	     */
-
-	    for (j = TkTextTagSetFindFirst(newTagInfoPtr);
-		    j != TK_TEXT_TAG_SET_NPOS;
-		    j = TkTextTagSetFindNext(newTagInfoPtr, j)) {
-		if (!TkTextTagSetTest(eiPtr->tagInfoPtr, j)) {
-		    tagPtr = sharedTextPtr->tagLookup[j];
-		    if (tagPtr != textPtr->selTagPtr
-			    && TkTextTagAddRemove(textPtr, &index[0], &index[1], tagPtr, true)) {
-			anyChanges = true;
-			if (tagPtr->undo) {
-			    altered = true;
-			}
-		    }
-		}
-	    }
-
-	    TkTextTagSetDecrRefCount(oldTagInfoPtr);
-	    TkTextTagSetDecrRefCount(newTagInfoPtr);
-
-	    if (anyChanges) {
-		/* still need to trigger enter/leave events on tags that have changed */
-		TkTextEventuallyRepick(textPtr);
-	    }
-	    if (altered) {
-		TkTextUpdateAlteredFlag(sharedTextPtr);
-	    }
-	    if (tagArrPtr != tagArrBuf) {
-		free(tagArrPtr);
-	    }
+	    TkTextReplaceTags(textPtr, eiPtr, objv[i + 1]);
 	}
     }
 
diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c
index cfa7c99..2eb8972 100644
--- a/generic/tkTextTag.c
+++ b/generic/tkTextTag.c
@@ -161,6 +161,8 @@ DEBUG_ALLOC(extern unsigned tkTextCountDestroyUndoToken);
 
 static bool		ChangeTagPriority(TkSharedText *sharedTextPtr, TkTextTag *tagPtr,
 			    unsigned newPriority, bool undo);
+static bool		TagAddRemove(TkText *textPtr, const TkTextIndex *index1Ptr,
+			    const TkTextIndex *index2Ptr, TkTextTag *tagPtr, bool add);
 static void		TagBindEvent(TkText *textPtr, XEvent *eventPtr, TkTextTagSet *tagInfoPtr,
 			    unsigned epoch);
 static void		AppendTags(Tcl_Interp *interp, unsigned numTags, TkTextTag **tagArray);
@@ -332,7 +334,7 @@ TkTextTagCmd(
 	    } else {
 		TkTextIndexForwChars(textPtr, &index1, 1, &index2, COUNT_INDICES);
 	    }
-	    if (TkTextTagAddRemove(textPtr, &index1, &index2, tagPtr, addTag)) {
+	    if (TagAddRemove(textPtr, &index1, &index2, tagPtr, addTag)) {
 		anyChanges = true;
 	    }
 	}
@@ -1420,6 +1422,121 @@ AppendTags(
 /*
  *----------------------------------------------------------------------
  *
+ * TkTextReplaceTags --
+ *
+ *	This function is replacing the tag information of given segment
+ *	with provided list of tags.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextReplaceTags(
+    TkText *textPtr,		/* Info about overall window. */
+    TkTextSegment *segPtr,	/* Setup tag info of this segment. */
+    Tcl_Obj *tagListPtr)	/* List of tags. */
+{
+    TkTextTagSet *newTagInfoPtr;
+    TkTextTagSet *oldTagInfoPtr;
+    TkSharedText *sharedTextPtr;
+    TkTextTag *tagArrBuf[TK_TEXT_SET_MAX_BIT_SIZE];
+    TkTextTag **tagArrPtr = tagArrBuf;
+    TkTextTag *tagPtr;
+    TkTextIndex index[2];
+    bool altered = false;
+    bool anyChanges = false;
+    Tcl_Obj **objs;
+    int objn = 0, k;
+    unsigned j;
+
+    assert(textPtr);
+    assert(segPtr);
+    assert(segPtr->tagInfoPtr);
+    assert(tagListPtr);
+
+    Tcl_ListObjGetElements(NULL, tagListPtr, &objn, &objs);
+    TkTextIndexClear(&index[0], textPtr);
+    TkTextIndexSetSegment(&index[0], segPtr);
+    TkTextIndexForwBytes(textPtr, &index[0], 1, &index[1]);
+    TkTextTagSetIncrRefCount(oldTagInfoPtr = segPtr->tagInfoPtr);
+
+    if (objn > (int) (sizeof(tagArrBuf)/sizeof(tagArrBuf[0]))) {
+	tagArrPtr = malloc(objn*sizeof(tagArrPtr[0]));
+    }
+
+    for (k = 0; k < objn; ++k) {
+	tagArrPtr[k] = TkTextCreateTag(textPtr, Tcl_GetString(objs[k]), NULL);
+    }
+
+    sharedTextPtr = textPtr->sharedTextPtr;
+    newTagInfoPtr = TkTextTagSetResize(NULL, sharedTextPtr->tagInfoSize);
+
+    for (k = 0; k < objn; ++k) {
+	newTagInfoPtr = TkTextTagSetAddToThis(newTagInfoPtr, tagArrPtr[k]->index);
+    }
+
+    /*
+     * Remove the deleted tags, but ignore the "sel" tag.
+     */
+
+    for (j = TkTextTagSetFindFirst(oldTagInfoPtr);
+	    j != TK_TEXT_TAG_SET_NPOS;
+	    j = TkTextTagSetFindNext(oldTagInfoPtr, j)) {
+	if (!TkTextTagSetTest(newTagInfoPtr, j)) {
+	    tagPtr = sharedTextPtr->tagLookup[j];
+	    if (tagPtr != textPtr->selTagPtr
+		    && TagAddRemove(textPtr, &index[0], &index[1], tagPtr, false)) {
+		anyChanges = true;
+		if (tagPtr->undo) {
+		    altered = true;
+		}
+	    }
+	}
+    }
+
+    /*
+     * Add new tags, but ignore the "sel" tag.
+     */
+
+    for (j = TkTextTagSetFindFirst(newTagInfoPtr);
+	    j != TK_TEXT_TAG_SET_NPOS;
+	    j = TkTextTagSetFindNext(newTagInfoPtr, j)) {
+	if (!TkTextTagSetTest(segPtr->tagInfoPtr, j)) {
+	    tagPtr = sharedTextPtr->tagLookup[j];
+	    if (tagPtr != textPtr->selTagPtr
+		    && TagAddRemove(textPtr, &index[0], &index[1], tagPtr, true)) {
+		anyChanges = true;
+		if (tagPtr->undo) {
+		    altered = true;
+		}
+	    }
+	}
+    }
+
+    TkTextTagSetDecrRefCount(oldTagInfoPtr);
+    TkTextTagSetDecrRefCount(newTagInfoPtr);
+
+    if (anyChanges) {
+	/* still need to trigger enter/leave events on tags that have changed */
+	TkTextEventuallyRepick(textPtr);
+    }
+    if (altered) {
+	TkTextUpdateAlteredFlag(sharedTextPtr);
+    }
+    if (tagArrPtr != tagArrBuf) {
+	free(tagArrPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TkTextFindTags --
  *
  *	This function is appending the tags from given char segment to the
@@ -1551,7 +1668,7 @@ GrabSelection(
 /*
  *----------------------------------------------------------------------
  *
- * TkTextTagAddRemove --
+ * TagAddRemove --
  *	This functions adds or removes a tag (or all tags) from the characters
  *	between given index range.
  *
@@ -1572,8 +1689,8 @@ UndoTagOperation(
     return sharedTextPtr->undoStack && (!tagPtr || tagPtr->undo);
 }
 
-bool
-TkTextTagAddRemove(
+static bool
+TagAddRemove(
     TkText *textPtr,		/* Info about overall widget. */
     const TkTextIndex *index1Ptr,
 				/* Indicates first character in range. */
diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c
index a053e6a..3e1ea10 100644
--- a/generic/tkTextWind.c
+++ b/generic/tkTextWind.c
@@ -177,6 +177,8 @@ static const Tk_OptionSpec optionSpecs[] = {
 	"0", -1, Tk_Offset(TkTextEmbWindow, padY), 0, 0, 0},
     {TK_OPTION_BOOLEAN, "-stretch", NULL, NULL,
 	"0", -1, Tk_Offset(TkTextEmbWindow, stretch), 0, 0, 0},
+    {TK_OPTION_STRING, "-tags", NULL, NULL,
+	NULL, -1, -1, TK_OPTION_NULL_OK, 0, 0},
     {TK_OPTION_WINDOW, "-window", NULL, NULL,
 	NULL, -1, Tk_Offset(TkTextEmbWindow, tkwin), TK_OPTION_NULL_OK, 0, 0},
     {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
@@ -372,6 +374,23 @@ RedoLinkSegmentGetRange(
  *--------------------------------------------------------------
  */
 
+static bool
+MatchTagsOption(
+    const char *opt)
+{
+    static const char *pattern = "-tags";
+    const char *p = pattern;
+    const char *start = opt;
+
+    for ( ; *opt; ++p, ++opt) {
+	if (*p != *opt) {
+	    return opt > start && *p == '\0';
+	}
+    }
+
+    return true;
+}
+
 int
 TkTextWindowCmd(
     TkText *textPtr,		/* Information about text widget. */
@@ -433,12 +452,16 @@ TkTextWindowCmd(
 	    ewPtr->body.ew.tkwin = NULL;
 	}
 
-	objPtr = Tk_GetOptionValue(interp, (char *) &ewPtr->body.ew,
-		ewPtr->body.ew.optionTable, objv[4], textPtr->tkwin);
-	if (!objPtr) {
-	    return TCL_ERROR;
+	if (MatchTagsOption(Tcl_GetString(objv[4]))) {
+	    TkTextFindTags(interp, textPtr, ewPtr, true);
+	} else {
+	    objPtr = Tk_GetOptionValue(interp, (char *) &ewPtr->body.ew,
+		    ewPtr->body.ew.optionTable, objv[4], textPtr->tkwin);
+	    if (!objPtr) {
+		return TCL_ERROR;
+	    }
+	    Tcl_SetObjResult(interp, objPtr);
 	}
-	Tcl_SetObjResult(interp, objPtr);
 	return TCL_OK;
     }
     case WIND_CONFIGURE: {
@@ -462,6 +485,8 @@ TkTextWindowCmd(
 	if (objc <= 5) {
 	    TkTextEmbWindowClient *client;
 	    Tcl_Obj *objPtr;
+	    Tcl_Obj **objs;
+	    int objn = 0, i;
 
 	    /*
 	     * Copy over client specific value before querying.
@@ -482,6 +507,21 @@ TkTextWindowCmd(
 	    if (!objPtr) {
 		return TCL_ERROR;
 	    }
+	    Tcl_ListObjGetElements(NULL, objPtr, &objn, &objs);
+	    for (i = 0; i < objn; ++i) {
+		Tcl_Obj **objv;
+		int objc = 0;
+
+		Tcl_ListObjGetElements(NULL, objs[i], &objc, &objv);
+		if (objc == 5 && strcmp(Tcl_GetString(objv[0]), "-tags") == 0) {
+		    Tcl_Obj *valuePtr;
+
+		    /* { argvName, dbName, dbClass, defValue, current value } */
+		    TkTextFindTags(interp, textPtr, ewPtr, true);
+		    valuePtr = Tcl_GetObjResult(interp);
+		    Tcl_ListObjReplace(NULL, objs[i], 4, 1, 1, &valuePtr);
+		}
+	    }
 	    Tcl_SetObjResult(interp, objPtr);
 	    return TCL_OK;
 	} else {
@@ -714,6 +754,7 @@ EmbWinConfigure(
 {
     Tk_Window oldWindow;
     TkTextEmbWindowClient *client;
+    int i;
 
     assert(textPtr);
 
@@ -730,6 +771,12 @@ EmbWinConfigure(
 	return TCL_ERROR;
     }
 
+    for (i = 0; i + 1 < objc; i += 2) {
+	if (MatchTagsOption(Tcl_GetString(objv[i]))) {
+	    TkTextReplaceTags(textPtr, ewPtr, objv[i + 1]);
+	}
+    }
+
     if (oldWindow != ewPtr->body.ew.tkwin && (!oldWindow || !IsPreservedWindow(client))) {
 	if (oldWindow) {
 	    Tcl_HashEntry *hPtr;
diff --git a/tests/textWind.test b/tests/textWind.test
index 16fb837..496788f 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -160,12 +160,12 @@ test textWind-2.11 {TkTextWindowCmd procedure} -setup {
     .t insert end "This is the first line"
     .t insert end "\nAnd this is a second line, which wraps around"
     frame .f -width 10 -height 6 -bg $color
-    .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo
+    .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -tags tag1 -create foo
     update
     .t window configure .f
 } -cleanup {
     destroy .f
-} -result  {{-align {} {} center baseline} {-create {} {} {} foo} {-owner {} {} 1 1} {-padx {} {} 0 1} {-pady {} {} 0 2} {-stretch {} {} 0 0} {-window {} {} {} .f}}
+} -result  {{-align {} {} center baseline} {-create {} {} {} foo} {-owner {} {} 1 1} {-padx {} {} 0 1} {-pady {} {} 0 2} {-stretch {} {} 0 0} {-tags {} {} {} tag1} {-window {} {} {} .f}}
 test textWind-2.12 {TkTextWindowCmd procedure} -setup {
 # I kept this as it "influenced" the test case in previous releases
     destroy .f
@@ -225,7 +225,7 @@ test textWind-2.17 {TkTextWindowCmd procedure} -setup {
     .t delete 1.0 end
 } -body {
     list [catch {.t window create 1.0} msg] $msg [.t window configure 1.0]
-} -result {0 {} {{-align {} {} center center} {-create {} {} {} {}} {-owner {} {} 1 1} {-padx {} {} 0 0} {-pady {} {} 0 0} {-stretch {} {} 0 0} {-window {} {} {} {}}}}
+} -result {0 {} {{-align {} {} center center} {-create {} {} {} {}} {-owner {} {} 1 1} {-padx {} {} 0 0} {-pady {} {} 0 0} {-stretch {} {} 0 0} {-tags {} {} {} {}} {-window {} {} {} {}}}}
 test textWind-2.18 {TkTextWindowCmd procedure} -setup {
 # I kept this as it "influenced" the test case in previous releases
     destroy .f