########################################################################
# ATTENTION : MODIF FAITE POUR ADAPTATION A TK3.6 (POUR STEAD)
########################################################################

package provide xtk 1.0

# Menu chapter
proc MenuSetup { {frame .menubar} } {
    global Menu
    frame $frame
    pack $frame -side top -fill x
    set Menu(menubar) $frame
    set Menu(uid) 0
}
proc Menu { label {side left}} {
    global Menu
    if [info exists Menu(menu,$label)] {
        error "Menu $label already defined"
    }
    # Create the menubutton and its menu
    set name $Menu(menubar).mb$Menu(uid)
    set menuName $name.menu
    incr Menu(uid)
    set mb [menubutton $name -text $label -menu $menuName]
    pack $mb -side $side
    # set menu [menu $menuName -tearoff 1]
    set menu [menu $menuName]
    
    # Remember the widget name under a variable derived from the label.
    # This allows mxMenuBind to be passed the label instead of the widget.
    set Menu(menu,$label) $menu
    return $menu
}

proc MenuCommand { menuName label command } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    $menu add command -label $label -command $command
}

proc MenuCheck { menuName label var { command  {} } } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    $menu add check -label $label -command $command \
        -variable $var
}

proc MenuRadio { menuName label var {value {}} { command  {} } } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    if {[string length $value] == 0} {
        set value $label
    }
    $menu add radio -label $label -command $command \
        -value $value -variable $var
}

proc MenuSeparator { menuName } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    $menu add separator
}

proc MenuCascade { menuName label } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    if [info exists Menu(menu,$label)] {
        error "Menu $label already defined"
    }
    set sub $menu.sub$Menu(uid)
    incr Menu(uid)
    # menu $sub -tearoff 0
    menu $sub
    $menu add cascade -label $label -menu $sub
    set Menu(menu,$label) $sub
}

proc MenuBind { what sequence menuName label } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    if [catch {$menu index $label} index] {
        error "$label not in menu $menuName"
    }
    set command [$menu entrycget $index -command]
    bind $what $sequence $command
    $menu entryconfigure $index -accelerator $sequence
}
proc MenuEntryConfigure { menuName label args } {
    global Menu
    if [catch {set Menu(menu,$menuName)} menu] {
        error "No such menu: $menuName"
    }
    eval {$menu entryconfigure $label} $args
}

proc MenuCascadeEditGlob {menuName pattern} {
    global env
    if ![info exist env(EDITOR)] {set env(EDITOR) stead}
    
    set firstTime 1
    set files [lsort [glob -nocomplain $pattern] ]
    foreach f $files  {
    
        if {$firstTime} {
            set label "$env(EDITOR) [file dirname $f]/..."
            set label "$env(EDITOR) $pattern..."
            MenuCascade  $menuName $label
            set firstTime 0
        }
        if [file isdirectory $f] continue
        MenuCommand  $label  [file tail $f] "exec $env(EDITOR) $f &"  
    }
  
}


proc MenuSampler {} {
    MenuSetup
    Menu Sampler1
    MenuCommand Sampler1 Hello! {puts "Hello, World!"}
    MenuCheck Sampler1 Boolean foo {puts "foo = $foo"}
    MenuSeparator Sampler1
    MenuCascade Sampler1 Fruit
    MenuCascadeEditGlob Sampler1 ~/.X*
    MenuRadio Fruit apple fruit
    MenuRadio Fruit orange fruit
    MenuRadio Fruit kimi fruit
    Menu Sampler2
    MenuCommand Sampler2 Hello! {puts "Hello, World!"}
    MenuCheck Sampler2 Boolean foo {puts "foo = $foo"}
    MenuSeparator Sampler2
    MenuCascade Sampler2 Colors
    MenuCascadeEditGlob Sampler2 ~/.*rc
    MenuRadio Colors blue Colors
    MenuRadio Colors white Colors
    MenuRadio Colors red Colors
}
