Posted to tcl by patthoyts at Wed Sep 03 20:53:48 GMT 2008view raw
- $chan(window) chat tag bind URL <Enter> [list UrlEnter %W]
- $chan(window) chat tag bind URL <Leave> [list UrlLeave %W]
- $chan(window) chat tag bind URL <Button-1> [list UrlClick %W %x %y]
- proc UrlEnter {w} {
- variable cursor:$w
- set cursor:$w [$w cget -cursor]
- $w configure -cursor hand2
- }
- proc UrlLeave {w} {
- variable cursor:$w
- if {![info exists cursor:$w]} {set cursor:$w {}}
- $w configure -cursor [set cursor:$w]
- }
- proc UrlClick {w x y} {
- set tags [$w tag names @$x,$y]
- if {[set ndx [lsearch -glob $tags URL-*]] != -1} {
- set url ""
- foreach {b e} [$w tag ranges [lindex $tags $ndx]] {
- append url [$w get $b $e]
- }
- if {[string length $url] > 0} {
- if {[catch {GotoURL $w $url} err]} {
- tk_messageBox -icon error -type ok \
- -title [mc "An error occurred"]\
- -message $err
- }
- }
- }
- }