
# This code is moved from visual3p to be shared by all GUIs
#
# by Jigen
#


proc form_text_optionMenu_dynamic {w varName func after geo {relief flat} \
          {borderwidth 0} {rows 0} {conf ""} {mwvar ""} {pk "-side left"}} {
   form_frame $w $relief $borderwidth $geo

   text_optionMenu_dynamic $w.choices $varName $func $rows $conf $after
   eval pack $w.choices $pk
   if {$mwvar != ""} {
       upvar #0 $mwvar mw_list
       lappend mw_list $w.choices
   }

   set trc [list update_text_optionMenu_dynamic $w.choices $varName \
                         $func $rows $conf $after $mwvar]
   upvar #0 $varName var
   set now [trace vinfo var]
   if ![lmember $now $trc] {
       trace variable var w $trc
   }
}

proc form_text_optionMenu_nt {w varName vals2 after geo {relief flat} \
           {borderwidth 0} {rows 0} {conf ""} {mwvar ""} {pk "-ipady 2"}} {
   form_frame $w $relief $borderwidth $geo

   text_optionMenu $w.m $varName $rows $conf $after $vals2 $mwvar
   eval pack $w.m $pk

   return $w.m
}

proc form_text_optionMenu {w varName vals2 after geo {relief flat} \
           {borderwidth 0} {rows 0} {conf ""} {mwvar ""} {pk "-side left"}} {
   form_frame $w $relief $borderwidth $geo

   text_optionMenu $w.choices $varName $rows $conf $after $vals2 $mwvar
   eval pack $w.choices $pk

   set trc [list update_text_optionMenu $w.choices "" $mwvar]
   upvar #0 $varName var
   set now [trace vinfo var]
   if ![lmember $now $trc] {
       trace variable var w $trc
   }
}


proc form_bitmap_optionMenu {w varName bpath bfiles after geo {relief flat} \
           {borderwidth 0} {rows 0} {conf ""} {mwvar ""} {pk "-side left"}} {
   form_frame $w $relief $borderwidth $geo

   fbitmap_optionMenu $w.choices $varName $rows $conf $after \
                    $bpath $bfiles $mwvar
   eval pack $w.choices $pk

   set trc [list update_fbitmap_optionMenu $w.choices $mwvar]
   upvar #0 $varName var
   set now [trace vinfo var]
   if ![lmember $now $trc] {
       trace variable var w $trc
   }
}


proc text_optionMenu_postcommand2 {m func rows cmd} {
    $m delete 0 1000
    foreach {L i} [eval $func] {
       $m add command -label $L -command "$cmd $i"
    }
    if {$rows} {
       set n [$m index last]
       $m entryconfigure 0 -columnbreak 1
       for {set i $rows} {$i <= $n} {incr i $rows} {
           $m entryconfigure $i -columnbreak 1
       }
    }
}


proc text_optionMenu_postcommand {m varName func rows cmd {ind_on 1}} {
    upvar #0 $varName var

    $m delete 0 1000
    foreach {L i} [eval $func] {
       $m add radiobutton -label $L  -indicatoron $ind_on \
              -variable $varName -value $i  -command $cmd
    }
    if {$rows} {
       set n [$m index last]
       $m entryconfigure 0 -columnbreak 1
       for {set i $rows} {$i <= $n} {incr i $rows} {
           $m entryconfigure $i -columnbreak 1
       }
    }
}


proc text_optionMenu_dynamic {w varName func rows conf cmd} {
    upvar #0 $varName var
    if ![info exists var] { set var 0 }
    set t0 ""
    foreach {L i} [eval $func] {
       if {$i == $var} {set $t0 $L; break}
    }
 
    menubutton $w -text $t0 -indicatoron 1 -menu $w.menu \
         -relief raised -bd 2 -highlightthickness 2 -anchor c -direction flush
    menu $w.menu -tearoff 0 -postcommand [list text_optionMenu_dynamic_post \
                                    $w $varName $func $rows $conf $cmd]
    text_optionMenu_dynamic_post $w $varName $func $rows $conf $cmd
}


proc update_text_optionMenu_dynamic {w varName func rows conf cmd mwvar args} {
    text_optionMenu_dynamic_post $w $varName $func $rows $conf $cmd
    update_text_optionMenu $w "" $mwvar
}

proc text_optionMenu_dynamic_post {w varName func rows conf cmd} {
    upvar #0 $varName var

    $w.menu delete 0 1000
    foreach {L i} [eval $func] {
       if {$cmd != ""} {
          set cmdi "$w configure -text {$L}; $cmd $i"
       } else {
          set cmdi "$w configure -text {$L}"
       }
       $w.menu add radiobutton -label $L  -indicatoron 1 -variable $varName \
              -value $i  -command $cmdi
       if {$i == $var} {eval $w configure -text {$L}}
    }
    if {$rows} {
       set n [$w.menu index last]
       $w.menu entryconfigure 0 -columnbreak 1
       for {set i $rows} {$i <= $n} {incr i $rows} {
           $w.menu entryconfigure $i -columnbreak 1
       }
    }
    if {$conf != ""} {
        eval $w configure $conf
    }
}


proc text_optionMenu {w varName rows conf cmd vals2 {mwvar ""}} {
    upvar #0 $varName var
    if ![info exists var] {
        set var 0 
    }
    menubutton $w -text [lindex $vals2 0] -indicatoron 1 -menu $w.menu \
        -relief raised -bd 2 -highlightthickness 2 -anchor c -direction flush

    if {$mwvar != ""} {
       upvar #0 $mwvar mw_list
       lappend mw_list $w
    }

    menu $w.menu -tearoff 0
    set j 0
    foreach {L i} $vals2 {
       if {$cmd != ""} {
          set cmdi "update_text_optionMenu $w $j ${mwvar}; $cmd $i"
       } else {
          set cmdi "update_text_optionMenu $w $j ${mwvar}"
       }

       $w.menu add radiobutton -label $L -indicatoron 1 -variable $varName \
              -value $i -command $cmdi
       if {$i == $var} {$w configure -text $L}
       incr j
    }
    
    if {$rows} {
       $w.menu entryconfigure 0 -columnbreak 1
       set n [$w.menu index last]
       for {set i $rows} {$i <= $n} {incr i $rows} {
           $w.menu entryconfigure $i -columnbreak 1
       }
    }
    if {$conf != ""} {
        eval $w configure $conf 
    }

    return $w.menu
}

proc update_text_optionMenu {w {i ""} {mwvar ""} args} {
    set varName [$w.menu entrycget 0 -variable]
    if {$varName == ""} return
    upvar #0 $varName var

    if {$i == ""} {
       set n [$w.menu index last]
       for {set i 0} {$i <= $n} {incr i} {
           if {[$w.menu entrycget $i -value] == $var} { break }
        }
    }

    set txt [$w.menu entrycget $i -label]
    if {$mwvar != ""} {
       upvar #0 $mwvar mw_list
       foreach m $mw_list {
          if [winfo exist $m] { $m configure -text $txt }
       }
    } else {
       $w configure -text $txt
    }
}

proc bitmap_optionMenu {w varName rows conf cmd bitmaps_list} {
    upvar #0 $varName var
    if ![info exists var] {
        set var 0
    }
    menubutton $w -image [lindex $bitmaps_list $var] -indicatoron 1 \
            -menu $w.menu -relief raised -bd 2 -highlightthickness 2 -anchor c

    menu $w.menu -tearoff 0
    set i 0
    while {$i < [llength $bitmaps_list] } {
       $w.menu add radiobutton -image [lindex $bitmaps_list $i] \
              -indicatoron 0 -variable $varName -value $i \
              -command "$w configure -image [lindex $bitmaps_list $i]; $cmd"
       incr i
    }

    if {$rows} {
       $w.menu entryconfigure 0 -columnbreak 1
       for {set i $rows} {$i < [llength $bitmaps_list] } \
                      {incr i $rows} {
           $w.menu entryconfigure $i -columnbreak 1
       }
    }
    if {$conf != ""} {
        eval $w configure $conf
    }

    return $w.menu
}

proc fbitmap_optionMenu {w varName rows conf cmd bpath bfiles mwvar} {
    upvar #0 $varName var
    if ![info exists var] {
        set var 0
    }
    menubutton $w -bitmap @$bpath/[lindex $bfiles $var] -indicatoron 1 \
            -menu $w.menu -relief raised -bd 2 -highlightthickness 2 -anchor c

    if {$mwvar != ""} {
       upvar #0 $mwvar mw_list
       lappend mw_list $w
    } 
    menu $w.menu -tearoff 0
    set i 0
    while {$i < [llength $bfiles] } {
       $w.menu add radiobutton -bitmap @$bpath/[lindex $bfiles $i] \
              -indicatoron 0 -variable $varName -value $i \
              -command "update_fbitmap_optionMenu $w $mwvar; $cmd"
       incr i
    }

    if {$rows} {
       $w.menu entryconfigure 0 -columnbreak 1
       for {set i $rows} {$i < [llength $bfiles] } \
                      {incr i $rows} {
           $w.menu entryconfigure $i -columnbreak 1
       }
    }
    if {$conf != ""} {
        eval $w configure $conf
    }

    return $w.menu
}

proc update_fbitmap_optionMenu {w {mwvar ""} args} {
    set varName [$w.menu entrycget 0 -variable]
    upvar #0 $varName var
    set bmp [$w.menu entrycget $var -bitmap]

    if {$mwvar != ""} {
       upvar #0 $mwvar mw_list
       foreach m $mw_list {
          if [winfo exist $m] { $m configure -bitmap $bmp }
       }
    } else {
       $w configure -bitmap $bmp
    }
}


proc foptionMenu_pulldown {w} {
   set m $w.menu
   if {![winfo exist $m] && ([winfo class $m] != "Menu")} {return}

   set postcmd [$m cget -postcommand]
   if {$postcmd != ""} {eval $postcmd}

   set x [winfo rootx $w]
   set y [expr [winfo rooty $w] + [winfo height $w]]

   $m post $x $y
  # BWidget::grab global $m
}
