*** /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}]
