* library/entry.tcl (tkEntryMouseSelect):

	* library/text.tcl (tkTextSelectTo): When
	the mouse is dragged with the button down,
	move the insertion cursor to the current
	mouse position.
	* tests/event.test: Add a series of tests
	for event generation. Add tests for selection,
	check the position of the insertion cursor.

4 files changed, 408 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index 171f57e..645f34f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2001-03-29  Mo DeJong  <mdejong@redhat.com>
+
+	* library/entry.tcl (tkEntryMouseSelect):
+	* library/text.tcl (tkTextSelectTo): When
+	the mouse is dragged with the button down,
+	move the insertion cursor to the current
+	mouse position.
+	* tests/event.test: Add a series of tests
+	for event generation. Add tests for selection,
+	check the position of the insertion cursor.
+
 2001-03-28  Jeff Hobbs  <jeffh@gimlet.activestate.com>
 
 	* unix/configure:
diff --git a/library/entry.tcl b/library/entry.tcl
index b44eaad..a826481 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -3,7 +3,7 @@
 # This file defines the default bindings for Tk entry widgets and provides
 # procedures that help in implementing those bindings.
 #
-# RCS: @(#) $Id: entry.tcl,v 1.13 2000/05/29 01:43:14 hobbs Exp $
+# RCS: @(#) $Id: entry.tcl,v 1.14 2001/03/29 11:05:49 mdejong Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -390,6 +390,9 @@ proc tkEntryMouseSelect {w x} {
 	    $w selection range 0 end
 	}
     }
+    if {$tkPriv(mouseMoved)} {
+        $w icursor $cur
+    }
     update idletasks
 }
 
diff --git a/library/text.tcl b/library/text.tcl
index 742f82f..79a49e1 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.13 2000/07/19 23:22:20 ericm Exp $
+# RCS: @(#) $Id: text.tcl,v 1.14 2001/03/29 11:05:49 mdejong Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -581,15 +581,9 @@ proc tkTextSelectTo {w x y {extend 0}} {
 	}
     }
     if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
-	if {[string compare $tcl_platform(platform) "unix"] \
-		&& [$w compare $cur < anchor]} {
-	    $w mark set insert $first
-	} else {
-	    $w mark set insert $last
-	}
-	$w tag remove sel 0.0 $first
+	$w tag remove sel 0.0 end
+	$w mark set insert $cur
 	$w tag add sel $first $last
-	$w tag remove sel $last end
 	update idletasks
     }
 }
diff --git a/tests/event.test b/tests/event.test
index f1d0450..42dc3e4 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: event.test,v 1.5 2000/04/10 22:43:13 ericm Exp $
+# RCS: @(#) $Id: event.test,v 1.6 2001/03/29 11:05:49 mdejong Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -22,6 +22,150 @@ raise .
 # a few of the procedures in tkEvent.c.  Please add more tests whenever
 # possible.
 
+
+
+# Setup table used to query key events.
+
+proc _init_keypress_lookup { } {
+    global keypress_lookup
+
+    scan A %c start
+    scan Z %c finish
+
+    for {set i $start} {$i <= $finish} {incr i} {
+        set l [format %c $i]
+        set keypress_lookup($l) $l
+    }
+
+    scan a %c start
+    scan z %c finish
+
+    for {set i $start} {$i <= $finish} {incr i} {
+        set l [format %c $i]
+        set keypress_lookup($l) $l
+    }
+
+    scan 0 %c start
+    scan 9 %c finish
+
+    for {set i $start} {$i <= $finish} {incr i} {
+        set l [format %c $i]
+        set keypress_lookup($l) $l
+    }
+
+    array set keypress_lookup [list \
+        " " space \
+        ! exclam \
+        \" quotedbl \
+        \# numbersign \
+        \$ dollar \
+        % percent \
+        & ampersand \
+        ( parenleft \
+        ) parenright \
+        * asterisk \
+        + plus \
+        , comma \
+        - minus \
+        . period \
+        / slash \
+        : colon \
+        \; semicolon \
+        < less \
+        = equal \
+        > greater \
+        ? question \
+        @ at \
+        \[ bracketleft \
+        \\ backslash \
+        \] bracketright \
+        ^ asciicircum \
+        _ underscore \
+        \{ braceleft \
+        | bar \
+        \} braceright \
+        ~ asciitilde \
+        ' apostrophe \
+        "\n" Return]
+}
+
+
+# Lookup an event in the keypress table.
+# For example:
+# Q -> Q
+# . -> period
+# / -> slash
+# Delete -> Delete
+# Escape -> Escape
+
+proc _keypress_lookup { char } {
+    global keypress_lookup
+
+    if {! [info exists keypress_lookup]} {
+        _init_keypress_lookup
+    }
+
+    if {$char == ""} {
+        error "empty char"
+    }
+
+    if {[info exists keypress_lookup($char)]} {
+        return $keypress_lookup($char)
+    } else {
+        return $char
+    }
+}
+
+
+# Lookup and generate a pair of KeyPress and KeyRelease events
+
+proc _keypress { win key } {
+    set keysym [_keypress_lookup $key]
+
+    event generate $win <KeyPress-$keysym>
+    _pause 50
+    event generate $win <KeyRelease-$keysym>
+    _pause 50
+}
+
+# Call _keypress for each character in the given string
+
+proc _keypress_string { win string } {
+    foreach letter [split $string ""] {
+        _keypress $win $letter
+    }
+}
+
+# Delay script execution for a given amount of time
+
+proc _pause { {msecs 1000} } {
+    global _pause
+
+    if {! [info exists _pause(number)]} {
+        set _pause(number) 0
+    }
+
+    set num [incr _pause(number)]
+    set _pause($num) 0
+
+    after $msecs "set _pause($num) 1"
+    vwait _pause($num)
+    unset _pause($num)
+}
+
+# Helper proc to convert index to x y position
+
+proc _text_ind_to_x_y { text ind } {
+    foreach {x1 y1 x2 y2} [$text bbox $ind] break
+    set middle_y [expr {$y1 + (($y2 - $y1) / 2)}]
+    return [list $x1 $middle_y]
+}
+
+
+
+
+# Begining of the actual tests
+
 test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
     button .b -text Test
     pack .b
@@ -51,19 +195,261 @@ test event-1.2 {event generate <Alt-z>} {
 	destroy .e
 	set ::event12result
 } 1
-# cleanup
-::tcltest::cleanupTests
-return
 
 
 
+test event-keypress-1.1 { type into entry widget and hit Return } {
+    destroy .t
+    set t [toplevel .t]
+    set e [entry $t.e]
+    pack $e
+    set return_binding 0
+    bind $e <Return> {set return_binding 1}
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e HELLO\n
+    list [$e get] $return_binding
+} {HELLO 1}
 
 
+test event-keypress-1.2 { type into entry widget and then delete some text } {
+    destroy .t
+    set t [toplevel .t]
+    set e [entry $t.e]
+    pack $e
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e MELLO
+    _keypress $e BackSpace
+    _keypress $e BackSpace
+    $e get
+} MEL
 
+test event-keypress-1.3 { type into entry widget, triple click,
+                          hit Delete key, and then type some more } {
+    destroy .t
+    set t [toplevel .t]
+    set e [entry $t.e]
+    pack $e
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e JUMP
+
+    set result [$e get]
+
+    event generate $e <Enter>
+    for {set i 0} {$i < 3} {incr i} {
+        _pause 100
+        event generate $e <ButtonPress-1>
+        _pause 100
+        event generate $e <ButtonRelease-1>
+    }
 
+    _keypress $e Delete
+    _keypress_string $e UP
+    lappend result [$e get]
+} {JUMP UP}
 
 
+test event-keypress-1.4 { type into text widget and hit Return } {
+    destroy .t
+    set t [toplevel .t]
+    set e [text $t.e]
+    pack $e
+    set return_binding 0
+    bind $e <Return> {set return_binding 1}
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e HELLO\n
+    list [$e get 1.0 end] $return_binding
+} [list "HELLO\n\n" 1]
 
+test event-keypress-1.5 { type into text widget and then delete some text } {
+    destroy .t
+    set t [toplevel .t]
+    set e [text $t.e]
+    pack $e
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e MELLO
+    _keypress $e BackSpace
+    _keypress $e BackSpace
+    $e get 1.0 1.end
+} MEL
 
+test event-keypress-1.6 { type into text widget, triple click,
+                          hit Delete key, and then type some more } {
+    destroy .t
+    set t [toplevel .t]
+    set e [text $t.e]
+    pack $e
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e JUMP
 
+    set result [$e get 1.0 1.end]
+
+    event generate $e <Enter>
+    for {set i 0} {$i < 3} {incr i} {
+        _pause 100
+        event generate $e <ButtonPress-1>
+        _pause 100
+        event generate $e <ButtonRelease-1>
+    }
+
+    _keypress $e Delete
+    _keypress_string $e UP
+    lappend result [$e get 1.0 1.end]
+} {JUMP UP}
+
+
+
+test event-click-drag-1.1 { click and drag in a text widget, this
+                            tests tkTextSelectTo in text.tcl } {
+    destroy .t
+    set t [toplevel .t]
+    set e [text $t.e]
+    pack $e
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e "A Tcl/Tk selection test!"
+    set anchor 1.6
+    set selend 1.18
+
+    set result [list [$e get 1.0 1.end]]
+
+    # Get the x,y coords of the second T in "Tcl/Tk"
+    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+    # Click down to set the insert cursor position
+    event generate $e <Enter>
+    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+
+    # Save the position of the insert cursor
+    lappend result [$e index insert]
+    
+    # Now drag until selend is highlighted, then click up
+
+    set current $anchor
+    while {[$e compare $current <= $selend]} {
+        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+        event generate $e <B1-Motion> -x $current_x -y $current_y
+        set current [$e index [list $current + 1 char]]
+        _pause 50
+    }
+
+    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+    _pause 200
+
+    # Save the position of the insert cursor
+    lappend result [$e index insert]
+
+    # Save the highlighted text
+    lappend result [$e get sel.first sel.last]
+
+    # Now click and click and drag to the left, over "Tcl/Tk selection"
+
+    event generate $e <ButtonPress-1> -x $current_x -y $current_y
+
+    while {[$e compare $current >= [list $anchor - 4 char]]} {
+        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+        event generate $e <B1-Motion> -x $current_x -y $current_y
+        set current [$e index [list $current - 1 char]]
+        _pause 50
+    }
+
+    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+    _pause 200
+
+    # Save the position of the insert cursor
+    lappend result [$e index insert]
+
+    # Save the highlighted text
+    lappend result [$e get sel.first sel.last]
+
+} {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}}
+
+
+
+
+test event-click-drag-1.2 { click and drag in an entry widget, this
+                            tests tkEntryMouseSelect in entry.tcl } {
+    destroy .t
+    set t [toplevel .t]
+    set e [entry $t.e]
+    pack $e
+    tkwait visibility $e
+    focus -force $e
+    _keypress_string $e "A Tcl/Tk selection test!"
+    set anchor 6
+    set selend 18
+
+    set result [list [$e get]]
+
+    # Get the x,y coords of the second T in "Tcl/Tk"
+    foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break
+
+    # Click down to set the insert cursor position
+    event generate $e <Enter>
+    event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
+
+    # Save the position of the insert cursor
+    lappend result [$e index insert]
+    
+    # Now drag until selend is highlighted, then click up
+
+    set current $anchor
+    while {$current <= $selend} {
+        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+        event generate $e <B1-Motion> -x $current_x -y $current_y
+        incr current
+        _pause 50
+    }
+
+    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+    _pause 200
+
+    # Save the position of the insert cursor
+    lappend result [$e index insert]
+
+    # Save the highlighted text
+    lappend result [selection get]
+
+    # Now click and click and drag to the left, over "Tcl/Tk selection"
+
+    event generate $e <ButtonPress-1> -x $current_x -y $current_y
+
+    while {$current >= ($anchor - 4)} {
+        foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+        event generate $e <B1-Motion> -x $current_x -y $current_y
+        incr current -1
+        _pause 50
+    }
+
+    event generate $e <ButtonRelease-1> -x $current_x -y $current_y
+    _pause 200
+
+    # Save the position of the insert cursor
+    lappend result [$e index insert]
+
+    # Save the highlighted text
+    lappend result [selection get]
+
+} {{A Tcl/Tk selection test!} 6 18 {Tk selection} 2 {Tcl/Tk selection}}
+
+
+
+# cleanup
+
+destroy .t
+
+unset keypress_lookup
+rename _init_keypress_lookup {}
+rename _keypress_lookup {}
+rename _keypress {}
+rename _pause {}
+rename _text_ind_to_x_y {}
+
+::tcltest::cleanupTests
+return