*** empty log message ***

1 files changed, 36 insertions, 2 deletions

diff --git a/sandbox/testtext.tcl b/sandbox/testtext.tcl
index 44df4e8..818d8df 100644
--- a/sandbox/testtext.tcl
+++ b/sandbox/testtext.tcl
@@ -6,10 +6,10 @@ package require Img
 set top 1
 set mask "/usr/X11R6/include/X11/bitmaps/fvwm.xbm"
 
-set r [zinc .r -backcolor gray -relief sunken]
+set r [zinc .r -backcolor gray -relief sunken -insertbackground red -insertwidth 10]
 pack .r -expand t -fill both
 .r configure -width 800 -height 500
-.r configure -drawbboxes t
+# .r configure -drawbboxes t
 .r addtag controls withtag $top
 
 .r add rectangle $top "-50 0 +50 1" -composescale 0
@@ -84,6 +84,40 @@ set y 300
 .r add rectangle $top [list [expr $x - 3.0] [expr $y - 3.0] \
 	[expr $x + 3.0] [expr $y + 3.0]] -filled 1 -fillcolor red
 
+
+.r addtag text withtype text
+.r bind text "<1>" {textB1press %x %y}
+.r bind text "<B1-Motion>" {textB1move %x %y}
+.r bind text "<Shift-B1-Motion>" {textB1move %x %y}
+.r bind text "<Shift-1>" {.r select adjust current @%x,%y}
+.r bind text "<KeyPress>" {.r insert [.r focus] insert %A}
+.r bind text "<Shift-KeyPress>" {.r insert [.r focus] insert %A}
+.r bind text "<Return>" {.r insert [.r focus] insert \n}
+.r bind text "<Control-h>" textBs
+.r bind text "<BackSpace>" textBs
+.r bind text "<Delete>" textBs
+.r bind text "<Control-d>" {.r dchars text sel.first sel.last}
+.r bind text "<Control-v>" {.r insert [.r focus] insert [selection get]}
+
+proc textB1press {x y} {
+    .r cursor current "@$x,$y"
+    .r focus current
+    focus .r
+    .r select from current "@$x,$y"
+}
+
+proc textB1move {x y} {
+    .r select to current "@$x,$y"
+}
+
+proc textBs { } {
+    set item [.r focus]
+    set i [expr [.r index $item insert] - 1]
+    if { $i >= 0 } {
+	.r dchars $item $i
+    }
+}
+
 #
 # Add controls to the main group
 #