Posted to tcl by patthoyts at Wed Sep 03 20:53:48 GMT 2008view raw

  1. $chan(window) chat tag bind URL <Enter> [list UrlEnter %W]
  2. $chan(window) chat tag bind URL <Leave> [list UrlLeave %W]
  3. $chan(window) chat tag bind URL <Button-1> [list UrlClick %W %x %y]
  4.  
  5. proc UrlEnter {w} {
  6. variable cursor:$w
  7. set cursor:$w [$w cget -cursor]
  8. $w configure -cursor hand2
  9. }
  10.  
  11. proc UrlLeave {w} {
  12. variable cursor:$w
  13. if {![info exists cursor:$w]} {set cursor:$w {}}
  14. $w configure -cursor [set cursor:$w]
  15. }
  16.  
  17. proc UrlClick {w x y} {
  18. set tags [$w tag names @$x,$y]
  19. if {[set ndx [lsearch -glob $tags URL-*]] != -1} {
  20. set url ""
  21. foreach {b e} [$w tag ranges [lindex $tags $ndx]] {
  22. append url [$w get $b $e]
  23. }
  24. if {[string length $url] > 0} {
  25. if {[catch {GotoURL $w $url} err]} {
  26. tk_messageBox -icon error -type ok \
  27. -title [mc "An error occurred"]\
  28. -message $err
  29. }
  30. }
  31. }
  32. }