scripts/hoverbox.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 option add *Hoverbox.background         "#ffffe1"               45
   4 option add *Hoverbox.font                       $tlc::config(smallfont) 45
   5 option add *Hoverbox.borderWidth        1                       45
   6 option add *Hoverbox.relief                     solid           45
   7
   8 class tlc::Hoverbox {
   9         inherit tlc::Module tlc::Baselog
  10
  11         constructor {args} {}
  12         destructor {}
  13
  14         itk_option define -delay delay Delay 1500
  15         itk_option define -showtime showTime ShowTime 10000
  16         itk_option define -hottime hotTime HotTime 200
  17         itk_option define -xofs xOfs XOfs 5
  18         itk_option define -yofs yOfs YOfs 13
  19
  20         public {
  21                 variable follow_mouse   1
  22
  23                 method attach {widget text}
  24                 method detach {widget}
  25                 method popup {x y text}
  26                 method popdown {}
  27         }
  28
  29         private {
  30                 variable afterid        ""
  31                 variable unshowid       ""
  32                 variable shown          0
  33                 variable lasthide
  34                 variable mouse_x
  35                 variable mouse_y
  36
  37                 method showtext {x y text}
  38                 method reset {}
  39                 method motion {x y}
  40                 method overself {}
  41                 method goto {x y}
  42         }
  43 }
  44
  45
  46 body tlc::Hoverbox::constructor {args} { #<<<1
  47         itk_component add display {
  48                 ttk::label $w.l -justify left
  49         } {
  50                 keep -textvariable -font
  51         }
  52
  53         blt::table $w \
  54                 $w.l -fill both
  55
  56         bind $w <Enter> [code $this overself]
  57         wm overrideredirect [component hull] 1
  58         itk_initialize {*}$args
  59 }
  60
  61
  62 body tlc::Hoverbox::destructor {} { #<<<1
  63         after cancel $afterid; set afterid      ""
  64         after cancel $unshowid; set unshowid    ""
  65 }
  66
  67
  68 body tlc::Hoverbox::attach {widget text} { #<<<1
  69         bind $widget <Enter> [code $this showtext %X %Y $text]
  70         bind $widget <Motion> [code $this motion %X %Y]
  71         bind $widget <Leave> [code $this popdown]
  72
  73         foreach child [winfo children $widget] {
  74                 attach $child $text
  75         }
  76 }
  77
  78
  79 body tlc::Hoverbox::detach {widget} { #<<<1
  80         bind $widget <Enter> {}
  81         bind $widget <Motion> {}
  82         bind $widget <Leave> {}
  83
  84         foreach child [winfo children $widget] {
  85                 detach $child $text
  86         }
  87 }
  88
  89
  90 body tlc::Hoverbox::showtext {x y text} { #<<<1
  91         if {$afterid != ""} return
  92
  93         set mouse_x             $x
  94         set mouse_y             $y
  95
  96         set shownow             0
  97         if {[info exists lasthide]} {
  98                 set interval    [expr {[clock clicks -milliseconds] - $lasthide}]
  99                 if {$interval < $itk_option(-hottime)} {
 100                         set shownow             1
 101                 }
 102         }
 103
 104         if {$shownow} {
 105                 popup $x $y $text
 106         } else {
 107                 set afterid     [after $itk_option(-delay) [code $this popup $x $y $text]]
 108         }
 109 }
 110
 111
 112 body tlc::Hoverbox::motion {x y} { #<<<1
 113         set mouse_x     $x
 114         set mouse_y     $y
 115
 116         if {$shown} {
 117                 if {$follow_mouse} {
 118                         goto $x $y
 119                 }
 120         } else {
 121                 reset
 122         }
 123 }
 124
 125
 126 body tlc::Hoverbox::reset {} { #<<<1
 127         if {$afterid == ""} return
 128         set handler             [lindex [after info $afterid] 0]
 129         after cancel $afterid; set afterid      ""
 130         set afterid     [after $itk_option(-delay) $handler]
 131 }
 132
 133
 134 body tlc::Hoverbox::popup {x y text} { #<<<1
 135         after cancel $afterid; set afterid      ""
 136
 137         if {[info exists mouse_x]} {set x       $mouse_x}
 138         if {[info exists mouse_y]} {set y       $mouse_y}
 139
 140         if {[string index $text 0] eq "@"} {
 141                 log debug "Interpreting text \"$text\" as an image to display"
 142                 $w.l configure -text "" -image [string range $text 1 end]
 143         } else {
 144                 log debug "Interpreting text \"$text\" as text to display"
 145                 $w.l configure -text $text -image ""
 146         }
 147         goto $x $y
 148         show
 149         set timeout             $itk_option(-showtime)
 150         if {$timeout != "" && $timeout != 0} {
 151                 set unshowid    [after $timeout [code $this popdown]]
 152         }
 153         set shown       1
 154 }
 155
 156
 157 body tlc::Hoverbox::popdown {} { #<<<1
 158         after cancel $afterid; set afterid      ""
 159         after cancel $unshowid; set unshowid    ""
 160         if {$shown} {
 161                 hide
 162                 set lasthide    [clock clicks -milliseconds]
 163                 set shown               0
 164         }
 165 }
 166
 167
 168 body tlc::Hoverbox::overself {} { #<<<1
 169         popdown
 170         if {[info exists lasthide]} {
 171                 unset lasthide          ;# prevent show / hide bounce
 172         }
 173 }
 174
 175
 176 body tlc::Hoverbox::goto {x y} { #<<<1
 177         blt::table arrange $w
 178
 179         incr x  $itk_option(-xofs)
 180         incr y  $itk_option(-yofs)
 181
 182         set screen_w [winfo screenwidth $w]
 183         set screen_h [winfo screenheight $w]
 184
 185         set wd          [winfo reqwidth $w]
 186         set ht          [winfo reqheight $w]
 187
 188         if {$x + $wd > $screen_w} {
 189                 set newx        [expr {$screen_w - $wd}]
 190         } else {
 191                 set newx        $x
 192         }
 193
 194         if {$y + $ht > $screen_h} {
 195                 set newy        [expr {$y - $itk_option(-yofs)*2 - $ht}]
 196         } else {
 197                 set newy        $y
 198         }
 199
 200         moveto $newx $newy
 201 }
 202
 203