proc Dialog {w geometry title text bitmap default cancel args} {
  global button

  toplevel $w -class Dialog
  wm title $w $title
  wm iconname $w Dialog
  wm geometry $w $geometry
  wm transient $w .

  frame $w.top
  pack $w.top -side top -fill both
  frame $w.rule -relief sunken -bd 2 -height 2
  pack $w.rule -side top -fill x
  frame $w.bot
  pack $w.bot -side bottom -fill both

  message $w.top.msg -width 250 -text $text \
    -font -Adobe-Times-Medium-R-Normal-*-180-*
  pack $w.top.msg -side right -expand 1 -fill both \
    -padx 5 -pady 5
  if {$bitmap != ""} {
    label $w.top.bitmap -bitmap $bitmap
    pack $w.top.bitmap -side left -padx 5 -pady 5
  }

  set i 0
  foreach but $args {
    set text [lindex $but 0]
    if [llength $but]>1 {
      bind $w [lindex $but 1] "set button $i"
    }
    if {$i == $default} {
      frame $w.bot.default -relief sunken -bd 1
      button $w.bot.button$i -text $text -command \
        "set button $i" -default active
      pack $w.bot.button$i -side left -expand 1 -padx 10 -pady 5
    } else {
     button $w.bot.button$i -text $text -command \
       "set button $i"
      pack $w.bot.button$i -side left -expand 1 \
        -padx 10 -pady 5 
    }
    incr i
  }
  if {$default >= 0} {
    bind $w <Control-Return> "$w.bot.button$default flash; \
      set button $default"
  }
  if {$cancel >= 0} {
    bind $w <Escape> "set button $cancel"
  }
  set oldfocus [focus]
  focus $w
  grab $w
  tkwait variable button
  grab release $w
  focus $oldfocus
  destroy $w
  return $button
}

proc Warning {geometry text} {
  Dialog .warn $geometry Warning $text warning 0 0 {OK <Return>} 
}
  
proc InpDlgTest {i} {
  global inpdlg_var
  global inpdlg_type

  switch -exact $inpdlg_type($i) {
    year {
      return 1
    }
    int {
      if {[catch {expr int($inpdlg_var($i)) == $inpdlg_var($i)} r] == 0} {
        if $r {return 1} else {return 0}
       } else {return 0}
    }
    default {return 1}
  }
  return 0
}

proc InpDlgNext {w i count} {

  if ![InpDlgTest $i] {
    puts \a
    return
  }
  incr i
  if $i>=$count {set i 0}
  focus $w.f$i.e
}

proc InpDlgPrev {w i count} {

  if ![InpDlgTest $i] {
    puts \a
    return
  }
  incr i -1
  if $i<0 {set i [expr $count-1]}
  focus $w.f$i.e
}

proc InpDlg {result w title geometry lab fields values} {
  upvar $result r
  upvar $values v

  global inpdlg_var
  global inpdlg_type

  toplevel $w
  wm geometry $w $geometry
  wm title $w $title

  label $w.label -text $lab
  pack $w.label -fill x
  frame $w.r1 -height 2 -bd 1 -relief sunken
  pack $w.r1 -pady 2 -fill x
  frame $w.fdata
  pack $w.fdata -fill x
  set count [llength $fields]
  set i 0
  foreach f $fields {
    frame $w.f$i
    pack $w.f$i -fill x -in $w.fdata
    label $w.f$i.l -width 20 -font fixed -text [lindex $f 0] -anchor w
    entry $w.f$i.e -textvariable inpdlg_var($i) -width [lindex $f 2] \
      -relief sunken -font fixed
    bind $w.f$i.e <Return> "%W xview 0 ; InpDlgNext $w $i $count"
    bind $w.f$i.e <Down> "%W xview 0 ; InpDlgNext $w $i $count"
    bind $w.f$i.e <Tab>   "%W xview 0 ; InpDlgNext $w $i $count"
    bind $w.f$i.e <Shift-Tab> "%W xview 0 ; InpDlgPrev $w $i $count"
    bind $w.f$i.e <Up> "%W xview 0 ; InpDlgPrev $w $i $count"
    bind $w.f$i.e <Control-Return> "set inpdlg(ok) 1"
    bind $w.f$i.e <Escape> "set inpdlg(ok) 0"
    pack $w.f$i.l $w.f$i.e -side left
    set inpdlg_type($i) [lindex $f 1]
    set inpdlg_var($i) ""
    incr i
  }

  set i 0
  foreach l $fields {
    set ri [lindex $l 3]
    switch $inpdlg_type($i) {
      default {set inpdlg_var($i) $v($ri)}
    }
    incr i
  }

  frame $w.r2 -height 2 -bd 1 -relief sunken
  pack $w.r2 -pady 2 -fill x
  frame $w.fbuttons
  pack $w.fbuttons -fill x
  button $w.ok -text "OK" -command "set inpdlg(ok) 1" -default active
  button $w.cancel -text "Cancel" -command "set inpdlg(ok) 0"

  pack $w.ok $w.cancel -side left -padx 10 -pady 5 -in $w.fbuttons

  set oldfocus [focus]
  focus $w.f0.e
  grab $w
  tkwait variable inpdlg(ok)
  grab release $w
  if $inpdlg(ok) {
    set i 0
    foreach l $fields {
      set ri [lindex $l 3]
      switch $inpdlg_type($i) {
        default {set r($ri) $inpdlg_var($i)}
      }
      incr i
    }
  }
  focus $oldfocus
  destroy $w
  return $inpdlg(ok)
}

# ListDlg

proc lstdlg_sel {{i 0}} {
  global dlg

  $dlg(win).fl.l activate $i
  $dlg(win).fl.l select anchor $i
  $dlg(win).fl.l select set anchor $i
  $dlg(win).fl.l see $i
}

proc lstdlg_selnext {} {
  global dlg

  set i [lindex [$dlg(win).fl.l curselection] 0]
  set l [llength $dlg(list)]
  incr i
  if {$i >= $l} {set i [expr $l - 1]}
  lstdlg_sel $i
}

proc lstdlg_selprev {} {
  global dlg

  set i [lindex [$dlg(win).fl.l curselection] 0]
  set l [llength $dlg(list)]
  incr i -1
  if {$i < 0} {set i 0}
  lstdlg_sel $i
}

proc ListDlg {w geometry text list {default 0}} {
  global dlg

  toplevel $w
  wm geometry $w $geometry
#  wm transient $w .
  wm title $w $text

  label $w.title -text $text
  pack $w.title -side top -expand 1
  frame $w.fl
  pack $w.fl -fill x -side top -pady 5
  scrollbar $w.fl.s -command "$w.fl.l yview"
  pack $w.fl.s -side right -fill y
  listbox $w.fl.l -relief sunken -bd 2 -height 8 -width 25 \
    -yscrollcommand "$w.fl.s set" -font fixed
  pack $w.fl.l -side left -fill both -expand true

  frame $w.rule -bd 1 -height 2 -relief sunken
  pack $w.rule -side top -fill x
  frame $w.b
  pack $w.b -fill x -side top
  button $w.b.ok -text OK -command "set dlg(ok) 1" -default active
  button $w.b.cancel -text Cancel -command "set dlg(ok) 0"
  pack $w.b.ok $w.b.cancel -padx 10 -pady 5 -side left -expand 1

#  bind $w <Down>    lstdlg_selnext
#  bind $w <Up>      lstdlg_selprev
  bind $w.fl.l <Any-Return> "set dlg(ok) 1"
  bind $w.fl.l <Escape>     "set dlg(ok) 0"

  set dlg(win) $w
  set dlg(list) $list
  eval $w.fl.l insert end $list
  set old_focus [focus]
  focus $w.fl.l
  grab $w
#  update
  lstdlg_sel $default 
  tkwait variable dlg(ok)
  grab release $w
  set i [lindex [$w.fl.l curselection] 0]
  focus $old_focus
  destroy $w
  if $dlg(ok) {
    return $i 
  } else {
    return -1
  }
}
