README.md

It's a Tcl/Tk tip widget inspired by:

https://wiki.tcl-lang.org/page/Tklib+tooltip

https://wiki.tcl-lang.org/page/balloon+help

The original code has been modified to make the tip:

be faded/destroyed after an interval defined by a caller

be enabled/disabled for all or specific widgets

be disabled for a while ("sleep")

be usable with labels, menus, text/canvas tags, notebook tabs, listbox/treeview items etc.

be displayed at the screen's edges

be displayed under the host widget

be displayed with a shift (on X and Y) relative to the mouse pointer

be displayed as a stand-alone balloon message at given coordinates

be displayed with given font, colors, paddings, border, relief, opacity, bell

have -image and -compound options to display images

have -command option to be displayed in a status bar instead of a balloon

have -command option to be changed dynamically, with each tip's exposition

have -maxexp option to limit the number of tip's expositions

have configure/cget etc. wrapped in Tcl ensemble for convenience

The video introduction to baltip is presented by baltip-1.3.1.mp4 (17 Mb).

Below are several pictures just to glance at baltip.

Under the mouse pointer. By default, the tips are displayed just under the mouse pointer.

Under the widget. This button's tip is configured to be just under the button. As well as the text's tip. This feature is well fit for widgets positioned in a row (e.g. in toolbar, tabbar etc.).

Tips of text tags. The text tags can have their own tips.

The tags of canvas have tips too.

Tips of menu items. The menu items can have their own tips. The popup menus may be tear-off at that.

The menu tips are useful e.g. when the items are displayed as short names, while the tips are wanted to be full names.

Label of danger. The labels are also tipped. This one is configured to be an alert shown "eternally" (i.e. till hovering over it).

The tabs of notebook are also supplied with tips.

The listbox can have tips per item as well as for a whole listbox widget.

The ttk::treeview can have tips per item and/or column as well as for a whole treeview widget.

The -command option allows to display tips in a status bar instead of a balloon.

Configurable tips. The tip configuration can be global or local (for a specific tip).

The configuring can include: font, colors, paddings, border, relief, exposition time, opacity, image (with -compound option), bell.

Balloon. The balloon messages aren't related to any widgets. This one is configurated to appear at the top right corner, disappearing after a while.

Usage

The baltip usage is rather straightforward. Firstly we need package require:

lappend auto_path "dir_of_baltip"
package require baltip

Then we set tips with ::baltip::tip command for each appropriate widget:

::baltip::tip widgetpath text ?-option value?
# or this way:
::baltip tip widgetpath text ?-option value?

For example, having a button .win.but1, we can set its tip this way:

::baltip tip .win.but1 "It's a tip.\n2nd line of it.\n3rd."

To get all or specific settings of baltip:

::baltip::cget ?-option?
# or this way:
::baltip cget ?-option?

To get a specific widget's tip option:

::baltip::cget widgetpath -option
# or this way:
::baltip cget widgetpath -option

To set some options:

::baltip::configure -option value ?-option value?
# or this way:
::baltip config -option value ?-option value?

To set a specific widget's tip option:

::baltip::configure widgetpath -option value ?-option value?
# or this way:
::baltip config widgetpath -option value ?-option value?

Note: the options set with configure command are global, i.e. active for all tips. The options set with tip command are local, i.e. active for the specific tip.

To disable all tips:

::baltip::configure -on false

To disable some specific tip:

::baltip::tip widgetpath ""
# or this way:
::baltip::tip widgetpath "old tip" -on false

To hide some specific (suspended) tip forcedly:

::baltip::hide widgetpath

To update a tip's text and options:

::baltip::update widgetpath text ?options?

To show a tip for a widget that has no "normal" tip, still needs a tip (e.g. on clicking):

::baltip::showTip path text ?options?

By default, ::baltip::showTip displays the tip under the mouse pointer. At that it regards -geometry option and ignores -under, -shiftX, -shiftY options.

When you click on a widget with its tip being displayed, the tip is hidden. It is the default behavior of baltip, but sometimes you need to re-display the hidden tip. If the widget is a button, you can include the following command in -command of the button:

::baltip::repaint widgetpath

Some special tips

The "text" for listbox can contain %i wildcard - and in such cases the text means a callback receiving a current index of item to tip:

proc ::lbxTip {idx} {
  set item [lindex $::lbxlist $idx]
  return "Tip for \"$item\"\nindex=$idx"
}
::baltip tip .listbox {::lbxTip %i}

The "text" for ttk::treeview can contain %i and/or %c wildcards - and in such cases the text means a callback receiving ID of item and/or column of item to tip:

proc ::treTip {id c} {
  set item [.treeview item $id -text]
  return "Tip for \"$item\"\nID=$id, column=$c"
}
::baltip::tip .treeview {::treTip %i %c}

If a tip for listbox and treeview widgets doesn't contain %i nor %c, it means a usual tip for a whole widget. At that, if those wildcards still need to be displayed, use %%i and %%c instead.

If you need to switch between "per item" and "per widget" tip of listbox and treeview , use ::baltip::tip with -reset yes option:

::baltip::tip .treeview {Common tip} -reset yes      ;# sets a usual tip
::baltip::tip .treeview {::treTip %i %c} -reset yes  ;# sets a callback

Some GUI objects (notebook tabs, listbox items, treeview items) have not <Enter> nor <Leave> event bindings, so that those bindings are imitated by baltip. Hence a problem with popup menus: when you right-click those GUI objects, baltip::tip and tk_popup might both fire, which results in a mess.

To avoid this, use ::baltip::sleep before tk_popup, for example:

::baltip::sleep 1000        ;# disables tips for 1000 milliseconds
tk_popup $popupmenu $X $Y   ;# calls a popup menu at $X $Y coordinates

As for tablelist widget, I would like to cite an advice by Csaba Nemethi :

The support for tablelist is a special case, don't waste your time with
it.  I have already tested that the built-in tooltip support of
Tablelist will work just fine when replacing tklib's tooltip package
with baltip (after fixing the reported bugs), and I intend to extend the
description of the -tooltipaddcommand option by hints showing how to use
this option with baltip instead of BWidget and tklib's tooltip.

Balloon

The normal tip has no -geometry option because it's calculated by baltip, to position the tip under its host widget.

By means of -geometry option you get a balloon message unrelated to any visible widget: it's parented by the toplevel window. The -geometry option has +X+Y form where X and Y are coordinates of the balloon.

For example:

::baltip::tip .win "It's a balloon at +1+100 (+X+Y) coordinates" \
  -geometry +1+100 -font {-weight bold -size 12} \
  -alpha 0.8 -fg white -bg black -per10 3000 -pause 1500 -fade 1500

The -pause and -fade options make the balloon fade at appearing and disappearing.

The -per10 option means "milliseconds per 10 characters", so it defines the balloon's duration: the more the longer.

The -per10 option is weird a little: while it is active (i.e. while baltip's clock is counting down according to -per10), other tips are locked. So, -per10 10000000 is a bad idea for balloons, use -eternal 1 instead. If -eternal 1 option is set, -per10 1 is set by force to unlock other tips immediately.

The -geometry value can include W and H wildcards meaning the width and the height of the balloon. This may be useful when you need to show a balloon at a window's edge and should use the balloon's dimensions which are available only after its creation. The X and Y coordinates are calculated by baltip as normal expressions. Of course, they should not include the "+" divider, but this restriction (if any) is easily overcome.

For example:

lassign [split [winfo geometry .win] x+] w h x y
set geom "+([expr {$w+$x}]-W-4)+$y"
set text "The balloon at the right edge of the window"
::baltip tip .win $text -geometry $geom -pause 2000 -fade 2000

To show a balloon under the mouse pointer, e.g. on clicking, timeout, processing etc., the following call is used:

::baltip::showBalloon text ?options?

By default, ::baltip::showBalloon displays the balloon under the mouse pointer. At that it regards -geometry option and ignores -under, -shiftX, -shiftY options.

Command

The -command option allows to display tips in other places, for example in a status bar. At that, the command can include %t and %w wildcards, meaning "text" and "widget path". Such tips are well fit for menu items, as seen in test.tcl.

The command of this option must return {}, if no tips should be displayed.

Also, it can return a new tip to display as a usual balloon tip, which fits for "dynamic tips" that are changed at each exposition of a tip.

For example:

proc ::Status {tip} {
  .labelstatus configure -text $tip
  return {}  ;# no redefining the tip
}
::baltip::tip .menu "File actions" -index 0 -command {::Status %t}
::baltip::tip .menu "Help, hints, Q&A, about etc." -index 1 -command {::Status %t}

Also, this option can be used if you need to fire some code when the mouse pointer enters or leaves a GUI object.

Note: the baltip is available for a few of GUI objects that have not <Enter> nor <Leave> bindings.

The only line

baltip::tip $w $tip -command $command

might save you other lines to fire the command at entering/leaving a GUI object. E.g. the command might highlight a GUI object entered, save its ID and unhighlight the object at leaving it.

For example:

proc ::SomeProc {tip} {
  lassign [split $tip] obj ID column
  if {[info exists ::OBJsaved]} {
    puts "$::OBJsaved object ID=[set ::IDsaved] is left... unhighlighted..."
    unset ::OBJsaved
  }
  if {$obj eq {}} return
  set ::OBJsaved $obj
  set ::IDsaved $ID
  puts "Now processing $obj object with ID=$ID column=$column"
  return {}  ;# means the proc executed and no tip needed
}
::baltip::tip .listbox {Listbox %i} -command {::SomeProc {%t}}
::baltip::tip .treeview {Treeview %i %c} -command {::SomeProc {%t}}

Options

Below are listed the baltip options that are set with tip and configure and got with cget:

-on - switches all tips on/off;

-per10 - a time of exposition per 10 characters (in millisec.);

-fade - a time of fading (in millisec.);

-pause - a pause before displaying tips (in millisec.);

-alpha - an opacity (from 0.0 to 1.0);

-fg - foreground of tip;

-bg - background of tip;

-bd - borderwidth of tip;

-font - font attributes;

-padx - X padding for text;

-pady - Y padding for text;

-padding - padding for pack;

-under - if >= 0, sets the tip under the widget, else under the pointer;

-shiftX - a horizontal shift relative to the mouse pointer

-shiftY - a vertical shift relative to the mouse pointer

-image - image option;

-compound - compound option;

-relief - relief option;

-bell - if true, rings at displaying;

-eternal - if true, makes a tip "eternal", i.e. visible till clicking.

The following options are special:

-global - if true, applies the settings to all registered tips;

-force - if true, forces the display by 'tip' command;

-index - index of menu item to tip;

-tag - name of text tag to tip;

-ctag - name of canvas tag to tip;

-nbktab - path to ttk::notebook tab to tip;

-geometry - geometry (+X+Y) of the balloon;

-reset - "-reset true" may be useful to set a new tip (callback or text) for listbox and treeview;

-command - a command to be executed, with %t (tip's text) and %w (widget's path) wildcards;

-maxexp - maximum number of tip's expositions.

-focus - path to widget to set focus on, after showing a tip

If -global yes option is used alone, it applies all global options to all registered tips. If -global yes option is used along with other options, only those options are applied to all registered tips.

Of course, all global options will be applied to all tips to be created after ::baltip configuration. For example:

::baltip config -global yes  ;# applies all global options to all registered and to-be-created tips
::baltip config -global yes -per10 2000  ;# applies `-per10` to all registered and to-be-created tips

The -index option may have numeric (0, 1, 2...) or symbolic form (active, end, none) to indicate a menu entry, e.g. in -command option. For example:

::baltip repaint .win.popupMenu -index active
::baltip::tip .menu "File actions" -index 0

There may be useful to define options in text argument of ::baltip::tip.

For this, provide the text argument as a list of pairs of uppercased options' name / value including -BALTIP option for tip. For example:

::baltip tip .text "-BALTIP {Sort of diary, todos etc.} -MAXEXP 1"

As seen in the above examples, baltip can be used as Tcl ensemble, so that the commands may be shortened.

See more examples in test.tcl of baltip.zip.

Also, you can test baltip with test2_pave.tcl of apave package.

Acknowledgements

The baltip package has been developed with help of these kind people:

Nicolas Bats prompted to add canvas tags' tips, baltip::show procedure and tested baltip in MacOS

Csaba Nemethi sent several bug fixes and advices, especially on listbox, treeview and menu tips

Links

Source at chiselapp (baltip.zip)

Source at github

Reference

Demo of baltip v1.3.1

baltip.tcl

###########################################################
# Name:    baltip.tcl
# Author:  Alex Plotnikov  (aplsimple@gmail.com)
# Date:    12/01/2021
# Brief:   Handles Tcl/Tk tip widget.
# License: MIT.
###########################################################

package provide baltip 1.6.2

# ________________________ Variables _________________________ #

namespace eval ::baltip {

  namespace export configure cget tip update hide repaint \
    optionlist tippath clear sleep showBalloon showTip
  namespace ensemble create

  namespace eval my {
    variable ttdata; array set ttdata [list]
    set ttdata(on) yes
    set ttdata(per10) 1600
    set ttdata(fade) 300
    set ttdata(pause) 1000
    set ttdata(fg) black
    set ttdata(bg) #FBFB95
    set ttdata(bd) 1
    set ttdata(padx) 4
    set ttdata(pady) 3
    set ttdata(padding) 0
    set ttdata(alpha) 1.0
    set ttdata(bell) no
    set ttdata(font) [font actual TkTooltipFont]
    set ttdata(under) -16
    set ttdata(image) {}
    set ttdata(compound) {}
    set ttdata(relief) {}
    set ttdata(shiftX) {}
    set ttdata(shiftY) {}
    set ttdata(ontop) no
    set ttdata(balloon) -
  }
}

# _________________________ UI ______________________ #

proc ::baltip::configure {args} {
  # Configurates the tip for all widgets or for a widget.
  #   args - options ("name value" pairs)
  # If *args* begins with a widget path, then
  # args is "w -opt val ?-opt val?", so the widget tip options are set.
  # Returns the list of special options' values or a widget's tip options.

  variable my::ttdata
  set w [lindex $args 0]
  if {[winfo exists $w]} {
    # configure a widget's tip
    return [tip $w -BALTIPSET {*}[lrange $args 1 end]]
  }
  set force no
  set index -1
  lassign {} geometry tag ctag nbktab reset command maxexp focus
  set global [expr {[dict exists $args -global] && [dict get $args -global]}]
  foreach {n v} $args {
    set n1 [string range $n 1 end]
    switch -glob -- $n {
      -SPECTIP* -
      -per10 - -fade - -pause - -fg - -bg - -bd - -alpha - -text - -relief - \
      -on - -padx - -pady - -padding - -bell - -under - -font - -image - -compound - \
      -shiftX - -shiftY - -ontop - -eternal {
        set my::ttdata($n1) $v
      }
      -force - -geometry - -index - -tag - -global - -ctag - -nbktab - -reset - \
      -command - -maxexp - -focus {
        set $n1 $v
      }
      default {return -code error "baltip: invalid option \"$n\""}
    }
    if {$global && ($n ne {-global} || [llength $args]==2)} {
      foreach k [array names my::ttdata -glob on,*] {
        set w [lindex [split $k ,] 1]
        set my::ttdata($n1,$w) $v
      }
    }
  }
  return [list \
    $force $geometry $index $tag $ctag $nbktab $reset $command $maxexp $focus]
}
#_______________________

proc ::baltip::cget {args} {
  # Gets global option values or a widget's option value.
  #   args - option names (if empty, returns all options)
  # If *args* begins with a widget path, then args is "w -option",
  # so the widget tip option's value is returned (e.g. for -text option).
  # Returns a list of "name value" pairs or an option value of a widget's tip.

  variable my::ttdata
  if {![llength $args]} {
    lappend args {*}[optionlist]
  }
  set w [lindex $args 0]
  if {[winfo exists $w]} {
    set dic [tip $w -BALTIPGET]
    if {[set opt [lindex $args 1]] ne {}} {
      if {[dict exists $dic $opt]} {
        return [dict get $dic $opt]
      }
      return {}
    }
    return $dic
  }
  set res [list]
  foreach n $args {
    set n [string range $n 1 end]
    if {[info exists my::ttdata($n)]} {
      lappend res -$n $my::ttdata($n)
    }
  }
  return $res
}
#_______________________

proc ::baltip::optionlist {} {
  # All options of baltip.

  return [list -on -per10 -fade -pause -fg -bg -bd -padx -pady -padding -font \
    -alpha -text -index -tag -bell -under -image -compound -relief -ctag \
    -nbktab -reset -command -maxexp -focus -shiftX -shiftY -ontop -eternal]
}
#_______________________

proc ::baltip::tippath {w} {
  # Gets a tip window's path.
  #   w - widget's path

  return [string trimright $w .].w__BALTIP
}
#_______________________

proc ::baltip::tip {w {text "-BALTIPGET"} args} {
  # Creates a tip for a widget.
  #   w - the parent widget's path
  #   text - the tip text
  #   args - options ("name value" pairs)
  # If *text* is equal to "-BALTIPGET", returns options of widget's tip
  # If *text* is equal to "-BALTIPSET", sets options of widget's tip

  variable my::ttdata
  array unset my::ttdata winGEO*
  if {[winfo exists $w] || $w eq {}} {
    if {$text in {-BALTIPGET -BALTIPSET}} {
      # "-BALTIPGET" is the same as "-BALTIPSET", just supposed not to include args
      if {![info exists my::ttdata(optvals,$w)]} {
        if {$text eq {-BALTIPGET}} {return {}}
        set my::ttdata(optvals,$w) [dict create]
      }
      set my::ttdata(optvals,$w) [dict replace $my::ttdata(optvals,$w) {*}$args]
      if {$text eq {-BALTIPGET}} {
        return $my::ttdata(optvals,$w)
      }
      if {[catch {set text [dict get $my::ttdata(optvals,$w) -text]}]} {
        return {}
      }
    }
    set arrsaved [array get my::ttdata]
    set optvals [::baltip::my::CGet {*}$args]
    # block of related lines for special options
    set specopt {forced geo index ttag ctag nbktab reset command maxexp focus}
    lassign $optvals {*}$specopt
    set optArgs [lrange $optvals [llength $specopt] end] ;# get rid of spec.options
    if {[catch {set optvals $my::ttdata(optvals,$w)}]} {
      set optvals $optArgs
    }
    # end of block
    set my::ttdata(global,$w) no
    # no redefining a command once set
    if {[info exists ttdata(command,$w)] && [string is false $reset]} {
      set command $my::ttdata(command,$w)
    } else {
      set my::ttdata(command,$w) $command
    }
    if {$command ne {}} {::baltip::update $w $text}
    if {![info exists my::ttdata(maxexp,$w)]} {
      set my::ttdata(maxexp,$w) $maxexp
    }
    if {[winfo exists $focus]} {
      set my::ttdata(focus,$w) $focus
    }
    set text [my::OptionsFromText $w $text]  ;# may reset -command and -maxexp
    set ontags [string length $nbktab$ctag$ttag]
    set onopt [expr {[string length $text] && $my::ttdata(on) || $ontags}]
    set optArgs [dict replace $optArgs -text $text]
    set optvals [dict replace $optvals -text $text]
    set et 0
    catch {set et [dict get $args -eternal]}
    if {[set my::ttdata(eternal,$w) $et]} {lappend optvals -per10 1}
    set my::ttdata(optvals,$w) $optvals
    set my::ttdata(on,$w) $onopt
    if {$text ne {} || $ontags} {
      if {$forced || $geo ne {}} {::baltip::my::Show $w $text yes $geo $optvals}
      if {$geo ne {}} {
        # balloon popup message
        array set my::ttdata $arrsaved
        set my::ttdata(balloon) $w
      } else {
        set widgetclass [winfo class $w]
        set tags [bindtags $w]
        if {[lsearch -exact $tags "Tooltip$w"] == -1} {
          bindtags $w [linsert $tags end "Tooltip$w"]
        }
        bind Tooltip$w <Any-Leave>    "::baltip::hide $w"
        bind Tooltip$w <Any-KeyPress> "::baltip::hide $w"
        bind Tooltip$w <Any-Button>   "::baltip::hide $w"
        if {$index>-1} {
          # tip for menu items
          set my::ttdata(LASTMITEM) {}
          set wt [my::Clonename $w]
          foreach w2 [list $w $wt] {
            set my::ttdata(on,$w2) $onopt
            set my::ttdata($w2,$index) $optArgs
            set my::ttdata(command,$w2) $command
            set my::ttdata(global,$w2) no
          }
          my::BindToEvent Menu <<MenuSelect>> ::baltip::my::MenuTip %W
        } elseif {$ttag ne {}} {
          # tip for text tags
          set my::ttdata($w,$ttag) $text
          my::BindTextagToEvent $w $ttag <Enter> ::baltip::my::TagTip $w $ttag $optArgs
          foreach event {Leave KeyPress Button} {
            my::BindTextagToEvent $w $ttag <$event> ::baltip::my::TagTip $w
          }
        } elseif {$ctag ne {}} {
          # tip for canvas tags
          set my::ttdata($w,$ctag) $text
          my::BindCantagToEvent $w $ctag <Enter> ::baltip::my::TagTip $w $ctag $optArgs
          my::BindCantagToEvent $w $ctag <Leave> ::baltip::my::TagTip $w
        } elseif {$nbktab ne {}} {
          # tip for notebook tabs
          configure -SPECTIP$nbktab $text
          bind Tooltip$w <Button-1> "::baltip::my::NbkInfo $w %x %y -"
          bind Tooltip$w <Motion> "::baltip::my::PrepareNbkTip $w %x %y"
        } elseif {$widgetclass eq {Listbox}} {
          # tip for listbox items
          if {[cget -SPECTIP$w] eq {} || [string is true -strict $reset]} {
            configure -SPECTIP$w $text
          }
          bind Tooltip$w <Any-Leave> \
            "::baltip hide $w; ::baltip configure -SPECTIPid$w {}"
          bind Tooltip$w <Motion> "::baltip::my::PrepareLbxTip $w %x %y"
        } elseif {$widgetclass eq {Treeview}} {
          # tip for treeview items
          if {[cget -SPECTIP$w] eq {} || [string is true -strict $reset]} {
            configure -SPECTIP$w $text
          }
          bind Tooltip$w <Any-Leave> \
            "::baltip hide $w; ::baltip configure -SPECTIPid$w {}"
          bind Tooltip$w <Motion> "::baltip::my::PrepareTreTip $w %x %y"
        } else {
          bind Tooltip$w <Enter> [list ::baltip::my::Show %W $text no $geo $optvals]
        }
      }
    }
  }
  return {}
}
#_______________________

proc ::baltip::update {w text args} {
  # Updates tip's text and settings.
  #  w - widget's path
  #  text - tip's text
  #  args - tip's settings

  variable my::ttdata
  set my::ttdata(text,$w) $text
  foreach {k v} $args {set my::ttdata([string range $k 1 end],$w) $v}
}
#_______________________

proc ::baltip::repaint {w args} {
  # Repaints a tip immediately.
  #   w - widget's path
  #  args - options (incl. -index/-tag)

  variable my::ttdata
  if {[winfo exists $w] && [info exists my::ttdata(optvals,$w)] && \
  [dict exists $my::ttdata(optvals,$w) -text]} {
    set optvals $my::ttdata(optvals,$w)
    lappend optvals {*}$args
    catch {after cancel $my::ttdata(after)}
    set win [tippath $w] ;# the tip's window
    if {[info exists my::ttdata(winGEO,$win)]} {
      set geo $my::ttdata(winGEO,$win)
    } else {
      set geo {}
    }
    set my::ttdata(after) [after idle [list ::baltip::my::Show $w \
      [dict get $my::ttdata(optvals,$w) -text] yes $geo $optvals]]
  }
}
#_______________________

proc ::baltip::hide {{w ""} {doit no}} {
  # Destroys the tip's window.
  #   w - widget's path
  #   doit - yes, if do hide by force
  # Returns 1, if the window was really hidden.

  variable my::ttdata
  my::Command $w {}
  set res 1
  if {(![my::Eternal $w] && $my::ttdata(balloon) ne $w) || $doit} {
    set res [expr {![catch {destroy [tippath $w]}]}]
    if {$w eq $my::ttdata(balloon)} {set my::ttdata(balloon) -}
  }
  return $res
}
#_______________________

proc ::baltip::clear {w args} {
  # Removes tip bindings for a widget.
  #   w - widget's path

  variable my::ttdata
  catch {unset my::ttdata(optvals,$w)}
  catch {hide $w}
  foreach ev {Any-Leave Any-KeyPress Any-Button Motion Any-Enter Leave Enter} {
    catch {bind Tooltip$w <$ev> {}}
  }
}
#_______________________

proc ::baltip::sleep {msec} {
  # Disables tips for a while.
  #   msec - time to sleep, in msec
  # This is useful esp. before calling a popup menu on listbox/treeview.

  configure -on no
  after $msec "::baltip::configure -on yes"
}
#_______________________

proc ::baltip::showBalloon {tip args} {
  # Shows a balloon under the pointer or according to -geometry option.
  #   tip - text of tip
  #   args - miscellaneous options of baltip
  # Can be used to show tips on clicking, timeout, processing etc.
  # If there is -geometry in args, shows the balloon
  # with this geometry and a minimal pause.

  variable my::ttdata
  set w .
  if {[set isgeo [dict exists $args -geometry]]} {
    lappend args -pause 10
  } else {
    lassign [winfo pointerxy $w] x y
    lappend args -geometry \
      +[expr {$x-int($my::ttdata(under)/2)}]+[expr {$y-$my::ttdata(under)}]
  }
  tip $w $tip -pause 100 -fade 100 {*}$args
  if {$isgeo} {
    after 20
    ::update
  }
}
#_______________________

proc ::baltip::showTip {w tip args} {
  # Shows a tip under the pointer, for a specific widget.
  #   tip - text of tip
  #   args - miscellaneous options of baltip
  # Can be used to show tips on clicking the widget
  # that has no "normal" tips on hovering it.

  my::BindToEvent $w <Leave> ::baltip hide .
  showBalloon $tip {*}$args
}

# _____________________ Internals ____________________ #

proc ::baltip::my::CGet {args} {
  # Gets options' values, using local (args) and global (ttdata) settings.
  #   args - local settings ("name value" pairs)
  # Returns the full list of settings ("name value" pairs, "name" without "-") \
   in which special options go first.
  # See also: cget, configure

  variable ttdata
  set saved [array get ttdata]
  set res [::baltip::configure {*}$args]
  lappend res {*}[::baltip::cget]
  array set ttdata $saved
  return $res
}
#_______________________

proc ::baltip::my::WidCoord {w} {
  # Gets widget's coordinate data.
  #   w - path to the widget
  # Returns a list of:
  #   x - X coordinate
  #   y - Y coordinate
  #   inside - flag "mouse pointer is inside the widget"

  set x [expr {[winfo pointerx $w]-[winfo rootx $w]}]
  set y [expr {[winfo pointery $w]-[winfo rooty $w]}]
  lassign [split [winfo geometry $w] x+] width height
  set inside [expr {$x>-1 && $x<$width && $y>-1 && $y<$height}]
  return [list $x $y $inside]
}
#_______________________

proc ::baltip::my::Clonename {mnu} {
  # Gets a clone name of a menu.
  #   mnu - the menu's path
  # This procedure is borrowed from BWidget's utils.tcl.

  set path [set menupath {}]
  set found 0
  foreach widget [lrange [split $mnu .] 1 end] {
    if {$found || [winfo class "$path.$widget"] eq {Menu}} {
      set found 1
      append menupath # $widget
      append path . $menupath
    } else {
      append menupath # $widget
      append path . $widget
    }
  }
  return $path
}
#_______________________

proc ::baltip::my::OptionsFromText {w txt} {
  # Extracts options from "text" argument of baltip::tip.
  #   w - widget's path
  #   txt - "-text" option's value
  # Options can be set in the "text" argument as uppercased-name / value pairs:
  #   "-BALTIP {True tip's text} -MAXEXP 1 -COMMAND {::mycom %i %c}"
  # In this case, *txt* must be a correct list of name/value sequences.
  # Returns an original *txt* or a value of -BALTIP option from *txt*.

  variable ttdata
  if {[string first {-BALTIP } $txt] >-1 && \
  !([catch {set lst [list {*}$txt]}] || [expr {[llength $lst] % 2 }])} {
    set ol [::baltip::optionlist]
    lappend ol -baltip
    foreach o $ol {lappend OL [string toupper $o]}
    foreach {o v} $lst {
      if {[set i [lsearch -exact $OL $o]]>-1} {
        set n1 [string range [lindex $ol $i] 1 end]
        set ttdata($n1,$w) $v
        if {$o eq {-BALTIP}} {set txt $v}
      }
    }
  } else {
    if {[winfo exists ttdata(optvals,$w)]} {
      catch {
        set txt [dict get $ttdata(optvals,$w) -text]
      }
    }
  }
  return $txt
}
#_______________________

proc ::baltip::my::Eternal {w} {
  # Checks if the tip is shown till clicking.
  #   w - tip/widget's path

  variable ttdata
  set res no
  if {[catch {set res $ttdata(eternal,$w)}]} {
    catch {set res $ttdata(eternal,[winfo parent $w])}
  }
  return $res
}

## ________________________ Binds _________________________ ##

proc ::baltip::my::BindToEvent {w event args} {
  # Binds an event on a widget to a command.
  #   w - the widget's path
  #   event - the event
  #   args - the command
  # The command can be ended with " ; break".

  if {[catch {set bound [bind $w $event]}]} {set bound {}}
  if {[string first $args $bound]<0} {
    catch {
      if {[lrange $args end-1 end] eq "{;} break"} {
        set com [lrange $args 0 end-2]
        bind $w $event "$com ; break"
      } else {
        bind $w $event [list + {*}$args]
      }
    }
  }
}
#_______________________

proc ::baltip::my::BindTextagToEvent {w tag event args} {
  # Binds an event on a text tag to a command.
  #   w - the widget's path
  #   tag - the tag
  #   event - the event
  #   args - the command
  # The command can be ended with " ; break".

  if {[catch {set bound [$w tag bind $tag]}]} {set bound {}}
  if {[string first $args $bound]<0} {
    catch {
      if {[lrange $args end-1 end] eq "{;} break"} {
        set com [lrange $args 0 end-2]
        $w tag bind $tag $event "$com ; break"
      } else {
        $w tag bind $tag $event [list + {*}$args]
      }
    }
  }
}
#_______________________

proc ::baltip::my::BindCantagToEvent {w tag event args} {
  # Binds an event on a canvas tag to a command.
  #   w - the widget's path
  #   tag - the tag
  #   event - the event
  #   args - the command
  # The command can be ended with " ; break".

  if {[catch {set bound [$w bind $tag $event]}]} {set bound {}}
  if {[string first $args $bound]<0} {
    catch {
      if {[lrange $args end-1 end] eq "{;} break"} {
        set com [lrange $args 0 end-2]
        $w bind $tag $event "$com ; break"
      } else {
        $w bind $tag $event [list + {*}$args]
      }
    }
  }
}

## ________________________ Shows _________________________ ##

proc ::baltip::my::Command {w text} {
  # Executes a command set for a window.
  #   w - the widget's path
  #   text - the tip text
  # The command allows wildcards:
  #   %w - window's path
  #   %t - text of the tip
  # Returns: list of "yes/no" and a result of the command.
  # The result of the command can be a new tip if "yes" and the result ne {}.

  variable ttdata
  if {![info exists ttdata(command,$w)] || $ttdata(command,$w) eq {}} {return no}
  set com [string map [list %w $w %t "{$text}"] $ttdata(command,$w)]
  if {[catch {set res [eval $com]} e]} {return no}
  if {$text ne {}} {
    set ttdata(text,$w) $res
  }
  return [list yes $res]
}
#_______________________

proc ::baltip::my::ShowWindow {win} {
  # Shows a window of tip.
  #   win - the tip's window

  variable ttdata
  if {![winfo exists $win] || ![info exists ttdata(winGEO,$win)]} return
  set geo $ttdata(winGEO,$win)
  set under $ttdata(winUNDER,$win)
  set shiftX $ttdata(winSHIFTX,$win)
  set shiftY $ttdata(winSHIFTY,$win)
  set w [winfo parent $win]
  set px [winfo pointerx .]
  set py [winfo pointery .]
  set width [winfo reqwidth $win.label]
  set height [winfo reqheight $win.label]
  set ady 0
  if {[catch {set wheight [winfo height $w]}]} {
    set wheight 0
  } else {
    for {set i 0} {$i<$wheight} {incr i} {  ;# find the widget's bottom
      incr py
      incr ady
      if {![string match $w* [winfo containing $px $py]]} break
    }
  }
  if {$geo eq {}} {
    if {$shiftX ne {}} {
      set x [expr {$px + $shiftX}]
    } else {
      set x [expr {max(1,$px - round($width / 2.0))}]
    }
    set y [expr {$under>=0 ? ($py + $under) : ($py - $under - $ady)}]
    if {$shiftY ne {}} {incr y $shiftY}
  } else {
    lassign [split $geo +] -> x y
    set x [expr [string map "W $width" $x]]  ;# W to shift horizontally
    set y [expr [string map "H $height" $y]] ;# H to shift vertically
  }
  # check for edges of screen incl. decors
  set scrw [winfo vrootwidth .]
  set scrh [winfo vrootheight .]
  if {($x + $width) > $scrw}  {set x [expr {$scrw - $width - 1}]}
  if {($y + $height) > $scrh} {set y [expr {$py - $height - 16}]}
  set x [expr {max(0,$x)}]
  set y [expr {max(0,$y)}]
  wm geometry $win [join  "$width x $height + $x + $y" {}]
  catch {wm deiconify $win ; raise $win}
}
#_______________________

proc ::baltip::my::Show {args} {
  # Calls DoShow catching errors.

  catch {DoShow {*}$args}
}
#_______________________

proc ::baltip::my::DoShow {w text force geo optvals} {
  # Creates and shows the tip's window.
  #   w - the widget's path
  #   text - the tip text
  #   force - if true, re-displays the existing tip
  #   geo - being +X+Y, sets the tip coordinates
  #   optvals - settings ("option value" pairs)
  # See also: Fade, ShowWindow, ::baltip::update

  variable ttdata
  if {![winfo exists $w]} return
  set win [::baltip::tippath $w]
  # keep the label's colors untouched (for apave package)
  catch {::apave::obj untouchWidgets $win.label}
  set px [winfo pointerx .]
  set py [winfo pointery .]
  array set data $optvals
  if {[info exists ttdata(optvals,$w)]} {
    catch {array set data [list {*}$ttdata(optvals,$w) {*}$optvals]}
  }
  if {$geo ne {}} {
    # balloons not related to widgets
  } elseif {$ttdata(global,$w)} {      ;# flag 'use global settings'
    array set data [::baltip::cget]
  } else {
    foreach k [array names ttdata -glob *,$w] {
      set n1 [lindex [split $k ,] 0]   ;# settings set by 'update'
      if {$n1 eq {text}} {
        if {$ttdata($k) ne {}} {
          set text $ttdata($k)         ;# tip's text
        }
      } else {
        set data(-$n1) $ttdata($k)     ;# tip's options
      }
    }
  }
  if {[catch {set widgetclass [winfo class $w]}]} {
    set widgetclass {}
  }
  if {!$force && $geo eq {}} {
    if {![info exists ttdata(on,$w)] || !$ttdata(on,$w)} return
    if {$widgetclass ne {Menu} && \
    ([winfo exists $win] || ![string match $w* [winfo containing $px $py]])} {
      return
    }
  }
  if {$geo eq {}} {::baltip::hide $w}
  set icount [string length [string trim $text]]
  if {!$icount || (!$ttdata(on) && !$data(-on))} return
  lassign [Command $w $text] ans res
  if {$ans} {
    if {$res eq {}} {
      # the command displayed the tip somewhere
      return
    }
    # the command redefined the tip's text
    set text $res
  }
  if {[info exists ttdata(maxexp,$w)] && \
  [string is integer -strict $ttdata(maxexp,$w)]} {
    if {$ttdata(maxexp,$w)<=0} return
  }
  lappend ttdata(REGISTERED) $w
  foreach wold [lrange $ttdata(REGISTERED) 0 end-1] {::baltip::hide $wold}
  if {$data(-fg) eq {}} {set data(-fg) black}
  if {$data(-bg) eq {}} {set data(-bg) #FBFB95}
  catch {destroy $win}
  toplevel $win -bg $data(-bg) -class Tooltip$w
  catch {wm withdraw $win}
  wm overrideredirect $win 1
  if {[info exists data(-ontop)] && $data(-ontop)} {
    wm attributes $win -topmost 1
  }
  if {$data(-relief) eq {}} {set data(-relief) solid}
  if {[set imgoptions $data(-image)] ne {}} {
    set imgoptions "-image $imgoptions"
  }
  if {[set cmpdoptions $data(-compound)] ne {}} {
    set cmpdoptions "-compound $cmpdoptions"
  }
  if {$imgoptions ne {} && $cmpdoptions eq {}} {
    set cmpdoptions {-compound left}
  }
  pack [label $win.label -text $text -justify left -relief $data(-relief) \
    -bd $data(-bd) -bg $data(-bg) -fg $data(-fg) -font $data(-font) \
    {*}$imgoptions {*}$cmpdoptions -padx $data(-padx) -pady $data(-pady)] \
    -padx $data(-padding) -pady $data(-padding)
  if {[info exists ttdata(focus,$w)]} {
    set foc $ttdata(focus,$w)
    after idle "catch {focus -force \[winfo toplevel $foc\]}; catch {focus $foc}"
  }
  # defeat rare artifact by passing mouse over a tip to destroy it
  bindtags $win "Tooltip$win"
  if {$geo eq {}} {
    # balloons are hidden on click or time-out
    bind $win <Any-Enter> "::baltip::hide $w"
    bind Tooltip$win <Any-Enter>  "::baltip::hide $w"
  }
  bind $win <Any-Button> "::baltip::hide $w 1"
  bind Tooltip$win <Any-Button> "::baltip::hide $w 1"
  set aint 20
  set fint [expr {int($data(-fade)/$aint)}]
  set icount [expr {int($data(-per10)/$aint*$icount/10.0)}]
  set icount [expr {$data(-per10) ? max(1000/$aint+1,$icount) : 0}] ;# 1 sec. minimum
  set ttdata(winGEO,$win) $geo
  set ttdata(winUNDER,$win) $data(-under)
  set ttdata(winSHIFTX,$win) $data(-shiftX)
  set ttdata(winSHIFTY,$win) $data(-shiftY)
  if {$icount} {
    if {$geo eq {}} {
      catch {wm attributes $win -alpha $data(-alpha)}
    } else {
      Fade $win $aint [expr {round(1.0*$data(-pause)/$aint)}] \
        0 Un $data(-alpha) 1 $geo {} $w
    }
    if {$force} {
      Fade $win $aint $fint $icount {} $data(-alpha) 1 $geo {} $w
    } elseif {$widgetclass ne {TNotebook}} {
      catch {after cancel $ttdata(after)}
      set ttdata(after) [after $data(-pause) [list \
        ::baltip::my::Fade $win $aint $fint $icount {} $data(-alpha) 1 $geo {} $w]]
    }
  } else {
    # just showing, no fading
    catch {after cancel $ttdata(after)}
    set ttdata(after) [after $data(-pause) \
      "::baltip::my::ShowWindow $win; catch {wm attributes $win -alpha $data(-alpha)}"]
  }
  if {$data(-bell)} [list after [expr {$data(-pause)/4}] bell]
  array unset data
}

## ________________________ Fade _________________________ ##

proc ::baltip::my::Fade {win aint fint icount Un alpha show geo {geos ""} {w {}}} {
  # Fades/unfades the tip's window.
  #   win - the tip's window
  #   aint - interval for 'after'
  #   fint - interval for fading
  #   icount - counter of intervals
  #   Un - if equal to "Un", unfades the tip
  #   alpha - value of -alpha option
  #   show - flag "show the window"
  #   geo - coordinates (+X+Y) of balloon
  #   geos - saved coordinates (+X+Y) of shown tip
  #   w - a host window
  # See also: FadeNext, UnFadeNext

  variable ttdata
  if {[winfo exists $win]} {
    if {$show && [info exists ttdata(maxexp,$w)] && \
    [string is integer -strict $ttdata(maxexp,$w)]} {
      incr ttdata(maxexp,$w) -1
    }
    update
    catch {after cancel $ttdata(after)}
    set ttdata(after) [after idle [list after $aint \
      [list ::baltip::my::${Un}FadeNext $win $aint $fint $icount $alpha $show $geo $geos]]]
  }
}
#_______________________

proc ::baltip::my::FadeNext {w aint fint icount alpha show geo {geos ""}} {
  # A step to fade the tip's window.
  #   w - the tip's window
  #   aint - interval for 'after'
  #   fint - interval for fading
  #   icount - counter of intervals
  #   alpha - value of -alpha option
  #   show - flag "show the window"
  #   geo - coordinates (+X+Y) of balloon
  #   geos - saved coordinates (+X+Y) of shown tip
  # See also: Fade

  variable ttdata
  incr icount -1
  if {$show} {ShowWindow $w}
  set show 0
  if {![winfo exists $w]} return
  lassign [split [wm geometry $w] +] -> X Y
  if {$geos ne {} && $geos ne "+$X+$Y"} return
  if {$fint<=0} {set fint 10}
  if {[catch {set al [expr {min($alpha,($fint+$icount*1.5)/$fint)}]}]} {
    set al 0
  }
  if {$icount<0} {
    if {[Eternal $w]} return
    if {$al>0} {
      if {[catch {wm attributes $w -alpha $al}]} {set al 0}
    }
    if {$al<=0.001 || ![winfo exists $w]} {
      ::baltip::hide
      catch {destroy $w}
      return
    }
  } elseif {$al>0 && $geo eq {}} {
    if {![Eternal $ttdata(balloon)] && $ttdata(balloon) ne {-}} {
      ::baltip::hide $ttdata(balloon) yes  ;# non-eternal balloon be destroyed
    }
    catch {wm attributes $w -alpha $al}
  }
  Fade $w $aint $fint $icount {} $alpha $show $geo +$X+$Y
}
#_______________________

proc ::baltip::my::UnFadeNext {w aint fint icount alpha show geo {geos ""}} {
  # A step to unfade the balloon's window.
  #   w - the tip's window
  #   aint - interval for 'after'
  #   fint - interval for fading
  #   icount - counter of intervals
  #   alpha - value of -alpha option
  #   show - not used (here just for compliance with Fade)
  #   geo - not used (here just for compliance with Fade)
  #   geos - not used (here just for compliance with Fade)
  # See also: Fade

  incr icount
  set al [expr {min($alpha,$icount*1.5/$fint)}]
  if {$al<$alpha && [catch {wm attributes $w -alpha $al}]} {set al 1}
  if {$show} {
    ShowWindow $w
    set show 0
  }
  if {[winfo exists $w] && $al<$alpha} {
    Fade $w $aint $fint $icount Un $alpha 0 $geo
  }
}

## ________________________ Specific widgets _________________________ ##

### ________________________ Tags _________________________ ###

proc ::baltip::my::TagTip {w {tag ""} {optvals ""}} {
  # Shows a text tag's tip.
  #   w - the text's path
  #   tag - the tag's name
  #   optvals - settings of tip

  variable ttdata
  ::baltip::hide $w
  if {$tag eq {}} return
  ::baltip::my::Show $w $ttdata($w,$tag) no {} $optvals
}

### ________________________ Menu _________________________ ###

proc ::baltip::my::MenuTip {wt} {
  # Shows a menu's tip.
  #   wt - the menu's path (incl. cloned menu)

  variable ttdata
  if {[string match .tearoff* $wt]} {
    # not implemented for tear-offed menus
    return
  }
  ::baltip::hide $wt
  set index [$wt index active]
  set mit "$wt/$index"
  if {$index eq {none}} return
  if {[info exists ttdata($wt,$index)] && ([::baltip::hide $wt] || \
  ![info exists ttdata(LASTMITEM)] || $ttdata(LASTMITEM) ne $mit)} {
    set optvals $ttdata($wt,$index)
    set text [dict get $optvals -text]
    ::baltip::my::Show $wt $text no {} $optvals
  }
  set ttdata(LASTMITEM) $mit
}

### ________________________ Notebook _________________________ ###

proc ::baltip::my::NbkInfo {w x y {tab {}}} {
  # Gets/sets a notebook tab's data.
  #   w - the notebook's path
  #   x - X coordinate of pointer
  #   y - Y coordinate of pointer
  #   tab - a current tab
  # When getting, returns a list of a current tab and a saved tab.

  set optid -SPECTIP$w
  if {$tab eq {}} {
    set tab [$w identify tab $x $y]
    set tab2 [lindex [::baltip cget $optid] 1]
    return [list $tab $tab2]
  }
  ::baltip configure $optid $tab
}

#_______________________

proc ::baltip::my::ShowNbkTip {w tip} {
  # Shows a tip for a notebook tab.
  #   w - the notebook's path
  #   tip - text of tip

  catch {
    set x [expr {[winfo pointerx $w]-[winfo rootx $w]}]
    set y [expr {[winfo pointery $w]-[winfo rooty $w]}]
    lassign [NbkInfo $w $x $y] tab tab2
    set wt [lindex [$w tabs] $tab]
    if {$tab2 ne {-} && [lsearch -exact [$w tabs] $wt]>-1} {
      ::baltip tip $w $tip -force yes
    } else {
      ::baltip hide $w
    }
  }
}

#_______________________

proc ::baltip::my::PrepareNbkTip {w x y} {
  # Prepares a tip for a notebook tab.
  #   w - the notebook's path
  #   x - X coordinate of pointer
  #   y - Y coordinate of pointer
  # The baltip isn't directly usable with notebook tabs
  # because they have not Enter/Leave event bindings.
  # This proc tries to imitate those events, with binding to <Motion> event.

  if {![string is integer -strict $x]} return
  catch {
    lassign [::baltip cget -pause] -> pause
    lassign [NbkInfo $w $x $y] tab tab2
    set nbktab [lindex [$w tabs] $tab]
    if {$tab ne {} && $tab2 ni "$tab -"} {
      ::baltip hide $w
      lassign [::baltip cget -SPECTIP$nbktab] -> tip
      lassign [Command $w $tip] ans res
      if {$ans} {
        if {$res ne {}} {
          # the command should be displayed here (not somewhere else)
          set $ans no
        }
        # the command redefined the tip's text
        set tip $res
      }
      if {!$ans} {
        set optafter -SPECTIPafter$w
        catch {
          after cancel [lindex [::baltip cget $optafter] 1]
        }
        set aftid [after $pause "::baltip::my::ShowNbkTip $w {$tip}"]
        ::baltip configure $optafter $aftid
      }
    } else {
      NbkInfo $w $x $y -1
    }
    NbkInfo $w $x $y $tab
  }
}

### ________________________ Listbox _________________________ ###

proc ::baltip::my::LbxCoord {w} {

  # Gets listbox's coordinate data.
  #   w - path to the listbox
  # Returns a list of:
  #   x - X coordinate
  #   y - Y coordinate
  #   idx - index of listbox's item
  #   inside - flag "mouse pointer is inside the listbox"

  lassign [WidCoord $w] x y inside
  set idx [$w index @$x,$y]
  return [list $x $y $idx $inside]
}
#_______________________

proc ::baltip::my::LbxTip {w idx whole} {
  # Gets a text of a listbox' tip.
  #   w - the listbox's path
  #   idx - index of listbox's item
  #   whole - flag "tip for a whole listbox, not per item"

  lassign [::baltip cget -SPECTIP$w] - com
  if {$whole} {
    set tip [string map "%%i %i" $com]
  } else {
    set com [string map [list %i $idx] $com]
    if {[catch {set tip [eval $com]}]} {set tip $com}
  }
  return $tip
}
#_______________________

proc ::baltip::my::ShowLbxTip {w optid idx whole} {
  # Shows a tip for a listbox.
  #   w - the listbox's path
  #   optid - option name for saving *idx*
  #   idx - index of listbox's item
  #   whole - flag "tip for a whole listbox, not per item"

  catch {
    lassign [LbxCoord $w] x y idx inside
    if {$inside} {
      set tip [LbxTip $w $idx $whole]
      ::baltip configure $optid $idx
      ::baltip tip $w $tip -force yes
    } else {
      ::baltip hide $w
      ::baltip configure $optid {}
    }
  }
}
#_______________________

proc ::baltip::my::PrepareLbxTip {w x y} {
  # Prepares a tip for a listbox.
  #   w - the listbox's path
  #   x - X coordinate of pointer
  #   y - Y coordinate of pointer
  # Imitates Enter/Leave events per items, with binding to <Motion> event.
  # If "-text" of tip doesn't contain %i, the tip is for a whole listbox.
  # If "-text" of tip contains %i, the tip is a callback with %i as item index.

  if {![string is integer -strict $x]} return
  catch {
    set idx [$w index @$x,$y]
    lassign [::baltip cget -pause] -> pause
    set optid -SPECTIPid$w
    lassign [::baltip cget $optid] -> idx2
    lassign [LbxCoord $w] x y idx inside
    if {$inside && $idx!=$idx2} {
      lassign [::baltip cget -SPECTIP$w] - com
      set com [string map "%%i \u0001" $com]
      set whole [expr {[string first %i $com]==-1}]
      set com [string map "\u0001 %i" $com]
      set text [LbxTip $w $idx $whole]
      if {$whole && $idx2 ne {}} {
        Command $w $text
        return  ;# tip for a whole listbox at entering
      }
      ::baltip hide $w
      lassign [Command $w $text] ans res
      if {$ans} {
        if {$res ne {}} {
          # the command should be displayed here (not somewhere else)
          set $ans no
        }
        # the command redefined the tip's text
        set text $res
      }
      if {!$ans} {
        set optafter -SPECTIPafter$w
        catch {after cancel [lindex [::baltip cget $optafter] 1]}
        set aftid [after $pause "::baltip::my::ShowLbxTip $w $optid $idx $whole"]
        ::baltip configure $optafter $aftid
      }
      ::baltip configure $optid $idx
    }
  }
}

### ________________________ Treeview _________________________ ###

proc ::baltip::my::TreCoord {w whole} {
  # Gets treeview's coordinate data.
  #   w - path to the treeview
  #   whole - flag "tip for a whole treeview, not per item"
  # Returns a list of:
  #   x - X coordinate
  #   y - Y coordinate
  #   id - ID of item
  #   c - column of item
  #   inside - flag "mouse pointer is inside the treeview"

  lassign [WidCoord $w] x y inside
  set id [$w identify item $x $y]
  set c [$w identify column $x $y]
  if {!$whole && [$w identify region $x $y] eq {heading}} {
    set inside no
  }
  return [list $x $y $id $c $inside]
}
#_______________________

proc ::baltip::my::TreTip {w id c whole} {
  # Gets a text of a treeview' tip.
  #   w - the treeview's path
  #   id - ID of item
  #   c - column of item
  #   whole - flag "tip for a whole treeview, not per item"

  lassign [::baltip cget -SPECTIP$w] - com
  if {$whole} {
    set tip [string map "%%i %i %%c %c" $com]
  } else {
    set tip {}
    set com [string map [list %i $id %c $c] $com]
    if {$id ne {} && [catch {set tip [eval $com]}]} {set tip $com}
  }
  return $tip
}
#_______________________

proc ::baltip::my::ShowTreTip {w optid id whole} {
  # Shows a tip for a treeview.
  #   w - the treeview's path
  #   optid - option name for saving *id*
  #   id - ID of item
  #   whole - flag "tip for a whole treeview, not per item"

  catch {
    lassign [TreCoord $w $whole] x y id c inside
    if {$inside} {
      set tip [TreTip $w $id $c $whole]
      ::baltip configure $optid [list $id $c]
      ::baltip tip $w $tip -force yes
    } else {
      ::baltip hide $w
      ::baltip configure $optid {}
    }
  }
}
#_______________________

proc ::baltip::my::PrepareTreTip {w x y} {
  # Prepares a tip for a treeview.
  #   w - the treeview's path
  #   x - X coordinate of pointer
  #   y - Y coordinate of pointer
  # Imitates Enter/Leave events per items, with binding to <Motion> event.
  # If "-text" of tip doesn't contain %i, the tip is for a whole treeview.
  # If "-text" of tip contains %i, the tip is a callback with %i as item index.

  if {![string is integer -strict $x]} return
  catch {
    set id [$w identify item $x $y]
    lassign [::baltip cget -pause] -> pause
    set optid -SPECTIPid$w
    lassign [lindex [::baltip cget $optid] 1] id2 c2
    lassign [::baltip cget -SPECTIP$w] - com
    set com [string map "%%i \u0001 %%c \u0002" $com]
    set isid [expr {[string first %i $com]>-1}]
    set isc  [expr {[string first %c $com]>-1}]
    set whole [expr {!$isid && !$isc}]
    set com [string map "\u0001 %i \u0002 %c" $com]
    lassign [TreCoord $w $whole] x y id c inside
    if {$whole || ($inside && $id ne {} && $c ne {} &&
    (($isid && $id ne $id2) || ($isc && $c ne $c2)))} {
      set text [TreTip $w $id $c $whole]
      if {$whole && $id2 ne {}} {
        Command $w $text
        return  ;# tip for a whole treeview at entering
      }
      lassign [Command $w $text] ans res
      if {$ans} {
        if {$res ne {}} {
          # the command should be displayed here (not somewhere else)
          set $ans no
        }
        # the command redefined the tip's text
        set text $res
      }
      if {!$ans} {
        ::baltip hide $w
        set optafter -SPECTIPafter$w
        catch {after cancel [lindex [::baltip cget $optafter] 1]}
        set aftid [after $pause "::baltip::my::ShowTreTip $w $optid {$id} $whole"]
        ::baltip configure $optafter $aftid
      }
      ::baltip configure $optid [list $id $c]
    } elseif {$id eq {}} {
      ::baltip hide $w
      ::baltip configure $optid {}
    }
  }
}

# ________________________________ EOF __________________________________ #

baltip.tcl