#
# A short function to build menus from structures
#
# <20210130.1623.03>
#
# This function takes a complex structure and builds a menu from it.
#
# The call:
#
# buildCasMenu struct1 struct2 button action ?options?
#
# struct1 is is the head info for the menu. It may be empty, but
#         if not, is intended to contain entries that are always
#         the same. Entries may be:
#         {}          empty, creates a seperator
#         simple      creates an entry with label 'simple' returns 'simple'
#         {lab sm}    creates an entry with label 'lab', returns 'sm'
#         {-lab {new}} where 'new' is a sub list of at least two entries
#                     creats a cascade with label 'lab'. Each entry in
#                     'new' creates an entry in the sub menu.
#                     this may be continued for as may cascades as needed.
#         If struct1 is {} any existing menu entries will not be cleared.

# struct2 is the structure containing the menu items. This has the same
#         format as struct1 (infact it is concationated with struct1)

# button is the menu is to be built. This should exist
#        when the call is made.  Any menu entries on this button will be
#        cleared when the call is made (to allow dynamic menus)
# action is a function that is the command that is called when a menu
#        item is selected. It will get three parameters:
#        A) the 'returns' value (see above list structure) and
#        b) 1 if from struct1 and 2 if from struc2
#        C) the entry number which is the lindex key for the entry
#           For cascade menus this will have form {n m ...}
#        Each 
# args   is an optional list of doublets of two forms:
#        a) the first of the doublet starts with "-" i.e.
#           {-ent value} which are to be used with the menu. Most useful
#           here is "-tearoffcommand xxx" and "-tearoff true -font 'font'"
#           These entries are only used on cascade menus.
#        b) the first of the doublet does NOT start with "-"
#           {filter command} will pass the menu entry label to "command" and
#           put the result as the label in the menu.
#
proc buildCasMenu {s1 s2 w ac args } {
  # our master window
  set wh 1
  # form two arg lists...
  set filter {set du}
  set textmenu [expr {[winfo class $w] == "TextMenu"}]
  set ops {}
  foreach {op val} $args {
    if {[string index $op 0] == "-"} {
      lappend ops $op $val
    } elseif {$op == "filter"} {
      set filter $val
    }
  }
  # frputs args filter ops
  if {$s1 != {}} {
    $w delete [expr {[$w type 0] == "tearoff" ? 1 : 0}] end
  }
  foreach list [list $s1 $s2] {
    buildMenuWork $w $list {}
    incr wh
  }  
}


proc buildMenuWork {w li sub} {
  upvar 1 ac ac wh wh ops ops filter filter textmenu textmenu
  set level -1
  foreach en $li {
    incr level
    set tag [expr {$sub == {} ? $level : [list {*}$sub $level]}]
    set remains [lassign $en lab val]
    # frputs  lab val
    switch -glob $lab  {
      {} {$w add separator}
      -* {
        # puts "$w $level $en $lab $val"
	if {! $textmenu} {
	  destroy $w.$level
	  menu $w.$level -title [string range $lab 1 end]  {*}$ops
	}
	$w add cascade -menu $w.$level -label [string range $lab 1 end]
	$w.$level delete 0 end
	buildMenuWork $w.$level $val [list {*}$tag 1]
      }
      default {
	if {$remains != {}} {
	  PopWarn [_ "Ill formed list at \"%s\"" $en]
	}
	# This allows {} as a valid return
	if {[llength $en] == 1} {
	  set val $lab
	}
	set dlab [eval [list {*}$filter $lab]]
	$w add command -label "$dlab" -command [list {*}$ac $val $wh   $tag]}
    }
  }
}
