# -*- tcl -*-
# <20161230.1328.03>

# this code fixes the tearoff menu so that it does NOT deiconify
# when the 'master' window loses focus.
# It should be called by using the '-tearoffcommand' this way:
#
# -tearoffcommand "FixTearoff <cmd>"
#
# The tk library routine 'tearoff.tcl' is called when -tearoff is true.
# It, in turn will call this function (given the above option).
# 'tearoff.tcl will add the 'menu' (orgional menu window name) and the
# new 'tearoff' window so we have those three parms as below:
# Note that the first
# parm is from the -tearoffcommand and the remaining two from the
# tk/library/tearoff.tcl.
#
# cmd     is treated as a command to execute if it is not {}
# menu    is the orgional menu
# tearoff is the resulting menu
#
# Just so you don't have to code a {} if you have no command to
# execute, we also accomadate getting just the last two parms.
#

proc FixTearoff {args} {
  set cmd {}
  switch -exact [llength $args] {
    2 {lassign $args menu tearoff}
    3 {lassign $args cmd menu tearoff}
    default {error "FixTearOff called with other than 2 or 3 parameters"}
  }
  if {[tk windowingsystem] == "win32"} {
    lassign [winfo pointerxy [winfo parent $tearoff]] x y
    wm geometry $tearoff "+$x+$y"
  } else {
    wm att $tearoff -type {}
    # insure the window is large enough to move
    wm minsize $tearoff 92 1
  }
  bind $tearoff <Enter> {+ incr tk::Priv(menuActivated)}
  bind $tearoff <Leave> {+ tk::MenuUnpost %W}
  wm with $tearoff
  wm deicon $tearoff
  frputs "Tearoff menu   " cmd menu tearoff
  if {$cmd != {}} {
    # puts "doing >$cmd<"
    uplevel #0 $cmd [list $menu $tearoff]
  }
  
}
