
# Bubble help.
# Copyright (c) 1998 Pacific Marketing and Consulting, Inc,
#               All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc bubble_setup {} {
    global bubble_delay is_win

    bind all <Enter> "bubble_action enter %W"
    bind all <Leave> "bubble_action leave %W"
if 0 {
    if $is_win {
        bind Menu <<MenuSelect>> {bubble_action move %W}
    } else {
        bind Menu <Motion> {
	    tkMenuMotion %W %x %y %s
	    bubble_action move %W
        }
    }
} else {
    bind Menu <<MenuSelect>> {bubble_action move %W}
}
    if ![info exists bubble_delay] { set bubble_delay 1000 }
}

proc bubble_action {what win {text ""}} {
    global bubble_after bubble_win bubble_last_menu bubble_delay

    if !$bubble_delay return

    if [string match .bubble_win* $win] {
	if {$what == "leave"} { bubble_hide }
	return
    }

    switch $what {
	enter {
	    if [info exists bubble_after] {
		after cancel $bubble_after
	    }
	    set bubble_win $win
	    set bubble_after [after $bubble_delay [list bubble_show $win $text]]
	}
	leave {
	    if {[info exists bubble_after] && ($bubble_win == $win)} {
		after cancel $bubble_after
		unset bubble_after
	    }
	    set wcont [winfo containing [winfo pointerx .] \
			   [winfo pointery .]]
	    if ![string match .bubble_win* $wcont] {
		bubble_hide
	    }
	}
	move {
	    if [info exists bubble_last_menu] {
		bubble_show $win $text
	    } else {
		if [info exists bubble_after] {
		    after cancel $bubble_after
		}
		set bubble_win $win
		set bubble_after [after $bubble_delay [list bubble_show $win $text]]
	    }
	}
    }
}

proc bubble_show {win {text ""}} {
    global bubble_help bubble_last_menu bubble_after is_win bubble_win
    global toplevel toolbar

    if [info exists bubble_after] { unset bubble_after }

    set px [winfo pointerx .]
    set py [winfo pointery .]

    if {$text == ""} {
	if ![winfo exists $win] return
	if {[winfo exists $win.m] && [winfo ismapped $win.m]} return
        if {(!$is_win || [string compare [winfo class $win] "Menu"]) &&
	    [winfo containing $px $py] != $win} return
	set realwin 1
    } else {
	set realwin 0
    }
    set key $win
    set wx [winfo rootx $win]
    set wy [winfo rooty $win]
    if {$realwin && ([winfo class $win] == "Menu")} {
if 0 {
        if $is_win {
            set ent [$win index active]
        } else {
	    set xr [expr $px - $wx]
	    set yr [expr $py - $wy]
	    set ent [$win index @$xr,$yr]
	}
} else {
        set ent [$win index active]
}
	if {($ent == 0) && [$win cget -tearoff]} {
	    set lab *tearoff*
	} elseif ![string compare $ent none] {
	    bubble_hide
	    set bubble_last_menu none
	    return
	} else {
	    if {[catch {$win entrycget $ent -label} lab] || [catch {$win entrycget $ent -image} image]} {
		bubble_hide
		set bubble_last_menu none
		return
	    }
	    if {$image != ""} { set lab $image }
	}

        # check for cloned menu
        if {$is_win && [string first \# $win] >= 0} {
	    regsub -all \# [lindex [split $win .] end] . wlab
        } else {
	    set wlab $win
        }

	if {[info exists bubble_last_menu] && \
		($bubble_last_menu == "$wlab,$ent")} return
	set bubble_last_menu $wlab,$ent

	set xd 2
	if {$lab == "*tearoff*"} {
	    set key *tearoff*
	} elseif {[$win cget -type] == "tearoff"} {
	    if [info exists toolbar(tearoff-source,$wlab)] {
		set key $toolbar(tearoff-source,$wlab),$lab
		incr xd 4
	    } else {
		set key $wlab,$lab
	    }
	} else {
	    set key $wlab,$lab
	}
	if ![info exists bubble_help($key)] {
            if [winfo exists .bubble_win] { top_withdraw .bubble_win }
            return
        }

	# The bubble will not go on top of the menu for some reason, since the
	# menu is a real toplevel and the bubble isn't, so just put it to one
	# side.

        if {!$is_win || [winfo width $win] > 1} {
            set ww [winfo width $win]
            set wh [winfo height $win]
        } elseif {[catch {WinMenuGeom $win} geom]} {
            set parent [winfo parent $win]
            if {$parent != "" && [winfo class $parent] == "Menubutton"} {
                set wx [winfo rootx $parent]
                set wy [expr [winfo rooty $parent] + [winfo height $parent]]
            } else {
                set wx $px
                set wy $py
            }
            set ww [winfo reqwidth $win]
            set wh [winfo reqheight $win]
        } else {
            incr xd
            set wx [lindex $geom 0]
            set wy [lindex $geom 1]
            set ww [lindex $geom 2]
            set wh [lindex $geom 3]
        }
	set x [expr $wx + $ww + $xd]
	set y [expr $wy + [$win yposition $ent]]

    } elseif !$realwin {
	set x $px
	set y [expr $py + 2]
    } else {
	set x $wx
	set y [expr $wy + [winfo height $win] + 5]
    }
    if $toplevel(single) {
	set x [expr $x - [winfo rootx .]]
	set y [expr $y - [winfo rooty .]]
    }

    if {$text == ""} {
	if ![info exists bubble_help($key)] return
	set text $bubble_help($key)
    }

    if ![winfo exists .bubble_win] {
	if $realwin { set subw $win } else { set subw "" }
	top_transient .bubble_win $subw
	frame .bubble_win.f -borderwidth 2 -relief ridge
	label .bubble_win.f.lab -background \#FFFF80 -justify l
	catch {.bubble_win.f.lab configure -cursor "plus orangered"}
	pack .bubble_win.f
	pack .bubble_win.f.lab
	bind .bubble_win <Motion> {
	    bubble_hide
	    bubble_action enter \$bubble_win
	}
    }
    top_geometry .bubble_win +$x+$y

    if [string match "__IMAGE__ *" $text] {
	.bubble_win.f.lab configure -text "" -image [lindex $text 1]

    } else {
	set text1 $text
	set text2 ""
	foreach l [split $text1 \n] {
	    set l [string trim $l]
	    if {$l != ""} { append text2 [string trim $l]\n }
	}

	.bubble_win.f.lab configure -text [string trim $text2] -image ""
    }
    update idle
    top_deiconify .bubble_win
    update idle
    if $is_win { top_geometry .bubble_win +$x+$y; update idle }
    if $toplevel(single) {
	set sw [winfo width .]
	set sh [winfo height .]
	set ex [expr [winfo x .bubble_win] + [winfo width .bubble_win]]
	set ey [expr [winfo y .bubble_win] + [winfo height .bubble_win]]
	set wx [expr $wx - [winfo rootx .]]
	set wy [expr $wy - [winfo rooty .]]
    } else {
	set sw [winfo screenwidth .bubble_win]
	set sh [winfo screenheight .bubble_win]
	set ex [expr [winfo rootx .bubble_win] + [winfo width .bubble_win]]
	set ey [expr [winfo rooty .bubble_win] + [winfo height .bubble_win]]
    }
    set mv 0
#    if {$ex > $sw} { set x [expr $sw - [winfo width .bubble_win]]; set mv 1 }
#    if {$ey > $sh} { set y [expr $sh - [winfo height .bubble_win]]; set mv 1 }
    if {$ex > $sw} { set x [expr $wx - [winfo width .bubble_win] - 2]; set mv 1 }
    if {$ey > $sh} { set y [expr $wy - [winfo height .bubble_win] - 2]; set mv 1 }
    if $mv {
	top_geometry .bubble_win +$x+$y
	if $is_win { update idle; top_geometry .bubble_win +$x+$y; update idle }
    }
    raise .bubble_win
}

proc bubble_hide {} {
    global bubble_last_menu

    if [winfo exists .bubble_win] { top_withdraw .bubble_win }
    if [info exists bubble_last_menu] { unset bubble_last_menu }
}

proc bubble_define {win mess} {
    global bubble_help

    if {$mess != ""} {
	set bubble_help($win) $mess
    } else {
	catch {unset bubble_help($win)}
    }
}

proc bubble_define_image {win name} {
    global bubble_help
    
    if {$name != ""} {
	set im [tree_get_image $name]
	set bubble_help($win) "__IMAGE__ $im"
    } else {
	catch {unset bubble_help($win)}
    }
}

proc bubble_clear {prefix} {
    global bubble_help
    
    foreach w [array names bubble_help] {
	if [string match $prefix* $w] {
	    unset bubble_help($w)
	}
    }
}
