Attachment "balloonhelp.patch" to
ticket [777061ffff]
added by
pkienzle
2003-07-25 00:00:12.
*** /home/pkienzle/packages/tcl/balloonhelp.tcl Wed Jul 23 16:59:44 2003
--- balloonhelp.tcl Thu Jul 24 11:42:00 2003
*************** package provide BalloonHelp 2.0
*** 29,39 ****
## enable OR on
## Enables balloon help for defined widgets.
##
! ## <widget> ?-index index? ?message?
## If -index is specified, then <widget> is assumed to be a menu
## and the index represents what index into the menu (either the
## numerical index or the label) to associate the balloon help
## message with. Balloon help does not appear for disabled menu items.
## If message is {}, then the balloon help for that
## widget is removed. The widget must exist prior to calling
## balloonhelp. The current balloon help message for <widget> is
--- 29,42 ----
## enable OR on
## Enables balloon help for defined widgets.
##
! ## <widget> ?-index index? ?-image image? ?-compound position? ?message?
## If -index is specified, then <widget> is assumed to be a menu
## and the index represents what index into the menu (either the
## numerical index or the label) to associate the balloon help
## message with. Balloon help does not appear for disabled menu items.
+ ## If -image is specified, then an image is used instead of text.
+ ## With Tk 8.4, both image and text can be displayed using -compound.
+ ## See the label command for a description of possible positions.
## If message is {}, then the balloon help for that
## widget is removed. The widget must exist prior to calling
## balloonhelp. The current balloon help message for <widget> is
*************** proc balloonhelp {w args} {
*** 113,133 ****
}
set b $BalloonHelp(TOPLEVEL)
if {![winfo exists $b]} {
! toplevel $b
wm overrideredirect $b 1
wm positionfrom $b program
wm withdraw $b
! pack [label $b.l -highlightthickness 0 -relief raised -bd 1 \
! -background lightyellow -fg black]
}
if {[info exists BalloonHelp($i)]} { return $BalloonHelp($i) }
}
}
}
-
;proc register {w args} {
variable BalloonHelp
set key [lindex $args 0]
while {[string match -* $key]} {
switch -- $key {
-index {
--- 116,142 ----
}
set b $BalloonHelp(TOPLEVEL)
if {![winfo exists $b]} {
! toplevel $b -class BalloonHelp
wm overrideredirect $b 1
wm positionfrom $b program
wm withdraw $b
! option add *BalloonHelp.info*wrapLength 3i widgetDefault
! option add *BalloonHelp.info*justify left widgetDefault
! option add *BalloonHelp.info*highlightThickness 0 widgetDefault
! option add *BalloonHelp.info*relief raised widgetDefault
! option add *BalloonHelp.info*borderWidth 1 widgetDefault
! option add *BalloonHelp.info*background lightyellow widgetDefault
! option add *BalloonHelp.info*foreground black widgetDefault
! pack [label $b.info]
}
if {[info exists BalloonHelp($i)]} { return $BalloonHelp($i) }
}
}
}
;proc register {w args} {
variable BalloonHelp
set key [lindex $args 0]
+ set cmd {}
while {[string match -* $key]} {
switch -- $key {
-index {
*************** proc balloonhelp {w args} {
*** 136,165 ****
menu, which is required for the -index switch"
}
set index [lindex $args 1]
! set args [lreplace $args 0 1]
}
default {
return -code error "unknown option \"$key\": should be -index"
}
}
set key [lindex $args 0]
}
! if {[llength $args] != 1} {
return -code error "wrong \# args: should be \"balloonhelp widget\
?-index index? message\""
}
! if {[string match {} $key]} {
clear $w
} else {
if {![winfo exists $w]} {
return -code error "bad window path name \"$w\""
}
if {[info exists index]} {
! set BalloonHelp($w,$index) $key
#bindtags $w [linsert [bindtags $w] end BalloonsMenu]
return $w,$index
} else {
! set BalloonHelp($w) $key
bindtags $w [linsert [bindtags $w] end Balloons]
return $w
}
--- 145,183 ----
menu, which is required for the -index switch"
}
set index [lindex $args 1]
! }
! -image -
! -compound -
! -bitmap {
! lappend cmd $key [lindex $args 1]
}
default {
return -code error "unknown option \"$key\": should be -index"
}
}
+ set args [lreplace $args 0 1]
set key [lindex $args 0]
}
! if {[llength $args] > 1} {
return -code error "wrong \# args: should be \"balloonhelp widget\
?-index index? message\""
}
! if {[string match {} $key] && [string match {} $cmd]} {
clear $w
} else {
+ if {[string match {} $cmd]} {
+ lappend cmd -image {}
+ }
+ lappend cmd -text $key
if {![winfo exists $w]} {
return -code error "bad window path name \"$w\""
}
if {[info exists index]} {
! set BalloonHelp($w,$index) $cmd
#bindtags $w [linsert [bindtags $w] end BalloonsMenu]
return $w,$index
} else {
! set BalloonHelp($w) $cmd
bindtags $w [linsert [bindtags $w] end Balloons]
return $w
}
*************** proc balloonhelp {w args} {
*** 190,196 ****
variable BalloonHelp
global tcl_platform
set b $BalloonHelp(TOPLEVEL)
! $b.l configure -text $msg
update idletasks
if {[string compare {} $i]} {
set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[$w yposition $i]+25}]
--- 208,214 ----
variable BalloonHelp
global tcl_platform
set b $BalloonHelp(TOPLEVEL)
! eval $b.info configure $msg
update idletasks
if {[string compare {} $i]} {
set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[$w yposition $i]+25}]
