Posted to tcl by apn at Wed Oct 17 12:44:35 GMT 2018view raw

  1. Tests began at Wed Oct 17 18:10:21 IST 2018
  2. textTag.test
  3.  
  4.  
  5. ==== textTag-18.1 TkTextPickCurrent tag bindings FAILED
  6. ==== Contents of test case:
  7.  
  8. text .t -width 30 -height 4 -relief sunken -borderwidth 10 -highlightthickness 10 -pady 2
  9. pack .t
  10. update ; # map the window, otherwise -warp can't be done
  11.  
  12. .t insert end " Tag here " TAG " no tag here"
  13. .t tag configure TAG -borderwidth 4 -relief raised
  14. .t tag bind TAG <Enter> {lappend res "%x %y tag-Enter"}
  15. .t tag bind TAG <Leave> {lappend res "%x %y tag-Leave"}
  16. bind .t <Enter> {lappend res Enter}
  17. bind .t <Leave> {lappend res Leave}
  18.  
  19. set res {}
  20. # Bindings must not trigger on the widget border, only over
  21. # the actual tagged characters themselves.
  22. event gen .t <Motion> -warp 1 -x 0 -y 0 ; update
  23. event gen .t <Motion> -warp 1 -x 10 -y 10 ; update
  24. event gen .t <Motion> -warp 1 -x 25 -y 25 ; update
  25. event gen .t <Motion> -warp 1 -x 20 -y 20 ; update
  26. event gen .t <Motion> -warp 1 -x 10 -y 10 ; update
  27. event gen .t <Motion> -warp 1 -x 25 -y 25 ; update
  28. return $res
  29.  
  30. ---- Result was:
  31. {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}
  32. ---- Result should have been (exact matching):
  33. Enter {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}
  34. ==== textTag-18.1 FAILED
  35.