From c3b96f601ce76e221a2dbd8fe8d747834c4a48ec Mon Sep 17 00:00:00 2001 From: fvogel Date: Sat, 14 Nov 2015 00:02:49 +0000 Subject: TIP #438 - [.text yupdate] command added, with corresponding new tests --- generic/tkText.c | 14 ++++++++++++-- tests/text.test | 45 ++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 52 insertions(+), 7 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index cb89218..4d2df7e 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -690,14 +690,14 @@ TextWidgetObjCmd( "bbox", "cget", "compare", "configure", "count", "debug", "delete", "dlineinfo", "dump", "edit", "get", "image", "index", "insert", "mark", "peer", "replace", "scan", "search", "see", "tag", "window", - "xview", "yview", NULL + "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_YVIEW + TEXT_TAG, TEXT_WINDOW, TEXT_XVIEW, TEXT_YUPDATE, TEXT_YVIEW }; if (objc < 2) { @@ -1494,6 +1494,16 @@ TextWidgetObjCmd( case TEXT_XVIEW: result = TkTextXviewCmd(textPtr, interp, objc, objv); break; + case TEXT_YUPDATE: { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + result = TCL_ERROR; + goto done; + } + TkTextUpdateLineMetrics(textPtr, 1, + TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr), -1); + break; + } case TEXT_YVIEW: result = TkTextYviewCmd(textPtr, interp, objc, objv); break; diff --git a/tests/text.test b/tests/text.test index 7c1731d..f08431d 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, or yview}} +} {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}} 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, or yview}} +} {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}} # "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, or yview}} +} {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}} 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, or yview}} +} {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}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} @@ -960,7 +960,42 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] } {{First second} {1.0 1.5} {1.5 1.12}} -# Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere. +test text-11a.1 {TextWidgetCmd procedure, "yupdate" option} { + destroy .yt + text .yt + list [catch {.yt yupdate mytext} msg] $msg +} {1 {wrong # args: should be ".yt yupdate"}} +test text-11a.2 {TextWidgetCmd procedure, "yupdate" option} { + destroy .top.yt .top + toplevel .top + pack [text .top.yt] + set content {} + for {set i 1} {$i < 30} {incr i} { + append content [string repeat "$i " 15] \n + } + .top.yt insert 1.0 $content + # wait for end of line metrics calculation to get correct $fraction1 + # as a reference + .top.yt yupdate + .top.yt yview moveto 1 + set fraction1 [lindex [.top.yt yview] 0] + set res [expr {$fraction1 > 0}] + # first case: do not wait for completion of line metrics calculation + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] + # second case: wait for completion of line metrics calculation + .top.yt delete 1.0 end + .top.yt insert 1.0 $content + .top.yt yupdate + .top.yt yview moveto $fraction1 + set fraction2 [lindex [.top.yt yview] 0] + lappend res [expr {$fraction1 == $fraction2}] +} {1 0 1} + +# edit, mark, scan, search, see, tag, window, xview and yview actions are tested elsewhere. test text-12.1 {ConfigureText procedure} { list [catch {.t2 configure -state foobar} msg] $msg -- cgit v0.12