#---------------------------------------------------------
# Ptk (Parenthesized tk)
#---------------------------------------------------------
# ptk-menus.tcl
# - complement to ptk.tcl
# - create menus
#---------------------------------------------------------
# MENU ENTRIES, and their main options are:
# * = mandatory (almost)
# + = usefull
#
# command
# * -label string, -bitmap bitmap, -image image
# + -underline charindex
# * -command script
#
# checkbutton
# * -label string, -bitmap bitmap, -image image
# + -underline charindex
# * -variable var
# * -offvalue value
# * -onvalue value
#   -selectcolor color
#   -selectimage image 
#   -indicatoron 0|1 
#
# radiobutton
# * -label string, -bitmap bitmap, -image image
# + -underline charindex
# * -variable var
# * -value value
#   -selectcolor color
#   -selectimage image 
#   -indicatoron 0|1 
#
# begin_cascade / end_cascade
# * -label string, -bitmap bitmap, -image image
# + -underline charindex
# 
# separator
#
#------------------------------------------------------------
# There are two environments to create menus:
#
# begin_main_menu / end_main_menu
#   - there MUST be at most ONE main menu
#   - accepts tk::menu options
#
# begin_menubutton / end_menubutton
#   - accepts tk::menubutton options
#------------------------------------------------------------
# Std tk entry options: 
#
# Sematics:
# -command script 
# -underline charindex (used with -label)
# -state normal|active|disabled 
# -accelerator string
#
# Content: not for separator or tear-off
# -label string
# -bitmap bitmap (see Tk_GetBitmap) 
# -image image
# -compound top|bottom|center|left|right|none
#  (display position of image relative to label)
# -font font
#
# Colors and layout:
# -activebackground color 
# -activeforeground color
# -background color
# -foreground color
# -hidemargin 0|1  (dflt 0)
#------------------------------------------------------------

#### MENU ENTRIES
# they do not have to 'packed'
# immediately added to the current menu

set menu_items {
   {kind              outer  params  components}
   {menu_separator    menu   {}     {separator}}
   {menu_command      menu   {}     {command}}
   {menu_checkbutton  menu   {}     {checkbutton}}
   {menu_radiobutton  menu   {}     {radiobutton}}
}
_def_props $menu_items

#puts "      $menu_items"
foreach meprop [lrange $menu_items 1 end] {
	set kind   [lindex $meprop 0]
	set tkname [lindex [lindex $meprop end] 0]
#puts "      menu item:$kind"
	interp alias {} ptk::_configure_$kind {} ptk::_configure_menu_item
	interp alias {} ptk::_configure_$kind\_$tkname {} ptk::_configure_menu_item
	interp alias {} ptk::_add_$kind {} ptk::_add_menu_item
}


# aliases: within 'menu'
proc ptk::within_menu { } {
	set x [winfo class $ptk::cur_node]
	return [expr {"$x" == "Menu"}]
}
ptk::new_alias "separator"   "menu_separator"    "ptk::within_menu"
ptk::new_alias "command"     "menu_command"      "ptk::within_menu"
ptk::new_alias "button"      "menu_command"      "ptk::within_menu"
ptk::new_alias "checkbutton" "menu_checkbutton"  "ptk::within_menu"
ptk::new_alias "radiobutton" "menu_radiobutton"  "ptk::within_menu"

proc ptk::_configure_menu_item { it opts } {
	# $it is the index in current menu
	set zemenu $ptk::cur_node
	set seindex $it
	foreach { a v } $opts {
		$zemenu entryconfigure $zeindex $a $v
	}
}

proc ptk::_add_menu_item { kind opts } {
	set zemenu $ptk::cur_node
	if { [winfo class $zemenu] != "Menu" } {
		ptk::_exit "ptk::menu $what must appear within a menu"
	}
	set what [lindex [ptk::get_prop $kind components] 0]
	$zemenu add $what
	set zeindex [$zemenu index last]
	foreach { a v } $opts {
		$zemenu entryconfigure $zeindex $a $v
	}
	return $zeindex
}

#### MENU ENVIRONMENTS
# alias: within 'main' menu -> main_menu
proc ptk::within_main { } {
	return [ expr $ptk::item_kind($ptk::cur_node) == main ]
}

#### MAIN MENU
# starts/end THE menu associated to the main window 
# args = tk::menu options

_def_props {
   {kind       outer   inner  nbsons   params    components}
   {main_menu   packer  packer   any   {}             {menu}}
}
ptk::new_alias "menu"     "main_menu"      "ptk::within_main"

#configure
# it =  menu -> basic
interp alias {} ptk::_configure_main_menu_menu {} ptk::_configure_basic
interp alias {} ptk::_configure_main_menu {} ptk::_configure_basic

proc ptk::_begin_main_menu { opts } {
	ptk::DBG "ptk::_begin main_menu $opts"
	# only ONE main menu
	if { [. cget -menu] != "" } {
		ptk::_error "begin_main_menu: main menu already defined"
	}
	# push a new menu
	set it [ ptk::push_node menu ]
	# prevent other container to pack this menu
	set ptk::packer_req($it) "none"
	#attach menu to main window
	. configure -menu $it
	# blindly set all usr attrs to the menu
	eval "$it configure $opts"
	return $it
}

proc ptk::_end_main_menu { opts } {
	ptk::DBG "ptk::_end_main_menu $opts"
	# just pop
	ptk::pop
}

#### MENU CASCADE
# Add rec. menu to current menu
# args = tk 'cascade' entry options
# WARNING: to path options to inner menu
# use later: ptk::menu_configure
_def_props {
   {kind       outer   inner  nbsons   params    components}
   {menu_cascade     menu    menu     any   {}        {cascade menu}}
}
ptk::new_alias "cascade"  "menu_cascade"   "ptk::within_menu"
ptk::new_alias "menu"     "menu_cascade"   "ptk::within_menu"

# config menu_cascade
# 'it' is the cascaded menu
# ptk::cascade_info($it) = { upmenu index }
variable ptk::cascade_info
proc ptk::_configure_menu_cascade_cascade { it opts } {
	set infos $ptk::cascade_info($it)
	set zemenu [lindex $infos 0]
	set zeindex [lindex $infos 1]
	foreach { a v } $opts {
		$zemenu entryconfigure $zeindex $a $v
	}
}
# cascade is the 'main' component
interp alias {} ptk::_configure_menu_cascade {} ptk::_configure_menu_cascade_cascade
# it =  menu -> basic
interp alias {} ptk::_configure_menu_cascade_menu {} ptk::_configure_basic

proc ptk::_begin_menu_cascade { opts } {
	ptk::DBG "ptk::begin_cascade $opts"
	set zemenu $ptk::cur_node
	if { [winfo class $zemenu] != "Menu" } {
		ptk::_exit "ptk::menu_cascade must appear within a menu"
	}
	# push a new menu
	set it [ ptk::push_node menu ]
	# prevent other container to pack this menu
	# (useless normally)
	set ptk::packer_req($it) "none"
	# attach it to up menu
	$zemenu add cascade -menu $it
	set zeindex [$zemenu index last]
	#set atts [lindex $args 0]
	foreach { a v } $opts {
ptk::DBG "      $zemenu entryconfigure $zeindex $a $v"
		$zemenu entryconfigure $zeindex $a $v
	}
	set ptk::cascade_info($it) { $zemenu $zeindex }
	return $it
}
proc ptk::_end_menu_cascade { opts } {
	ptk::DBG "ptk::end cascade $opts"
	# just pop
	ptk::pop
}

#### ADD MENU OPTIONS
# Menus hardly require options to work,
# however, this proc is provided since
# 'menu' widgets are implicitely created.
# add tk::menu options to current menu
# args = tk::menu options
proc ptk::menu_configure args {
	ptk::DBG "ptk::menu_configure $args"
	set zemenu $ptk::cur_node
	if { [winfo class $zemenu] != "Menu" } {
		ptk::_exit "ptk::menu_configure must appear within a menu"
	}
	#set atts [lindex $args 0]
	set atts $args
	foreach { a v } $atts {
ptk::DBG "      $zemenu configure $a $v"
		$zemenu configure $a $v
	}
}



#### MENUBUTTON
# starts/end a menu associated to a menubutton
# args = tk::menutton options
# WARNING: to path options to inner menu
# use later: ptk::menu_configure

_def_props {
   {kind       outer   inner  nbsons   params    components}
   {menubutton  packer  menu     any   {}        {menubutton menu}}
}

# 'it' is the menu, [winfo parent $it] is the menubutton
proc ptk::_configure_menubutton_menubutton { it opts } {
	set mb [winfo parent $it]
	ptk::_configure_basic $mb $opts
}
interp alias {} ptk::_configure_menubutton {} ptk::_configure_menubutton_menubutton
interp alias {} ptk::_configure_menubutton_menu {} ptk::_configure_basic


proc ptk::_begin_menubutton { opts } {
	# create a menubutton inside current frame
	set zebut [ ptk::push_node menubutton ]
	eval "$zebut configure $opts"
	# push a new menu inside this menubutton
	set zemenu [ ptk::push_node menu ]
	# attach it to the button
	$zebut configure -menu $zemenu
	return $zemenu
}
proc ptk::_end_menubutton args {
	# TODO check:
	# cur_node must be a menu
	# it's father must be a menubutton
	# pop twice
	ptk::pop
	ptk::pop
}


