### Copyright (C) 1995-2000 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

######################################################################
### This function is called at startup, and takes care of creating
### The pulldown menus, and the text widget which the menus are
### located in.
######################################################################
proc createMenu {} {
  global  __language
  set bar [frame .bar]
  pack $bar -fill x

  ### The menubar
  foreach elm {file setup mail help} {
    menubutton $bar.$elm -text [capitalize $elm] -menu $bar.$elm.menu \
        -underline 0
    menu $bar.$elm.menu
  }
  pack $bar.file $bar.setup $bar.mail -side left
  pack $bar.help -side right
  bind $bar.file <3> "help`gotoTag menu_file"
  bind $bar.setup <3> "help`gotoTag menu_setup"
  bind $bar.mail <3> "help`gotoTag menu_mail"
  bind $bar.help <3> "help`gotoTag menu_help"
  
  ### File
  set file $bar.file.menu
  $file add command -label $__language(menus,1) -command generate
  $file add command -label $__language(menus,2) -command regenerate
  $file add command -label $__language(menus,3) -command save
  $file add command -label $__language(menus,4) -command "saveOrExport user-save"
  $file add command -label $__language(menus,5) -command "saveOrExport user-export"
  $file add command -label $__language(menus,6) -command "loadPage 0"
  $file add separator
  $file add command -label $__language(menus,7) -command quit

  ### Setup
  set setup $bar.setup.menu
  $setup add command -label $__language(menus,8) -command setup
  $setup add command -label $__language(menus,9) -command manageSaveFiles

  ### Mail
  set mail $bar.mail.menu
  $mail add command -label $__language(menus,10) \
    -command "mail`comment_bug Comment/Suggestion"
  $mail add command -label $__language(menus,11) \
    -command "mail`comment_bug {Bug Report}"
  $mail add command -label $__language(menus,12) -command mail`postcard
  
  ### help
  set help $bar.help.menu
  $help add command -label $__language(menus,13) -command about
  $help add command -label $__language(menus,14) -command help`helpOnHelp
  $help add command -label $__language(menus,15) \
    -command "help`gotoTag howToUse"
  $help add separator
  $help add command -label $__language(menus,16) -command "showFile Warranty"
  $help add command -label $__language(menus,17) -command "showFile Copying"

  ### The busy indicator
  label .busy -font fixed -justify left -anchor w
  pack .busy -side bottom -padx 3 -fill x -anchor w
  
  ### The text widget
  label .dummy
  text .menu -width 40 -cursor left_ptr -font [.dummy cget -font] -wrap none\
       -yscrollcommand ".scroll set" 
  pack .menu -expand 1 -fill both -side left
  scrollbar .scroll -command ".menu yview"
  bind . <3> "help`gotoTag navigating"
  bind .menu <3> "help`gotoTag navigating"
  bind .menu <Configure> "reconfigureMenu"
  bind .menu <Button1-Motion> break
  bind .menu <Double-1> break
  bindtags .menu ".menu Text"


  ### insert the topmost widgets
  global __dotfile __subPath
  set __dotfile(tagcount) 0
  foreach sub  $__subPath(/) {
    insertMenuItem 2 / $sub
  }
  wm withdraw .
  update
  raise .
}

proc insertMenuItem {offset path name} {
  global __dotfile __menu2funk __folderState argv
  incr __dotfile(tagcount)

  if {[info exists __menu2funk($path$name)]} {
    ### The element is a config page
    set bitmap file.xbm
  } else {
    ### The element is a folder
    set bitmap folder.xbm
  }

  .menu configure -state normal
  set start [.menu index insert]
  .menu insert insert [space $offset]
  set i $__dotfile(tagcount)
  set label .menu.$i
  label $label -bitmap @[lindex $argv 0]/bitmaps/$bitmap
  .menu window create insert -window .menu.$i
  .menu insert insert "$name\n"
  set tag tag$i
  .menu tag add $tag $start insert


  ### binding Enter/Leave/Mouse 1
  set fg [.menu cget -foreground]
  set bg [.menu cget -background]

  set on "
      $label configure -background $fg -foreground $bg
      .menu tag configure $tag -background $fg -foreground $bg
  "
  set off "
      $label configure -background $bg -foreground $fg
      .menu tag configure $tag -background $bg -foreground $fg
  "
  bind $label <Enter> $on
  bind $label <Leave> $off
  .menu tag bind $tag <Enter> $on
  .menu tag bind $tag <Leave> $off

  if {[info exists __menu2funk($path$name)]} {
    ### The element is a config page
    bind $label <1> "loadMenu $__menu2funk($path$name);break"
    .menu tag bind $tag <1> "loadMenu $__menu2funk($path$name);break"
  } else {
    set __folderState($path$name) closed
    bind $label <1> "travelMenu {$path} {$name} $label $offset %X %Y"
    .menu tag bind $tag <1> "travelMenu {$path} {$name} $label $offset %X %Y"
  }
  
  .menu configure -state disabled
}









proc travelMenu {path name bitmap offset x y} {
  global __subPath  __menu2funk __editInfo argv __var2path module __windows
  global __activeNivau __folderState
  
  ### checking if a page is being loaded
  if {$__editInfo(menuload)} return
  set __editInfo(menuload) 1

  
  startBusy "Loading menu...."

    
  ### get the location of the event
  if {![regexp {^([0-9]+)x([0-9]+)([+-][0-9]+)([+-][0-9]+)$} \
            [winfo geometry .] all topDx topDy topSx topSy]} {
    error "Internal error: couldn't match regexp geometry: [winfo geometry .]"
  }
  if {![regexp {^([0-9]+)x([0-9]+)([+-][0-9]+)([+-][0-9]+)$} \
            [winfo geometry .menu] all dx dy sx sy]} {
    error \
        "Internal error: couldn't match regexp geometry: [winfo geometry .menu]"
  }

  set x [expr $x - ($sx+$topSx)]
  set y [expr $y - ($sy+$topSy)]

  ### set the insertion mark
  .menu mark set insert [.menu index [.menu index "@$x,$y lineend"]+1c]

  if {[info exists __folderState($path$name)] &&
      $__folderState($path$name) == "opened"} {
    ## Now close the folder
    $bitmap configure -bitmap @[lindex $argv 0]/bitmaps/folder.xbm
    .menu configure -state normal
    .menu delete insert [.menu index "insert +[countSubOpenSubPages $path$name]l"]
    .menu configure -state disabled
    set __folderState($path$name) "closed"
  } else {
    ## now open the folder
    $bitmap configure -bitmap @[lindex $argv 0]/bitmaps/act_folder.xbm
    set __folderState($path$name) "opened"
    foreach sub $__subPath($path$name/) {
      insertMenuItem [expr $offset+5] $path$name/ $sub
    }
  }

  reconfigureMenu
  endBusy
  set __editInfo(menuload) 0

}




######################################################################
### This function count the number of items below a given page.
### Used in travelMenu, when a folder has to be closed.
######################################################################
proc countSubOpenSubPages {page} {
  global __subPath __folderState
  set count 0
  foreach sub $__subPath($page/) {
    set temp $page/$sub
    if {[lsearch [array names __subPath] $temp/] == -1} {
      incr count
    } else {
      if {[info exists __folderState($temp)] &&
          $__folderState($temp) == "opened"} {
        incr count [countSubOpenSubPages $temp]
      } 
      incr count 1
    }
  }
  return $count
}



############################################################
# This function is called when a menu page is about to be
# created. It is here all initialization is done.
############################################################
proc loadMenu {function} {
  global __editInfo __children __pathProgsNames __activeNivau __changeFunc 
  global __desc __showPage __clean __var2path module  __windows __language

  # check that we are not loading a menu
  # which could happend if the user choose a new menu to fast.
  if {$__editInfo(menuload)} return
  set __editInfo(menuload) 1

  if {$__editInfo(name) == $function && [winfo exist .edit]} {
    set __editInfo(menuload) 0
    wm deiconify .edit
    return
  }

  ### close all sub windows from the old page
  foreach elm [array names __windows] {
    set path [lindex $__windows($elm) 1]
    set prefix [lindex $__windows($elm) 2]
    set name [lindex $__windows($elm) 3]
    UpdateActive [lindex $__children([set __editInfo(name)]__$name) 0] \
      $prefix
    set result [closeWindow $path $prefix $name]
    if {$result == "error"} {
      set __editInfo(menuload) 0
      return
    }
  }

  ### check the page before we leave it.
  if {[checkPage] == 0} {
    set __editInfo(menuload) 0
    return
  }

  startBusy $__language(menus,18)
  


  # check if the window exist, if not create it.
  if {![winfo exists .edit]} {
    makeEdit
  } else {
    catch "destroy .edit.options"
    catch "unset __var2path"
  }

  ### set the title on the window
  set name [lindex [split $__pathProgsNames($function) /] end]
  wm title .edit "$module(name) - $name"

  # unlink all variables
  if {$__editInfo(name) != ""} {
    unlink $__editInfo(name) top ""
    catch {unset __activeNivau}
  }
  
  frame .edit.options -borderwidth 1 -relief sunken
  pack .edit.options -after .edit.name -expand 1 -fill both -expand 1 
  
  set __editInfo(name) $function

  # create the change function
  setChangeFunc
  
  setWhatToGenerate

  # linking the variables of top
  linkVars $function __$function top
  # packing the page
  packAll .edit.options __$function 0

  ### call the showPage and change function
  uplevel \#0 $__showPage($function)
  if {![info exists __clean(__$function)]} {
    cleanUp $function __$function top 
    set __clean(__$function) 1
  }

  # setting the description
  setDesc $__desc($function) .edit

  wm deiconify .edit
  raise .edit
  set __editInfo(menuload) 0
  endBusy
}

######################################################################
### This function should distribute the time spend with calling change
### for each element on a dirty page
######################################################################
proc cleanUp {function prefix name {tuple -1}} {
  global __clean __widgetArgs changeElm __changeFunc __children __scrollBar
  if {$name == "top"} {
    set type frame
  } else {
    set type $__widgetArgs(${function}__${name}__type)
  }

  set children $__children(${function}__$name)

  switch $type {
    frame -
    window {
      ### Do I really want to call the Change function for frames and windows?
      ### Sun Aug 25 14:59:37 1996 -- Jesper Pedersen
#       set changeElm $name
#       if {$name != "top"} {
#         uplevel \#0 $__changeFunc($function)
#       }
      foreach child $children {
        set ctype $__widgetArgs(${function}__${child}__type)
        if {[lsearch {frame window extentry} $ctype] != -1} {
          cleanUp $function $prefix $child
        } elseif {[lsearch {header line label} $ctype] == -1} {
          set changeElm $child
          uplevel \#0 $__changeFunc($function)
        }
      }
    }
    extentry {
      if {$tuple == -1} {
        set count $__widgetArgs(${function}__${name}__count)
        ### run though all the visual tuples of this extentry
        set start [lindex $__scrollBar(${prefix}_$name) 0]
        set total [lindex $__scrollBar(${prefix}_$name) 1]
        set end [min [expr $start+$count] $total]
      } else {
        ### change the given tuple
        set start $tuple
        set end [expr $tuple+1]
      }
      for {set i $start} {$i < $end} {incr i} {
        if {[info exists __clean(${prefix}_${name}_$i)] && $tuple == -1} \
            continue
        UpdateActive [lindex $children 0] ${prefix}_${name}$i
        foreach child $children {
          set ctype $__widgetArgs(${function}__${child}__type)
          if {[lsearch {frame window extentry} $ctype] != -1} {
            cleanUp $function ${prefix}_${name}$i $child
          } elseif {[lsearch {header line label} $ctype] == -1} {
            set changeElm $child
            uplevel \#0 $__changeFunc($function)
          }
        }
        set __clean(${prefix}_${name}_$i) 1
      }
    }
    default {
      error "Internal error: cleanUp called with \"$name\" which were type"\
        "\"$type\""
    }
  }
} 
        
######################################################################
### This function calls the change function for each element from
### the given point and below
######################################################################
proc changeAll {name} {
  global changeElm __editInfo __changeFunc __widgetArgs __children __var2path
  global widget
  set function $__editInfo(name)
  if {$name == "top"} {
    set type frame
  } else {
    set type $__widgetArgs(${function}__${name}__type)
  }

  if {$type == "header" | $type == "line" || $type == "label"} {
    return
  }
  if {$type == "extentry"} {
    forevery $name "foreach child {$__children(${function}__$name)} {changeAll \$child}"
  } else {
    set changeElm $name
    if {$name != "top"} {
      uplevel \#0 $__changeFunc($function)
    }
    if {$type == "frame" || $type == "window" || $type == "filloutelm"} {
      foreach child $__children(${function}__$name) {
        changeAll $child
      }
    }
    if {$type == "command"} {
### In which case should this be done?
### Sun Aug 25 12:46:06 1996 -- Jesper Pedersen      
#       set prefix [buildPath $name $function]
#       if {[info exists __var2path(${prefix}_$name)]} {
#         set widget $__var2path(${prefix}_$name)._$name.2
#         uplevel \#0 $__widgetArgs(${function}__${name}__setvalue)
#         unset widget
#       }
    }
  }
}

######################################################################
###
######################################################################
proc checkPage {} {
  global __editInfo __pageEnd __windows __language
  set function $__editInfo(name)
  if {$function == ""} return 

  startBusy $__language(menus,19)
  saveDefinition print
  proc print {args} {
    error "You can not Print in the PageEnd function"
  }

  ### removing all opened Window widgets
  foreach elm [array names __windows] {
    set path [lindex $__windows($elm) 1]
    set prefix [lindex $__windows($elm) 2]
    set name [lindex $__windows($elm) 3]
    set result [closeWindow $path $prefix $name]
    if {$result == "error"} {
      loadDefinition print
      endBusy
      return 1
     }
  }

  unlink $function top ""
  linkVars $function __$function top
  
  # evaluate the checkfunction
  set err [catch {uplevel \#0 $__pageEnd($function)} errmsg]

  if {$err} {
    global errorInfo
    # check if the window exist, if not create it.
    if {![winfo exists .edit]} {
      makeEdit
      frame .edit.options -borderwidth 1 -relief sunken
      pack .edit.options -after .edit.name -expand 1 -fill both -expand 1 
      packAll .edit.options $function 0
    }
    tk_dialog .errmsg $__language(menus,20) $errmsg error 0 $__language(ok)
    loadDefinition print
    linkVars $function __$function top
    endBusy
    return 0
  }
  loadDefinition print
  endBusy
  return 1
}


proc reconfigureMenu {} {
  if {[lindex [.menu yview] 1] != 1} {
    pack .scroll -fill y  -before .menu -side left
  } else {
     pack forget .scroll
  }
}