summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormdejong <mdejong>2001-03-29 11:05:49 (GMT)
committermdejong <mdejong>2001-03-29 11:05:49 (GMT)
commit6181e4e8acc4749738972dd987facd578e1d4ba0 (patch)
tree9d6abc2c93dfebf503b7eb3673381b74c064ed01
parent42bf452631a363ad20faefed4dc926035d2cdceb (diff)
downloadtk-6181e4e8acc4749738972dd987facd578e1d4ba0.zip
tk-6181e4e8acc4749738972dd987facd578e1d4ba0.tar.gz
tk-6181e4e8acc4749738972dd987facd578e1d4ba0.tar.bz2
* 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.
-rw-r--r--ChangeLog11
-rw-r--r--library/entry.tcl5
-rw-r--r--library/text.tcl12
-rw-r--r--tests/event.test394
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