# balloon.tcl
#
#	This file implements the balloon help system
#	It is loosely based on code by Jeffrey Hobbs
#
#
#  TkRat software and its included text is Copyright 1996,1997,1998
#  by Martin Forssén
#
#  Postilion software and its included text and images
#  Copyright (C) 1998, 1999, 2000 Nic Bernstein
#
#  The full text of the legal notices is contained in the files called
#  COPYING and COPYRIGHT.TkRat, included with this distribution.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.
# 
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.

#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# balloonInit --
#
#	Initialize the balloon help module
#
# Arguments:
#	wins		Name of text spcifier array
#	texts		Name of texts array
# Results:
#	Initializes Enter and Leave bindings for all widgets.

proc BalloonInit {wins texts} {
    global balPrivate option

    set balPrivate(winsVar) $wins
    set balPrivate(textsVar) $texts
    set balPrivate(last) -1
    set balPrivate(afterID) {}
    set balPrivate(toplevel) .__balloonHelp
    set balPrivate(text) ""

    # Prepare bindings
    bind all <Any-Motion> {+
	if $option(show_balhelp) {
	    BalloonHide
	    set balPrivate(last) -1
	    if {"Menu" == [winfo class %W]} {
		set cur [%W index active]
		if [info exists $balPrivate(winsVar)(%W,$cur)] {
		    set balPrivate(afterID) [after $option(balhelp_delay) \
			    [list BalloonShow %W $cur]]
		}
	    } else {
		if [info exists $balPrivate(winsVar)(%W)] {
		    set balPrivate(afterID) [after $option(balhelp_delay) \
			    [list BalloonShow %W]]
		}
	    }
	}
    }
    bind all <Leave>		    {+BalloonHide }
    bind Balloons <Any-KeyPress>    {+BalloonHide }
    bind Balloons <Any-Button>      {+BalloonHide }

    # Create the actual balloon
    toplevel $balPrivate(toplevel) -bd 1 -background black
    wm overrideredirect $balPrivate(toplevel) 1
    wm positionfrom $balPrivate(toplevel) program
    wm withdraw $balPrivate(toplevel)
    label $balPrivate(toplevel).l -highlightthickness 0 -bd 0 \
	    -background #fefeb4 -textvariable balPrivate(text) \
	    -justify left -padx 2 -pady 2
    pack $balPrivate(toplevel).l
}


# BalloonShow --
#
#	Show the help balloon
#
# Arguments:
#	w	Window to show help for
#	i	Index in window to show the help for
# Results:
#	Sets the helptext, shows the balloon and adds bindings to the window
#	if not already there

proc BalloonShow {w {i {}}} {
    if {![winfo exists $w] || [string compare \
	    $w [eval winfo containing [winfo pointerxy $w]]]} return

    global balPrivate
    upvar #0 $balPrivate(winsVar) wins
    upvar #0 $balPrivate(textsVar) texts

    if {[string compare {} $i]} {
	set balPrivate(text) $texts($wins($w,$i))
    } else {
	set balPrivate(text) $texts($wins($w))
    }

    update idletasks
    set b $balPrivate(toplevel)
    set x [expr [winfo pointerx $w]+16]
    set y [expr [winfo pointery $w]+10]
    if {$x<0} {
        set x 0
    } elseif {($x+[winfo reqwidth $b])>[winfo screenwidth $w]} {
        set x [expr [winfo screenwidth $w]-[winfo reqwidth $b]]
    }
    wm geometry $b +$x+$y
    wm deiconify $b
    raise $b

    if {-1 == [lsearch [bindtags $w] Balloons]} {
	bindtags $w [linsert [bindtags $w] end Balloons]
    }
    set f [focus]
    if {"" != $f && -1 == [lsearch [bindtags $f] Balloons]} {
	bindtags $f [linsert [bindtags $f] end Balloons]
    }
}


# BalloonHide --
#
#	Hide the help balloon
#
# Arguments:
#	None
# Results:
#	Withdraws the ballon window and cancels any pending shows.

proc BalloonHide {} {
    global balPrivate

    after cancel $balPrivate(afterID)
    catch {wm withdraw $balPrivate(toplevel)}
}


# balloonHelp::TranslateMenu --
#
#	Translate the name of a menu to the actual window name
#	This is for tk8.0 menubar menus only
#
# Arguments:
#	m	Menu to find
# Results:
#	The actual window name of the menu
#
#proc balloonHelp::TranslateMenu {m} {
#    regexp {(\.[^\.]+)} $m top
#    set bar [$top cget -menu]
#    regsub -all {\.} $bar # barName
#
#    if {$bar == $m} {
#	return $top.$barName
#    } else {
#	regsub -all {\.} $m # menu
#	return $top.$barName.$menu
#    }
#}
