* 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.

1 files changed, 390 insertions, 4 deletions

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