TIP #438 - [.text pendingyupdate] command added, with corresponding new tests

4 files changed, 83 insertions, 10 deletions

diff --git a/generic/tkText.c b/generic/tkText.c
index 4d2df7e..36bb4d4 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -689,15 +689,16 @@ TextWidgetObjCmd(
     static const char *optionStrings[] = {
 	"bbox", "cget", "compare", "configure", "count", "debug", "delete",
 	"dlineinfo", "dump", "edit", "get", "image", "index", "insert",
-	"mark", "peer", "replace", "scan", "search", "see", "tag", "window",
-	"xview", "yupdate", "yview", NULL
+	"mark", "peer", "pendingyupdate", "replace", "scan", "search",
+	"see", "tag", "window", "xview", "yupdate", "yview", NULL
     };
     enum options {
 	TEXT_BBOX, TEXT_CGET, TEXT_COMPARE, TEXT_CONFIGURE, TEXT_COUNT,
 	TEXT_DEBUG, TEXT_DELETE, TEXT_DLINEINFO, TEXT_DUMP, TEXT_EDIT,
 	TEXT_GET, TEXT_IMAGE, TEXT_INDEX, TEXT_INSERT, TEXT_MARK,
-	TEXT_PEER, TEXT_REPLACE, TEXT_SCAN, TEXT_SEARCH, TEXT_SEE,
-	TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW, TEXT_YUPDATE, TEXT_YVIEW
+	TEXT_PEER, TEXT_PENDINGYUPDATE, TEXT_REPLACE, TEXT_SCAN,
+	TEXT_SEARCH, TEXT_SEE, TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW,
+	TEXT_YUPDATE, TEXT_YVIEW
     };
 
     if (objc < 2) {
@@ -1372,6 +1373,18 @@ TextWidgetObjCmd(
     case TEXT_PEER:
 	result = TextPeerCmd(textPtr, interp, objc, objv);
 	break;
+    case TEXT_PENDINGYUPDATE: {
+        int number;
+
+        if (objc != 2) {
+            Tcl_WrongNumArgs(interp, 2, objv, NULL);
+            result = TCL_ERROR;
+            goto done;
+        }
+        number = TkTextPendingyupdate(textPtr);
+        Tcl_SetObjResult(interp, Tcl_NewIntObj(number));
+        break;
+    }
     case TEXT_REPLACE: {
 	const TkTextIndex *indexFromPtr, *indexToPtr;
 
diff --git a/generic/tkText.h b/generic/tkText.h
index 6f5f153..2d1bcaa 100644
--- a/generic/tkText.h
+++ b/generic/tkText.h
@@ -1124,6 +1124,7 @@ MODULE_SCOPE int	TkTextMarkNameToIndex(TkText *textPtr,
 MODULE_SCOPE void	TkTextMarkSegToIndex(TkText *textPtr,
 			    TkTextSegment *markPtr, TkTextIndex *indexPtr);
 MODULE_SCOPE void	TkTextEventuallyRepick(TkText *textPtr);
+MODULE_SCOPE int	TkTextPendingyupdate(TkText *textPtr);
 MODULE_SCOPE void	TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr);
 MODULE_SCOPE void	TkTextPixelIndex(TkText *textPtr, int x, int y,
 			    TkTextIndex *indexPtr, int *nearest);
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
index 6036222..d740181 100644
--- a/generic/tkTextDisp.c
+++ b/generic/tkTextDisp.c
@@ -2920,6 +2920,8 @@ AsyncUpdateLineMetrics(
     lineNum = TkTextUpdateLineMetrics(textPtr, lineNum,
 	    dInfoPtr->lastMetricUpdateLine, 256);
 
+    dInfoPtr->currentMetricUpdateLine = lineNum;
+
     if (tkTextDebug) {
 	char buffer[2 * TCL_INTEGER_SPACE + 1];
 
@@ -2946,7 +2948,6 @@ AsyncUpdateLineMetrics(
 	}
 	return;
     }
-    dInfoPtr->currentMetricUpdateLine = lineNum;
 
     /*
      * Re-arm the timer. We already have a refCount on the text widget so no
@@ -6034,6 +6035,33 @@ TkTextYviewCmd(
 /*
  *--------------------------------------------------------------
  *
+ * TkTextPendingyupdate --
+ *
+ *	This function computes how many lines are not up-to-date regarding
+ *	asynchronous height calculations.
+ *
+ * Results:
+ *	Returns a positive integer corresponding to the number of lines for
+ *	which the height is outdated.
+ *
+ * Side effects:
+ *	None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextPendingyupdate(
+    TkText *textPtr)		/* Information about text widget. */
+{
+    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+    return (dInfoPtr->lastMetricUpdateLine - dInfoPtr->currentMetricUpdateLine);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
  * TkTextScanCmd --
  *
  *	This function is invoked to process the "scan" option for the widget
diff --git a/tests/text.test b/tests/text.test
index f08431d..d8ed533 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -153,7 +153,7 @@ test text-3.1 {TextWidgetCmd procedure, basics} {
 } {1 {wrong # args: should be ".t option ?arg arg ...?"}}
 test text-3.2 {TextWidgetCmd procedure} {
     list [catch {.t gorp 1.0 z 1.2} msg] $msg
-} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
+} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
 
 test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
     list [catch {.t bbox} msg] $msg
@@ -221,7 +221,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} {
 } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
 test text-6.14 {TextWidgetCmd procedure, "compare" option} {
     list [catch {.t co 1.0 z 1.2} msg] $msg
-} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
+} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
 
 # "configure" option is already covered above
 
@@ -230,7 +230,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} {
 } {1 {wrong # args: should be ".t debug boolean"}}
 test text-7.2 {TextWidgetCmd procedure, "debug" option} {
     list [catch {.t de 0 1} msg] $msg
-} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
+} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
 test text-7.3 {TextWidgetCmd procedure, "debug" option} {
     .t debug true
     .t deb
@@ -901,7 +901,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} {
 } {1 {wrong # args: should be ".t index index"}}
 test text-10.3 {TextWidgetCmd procedure, "index" option} {
     list [catch {.t in a b} msg] $msg
-} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
+} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, pendingyupdate, replace, scan, search, see, tag, window, xview, yupdate, or yview}}
 test text-10.4 {TextWidgetCmd procedure, "index" option} {
     list [catch {.t index @xyz} msg] $msg
 } {1 {bad text index "@xyz"}}
@@ -994,6 +994,37 @@ test text-11a.2 {TextWidgetCmd procedure, "yupdate" option} {
     set fraction2 [lindex [.top.yt yview] 0]
     lappend res [expr {$fraction1 == $fraction2}]
 } {1 0 1}
+test text-11a.11 {TextWidgetCmd procedure, "pendingyupdate" option} {
+    destroy .yt
+    text .yt
+    list [catch {.yt pendingyupdate mytext} msg] $msg
+} {1 {wrong # args: should be ".yt pendingyupdate"}}
+test text-11a.12 {TextWidgetCmd procedure, "pendingyupdate" option} {
+    destroy .top.yt .top
+    toplevel .top
+    pack [text .top.yt]
+    set content {}
+    for {set i 1} {$i < 300} {incr i} {
+        append content [string repeat "$i " 15] \n
+    }
+    .top.yt insert 1.0 $content
+    update
+    # wait for end of line metrics calculation to get correct $fraction1
+    # as a reference
+    while {[.top.yt pendingyupdate]} {update}
+    .top.yt yview moveto 1
+    set fraction1 [lindex [.top.yt yview] 0]
+    set res [expr {$fraction1 > 0}]
+    .top.yt delete 1.0 end
+    .top.yt insert 1.0 $content
+    # ensure the test is relevant
+    lappend res [expr {[.top.yt pendingyupdate] > 0}]
+    # asynchronously wait for completion of line metrics calculation
+    while {[.top.yt pendingyupdate]} {update}
+    .top.yt yview moveto $fraction1
+    set fraction2 [lindex [.top.yt yview] 0]
+    lappend res [expr {$fraction1 == $fraction2}]
+} {1 1 1}
 
 # edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere.
 
@@ -3733,7 +3764,7 @@ test text-31.2 {TextWidgetCmd procedure, "peer" option} {
     list [catch {.t peer names foo} msg] $msg
 } {1 {wrong # args: should be ".t peer names"}}
 test text-31.3 {TextWidgetCmd procedure, "peer" option} {
-    list [catch {.t p names} msg] $msg
+    list [catch {.t pee names} msg] $msg
 } {0 {}}
 test text-31.4 {TextWidgetCmd procedure, "peer" option} {
     .t peer names