Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 2 | mjames | 1 | ############################################################################## |
| 2 | # balloon.tcl - procedures used by balloon help |
||
| 3 | # |
||
| 4 | # Copyright (C) 1996-1997 Stewart Allen |
||
| 5 | # |
||
| 6 | # This is part of vtcl source code |
||
| 7 | # Adapted for general purpose by |
||
| 8 | # Daniel Roche <dan@lectra.com> |
||
| 9 | # version 1.1 ( Dec 02 1998 ) |
||
| 10 | # |
||
| 11 | # This program is free software; you can redistribute it and/or |
||
| 12 | # modify it under the terms of the GNU General Public License |
||
| 13 | # as published by the Free Software Foundation; either version 2 |
||
| 14 | # of the License, or (at your option) any later version. |
||
| 15 | # |
||
| 16 | # This program is distributed in the hope that it will be useful, |
||
| 17 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
||
| 18 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||
| 19 | # GNU General Public License for more details. |
||
| 20 | # |
||
| 21 | # You should have received a copy of the GNU General Public License |
||
| 22 | # along with this program; if not, write to the Free Software |
||
| 23 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
||
| 24 | |||
| 25 | ############################################################################## |
||
| 26 | # |
||
| 27 | |||
| 28 | bind Bulle <Enter> { |
||
| 29 | set Bulle(set) 0 |
||
| 30 | set Bulle(first) 1 |
||
| 31 | set Bulle(id) [after 500 {balloon %W $Bulle(%W) %X %Y}] |
||
| 32 | } |
||
| 33 | |||
| 34 | bind Bulle <Button> { |
||
| 35 | set Bulle(first) 0 |
||
| 36 | kill_balloon |
||
| 37 | } |
||
| 38 | |||
| 39 | bind Bulle <Leave> { |
||
| 40 | set Bulle(first) 0 |
||
| 41 | kill_balloon |
||
| 42 | } |
||
| 43 | |||
| 44 | bind Bulle <Motion> { |
||
| 45 | if {$Bulle(set) == 0} { |
||
| 46 | after cancel $Bulle(id) |
||
| 47 | set Bulle(id) [after 500 {balloon %W $Bulle(%W) %X %Y}] |
||
| 48 | } |
||
| 49 | } |
||
| 50 | |||
| 51 | proc set_balloon {target message} { |
||
| 52 | global Bulle |
||
| 53 | set Bulle($target) $message |
||
| 54 | bindtags $target "[bindtags $target] Bulle" |
||
| 55 | } |
||
| 56 | |||
| 57 | proc kill_balloon {} { |
||
| 58 | global Bulle |
||
| 59 | after cancel $Bulle(id) |
||
| 60 | if {[winfo exists .balloon] == 1} { |
||
| 61 | destroy .balloon |
||
| 62 | } |
||
| 63 | set Bulle(set) 0 |
||
| 64 | } |
||
| 65 | |||
| 66 | proc balloon {target message {cx 0} {cy 0} } { |
||
| 67 | global Bulle |
||
| 68 | if {$Bulle(first) == 1 } { |
||
| 69 | set Bulle(first) 2 |
||
| 70 | if { $cx == 0 && $cy == 0 } { |
||
| 71 | set x [expr [winfo rootx $target] + ([winfo width $target]/2)] |
||
| 72 | set y [expr [winfo rooty $target] + [winfo height $target] + 4] |
||
| 73 | } else { |
||
| 74 | set x [expr $cx + 4] |
||
| 75 | set y [expr $cy + 4] |
||
| 76 | } |
||
| 77 | toplevel .balloon -bg black |
||
| 78 | wm overrideredirect .balloon 1 |
||
| 79 | label .balloon.l \ |
||
| 80 | -text $message -relief flat \ |
||
| 81 | -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w |
||
| 82 | pack .balloon.l -side left -padx 1 -pady 1 |
||
| 83 | wm geometry .balloon +${x}+${y} |
||
| 84 | set Bulle(set) 1 |
||
| 85 | } |
||
| 86 | } |
||
| 87 |