/usr/share/cgnstools/balloon.tcl is in cgns-convert 3.3.0-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | array set Balloon {
set 0
first 0
id ""
}
proc set_balloon {target message} {
global Balloon
set tags [bindtags $target]
set n [lsearch $tags Balloon]
if {$message == ""} {
if {$n >= 0} {
bindtags $target [lreplace $tags $n $n]
}
} else {
if {$n < 0} {
bindtags $target "Balloon $tags"
}
}
set Balloon($target) $message
}
proc end_balloon {target} {
set_balloon $target ""
}
bind Balloon <Enter> {
set Balloon(set) 0
set Balloon(first) 1
set Balloon(id) [after 500 {Balloon:show %W $Balloon(%W) %X %Y}]
}
bind Balloon <Button> {
set Balloon(first) 0
Balloon:kill
}
bind Balloon <Leave> {
set Balloon(first) 0
Balloon:kill
}
bind Balloon <Motion> {
if {$Balloon(set) == 0} {
after cancel $Balloon(id)
set Balloon(id) [after 500 {Balloon:show %W $Balloon(%W) %X %Y}]
}
}
proc Balloon:kill {} {
global Balloon
after cancel $Balloon(id)
if {[winfo exists .balloon] == 1} {
destroy .balloon
}
set Balloon(set) 0
}
proc Balloon:show {target message {cx 0} {cy 0}} {
global Balloon
if {$Balloon(first) == 1 } {
set Balloon(first) 2
if {$cx == 0 && $cy == 0} {
set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
set y [expr [winfo rooty $target] + [winfo height $target] + 4]
} else {
set x [expr $cx + 4]
set y [expr $cy + 4]
}
toplevel .balloon -bg black
wm overrideredirect .balloon 1
label .balloon.l -text $message -relief flat \
-bg #ffffcc -fg black -padx 2 -pady 0 -anchor w
pack .balloon.l -side left -padx 1 -pady 1
wm geometry .balloon +$x+$y
set Balloon(set) 1
}
}
proc entry_balloon {target} {
global Balloon
bind $target <Enter> {
incr Balloon(first)
set xv [%W xview]
if {[string compare [focus] %W] &&
[expr [lindex $xv 1] - [lindex $xv 0] < 0.999]} {
set Balloon(id) [after 500 {Balloon:entry %W}]
}
}
bind $target <Leave> {
catch {after cancel $Balloon(id)}
if {![winfo exists .balloon]} {
set Balloon(first) 0
}
}
bind $target <Button> {
catch {after cancel $Balloon(id)}
}
}
proc Balloon:entry {target} {
global Balloon
if {$Balloon(first) == 1} {
set x [winfo rootx $target]
set y [winfo rooty $target]
toplevel .balloon -bg black
wm overrideredirect .balloon 1
label .balloon.l -text [$target get] -relief flat -bg #ffffcc -fg black \
-padx 2 -pady 0 -anchor w -font [$target cget -font]
pack .balloon.l -side left -padx 1 -pady 1
wm withdraw .balloon
update idletasks
set w [winfo reqwidth .balloon]
if {[expr $x + $w > [winfo screenwidth .balloon]]} {
set x [expr [winfo screenwidth .balloon] - $w]
}
wm geometry .balloon +$x+$y
update idletasks
wm deiconify .balloon
bind .balloon <Leave> {
set Balloon(first) 0
Balloon:kill
}
bind .balloon <Button> {Balloon:kill}
}
}
|