# menu.tcl --
#
#

namespace eval NSMenu {

variable MenuPriv

# Option: Use array instead of list for identifiers
variable IdentArray 1

# NSMenu::NSMenu --
#
#	Object constructor called by NSObject::New.
#
# Arguments:
#	oop				OOP ID returned by NSObject::New
#	parent				OOP ID of parent menu or toplevel window pathname
#	menuDef				Menu definition

proc NSMenu {oop parent menuDef} {

	global NSMenu
	variable MenuPriv

# Debug "Parsing OOP ID #$oop > $menuDef"

	set MenuPriv(postcommand) {}
	set MenuPriv(ident) {}
	set MenuPriv(entries) {}
	set MenuPriv(options) {}
	_MenuParseMenu $menuDef

	if {"[string index $parent 0]" != "."} {

		set topOop $NSMenu($parent,topOop)

		set m $NSMenu($parent,menu).menu$oop

		# Append OOP ID to menubar's list of OOP ID's
		lappend NSMenu($topOop,subOop) $oop

	} else {

		set m $parent.menu$oop
		$parent configure -menu $m

		set topOop $oop
#		lappend NSMenu($topOop,subOop) $oop
	}

# Debug "Making menu $m $MenuPriv(options)"

	eval menu $m $MenuPriv(options)

	if {$topOop == $oop} {
		$m configure -postcommand "NSMenu::_MenuPostCommand $topOop"
	} elseif {$MenuPriv(postcommand) != {}} {
		$m configure -postcommand $MenuPriv(postcommand)
	}

	set NSMenu($oop,menu) $m
	set NSMenu($oop,postcommand) $MenuPriv(postcommand)
	set NSMenu($oop,ident) $MenuPriv(ident)
	set NSMenu($oop,subIdent) {}
	set NSMenu($oop,subOop) {}
	set NSMenu($oop,topOop) $topOop

	bind $m <Destroy> "Debug \"Destroy menu $oop\" ; NSObject::Delete NSMenu $oop"

	# _MenuMonster $menu $menuDef $entryDef
}

# NSMenu::~NSMenu --
#
#	Object destructor called by NSObject::Delete.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc ~NSMenu oop {

	global NSMenu

	# Seems to destroy things twice...
	if {![info exists NSMenu($oop,topOop)]} return

	set topOop $NSMenu($oop,topOop)
	set index [lsearch -exact $NSMenu($topOop,subOop) $oop]
	if {$index == -1} return

	set NSMenu($topOop,subOop) [lreplace $NSMenu($topOop,subOop) $index $index]
}

# NSMenu::MenuInsertEntry --
#
#	Search menu tree for given identifier, then parse the menu
#	entry definition and insert the new entry before the entry
#	specified by the identifier.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc MenuInsertEntry {top pos ident entryDef} {

# Debug "MenuInsertEntry $top $pos $ident > $entryDef"

	set entry [_MenuFindEntry $top $ident]
	if {$entry == {}} return

	set oop [lindex $entry 0]
	set index [lindex $entry 1]

	switch -- $pos {

		-first {set index 0}
		-end {set index end}
		-append {set index 1000}
		-before {}
		-after {incr index}
	}

	if {$index == "IS_MENU"} {
	}

	_MenuInsertEntry $oop $index $entryDef
}

# NSMenu::_MenuInsertEntry --
#
#	Parse entry definition and insert into menu widget.
#	Also insert matching identifier into list of identifiers.
#
# Arguments:
#	oop				OOP ID of this menu
#	beforeIdent				Entry identifier to insert just before, or end
#	entryDef				Menu entry definition
#
# Results:
#	What happened.

proc _MenuInsertEntry {oop index entryDef} {

	global NSMenu
	variable MenuPriv

	set menu $NSMenu($oop,menu)

	set MenuPriv(ident) {}
	set MenuPriv(menu) {}
	set string [_MenuParseEntry $menu $index $entryDef]

	if {$MenuPriv(menu) != {}} {

		set topOop $NSMenu($oop,topOop)
		foreach subOop $NSMenu($topOop,subOop) {
			if {![string compare $NSMenu($subOop,ident) $MenuPriv(menu)]} {
				append string " -menu $NSMenu($subOop,menu)"
			}
		}
	}

	eval $string

	if $NSMenu::IdentArray {
	if {$index == "end"} {
		set index [$menu index end]
	}
	set NSMenu($oop,subIdent,$MenuPriv(ident)) $index
	} else {
	set NSMenu($oop,subIdent) [linsert $NSMenu($oop,subIdent) $index $MenuPriv(ident)]
	}
}

# NSMenu::MenuDeleteEntry --
#
#	Delete menu entry from menu widget and identifier from list
#	of identifiers.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc MenuDeleteEntry {top ident} {

	global NSMenu

	set entry [_MenuFindEntry $top $ident]
	if {$entry == {}} return

	set oop [lindex $entry 0]
	set index [lindex $entry 1]
	set menu $NSMenu($oop,menu)

	if {$index == "IS_MENU"} {
		destroy $menu
	} else {
		$menu delete $index
		if $NSMenu::IdentArray {
		unset NSMenu($oop,subIdent,$ident)
		} else {
		set NSMenu($oop,subIdent) [lreplace $NSMenu($oop,subIdent) $index $index]
		}
	}
}

# NSMenu::_MenuSetupOne --
#
#	Disable all the entries in the given menu.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc _MenuSetupOne {oop} {

	global NSMenu

	set menu $NSMenu($oop,menu)
	set last [$menu index end]
	if {$last == "none"} return

	for {set i 0} {$i <= $last} {incr i} {
		if {[$menu type $i] == "separator"} continue
		$menu entryconfigure $i -state disabled
	}
}

# NSMenu::MenuSetup --
#
#	Set up each sub menu.
#
# Arguments:
#	toop						OOP ID of menubar
#
# Results:
#	What happened.

proc MenuSetup toop {

	global NSMenu

	foreach subOop $NSMenu($toop,subOop) {
		_MenuSetupOne $subOop
	}
}

# NSMenu::MenuEnable --
#
#	Search menu tree for given identifier and set state
#	of entry to normal.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc MenuEnable {oop identList} {

	global NSMenu
	variable MenuPriv

	foreach ident $identList {

		set entry [_MenuFindEntry $oop $ident]
		if {$entry == ""} continue
	
		set menu $NSMenu([lindex $entry 0],menu)
		$menu entryconfigure [lindex $entry 1] -state normal
	}
}

# NSMenu::MenuMatchEntryOne --
#
#	Search given menu for identifiers matching pattern.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	Return numerical index into menu or -1.

proc MenuMatchEntryOne {oop pattern} {

	global NSMenu

	set result {}

	if {![string match $pattern $NSMenu($oop,ident)]} {
		lappend result $ident
	}

	foreach ident $NSMenu($oop,subIdent) {
		if {![string match $pattern $ident]} {
			lappend result $ident
		}
	}

	return $result
}

# NSMenu::MenuMatchEntry --
#
#	Search given menu and submenus for identifiers matching pattern.
#
# Arguments:
#	oop					OOP ID of menubar
#	pattern					Pattern to match identifiers against
#
# Results:
#	Return list "oop index" or empty list.

proc MenuMatchEntry {oop pattern} {

	global NSMenu

	append result [MenuMatchPattern $oop $pattern]

	foreach subOop $NSMenu($oop,subOop) {
		append result [MenuMatchEntry $subOop $pattern]
	}

	return result
}

# NSMenu::_MenuFindEntryOne --
#
#	Search given menu only for identifier.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	Return numerical index into menu or -1.

proc _MenuFindEntryOne {oop ident} {

	global NSMenu

if {![string compare $NSMenu($oop,ident) $ident]} {
	return IS_MENU
}

	if $NSMenu::IdentArray {
	if {![info exists NSMenu($oop,subIdent,$ident)]} {return -1}
	return $NSMenu($oop,subIdent,$ident)
	} else {
	return [lsearch -exact $NSMenu($oop,subIdent) $ident]
	}
}

# NSMenu::_MenuFindEntry --
#
#	Search given menu and submenus for identifier.
#
# Arguments:
#	oop					OOP ID of menubar
#	ident					identifier to look for
#
# Results:
#	Return list "oop index" or empty list.

proc _MenuFindEntry {oop ident} {

	global NSMenu

	set index [_MenuFindEntryOne $oop $ident]
	if {$index != -1} {
		return [list $oop $index]
	}

	foreach subOop $NSMenu($oop,subOop) {
		set index [_MenuFindEntryOne $subOop $ident]
		if {$index != -1} {
			return [list $subOop $index]
		}
	}

	return ""
}

# NSMenu::_MenuParseMenu --
#
#	Given a menu definition, return a string such that "eval $string"
#	will create a menu widget.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc _MenuParseMenu entry {

    variable MenuPriv
 
    foreach {option value} $entry {
    
        switch -- $option {
        
			-postcommand {set MenuPriv(postcommand) $value}

            -identifier {set MenuPriv(ident) $value}

            -entries {set MenuPriv(entries) $value}

            -parent {set MenuPriv(parent) $value}

            default {append MenuPriv(options) " $option {$value}"}
        }
    }
}

# NSMenu::_MenuParseEntry
#
#	Given a menu entry definition, return a string such that
#	"eval $string" will create a menu widget entry.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc _MenuParseEntry {menu index entry} {

	variable MenuPriv

	set string "$menu insert $index"

    foreach {option value} $entry {
    
        switch -- $option {
        
            -type {append string " $value"}

            -menu {set MenuPriv(menu) $value}

            -identifier {set MenuPriv(ident) $value}

            default {
				regsub -all "\{" $value "\\\{" value
				regsub -all "\}" $value "\\\}" value
				append string " $option {$value}"
			}
        }
    }

# Debug "_MenuParseEntry:\n  $entry\n  $string"

    return $string
}

# NSMenu::_MenuPostCommand --
#
#	Called before posting a menu. Calls MenuSetup to configure the
#	state of each item.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc _MenuPostCommand toop {

	global NSMenu

# Debug "_MenuPostCommand $toop"

	MenuSetup $toop

	if {$NSMenu($toop,postcommand) != {}} {
		uplevel #0 "$NSMenu($toop,postcommand) $toop"
	}
}

# NSMenu::MenuInsertEntries --
#
#	Description
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc MenuInsertEntries {top pos ident entryDef} {

	global NSMenu

	set entry [_MenuFindEntry $top $ident]
	if {$entry == {}} return

	set oop [lindex $entry 0]
	set index [lindex $entry 1]

	switch -- $pos {

		-first {set index 0}
		-end {set index end}
		-append {set index 1000}
		-before {}
		-after {incr index}
	}

if 1 {
	if {$pos == "-end"} {
		set index [$NSMenu($oop,menu) index end]
		if {$index == "none"} {
			set index 0
		} else {
			incr index
		}
	}
} else {
	if {$pos != "-append"} {
		set index [$NSMenu($oop,menu) index $index]
		if {$index == "none"} {set index 0}
	}
}
	foreach entry $entryDef {
		_MenuInsertEntry $oop $index $entry
		incr index
	}
}

# NSMenu::_MenuMonster --
#
# Arguments:
#	menuWidget				an existing menu widget
#	menuList				a list of menu definitions to add to the menu widget
#	menuEntries				a list of menu entry definitions for all items in "menuList"
#
# Results:
#	What happened.

proc _MenuMonster {menuWidget menuList menuEntries} {

	global NSMenu
	variable MenuPriv

    set i 0
    foreach menuDef $menuList {

        # Each menu entry has a single (unique) identifier associated
        # with it
        set identifiers ""

        set MenuPriv(entries) ""
        set MenuPriv(ident) ""
        set MenuPriv(options) ""
        set MenuPriv(parent) ""

        _MenuParseMenu $menuDef

        # If the menu definition specified a -parent option, it
        # indicates the entry identifier of an existing parent
        # entry, which this menu is to be made a child of
        if {$MenuPriv(parent) != ""} {

            set infoList [menuFindEntry $menuWidget $MenuPriv(parent)]
            set parent [lindex $infoList 0]
            set index [lindex $infoList 1]

            # Create the menu widget
            set m $parent.menu$index
            set string "menu $m -tearoff no"
            eval $string

            # Configure parent entry 
            set string "$parent entryconfigure $index -menu $m $MenuPriv(options)"
            eval $string

        } else {

            # Create the child menu widget
            set m $menuWidget.menu$i
            menu $m -tearoff no

            # Add a cascading menu entry to the parent
            set string "$menuWidget add cascade -menu $m $MenuPriv(options)"
            eval $string

            # Each child menu added also has an identifier
            lappend MenuTable($menuWidget) $MenuPriv(ident)

            incr i
        }

        $m configure -postcommand "setupMenu $m"

        # The MenuPriv(entries) list is extracted in ParseMenuDef
        foreach identifier $MenuPriv(entries) {

            if {$identifier == "-"} {

                $m add separator
                lappend identifiers "-"

            } else {

                # Search the list of entry definitions for the one
                # associated with the identifier
                foreach entryDef $menuEntries {

                    set index [lsearch $entryDef -identifier]
                    set entryIdent [lindex $entryDef [expr $index + 1]]
                    if {$entryIdent == $identifier} {

                        set string [parseEntryDef $m $entryDef]
                        eval $string
                        lappend identifiers $entryIdent
                        break
                    }
                }
            }
        }

        # For each menu widget, keep a list of identifiers associated with
        # the menu entries. Each menu widget entry is associated with 
        # one (unique) identifier
        set MenuTable($m) $identifiers
    }
}

# namespace eval NSMenu
}

