Posted to tcl by dburns at Tue Jan 25 00:27:25 GMT 2011view raw

  1. # BubbleHelp
  2. #
  3. # Args: <widget> [<tag>] <help-text>
  4. #
  5. # Sets up bindings so that when the mouse-cursor moves into <widget>, a bubble-help window
  6. # appears showing <help-text> after the mouse has hovered for a while.
  7. #
  8. # If <help-text> is empty, then any existing bindings are removed.
  9. #
  10. # Most of the heavy-lifting is done by the tcl procedure "BubbleHelp" bound to the widget's
  11. # event stream.
  12. #
  13. proc BindBubbleHelp { w tag htext } {
  14.  
  15. # Removing existing bindings?
  16. if { [string length $htext] == 0 } {
  17.  
  18. # Did the user pass in a tag?
  19. if { [string length $tag] == 0 } {
  20. # Nope - Just bind to the widget
  21. #
  22. # Delete the bindings
  23. bind $w <Enter> {}
  24. bind $w <Leave> {}
  25. bind $w <Motion> {}
  26. } \
  27. else {
  28. # Yes: - They passed in a tag, the widget must be a text widget
  29. #
  30. $w tag bind $tag <Enter> {}
  31. $w tag bind $tag <Leave> {}
  32. $w tag bind $tag <Motion> {}
  33. }
  34.  
  35. # That's it!
  36. return
  37. }
  38.  
  39. # Did the user pass in a tag?
  40. if { [string length $tag] == 0 } {
  41. # Nope - Just bind to the widget
  42. #
  43. # Set up the necessary bindings
  44. bind $w <Enter> { BubbleHelp ENTER %W "" "" "" }
  45. bind $w <Leave> { BubbleHelp LEAVE %W "" "" "" }
  46. bind $w <Motion> [list BubbleHelp MOTION %W %X %Y $htext]
  47. } \
  48. else {
  49. # Yes: - They passed in a tag, the widget must be a text widget
  50. #
  51. $w tag bind $tag <Enter> {BubbleHelp ENTER %W "" "" "T" }
  52. $w tag bind $tag <Leave> {BubbleHelp LEAVE %W "" "" "T" }
  53. $w tag bind $tag <Motion> [list BubbleHelp MOTION %W %X %Y $htext]
  54. }
  55.  
  56. # Initialize state to 'empty' if we haven't before
  57. global BHS_cds
  58. if { ![info exists BHS_cds(lastEntered)] } {
  59. set BHS_cds(lastEntered) ""
  60. unset -nocomplain BHS_cds(timerID)
  61. unset -nocomplain BHS_cds(floatingWW)
  62. }
  63. }
  64.  
  65.  
  66. # BubbleHelp
  67. # BubbleHelp - Handles Mouse movement events for Bubble Help
  68. # BubbleHelp
  69. #
  70. #==============================================================================
  71. #
  72. # HELPER PURPOSE:
  73. # This function handles events for movement of the mouse within the
  74. # widget selected for bubble-help support by G_BIND_BUBBLEHELP
  75. #
  76. # ARGUMENTS:
  77. # Entered from these different events (three Tk window-generated,
  78. # our internal TIMER event.
  79. #
  80. # Event type w X Y text
  81. # -------- ------------------------
  82. # <Enter> ENTER %W - - T
  83. # <Leave> LEAVE %W - - T
  84. # <Motion> MOTION %W %X %Y <text-string>
  85. # [after] TIMER %W - - -
  86. #
  87. # X and Y coordinates of the mouse in WIDGET-COORDINATES.
  88. # W is the widget. "T" is either empty, or "T" which means
  89. # the binding is for a tag in a text widget and the cursor
  90. # shape needs to be modified.
  91. #
  92. # MESSAGES ISSUED:
  93. # ----------------
  94. # None.
  95. #
  96. # OTHER THINGS TO KNOW:
  97. #
  98. # The Mx and My coordinates are relative to the bound widget.
  99. #
  100. # The effect we're supposed to achieve is the popping up of a small bubble-help
  101. # window (containing the help-text) after the mouse cursor has entered
  102. # within the bounds of the widget for a short period of time. After the bubble-help
  103. # window is popped up, it stays there for five seconds (while the cursor is in the widget)
  104. # widget, or until the cursor moves into another widget. Once the bubble-help window has been
  105. # taken down, it's supposed to stay down as long as the cursor remains within the
  106. # widget (even if it moves a bit).
  107. #
  108. # State maintained within array "BHS_cds" is made up of:
  109. #
  110. # Index Purpose
  111. # ----- -------
  112. # lastEntered String name of the last-entered widget, otherwise "" if none.
  113. # timerID If a timer has been started due to entry into "lastEntered",
  114. # the "after id" appears here, otherwise it is undefined.
  115. # floatingWW Window widget for the floating bubblehelp window.
  116. #==============================================================================
  117. proc BubbleHelp { type W X Y htext} {
  118.  
  119. global BHS_cds
  120.  
  121. # What kind of entry are we dealing with?
  122. switch $type {
  123. "ENTER" {
  124. # We use the arrival of an ENTER event merely to check to see if
  125. # we need to kill an existing bubblehelp window that was put up for
  126. # a DIFFERENT widget than the one for which the ENTER was sent.
  127. # (We depend on the arrival of a corresponding MOTION event to
  128. # actually cause the bubblehelp window to appear for this widget.)
  129.  
  130. # If the "last-entered" widget is known AND is different from "W"...
  131. if { ![string length $BHS_cds(lastEntered)] == 0 && \
  132. ![string equal $BHS_cds(lastEntered) $W] } {
  133.  
  134. # Cancel any timer for the previous widget that might be ticking
  135. if { [info exists BHS_cds(timerID)] } {
  136. after cancel $BHS_cds(timerID)
  137. unset BHS_cds(timerID)
  138. }
  139.  
  140. # Take down any bubble-help window we may have still up
  141. if { [info exists BHS_cds(floatingWW)] } {
  142. destroy $BHS_cds(floatingWW)
  143. unset BHS_cds(floatingWW)
  144. }
  145.  
  146. # Show us in an "un-ENTERed" state, even as we expect the imminent
  147. # arrival of a MOTION event within this widget.
  148. set BHS_cds(lastEntered) ""
  149. }
  150.  
  151. # If we're entering a "tagged" section of a text widget
  152. if { [string equal $htext "T"] } {
  153. # Convert the cursor back to normal
  154. $W configure -cursor arrow
  155. }
  156. }
  157. "LEAVE" {
  158. # We simply shut-down anything going on for this widget.
  159.  
  160. # If the "last-entered" widget is known AND is the SAME AS "W"...
  161. if { ![string length $BHS_cds(lastEntered)] == 0 && \
  162. [string equal $BHS_cds(lastEntered) $W] } {
  163.  
  164. # Cancel any timer for the previous widget that might be ticking
  165. if { [info exists BHS_cds(timerID)] } {
  166. after cancel $BHS_cds(timerID)
  167. unset BHS_cds(timerID)
  168. }
  169.  
  170. # Take down any bubble-help window we may have still up
  171. if { [info exists BHS_cds(floatingWW)] } {
  172. destroy $BHS_cds(floatingWW)
  173. unset BHS_cds(floatingWW)
  174. }
  175.  
  176. # Mark the fact that the cursor has passed OUT OF this particular widget
  177. set BHS_cds(lastEntered) ""
  178.  
  179. # If we're leaving a "tagged" section of a text widget
  180. if { [string equal $htext "T"] } {
  181. # Revert the cursor back to normal for a text widget
  182. $W configure -cursor xterm
  183. }
  184. }
  185. }
  186. "MOTION" {
  187. # Take care of blowing off a previous help window for which we missed the
  188. # LEAVE event...
  189. #
  190. # If the "last-entered" widget is known AND is different from "W"...
  191. if { ![string length $BHS_cds(lastEntered)] == 0 && \
  192. ![string equal $BHS_cds(lastEntered) $W] } {
  193.  
  194. # Simulate a LEAVE event
  195. BubbleHelp LEAVE $BHS_cds(lastEntered) fake fake fake
  196. }
  197.  
  198. # We want the first MOTION event for this widget to cause the bubblehelp
  199. # window to go up. If "lastEntered" is currently "", then we infer it's
  200. # the first MOTION event for this widget.
  201. if { [string length $BHS_cds(lastEntered)] == 0 } {
  202.  
  203. # Window must be created...
  204. #
  205. # Does it exist now?
  206. if { ![info exists BHS_cds(floatingWW)] } {
  207.  
  208. # Nope, create the Floating Window
  209. set BHS_cds(floatingWW) ".bubblehelp"
  210. toplevel $BHS_cds(floatingWW) -bg yellow
  211. wm overrideredirect $BHS_cds(floatingWW) 1
  212. global tcl_platform
  213. if { [string equal "windows" $tcl_platform(platform)] } {
  214. wm attributes $BHS_cds(floatingWW) -topmost 1
  215. }
  216.  
  217. # Put in the label that gets filled with the summary of the session
  218. set f [frame $BHS_cds(floatingWW).frame -bd 1 -bg black]
  219. label $f.label \
  220. -borderwidth 2 -bg yellow \
  221. -font {-*-MS Sans Serif-Medium-R-Normal-*-*-80-*-*-*-*-*-*} \
  222. -justify left -relief flat
  223. pack $f $f.label -side left
  224. }
  225.  
  226. # Update the contents of the window (and it's position)
  227. $BHS_cds(floatingWW).frame.label configure -text $htext
  228.  
  229. # Position it according to Mouse Coordinates passed and size computed
  230. set xoffset 0 ; set yoffset 32 ; set height 30
  231. set x [expr $X + $xoffset ]
  232. set y [expr $Y + $yoffset ]
  233.  
  234. # Now diddle Y if we're too near the bottom of the screen.
  235. #
  236. # If the top of the window (x,y) is closer than "height" to the screen size,
  237. # flip the window to float above the cursor rather than below.
  238. #
  239. if { $y > ( [winfo screenheight .] - $height ) } {
  240. set y [expr $y - $yoffset - $height]
  241. }
  242.  
  243. #----Bug in 8.4.4 under XP with multiple-screens, screen width is incorrect.
  244. # Likewise diddle X if we're too near the right hand side of the screen
  245. # set width [winfo reqwidth $BHS_cds(floatingWW)]
  246. # set scrnwidth [winfo screenwidth .]
  247. # if { $x+$width > $scrnwidth } {
  248. # set x [expr {$scrnwidth - $width}]
  249. # }
  250.  
  251. wm geometry $BHS_cds(floatingWW) +$x+$y
  252.  
  253. # Start a timer to make the window come down.
  254. set BHS_cds(timerID) [after 5000 BubbleHelp TIMER $W fake fake fake]
  255.  
  256. # Show us officially "entered"
  257. set BHS_cds(lastEntered) "$W"
  258. }
  259.  
  260. # If we reach here, it's another MOTION event for the current widget..
  261. # nothing to do.
  262. }
  263. "TIMER" {
  264. # The cursor has hovered for the required amount of time in the
  265. # widget. If the cursor is still in the window, "Do Our Thing".
  266.  
  267. # If the timer still lurks, dump it
  268. if { [info exists BHS_cds(timerID)] } {
  269. after cancel $BHS_cds(timerID)
  270. unset BHS_cds(timerID)
  271. }
  272.  
  273. # If the bubble window is already up... (it should be)
  274. if { [info exists BHS_cds(floatingWW)] } {
  275. # Take it down
  276. destroy $BHS_cds(floatingWW)
  277. unset BHS_cds(floatingWW)
  278. }
  279. }
  280. }
  281. }
  282.