#!/usr/bin/env tclsh
## -*- tcl -*-

package require Tcl 8.6
package require Tk

package require TclOO

## --
## Extend auto_path so package require will find the menubar package
## in the tklib directory hierarchy.
set selfdir  [file dirname [file normalize [info script]]]
set modules [file join [file dirname [file dirname $selfdir]] modules]
lappend auto_path [file join ${modules} menubar]

package require menubar

# uncomment the following line to enable the debugging menu
# package require menubar::debug

package provide AppMain 0.5

# --
# 
namespace eval Main {

	variable wid
	variable mbar
	variable wid

	proc main { } {
		variable mbar
		variable wid
		set wid 0
		
		wm withdraw .

		##
		## Create a menu bar definition
		##

		# create an instance of the menubar class
		set mbar [menubar new \
			-borderwidth 4 \
			-relief groove  \
			-foreground black \
			-background tan \
			-cursor dot \
			-activebackground red \
			-activeforeground white \
			]

		# define the menu tree for the instance
		${mbar} define {
			File M:file {
			#   Label				 Type	Tag Name(s)	
			#   ----------------- 	 ----	---------
				"New Window"	 	 C 		new
				--					 S 							s0
				"Show Macros Menu"	 C 		mshow
				"Hide Macros Menu"   C 		mhide
				"Toggle Paste State" C 		paste_state
				--					 S 							s1
				Close                C      close
				--					 S 							s2
				Exit			  	 C		exit
			}
			Edit M:items+ {
			#   Label				Type	Tag Name(s)	
			#   ----------------- 	----	---------
				"Cut"				C 		cut
				"Copy"				C 		copy
				"Paste"				C 		paste
				"Scope (buttons)"		S 							s3
				"Global" M:opts+ {
					"CheckButtons"	S							s4
						Apple		X 		apple+
						Bread		X 		bread
						Coffee		X 		coffee
						Donut		X 		donut+
					"RadioButtons"	S							s5
						"Red"		R 		color
						"Green"		R 		color+
						"Blue"		R 		color
						"~!@#%^&*()_+{}: <>?`-=;',./" R color
				}
				"Local" M:opts2 {
					"Default" M:local1+ {
						"CheckButtons"	S						s6
							Square  	X@		square
							Triangle	X@		triangle+
							rectangle	X@		rectangle
						"RadioButtons"	S						s7
							"Magenta"	R@ 		ryb+
							"Yellow"	R@ 		ryb
							"Cyan"		R@ 		ryb
					}
					"Notebook Tab" M:local2+ {
						"CheckButtons"	S						s8
							Right  		X=		right
							Left		X=		left+
							Top			X=		top
						"RadioButtons"	S						s9
							"North"		R= 		compass+
							"South"		R= 		compass
							"East"		R= 		compass
					}
				}
			}
 			Macros M:macros+ {
 			#	Label				Type	Tag Name(s) 
 			#	-----------------	----	---------
				"Add Item" 			C		item_add
				"Delete Item" 		C		item_delete
				"Add MARK Item" 	C		mark_add
				"Move MARK Up"  	C		mark_up
				"Move MARK Down"	C		mark_down
				"Delete MARK"		C		mark_del
				"Macros"		  	C 		macro_entries
				"Save Macros"  		C		serialize
				"Restore Macros" 	C		deserialize
				--COMMANDGROUP--	G		macro
 			}
			Debug M:debug {
			#   Label				Type	Tag Name(s)	
			#   ----------------- 	----	---------
				"Test tag.cget"		C 		testcget
				"Debug Tree"		C 		debug_tree
				"Debug Nodes"		C 		debug_nodes
				"Debug Installs"	C 		debug_installs
				"Debug notebook"	C 		debug_notebook
				"ptree"				C 		ptree
				"pnodes"			C 		pnodes
				"pkeys"				C 		pkeys
			}
			Help M:help {
			#   Label				Type	Tag Name(s)	
			#   ----------------- 	----	---------
				About			  	C 		about
				--					S						s10
				Clear			  	C 		clear
			}
		}
		
		NewWindow

	}
	
	proc NewWindow { args } {
		variable mbar
		variable wid

		# create pathname for new toplevel window
		set w ".top${wid}"
		incr wid
		
		Gui new ${wid} ${w} ${mbar}
	}
}

# --
# 
oo::class create Gui {

	# ----------------------------------------
	# Create a toplevel with a menu bar
	constructor { wid w menubar } {
		my variable mbar
		my variable wtop
		my variable nb
		my variable tout
		my variable tabvars
		
		## 
		## Create toplevel window
		##

		set wtop ${w}
		toplevel ${wtop}
		wm withdraw ${wtop}
		
		##
		## Define the GUI
		##

		# -- note
		# This demo doesn't use the notebook frames.
		# A real application would include gui elements in the
		# notebook frames.

		set nb [ttk::notebook ${wtop}.nb]
		set tout [text ${wtop}.t -height 12]
		grid ${nb} -sticky news
		grid ${tout} -sticky news
		grid rowconfigure ${wtop} 1 -weight 1
		grid rowconfigure ${wtop} 2 -weight 0

		# add binding for notebook tabs
		bind ${nb} "<<NotebookTabChanged>>" [list [self object] nbTabSelect ${wtop}]

		## 
		## Install & Configure the menu bar
		##
		
		set mbar ${menubar}
		
		${mbar} install ${wtop} {

			# Create tags for this windows text widget. They will be 
			# used by the menubar callbacks to direct output to the
			# text widget.
			${mbar} tag.add tout ${tout}
			${mbar} tag.add gui [self object]

			${mbar} menu.configure -command {
				# file menu
				new				{::Main::NewWindow}
				mshow			{my mShow}
				mhide			{my mHide}
				paste_state		{my TogglePasteState}
				close			{my Close}
				exit			{my Exit}
				# Item menu
				cut				{my Edit cut}
				copy			{my Edit copy}
				paste			{my Edit paste}
				# boolean menu
				apple	     	{my BoolToggle}
				bread	     	{my BoolToggle}
				coffee	     	{my BoolToggle}
				donut	     	{my BoolToggle}
				square	     	{my BoolToggle}
				triangle     	{my BoolToggle}
				rectangle     	{my BoolToggle}
				left     		{my NotebookBoolToggle}
				right     		{my NotebookBoolToggle}
				top    			{my NotebookBoolToggle}
				# radio menu
				color	     	{my RadioToggle}
				ryb		     	{my RadioToggle}
				compass	     	{my NotebookRadioToggle}
				# Help menu
				about			{my About}
				clear			{my Clear}
			} -state {
				mhide	    	disabled
				paste	    	disabled
			} -bind {
				exit		{1 Cntl+Q  Control-Key-q}
				cut			{2 Cntl+X  Control-Key-x}
				copy		{0 Cntl+C  Control-Key-c}
				paste		{0 Cntl+V  Control-Key-v}
				apple		{0 Cntl+A  Control-Key-a}
				bread		{0 Cntl+B  Control-Key-b}
				about		0
				clear		{0 {}	  Control-Key-d}
			} -background {
				exit red
			} -foreground {
				exit white
			}


			# change the namespace for commands associated the 
			# 'macros' commands and 'macro' command group
			${mbar} menu.namespace macros ::Macros
			${mbar} menu.namespace macro  ::Macros
			
			# configure the macros menu
			${mbar} menu.configure -command {
				item_add		{NewItem}
				item_delete		{DeleteItem}
				mark_add		{Mark add}
				mark_up			{Mark up}
				mark_down		{Mark down}
				mark_del		{Mark delete}
				macro_entries	{Macros}
				serialize		{Serialize}
				deserialize		{Deserialize}
			} -bind {
				item_add	{0 Cntl+I  Control-Key-i}
				mark_add	{0 Cntl+m  Control-Key-m}
				mark_up		{0 Cntl+U  Control-Key-u}
				mark_down	{0 Cntl+J  Control-Key-j}
				mark_del	{0 Cntl+K  Control-Key-k}
			}
			
			# initally hide the macros menu
			${mbar} menu.hide macros

			# hide the debugging menu unless the package is loaded
			if { [catch {package present menubar::debug}] } {
				${mbar} menu.hide debug
			} else {
				${mbar} menu.configure -command {
					testcget		{my TestCget}
					debug_tree		{my Debug tree}
					debug_nodes		{my Debug nodes}
					debug_installs	{my Debug installs}
					debug_notebook	{my Debug notebook}
					ptree			{my print tree}
					pnodes			{my print nodes}
					pkeys			{my print keys}
				}
			}
		}

		# After the menubar is installed we add 3 tabs
		# to its widget scope.
		my nbNewTab "One"
		my nbNewTab "Two"
		my nbNewTab "Three"

		wm minsize ${wtop} 300 300
		wm geometry ${wtop} 300x300+[expr ${wid}*20]+[expr ${wid}*20]
		wm protocol ${wtop} WM_DELETE_WINDOW [list [self object] closeWindow ${wtop}]
		wm title ${wtop} "Menubar Demo"
		wm focusmodel ${wtop} active
		wm deiconify ${wtop}

		return
	}
	
	method pout { txt } {
		my variable wtop
		my variable mbar
		set tout [${mbar} tag.cget ${wtop} tout]
		${tout} insert end "${txt}\n"
	}
	
	method nbNewTab { text } {
		my variable mbar
		my variable wtop
		my variable nb
		set tabid [${nb} index end]
		incr tabid
		set tabwin ${wtop}.tab${tabid}
		${nb} add [frame ${tabwin}] -text ${text}
		${mbar} notebook.addTabStore ${tabwin}
	}
	
	method nbTabSelect { wtop args } {
		my variable mbar
		my variable nb
		my Clear
		# restore tab values
		set tabwin [${nb} select]
		${mbar} notebook.restoreTabValues ${tabwin}
		my pout "Tab Selected: ${tabwin}"
	}

	method mShow { args } {
		my variable mbar
		${mbar} menu.show macros
		${mbar} menu.configure -state {
			mshow		disabled
			mhide		normal
		}
	}

	method mHide { args } {
		my variable mbar
		${mbar} menu.hide macros
		${mbar} menu.configure -state {
			mshow		normal
			mhide		disabled
		}
	}

	method closeWindow { wtop } {
		my variable mbar
		destroy ${wtop}
		# check to see if we closed the last window
		if { [winfo children .] eq ""  } {
			my Exit
		}
	}

	method Close { args } {
		my closeWindow {*}${args}
	}

	method Exit { args } {
		puts "Goodbye"
		exit
	}

	method Debug { args } {
		my variable wtop
		my variable mbar
		lassign ${args} type
		my Clear
		foreach line [${mbar} debug ${type}] {
			my pout ${line}
		}
	}
	method Clear { args } {
		my variable wtop
		my variable mbar
		set tout [${mbar} tag.cget ${wtop} tout]
		${tout} delete 0.0 end
	}
	
	method TestCget { args } {
		my variable wtop
		my variable mbar
		my Clear
		my pout "user define tag: tout = [${mbar} tag.cget ${wtop} tout]"
		my pout "Command tag: exit -background = [${mbar} tag.cget ${wtop} exit -background]"
		my pout "Checkbutton tag: apple -state = [${mbar} tag.cget ${wtop} apple -state]"
		my pout "Radiobutton tag: color -state = [${mbar} tag.cget ${wtop} color -state]"
		my pout "Cascade tag: chx -background = [${mbar} tag.cget ${wtop} chx -background]"
	}

	method Edit { args } {
		my pout "Edit: [join ${args} {, }]"
	}

	method TogglePasteState { args } {
		my variable mbar
		my pout "TogglePasteState: [join ${args} {, }]"
		lassign ${args} wtop
		set value [${mbar} tag.cget ${wtop} paste -state]
		if { [${mbar} tag.cget ${wtop} paste -state] eq "normal" } {
			${mbar} tag.configure ${wtop} paste -state "disabled" -background {}
		} else {
			${mbar} tag.configure ${wtop} paste -state "normal" -background green
		}
	}

	method BoolToggle { args } {
		my variable wtop
		my variable mbar
		my variable nb
		my pout "BoolToggle: [join ${args} {, }]"
	}

	method RadioToggle { args } {
		my variable wtop
		my variable mbar
		my variable nb
		my pout "RadioToggle: [join ${args} {, }]"
	}

	method NotebookBoolToggle { args } {
		my variable wtop
		my variable mbar
		my variable nb
		my pout "NotebookBoolToggle: [join ${args} {, }]"
		lassign ${args} wtop tag val
		set tabwin [${nb} select]
		${mbar} notebook.setTabValue ${tabwin} ${tag}
	}

	method NotebookRadioToggle { args } {
		my variable wtop
		my variable mbar
		my variable nb
		my pout "NotebookRadioToggle: [join ${args} {, }]"
		lassign ${args} wtop tag val
		set tabwin [${nb} select]
		${mbar} notebook.setTabValue ${tabwin} ${tag}
	}

	method About { args } {
		my pout "MenuBar Demo 0.5"
	}

	method print { args } {
		my variable mbar
		lassign ${args} type wtop
		${mbar} print ${type}
	}
}

# --
# 
namespace eval Macros {

	variable next 0
	variable stream
	variable stream_next

	proc Mark { args } {
		set mbar $::Main::mbar
		
		lassign ${args} action wtop
		set gui [${mbar} tag.cget ${wtop} gui]

		set errno 0
		switch -exact -- ${action} {
		"add"	 {
			set errno [${mbar} group.add macro MARK {Mout "MARK"} Cntl+0 Control-Key-0]
 			if { ${errno} != 0 } {
				${gui} pout "warning: MARK already exists"
 			} else {
 				${mbar} group.configure macro MARK \
 					-background tan \
					-foreground white
 			}
		}
		"delete" {
			set errno [${mbar} group.delete macro MARK]
			if { ${errno} != 0 } {
				${gui} pout  "warning: MARK not found"
			}
		}
		"up"	 {
			set errno [${mbar} group.move up macro MARK]
 			if { ${errno} != 0 } {
				${gui} pout "warning: MARK move up failed"
 			}
		}
		"down"	 {
			set errno [${mbar} group.move down macro MARK]
 			if { ${errno} != 0 } {
				${gui} pout "warning: MARK move down failed"
 			}
		}}
	}
	
	proc NewItem { args } {
		variable next
		if { ${next} == 9 } { return }
		incr next
		set mbar $::Main::mbar
		set errno [${mbar} group.add macro Item${next} "Mout item${next}" Cntl+${next} Control-Key-${next}]
 		if { ${errno} != 0 } {
			lassign ${args} wtop
			set gui [${mbar} tag.cget ${wtop} gui]
			${gui} pout "warning: Item${next} already exists"
 		}	
	}
	
	proc DeleteItem { args } {
		variable next
		set mbar $::Main::mbar
		set item "Item${next}"
		${mbar} group.delete macro ${item}
		if { ${next} > 0 } {
			incr next -1
		}
	}

	proc Macros { args } {
		set mbar $::Main::mbar
		puts "---"
		puts [${mbar} group.entries macro]
	}

	proc Serialize { args } {
		variable next
		variable stream
		variable stream_next
		set mbar $::Main::mbar
		set stream [${mbar} group.serialize macro]
		set stream_next ${next}
		puts "---"
		puts ${stream}
	}

	proc Deserialize { args } {
		variable next
		variable stream
		variable stream_next
		set next ${stream_next}
		set mbar $::Main::mbar
		${mbar} group.deserialize macro ${stream}
	}

	proc Mout { args } {
		set mbar $::Main::mbar
		lassign ${args} action wtop
		set gui [${mbar} tag.cget ${wtop} gui]
		${gui} pout  "Mout: [join ${args} {, }]"
	}
}


Main::main