From 0068c1b934fc15e422075268a35e85477ff813b0 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 12 Aug 2010 07:59:14 +0000 Subject: * library/text.tcl (TextCursorInSelection): [Patch 2585265]: Backport of factoring-out of decision logic for whether to delete the selected text. --- ChangeLog | 10 ++++++++-- library/text.tcl | 55 +++++++++++++++++++++++++++++++------------------------ 2 files changed, 39 insertions(+), 26 deletions(-) diff --git a/ChangeLog b/ChangeLog index 003c68f..f88db20 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2010-08-12 Donal K. Fellows + + * library/text.tcl (TextCursorInSelection): [Patch 2585265]: Backport + of factoring-out of decision logic for whether to delete the selected + text. + 2010-08-11 Jeff Hobbs * win/Makefile.in (%.${OBJEXT}): better implicit rules support @@ -5,8 +11,8 @@ * unix/configure: regen with ac-2.59 * unix/configure.in, unix/Makefile.in: * unix/tcl.m4 (AIX): remove the need for ldAIX, replace with - -bexpall/-brtl. Remove TK_EXP_FILE (export file) and other - baggage that went with it. Remove pre-4 AIX build support. + -bexpall/-brtl. Remove TK_EXP_FILE (export file) and other baggage + that went with it. Remove pre-4 AIX build support. 2010-08-11 Donal K. Fellows diff --git a/library/text.tcl b/library/text.tcl index fc98743..acdaa8e 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.41.4.2 2009/10/25 13:50:48 dkf Exp $ +# RCS: @(#) $Id: text.tcl,v 1.41.4.3 2010/08/12 07:59:15 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -208,24 +208,20 @@ bind Text { } } bind Text { - if {[%W tag nextrange sel 1.0 end] ne ""} { + if {[tk::TextCursorInSelection %W]} { %W delete sel.first sel.last - } else { - if {[%W compare end != insert+1c]} { - %W delete insert - } - %W see insert + } elseif {[%W compare end != insert+1c]} { + %W delete insert } + %W see insert } bind Text { - if {[%W tag nextrange sel 1.0 end] ne ""} { + if {[tk::TextCursorInSelection %W]} { %W delete sel.first sel.last - } else { - if {[%W compare insert != 1.0]} { - %W delete insert-1c - } - %W see insert + } elseif {[%W compare insert != 1.0]} { + %W delete insert-1c } + %W see insert } bind Text { @@ -849,6 +845,21 @@ proc ::tk::TextResetAnchor {w index} { } } +# ::tk::TextCursorInSelection -- +# Check whether the selection exists and contains the insertion cursor. Note +# that it assumes that the selection is contiguous. +# +# Arguments: +# w - The text widget whose selection is to be checked + +proc ::tk::TextCursorInSelection {w} { + expr { + [llength [$w tag ranges sel]] + && [$w compare sel.first <= insert] + && [$w compare sel.last >= insert] + } +} + # ::tk::TextInsert -- # Insert a string into a text at the point of the insertion cursor. # If there is a selection in the text, and it covers the point of the @@ -863,21 +874,17 @@ proc ::tk::TextInsert {w s} { return } set compound 0 - if {[llength [set range [$w tag ranges sel]]]} { - if {[$w compare [lindex $range 0] <= insert] \ - && [$w compare [lindex $range end] >= insert]} { - set oldSeparator [$w cget -autoseparators] - if {$oldSeparator} { - $w configure -autoseparators 0 - $w edit separator - set compound 1 - } - $w delete [lindex $range 0] [lindex $range end] + if {[TextCursorInSelection $w]} { + set compound [$w cget -autoseparators] + if {$compound} { + $w configure -autoseparators 0 + $w edit separator } + $w delete sel.first sel.last } $w insert insert $s $w see insert - if {$compound && $oldSeparator} { + if {$compound} { $w edit separator $w configure -autoseparators 1 } -- cgit v0.12