From e56f7568a9098556d07267dbfd0d84238207983a Mon Sep 17 00:00:00 2001 From: fvogel Date: Sun, 14 Jan 2018 15:18:02 +0000 Subject: Take some proposals from kjnash in [b68710aed6], namely 1. Add test of -state normal to , and 2. Don't add autoseparators when doing <> if the widget is disabled and the operation is therefore only a <>. --- library/text.tcl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index 645776d..5b6628a 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -358,7 +358,7 @@ bind Text { } } bind Text { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {[%W cget -state] eq "normal" && !$tk_strictMotif && [%W compare end != insert+1c]} { %W delete insert [tk::TextNextWord %W insert] } } @@ -1058,13 +1058,13 @@ proc ::tk_textCut w { # make <> an atomic operation on the Undo stack, # i.e. separate it from other delete operations on either side set oldSeparator [$w cget -autoseparators] - if {$oldSeparator} { + if {([$w cget -state] eq "normal") && $oldSeparator} { $w edit separator } clipboard clear -displayof $w clipboard append -displayof $w $data $w delete sel.first sel.last - if {$oldSeparator} { + if {([$w cget -state] eq "normal") && $oldSeparator} { $w edit separator } } -- cgit v0.12 From 07a6cd2185de4b3d27104dad6178c841d0fcb4d9 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 15 Jan 2018 20:56:57 +0000 Subject: Remove unnecessary (in the legacy text widget) check for normal state when --- library/text.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/text.tcl b/library/text.tcl index 5b6628a..468696b 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -358,7 +358,7 @@ bind Text { } } bind Text { - if {[%W cget -state] eq "normal" && !$tk_strictMotif && [%W compare end != insert+1c]} { + if {!$tk_strictMotif && [%W compare end != insert+1c]} { %W delete insert [tk::TextNextWord %W insert] } } -- cgit v0.12 From 20d035df8daad6946c62976f7c92c2e3e4109c67 Mon Sep 17 00:00:00 2001 From: fvogel Date: Mon, 15 Jan 2018 22:25:30 +0000 Subject: Add three (currently failing) tests text-27.15[abc] that will pass when <> will fire from the text widget upon <>, or <>, when the text widget selection is impacted and it exports its selection (such events will therefore impact the PRIMARY selection, and this must trigger a <> event) --- tests/text.test | 51 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 49 insertions(+), 2 deletions(-) diff --git a/tests/text.test b/tests/text.test index 07192e8..9e8ed9b 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6395,9 +6395,9 @@ test text-27.14a {<> virtual event - propagation to peers} -body { } -cleanup { destroy .t .tt } -result {4} -test text-27.15 {<> virtual event} -body { +test text-27.15 {<> virtual event on sel tagging} -body { set ::retval no_selection - pack [text .t -undo 1] + pack [text .t] bind .t <> "set ::retval selection_changed" update idletasks .t insert end "nothing special\n" @@ -6407,6 +6407,53 @@ test text-27.15 {<> virtual event} -body { } -cleanup { destroy .t } -result {selection_changed} +test text-27.15a {<> virtual event on <>} -body { + pack [text .t -exportselection 1] + .t insert end "There is a PRIMARY selection in this text widget, " + .t insert end "and it will be impacted by the <> event received.\n" + .t insert end "Therefore a <> event must fire back." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> -x 15 -y 3 + update + set ::retval +} -cleanup { + destroy .t +} -result {<>_fired} +test text-27.15b {<> virtual event on } -body { + pack [text .t -exportselection 1] + .t insert end "There is a PRIMARY selection in this text widget, " + .t insert end "and it will be impacted by the event received.\n" + .t insert end "Therefore a <> event must fire back." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + .t mark set insert 1.15 + focus .t + event generate .t + update + set ::retval +} -cleanup { + destroy .t +} -result {<>_fired} +test text-27.15c {<> virtual event on <>} -body { + pack [text .t -exportselection 1] + .t insert end "There is a PRIMARY selection in this text widget, " + .t insert end "and it will be impacted by the <> event received.\n" + .t insert end "Therefore a <> event must fire back." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> + update + set ::retval +} -cleanup { + destroy .t +} -result {<>_fired} test text-27.16 {-maxundo configuration option} -body { text .t -undo 1 -autoseparators 1 -maxundo 2 pack .t -- cgit v0.12 From 09f7781c81fdf230a784fa3c74d7898a894f3c94 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 16 Jan 2018 20:13:54 +0000 Subject: Avoid confusion: the <> event is documented to fire when the selection in the widget is changed. The previous commit message (and content) confused text widget selection and PRIMARY (X) selection. <> shall fire whenever the text widget selection is changed, independently of whether the widget exports its selection or not, i.e. whether the PRIMARY selection is impacted or not. --- tests/text.test | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/text.test b/tests/text.test index 9e8ed9b..e330a61 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6408,8 +6408,8 @@ test text-27.15 {<> virtual event on sel tagging} -body { destroy .t } -result {selection_changed} test text-27.15a {<> virtual event on <>} -body { - pack [text .t -exportselection 1] - .t insert end "There is a PRIMARY selection in this text widget, " + pack [text .t] + .t insert end "There is a selection in this text widget, " .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 @@ -6423,8 +6423,8 @@ test text-27.15a {<> virtual event on <>} -body { destroy .t } -result {<>_fired} test text-27.15b {<> virtual event on } -body { - pack [text .t -exportselection 1] - .t insert end "There is a PRIMARY selection in this text widget, " + pack [text .t] + .t insert end "There is a selection in this text widget, " .t insert end "and it will be impacted by the event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 @@ -6440,8 +6440,8 @@ test text-27.15b {<> virtual event on } -body { destroy .t } -result {<>_fired} test text-27.15c {<> virtual event on <>} -body { - pack [text .t -exportselection 1] - .t insert end "There is a PRIMARY selection in this text widget, " + pack [text .t] + .t insert end "There is a selection in this text widget, " .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 -- cgit v0.12 From 0d081ffec083a435733efdf54b85b97517643831 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 16 Jan 2018 20:29:03 +0000 Subject: Deal with the case of selection modification by deletion. This makes text-27.15b and text-27.15c pass. --- generic/tkText.c | 59 +++++++++++++++++++++++++++----------------------------- 1 file changed, 28 insertions(+), 31 deletions(-) diff --git a/generic/tkText.c b/generic/tkText.c index 28fca76..136686b 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -3069,6 +3069,9 @@ DeleteIndexRange( int *lineAndByteIndex; int resetViewCount; int pixels[2*PIXEL_CLIENTS]; + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + int i; if (sharedTextPtr == NULL) { sharedTextPtr = textPtr->sharedTextPtr; @@ -3133,42 +3136,36 @@ DeleteIndexRange( } } - if (line1 < line2) { - /* - * We are deleting more than one line. For speed, we remove all tags - * from the range first. If we don't do this, the code below can (when - * there are many tags) grow non-linearly in execution time. - */ - - Tcl_HashSearch search; - Tcl_HashEntry *hPtr; - int i; + /* + * For speed, we remove all tags from the range first. If we don't + * do this, the code below can (when there are many tags) grow + * non-linearly in execution time. + */ - for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search); - hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { - TkTextTag *tagPtr = Tcl_GetHashValue(hPtr); + for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search); + hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { + TkTextTag *tagPtr = Tcl_GetHashValue(hPtr); - TkBTreeTag(&index1, &index2, tagPtr, 0); - } + TkBTreeTag(&index1, &index2, tagPtr, 0); + } - /* - * Special case for the sel tag which is not in the hash table. We - * need to do this once for each peer text widget. - */ + /* + * Special case for the sel tag which is not in the hash table. We + * need to do this once for each peer text widget. + */ - for (tPtr = sharedTextPtr->peers; tPtr != NULL ; - tPtr = tPtr->next) { - if (TkBTreeTag(&index1, &index2, tPtr->selTagPtr, 0)) { - /* - * Send an event that the selection changed. This is - * equivalent to: - * event generate $textWidget <> - */ + for (tPtr = sharedTextPtr->peers; tPtr != NULL ; + tPtr = tPtr->next) { + if (TkBTreeTag(&index1, &index2, tPtr->selTagPtr, 0)) { + /* + * Send an event that the selection changed. This is + * equivalent to: + * event generate $textWidget <> + */ - TkTextSelectionEvent(textPtr); - tPtr->abortSelections = 1; - } - } + TkTextSelectionEvent(textPtr); + tPtr->abortSelections = 1; + } } /* -- cgit v0.12 From 7a77f1939db69697ab845bfe824463ef0af965bb Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 18 Jan 2018 00:29:00 +0000 Subject: Add more <> event generation tests. --- tests/text.test | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 63 insertions(+), 6 deletions(-) diff --git a/tests/text.test b/tests/text.test index e330a61..5b688f1 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6407,9 +6407,22 @@ test text-27.15 {<> virtual event on sel tagging} -body { } -cleanup { destroy .t } -result {selection_changed} -test text-27.15a {<> virtual event on <>} -body { +test text-27.15a {<> virtual event on sel removal} -body { + set ::retval no_selection + pack [text .t] + .t insert end "nothing special\n" + .t tag add sel 1.0 1.1 + bind .t <> "set ::retval selection_changed" + update idletasks + .t tag remove 1.0 end + update + set ::retval +} -cleanup { + destroy .t +} -result {selection_changed} +test text-27.15b {<> virtual event on <> inside widget selection} -body { pack [text .t] - .t insert end "There is a selection in this text widget, " + .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 @@ -6422,9 +6435,23 @@ test text-27.15a {<> virtual event on <>} -body { } -cleanup { destroy .t } -result {<>_fired} -test text-27.15b {<> virtual event on } -body { +test text-27.15c {No <> virtual event on <> outside widget selection} -body { pack [text .t] - .t insert end "There is a selection in this text widget, " + .t insert end "There is a selection in this text widget,\n" + .t insert end "but it will not be impacted by the <> event received." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> -x 15 -y 80 + update + set ::retval +} -cleanup { + destroy .t +} -result {no_<>_event_fired} +test text-27.15d {<> virtual event on with cursor inside selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 @@ -6439,9 +6466,25 @@ test text-27.15b {<> virtual event on } -body { } -cleanup { destroy .t } -result {<>_fired} -test text-27.15c {<> virtual event on <>} -body { +test text-27.15e {No <> virtual event on with cursor outside selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "but it will not be impacted by the event received." + .t tag add sel 1.0 1.28 + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + .t mark set insert 2.15 + focus .t + event generate .t + update + set ::retval +} -cleanup { + destroy .t +} -result {no_<>_event_fired} +test text-27.15f {<> virtual event on <> with a widget selection} -body { pack [text .t] - .t insert end "There is a selection in this text widget, " + .t insert end "There is a selection in this text widget,\n" .t insert end "and it will be impacted by the <> event received.\n" .t insert end "Therefore a <> event must fire back." .t tag add sel 1.0 1.28 @@ -6454,6 +6497,20 @@ test text-27.15c {<> virtual event on <>} -body { } -cleanup { destroy .t } -result {<>_fired} +test text-27.15g {No <> virtual event on <> without widget selection} -body { + pack [text .t] + .t insert end "There is a selection in this text widget,\n" + .t insert end "and it will be impacted by the <> event received.\n" + .t insert end "Therefore a <> event must fire back." + bind .t <> "set ::retval <>_fired" + update + set ::retval no_<>_event_fired + event generate .t <> + update + set ::retval +} -cleanup { + destroy .t +} -result {no_<>_event_fired} test text-27.16 {-maxundo configuration option} -body { text .t -undo 1 -autoseparators 1 -maxundo 2 pack .t -- cgit v0.12 From ce270e3152dc902f3b190091f767f5b9c6673aa4 Mon Sep 17 00:00:00 2001 From: fvogel Date: Thu, 18 Jan 2018 00:42:40 +0000 Subject: Deal with the case of selection modification by insertion. All tests about <> now pass, and no test is newly failing. --- generic/tkText.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/generic/tkText.c b/generic/tkText.c index 136686b..f5a0d94 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2726,10 +2726,14 @@ InsertChars( } /* - * Invalidate any selection retrievals in progress. + * Invalidate any selection retrievals in progress, and send an event + * that the selection changed if that is the case. */ for (tPtr = sharedTextPtr->peers; tPtr != NULL ; tPtr = tPtr->next) { + if (TkBTreeCharTagged(indexPtr, tPtr->selTagPtr)) { + TkTextSelectionEvent(tPtr); + } tPtr->abortSelections = 1; } -- cgit v0.12