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
  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                 label $w.l -borderwidth 0 -relief flat -justify left
  49         } {
  50                 usual
  51                 keep -background -textvariable -font
  52         }
  53
  54         blt::table $w \
  55                 $w.l -fill both
  56
  57         bind $w <Enter> [code $this overself]
  58         wm overrideredirect $w 1
  59         eval itk_initialize $args
  60 }
  61
  62
  63 body tlc::Hoverbox::destructor {} { #<<<1
  64         after cancel $afterid; set afterid      ""
  65         after cancel $unshowid; set unshowid    ""
  66 }
  67
  68
  69 body tlc::Hoverbox::attach {widget text} { #<<<1
  70         bind $widget <Enter> [code $this showtext %X %Y $text]
  71         bind $widget <Motion> [code $this motion %X %Y]
  72         bind $widget <Leave> [code $this popdown]
  73
  74         foreach child [winfo children $widget] {
  75                 attach $child $text
  76         }
  77 }
  78
  79
  80 body tlc::Hoverbox::detach {widget} { #<<<1
  81         bind $widget <Enter> {}
  82         bind $widget <Motion> {}
  83         bind $widget <Leave> {}
  84
  85         foreach child [winfo children $widget] {
  86                 detach $child $text
  87         }
  88 }
  89
  90
  91 body tlc::Hoverbox::showtext {x y text} { #<<<1
  92         if {$afterid != ""} return
  93
  94         set mouse_x             $x
  95         set mouse_y             $y
  96
  97         set shownow             0
  98         if {[info exists lasthide]} {
  99                 set interval    [expr {[clock clicks -milliseconds] - $lasthide}]
 100                 if {$interval < $itk_option(-hottime)} {
 101                         set shownow             1
 102                 }
 103         }
 104
 105         if {$shownow} {
 106                         popup $x $y $text
 107         } else {
 108                 set afterid     [after $itk_option(-delay) [code $this popup $x $y $text]]
 109         }
 110 }
 111
 112
 113 body tlc::Hoverbox::motion {x y} { #<<<1
 114         set mouse_x     $x
 115         set mouse_y     $y
 116
 117         if {$shown} {
 118                 if {$follow_mouse} {
 119                         goto $x $y
 120                 }
 121         } else {
 122                 reset
 123         }
 124 }
 125
 126
 127 body tlc::Hoverbox::reset {} { #<<<1
 128         if {$afterid == ""} return
 129         set handler             [lindex [after info $afterid] 0]
 130         after cancel $afterid; set afterid      ""
 131         set afterid     [after $itk_option(-delay) $handler]
 132 }
 133
 134
 135 body tlc::Hoverbox::popup {x y text} { #<<<1
 136         after cancel $afterid; set afterid      ""
 137
 138         if {[info exists mouse_x]} {set x       $mouse_x}
 139         if {[info exists mouse_y]} {set y       $mouse_y}
 140
 141         $w.l configure -text $text
 142         goto $x $y
 143         show
 144         set timeout             $itk_option(-showtime)
 145         if {$timeout != "" && $timeout != 0} {
 146                 set unshowid    [after $timeout [code $this popdown]]
 147         }
 148         set shown       1
 149 }
 150
 151
 152 body tlc::Hoverbox::popdown {} { #<<<1
 153         after cancel $afterid; set afterid      ""
 154         after cancel $unshowid; set unshowid    ""
 155         if {$shown} {
 156                 hide
 157                 set lasthide    [clock clicks -milliseconds]
 158                 set shown               0
 159         }
 160 }
 161
 162
 163 body tlc::Hoverbox::overself {} { #<<<1
 164         popdown
 165         if {[info exists lasthide]} {
 166                 unset lasthide          ;# prevent show / hide bounce
 167         }
 168 }
 169
 170
 171 body tlc::Hoverbox::goto {x y} { #<<<1
 172         blt::table arrange $w
 173
 174         incr x  $itk_option(-xofs)
 175         incr y  $itk_option(-yofs)
 176
 177         set screen_w [winfo screenwidth $w]
 178         set screen_h [winfo screenheight $w]
 179
 180         set wd          [winfo reqwidth $w]
 181         set ht          [winfo reqheight $w]
 182
 183         if {$x + $wd > $screen_w} {
 184                 set newx        [expr {$screen_w - $wd}]
 185         } else {
 186                 set newx        $x
 187         }
 188
 189         if {$y + $ht > $screen_h} {
 190                 set newy        [expr {$y - $itk_option(-yofs)*2 - $ht}]
 191         } else {
 192                 set newy        $y
 193         }
 194
 195         moveto $newx $newy
 196 }
 197
 198