#!../wafe --f
# Wafe script to demonstrate how to create 
# a popup menu with cascaded sub menus in Wafe.
# Cascaded menus are not supported by Athena, therefore we need 
# a little bit more code.
# Gustaf Neumann    Jun  3 3:03:55 EDT 1994

mergeResources topLevel \
    *font -adobe-*-medium-*-*-*-14-*-*-*-*-*-*-* \
    *menuLabel*font  -adobe-*-bold-*-*-*-14-*-*-*-*-*-*-* \
    *background gray90 \
    *foreground black \
    *SmeBSB.callback {echo %w}

set mainMenuTrans {#override
  <EnterWindow>: exec(checkSubMenu %W %Y) highlight()
  <BtnMotion>: exec(checkSubMenu %W %Y) highlight()
  <BtnUp>: exec(popdownMainMenu %W) notify() unhighlight()
}

set cascadeTrans {#override
  <LeaveWindow>: MenuPopdown() unhighlight() 
} 

# mkMenu simply reduces the for creating widgets
proc mkMenu {name parent label menuEntries translations} {
  global subMenu
  set M [SimpleMenu $name $parent label $label translations $translations]
  foreach e [concat - $menuEntries] {
    if ![string compare - $e]          {SmeLine line $M
    } elseif [info exists subMenu($e)] {SmeBSB $e $M label "$e ==>" callback {}
    } else                             {SmeBSB $e $M }
  }
}

# checkSubMenu tests whether a cascaded menu should be popped up for
# the current menu entry in $menu. $Y is the y screen coordinate
proc checkSubMenu {menu Y} {
  global up subMenu
  set currentItem [widgetName [XawSimpleMenuGetActiveEntry $menu]]
  if [info exists subMenu($currentItem)] {
    set sub $subMenu($currentItem)
    popdownCascaded $menu $sub
    sV $sub popupCallback "positionMenuCascade $sub $menu $Y"
    popup $sub nonexclusive
    set up($menu) $sub
  } else {
    popdownCascaded $menu {}
  }
}

# positionMenuCascade is the popupCallback routine for cascade menus
proc positionMenuCascade {subMenu mainMenu Y} {
  translateCoords $mainMenu [expr [gV $mainMenu width]+5] 0 X py
  sV $subMenu x $X y [expr $Y-30]
}

# popdownCascaded checks whether cascaded submenus of $menu should be
# popped down
proc popdownCascaded {menu new} {
  global up
  if {[info exists up($menu)] && [string compare $up($menu) $new]} {
    popdown $up($menu)
    unset up($menu)
  }
}

# popdownMainMenu popps a main menu and its associated cascaded windows down
proc popdownMainMenu {menu} {
   popdownCascaded $menu {}
   addWorkProc "popdown $menu;return 1"
}

# now the widgets are created
Label pressMe topLevel translations {#override 
  <Btn1Down>: XtMenuPopup(mainMenu) 
}
# the  menues can be created after the realize
realize

# specify, which menu points have cascaded sub menues
set subMenu(sub1) subMenu1
set subMenu(sub2) subMenu2

# create the menues
mkMenu mainMenu pressMe "MainMenu" {one two sub1 sub2 - quit} $mainMenuTrans
  sV mainMenu.quit callback quit
  callback mainMenu popupCallback positionCursor 0

mkMenu subMenu1 pressMe "SubMenu 1" {three four five} $cascadeTrans
mkMenu subMenu2 pressMe "SubMenu 2" {six seven eight} $cascadeTrans


