diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/text.n | 23 | ||||
| -rw-r--r-- | generic/tkText.c | 264 | ||||
| -rw-r--r-- | generic/tkTextIndex.c | 4 | ||||
| -rw-r--r-- | tests/text.test | 91 |
5 files changed, 340 insertions, 50 deletions
@@ -1,3 +1,11 @@ +2002-06-22 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/text.n: TIP #93 implementation that + * generic/tkText.c (TextWidgetCmd): enhances the text get and + * generic/tkTextIndex.c (TkTextGetIndex): delete methods to accept + * tests/text.test: multiple range pairs. + This handles the delete case in an atomic, fixed-index fashion. + 2002-06-21 Mo DeJong <mdejong@users.sourceforge.net> * tests/wm.test: Add tests to make sure a withdrawn @@ -5,10 +5,10 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: text.n,v 1.13 2002/06/21 23:22:24 hobbs Exp $ +'\" RCS: @(#) $Id: text.n,v 1.14 2002/06/22 08:21:51 hobbs Exp $ '\" .so man.macros -.TH text n 4.0 Tk "Tk Built-In Commands" +.TH text n 8.4 Tk "Tk Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -843,7 +843,7 @@ to the lists of indices that are redrawn. The values of these variables are tested by Tk's test suite. .VE 8.4 .TP -\fIpathName \fBdelete \fIindex1 \fR?\fIindex2\fR? +\fIpathName \fBdelete \fIindex1 \fR?\fIindex2 ...\fR? Delete a range of characters from the text. If both \fIindex1\fR and \fIindex2\fR are specified, then delete all the characters starting with the one given by \fIindex1\fR @@ -856,6 +856,16 @@ If \fIindex2\fR isn't specified then the single character at It is not allowable to delete characters in a way that would leave the text without a newline as the last character. The command returns an empty string. +.VS 8.4 +If more indices are given, multiple ranges of text will be deleted. +All indices are first checked for validity before any deletions are made. +They are sorted and the text is removed from the last range to the +first range to deleted text does not cause a undesired index shifting +side-effects. If multiple ranges with the same start index are given, +then the longest range is used. If overlapping ranges are given, then +they will be merged into spans that do not cause deletion of text +outside the given ranges due to text shifted during deletion. +.VE 8.4 .TP \fIpathName \fBdlineinfo \fIindex\fR Returns a list with five elements describing the area occupied @@ -969,7 +979,7 @@ option is false. .RE .VE 8.4 .TP -\fIpathName \fBget \fIindex1 \fR?\fIindex2\fR? +\fIpathName \fBget \fIindex1 \fR?\fIindex2 ...\fR? Return a range of characters from the text. The return value will be all the characters in the text starting with the one whose index is \fIindex1\fR and ending just before @@ -982,6 +992,11 @@ is past the end of the file or \fIindex2\fR is less than or equal to \fIindex1\fR) then an empty string is returned. If the specified range contains embedded windows, no information about them is included in the returned string. +.VS 8.4 +If multiple index pairs are given, multiple ranges of text will be returned +in a list. Invalid ranges will not be represented with empty strings in +the list. The ranges are returned in the order passed to \fBget\fR. +.VE 8.4 .TP \fIpathName \fBimage \fIoption \fR?\fIarg arg ...\fR? This command is used to manipulate embedded images. diff --git a/generic/tkText.c b/generic/tkText.c index 6d5f024..7a929e8 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkText.c,v 1.27 2002/06/21 23:09:54 hobbs Exp $ + * RCS: @(#) $Id: tkText.c,v 1.28 2002/06/22 08:21:51 hobbs Exp $ */ #include "default.h" @@ -287,7 +287,8 @@ WrapModePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp, TkText *textPtr, int argc, char **argv, int flags)); static int DeleteChars _ANSI_ARGS_((TkText *textPtr, - char *index1String, char *index2String)); + char *index1String, char *index2String, + TkTextIndex *indexPtr1, TkTextIndex *indexPtr2)); static void DestroyText _ANSI_ARGS_((char *memPtr)); static void InsertChars _ANSI_ARGS_((TkText *textPtr, TkTextIndex *indexPtr, char *string)); @@ -298,6 +299,8 @@ static void TextEventProc _ANSI_ARGS_((ClientData clientData, XEvent *eventPtr)); static int TextFetchSelection _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); +static int TextIndexSortProc _ANSI_ARGS_((CONST VOID *first, + CONST VOID *second)); static int TextSearchCmd _ANSI_ARGS_((TkText *textPtr, Tcl_Interp *interp, int argc, char **argv)); static int TextEditCmd _ANSI_ARGS_((TkText *textPtr, @@ -590,15 +593,114 @@ TextWidgetCmd(clientData, interp, argc, argv) } } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0) && (length >= 3)) { - if ((argc != 3) && (argc != 4)) { + int i; + + if (argc < 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delete index1 ?index2?\"", (char *) NULL); + argv[0], " delete index1 ?index2 ...?\"", (char *) NULL); result = TCL_ERROR; goto done; } if (textPtr->state == TK_STATE_NORMAL) { - result = DeleteChars(textPtr, argv[2], - (argc == 4) ? argv[3] : (char *) NULL); + if (argc < 5) { + /* + * Simple case requires no predetermination of indices. + */ + result = DeleteChars(textPtr, argv[2], + (argc == 4) ? argv[3] : (char *) NULL, NULL, NULL); + } else { + /* + * Multi-index pair case requires that we prevalidate the + * indices and sort from last to first so that deletes + * occur in the exact (unshifted) text. It also needs to + * handle partial and fully overlapping ranges. We have to + * do this with multiple passes. + */ + TkTextIndex *indices, *ixStart, *ixEnd, *lastStart, *lastEnd; + char *useIdx; + + argc -= 2; + argv += 2; + indices = (TkTextIndex *) + ckalloc((argc + 1) * sizeof(TkTextIndex)); + + /* + * First pass verifies that all indices are valid. + */ + for (i = 0; i < argc; i++) { + if (TkTextGetIndex(interp, textPtr, argv[i], + &indices[i]) != TCL_OK) { + result = TCL_ERROR; + ckfree((char *) indices); + goto done; + } + } + /* + * Pad out the pairs evenly to make later code easier. + */ + if (argc & 1) { + indices[i] = indices[i-1]; + TkTextIndexForwChars(&indices[i], 1, &indices[i]); + argc++; + } + useIdx = (char *) ckalloc((unsigned) argc); + memset(useIdx, 0, (unsigned) argc); + /* + * Do a decreasing order sort so that we delete the end + * ranges first to maintain index consistency. + */ + qsort((VOID *) indices, (unsigned) (argc / 2), + 2 * sizeof(TkTextIndex), TextIndexSortProc); + lastStart = lastEnd = NULL; + /* + * Second pass will handle bogus ranges (end < start) and + * overlapping ranges. + */ + for (i = 0; i < argc; i += 2) { + ixStart = &indices[i]; + ixEnd = &indices[i+1]; + if (TkTextIndexCmp(ixEnd, ixStart) <= 0) { + continue; + } + if (lastStart) { + if (TkTextIndexCmp(ixStart, lastStart) == 0) { + /* + * Start indices were equal, and the sort placed + * the longest range first, so skip this one. + */ + continue; + } else if (TkTextIndexCmp(lastStart, ixEnd) < 0) { + /* + * The next pair has a start range before the end + * point of the last range. Constrain the delete + * range, but use the pointer values. + */ + *ixEnd = *lastStart; + if (TkTextIndexCmp(ixEnd, ixStart) <= 0) { + continue; + } + } + } + lastStart = ixStart; + lastEnd = ixEnd; + useIdx[i] = 1; + } + /* + * Final pass take the input from the previous and deletes + * the ranges which are flagged to be deleted. + */ + for (i = 0; i < argc; i += 2) { + if (useIdx[i]) { + /* + * We don't need to check the return value because all + * indices are preparsed above. + */ + DeleteChars(textPtr, NULL, NULL, + &indices[i], &indices[i+1]); + } + } + ckfree((char *) indices); + } } } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0) && (length >= 2)) { @@ -624,34 +726,61 @@ TextWidgetCmd(clientData, interp, argc, argv) } else if ((c == 'e') && (strncmp(argv[1], "edit", length) == 0)) { result = TextEditCmd(textPtr, interp, argc, argv); } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { - if ((argc != 3) && (argc != 4)) { + Tcl_Obj *objPtr = NULL; + Tcl_DString ds; + int i, found = 0; + + if (argc < 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get index1 ?index2?\"", (char *) NULL); - result = TCL_ERROR; - goto done; - } - if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) { + argv[0], " get index1 ?index2 ...?\"", (char *) NULL); result = TCL_ERROR; goto done; } - if (argc == 3) { - index2 = index1; - TkTextIndexForwChars(&index2, 1, &index2); - } else if (TkTextGetIndex(interp, textPtr, argv[3], &index2) - != TCL_OK) { - result = TCL_ERROR; - goto done; + for (i = 2; i < argc; i += 2) { + if (TkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (i+1 == argc) { + index2 = index1; + TkTextIndexForwChars(&index2, 1, &index2); + } else if (TkTextGetIndex(interp, textPtr, argv[i+1], &index2) + != TCL_OK) { + if (objPtr) { + Tcl_DecrRefCount(objPtr); + } + result = TCL_ERROR; + goto done; + } + if (TkTextIndexCmp(&index1, &index2) < 0) { + /* + * Place the text in a DString and move it to the result. + * Since this could in principle be a megabyte or more, we + * want to do it efficiently! + */ + TextGetText(&index1, &index2, &ds); + found++; + if (found == 1) { + Tcl_DStringResult(interp, &ds); + } else { + if (found == 2) { + /* + * Move the first item we put into the result into + * the first element of the list object. + */ + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_GetObjResult(interp)); + } + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds))); + } + Tcl_DStringFree(&ds); + } } - if (TkTextIndexCmp(&index1, &index2) < 0) { - /* - * Place the text in a DString and move it to the result. Since - * this could in principle be a megabyte or more, we want to do - * it efficiently! - */ - Tcl_DString ds; - TextGetText(&index1, &index2, &ds); - Tcl_DStringResult(interp, &ds); - Tcl_DStringFree(&ds); + if (found > 1) { + Tcl_SetObjResult(interp, objPtr); } } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0) && (length >= 3)) { @@ -754,6 +883,49 @@ TextWidgetCmd(clientData, interp, argc, argv) /* *---------------------------------------------------------------------- * + * TextIndexSortProc -- + * + * This procedure is called by qsort when sorting an array of + * indices in *decreasing* order (last to first). + * + * Results: + * The return value is -1 if the first argument should be before + * the second element, 0 if it's equivalent, and 1 if it should be + * after the second element. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TextIndexSortProc(first, second) + CONST VOID *first, *second; /* Elements to be compared. */ +{ + TkTextIndex *pair1 = (TkTextIndex *) first; + TkTextIndex *pair2 = (TkTextIndex *) second; + int cmp = TkTextIndexCmp(&pair1[1], &pair2[1]); + + if (cmp == 0) { + /* + * If the first indices were equal, we want the second index of the + * pair also to be the greater. Use pointer magic to access the + * second index pair. + */ + cmp = TkTextIndexCmp(&pair1[0], &pair2[0]); + } + if (cmp > 0) { + return -1; + } else if (cmp < 0) { + return 1; + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * * DestroyText -- * * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release @@ -1314,7 +1486,7 @@ InsertChars(textPtr, indexPtr, string) */ static int -DeleteChars(textPtr, index1String, index2String) +DeleteChars(textPtr, index1String, index2String, indexPtr1, indexPtr2) TkText *textPtr; /* Overall information about text widget. */ char *index1String; /* String describing location of first * character to delete. */ @@ -1322,6 +1494,12 @@ DeleteChars(textPtr, index1String, index2String) * character to delete. NULL means just * delete the one character given by * index1String. */ + TkTextIndex *indexPtr1; /* index describing location of first + * character to delete. */ + TkTextIndex *indexPtr2; /* index describing location of last + * character to delete. NULL means just + * delete the one character given by + * indexPtr1. */ { int line1, line2, line, byteIndex, resetView; TkTextIndex index1, index2; @@ -1331,18 +1509,28 @@ DeleteChars(textPtr, index1String, index2String) * Parse the starting and stopping indices. */ - if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1) - != TCL_OK) { - return TCL_ERROR; - } - if (index2String != NULL) { - if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2) + if (index1String != NULL) { + if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1) != TCL_OK) { return TCL_ERROR; } + if (index2String != NULL) { + if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2) + != TCL_OK) { + return TCL_ERROR; + } + } else { + index2 = index1; + TkTextIndexForwChars(&index2, 1, &index2); + } } else { - index2 = index1; - TkTextIndexForwChars(&index2, 1, &index2); + index1 = *indexPtr1; + if (indexPtr2 != NULL) { + index2 = *indexPtr2; + } else { + index2 = index1; + TkTextIndexForwChars(&index2, 1, &index2); + } } /* diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index 1ee3b05..b130d32 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkTextIndex.c,v 1.4 2002/01/17 03:35:00 dgp Exp $ + * RCS: @(#) $Id: tkTextIndex.c,v 1.5 2002/06/22 08:21:51 hobbs Exp $ */ #include "default.h" @@ -377,6 +377,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) &last); TkBTreeStartSearch(&first, &last, tagPtr, &search); if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) { + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "text doesn't contain any characters tagged with \"", Tcl_GetHashKey(&textPtr->tagTable, hPtr), "\"", @@ -527,6 +528,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr) return TCL_OK; error: + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad text index \"", string, "\"", (char *) NULL); return TCL_ERROR; diff --git a/tests/text.test b/tests/text.test index c65c7fb..a6bfc19 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: text.test,v 1.15 2002/06/21 23:09:53 hobbs Exp $ +# RCS: @(#) $Id: text.test,v 1.16 2002/06/22 08:21:52 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -243,10 +243,10 @@ test text-7.4 {TextWidgetCmd procedure, "debug" option} { test text-8.1 {TextWidgetCmd procedure, "delete" option} { list [catch {.t delete} msg] $msg -} {1 {wrong # args: should be ".t delete index1 ?index2?"}} +} {1 {wrong # args: should be ".t delete index1 ?index2 ...?"}} test text-8.2 {TextWidgetCmd procedure, "delete" option} { list [catch {.t delete a b c} msg] $msg -} {1 {wrong # args: should be ".t delete index1 ?index2?"}} +} {1 {bad text index "a"}} test text-8.3 {TextWidgetCmd procedure, "delete" option} { list [catch {.t delete @x 2.2} msg] $msg } {1 {bad text index "@x"}} @@ -254,11 +254,11 @@ test text-8.4 {TextWidgetCmd procedure, "delete" option} { list [catch {.t delete 2.3 @y} msg] $msg } {1 {bad text index "@y"}} test text-8.5 {TextWidgetCmd procedure, "delete" option} { - .t con -state disabled + .t configure -state disabled .t delete 2.3 .t g 2.0 2.end } abcdefghijklm -.t con -state normal +.t configure -state normal test text-8.6 {TextWidgetCmd procedure, "delete" option} { .t delete 2.3 .t get 2.0 2.end @@ -267,13 +267,71 @@ test text-8.7 {TextWidgetCmd procedure, "delete" option} { .t delete 2.1 2.3 .t get 2.0 2.end } aefghijklm +test text-8.8 {TextWidgetCmd procedure, "delete" option} { + # All indices are checked before we actually delete anything + list [catch {.t delete 2.1 2.3 foo} msg] $msg \ + [.t get 2.0 2.end] +} {1 {bad text index "foo"} aefghijklm} +set prevtext [.t get 1.0 end-1c] +test text-8.9 {TextWidgetCmd procedure, "delete" option} { + # auto-forward one byte if the last "pair" is just one + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.1 2.3 2.3 + .t get 1.0 end-1c +} foo\naefghijklm +test text-8.10 {TextWidgetCmd procedure, "delete" option} { + # all indices will be ordered before deletion + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.3 2.7 2.9 2.4 + .t get 1.0 end-1c +} foo\ndfgjklm +test text-8.11 {TextWidgetCmd procedure, "delete" option} { + # and check again with even pairs + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 2.7 2.9 2.4 2.5 + .t get 1.0 end-1c +} foo\ncdfgjklm +test text-8.12 {TextWidgetCmd procedure, "delete" option} { + # we should get the longest range on equal start indices + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7 + .t get 1.0 end-1c +} foo\nfghijklm +test text-8.13 {TextWidgetCmd procedure, "delete" option} { + # we should get the longest range on equal start indices + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 1.2 2.6 2.0 2.5 + .t get 1.0 end-1c +} foghijklm +test text-8.14 {TextWidgetCmd procedure, "delete" option} { + # we should get the longest range on equal start indices + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7 + .t get 1.0 end-1c +} ffghijklm +test text-8.15 {TextWidgetCmd procedure, "delete" option} { + # we should get the watch for overlapping ranges - they should + # essentially be merged into one span. + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.6 2.2 2.8 + .t get 1.0 end-1c +} foo\nijklm +test text-8.16 {TextWidgetCmd procedure, "delete" option} { + # we should get the watch for overlapping ranges - they should + # essentially be merged into one span. + .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 2.0 2.6 2.2 2.4 + .t get 1.0 end-1c +} foo\nghijklm + +.t delete 1.0 end; .t insert 1.0 $prevtext test text-9.1 {TextWidgetCmd procedure, "get" option} { list [catch {.t get} msg] $msg -} {1 {wrong # args: should be ".t get index1 ?index2?"}} +} {1 {wrong # args: should be ".t get index1 ?index2 ...?"}} test text-9.2 {TextWidgetCmd procedure, "get" option} { list [catch {.t get a b c} msg] $msg -} {1 {wrong # args: should be ".t get index1 ?index2?"}} +} {1 {bad text index "a"}} test text-9.3 {TextWidgetCmd procedure, "get" option} { list [catch {.t get @q 3.1} msg] $msg } {1 {bad text index "@q"}} @@ -304,6 +362,25 @@ test text-9.9 {TextWidgetCmd procedure, "get" option} { test text-9.10 {TextWidgetCmd procedure, "get" option} { .t get 5.2 5.4 } {y } +test text-9.11 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.4 5.4 +} {{y } G} +test text-9.12 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.4 5.4 5.5 +} {{y } G} +test text-9.13 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.4 5.5 "5.5+5c" +} {{y } {Irl .}} +test text-9.14 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.4 5.4 5.5 end-3c +} {{y } G { }} +test text-9.15 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.4 5.4 5.5 end-3c end +} {{y } G { 7 +}} +test text-9.17 {TextWidgetCmd procedure, "get" option} { + list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg +} {1 {bad text index "foo"}} test text-10.1 {TextWidgetCmd procedure, "index" option} { list [catch {.t index} msg] $msg |