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 -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  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"
      pack $w.bot.button$i -in $w.bot.default -side left \
        -padx 5 -pady 3
      pack $w.bot.default -side left -expand 1 \
        -padx 5 -pady 3
    } else {
     button $w.bot.button$i -text $text -command \
       "set button $i"
      pack $w.bot.button$i -side left -expand 1 \
        -padx 10 -pady 10 -ipadx 2 -ipady 1
    }
    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 InpDlg {result w title geometry lab fields values} {
upvar $result r
upvar $values v

global inpdlg_var
global inpdlg_type
global inpdlg_ok

proc InpDlgOk {} {
  global inpdlg_ok

  set inpdlg_ok 1
}

proc InpDlgCancel {} {
  global inpdlg_ok

  set inpdlg_ok 0
}

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 ViewCursor {w} {
  set l [lindex [$w config -width] 4]
  set i [$w index insert]
  if {$i < $l} {
    $w xview 0
  } else {
    $w xview [expr $i - $l + 1]
  }
}

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

label $w.label -text $lab -relief groove -bd 1
pack $w.label -fill x
frame $w.fdata -bd 1 -relief groove
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> "InpDlgOk"
  bind $w.f$i.e <Escape> "InpDlgCancel"
  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) {
    money {
      set sig [sign $v($ri)]
      if ![catch {expr abs($v($ri))/100} mark] {
        set inpdlg_var($i) [format "%4d,%02d" \
          [expr $sig * $mark] [expr abs($v($ri))%100]]
      } else {
        puts $mark
        set inpdlg_var($i) ""
      }
    }
    mnr6 {
      if [string match $v($ri) ""] {
        set inpdlg_var($i) ""
      } else {
        set inpdlg_var($i) "$v($ri)00"
      }
    }
    default {set inpdlg_var($i) $v($ri)}
  }
  incr i
}

frame $w.fbuttons -bd 1 -relief groove
pack $w.fbuttons -fill x
frame $w.fok -relief sunken -bd 2
button $w.ok -text "OK" -command InpDlgOk
button $w.cancel -text "Cancel" -command InpDlgCancel

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

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) {
      money {
        set val $inpdlg_var($i)
        set m [string first "," $val]
        if $m!=-1 {
          set val [string range $val 0 [expr $m-1]].[string range $val \
            [expr $m+1] end]
        }
        if [catch {expr round($val*100)} r($ri)] {set r($ri) 0}
      }
      mnr6 {
        if [catch \
          {format "%6d" [expr $inpdlg_var($i) / 100]} r($ri)] {
          set r($ri) 0
        }
      }
      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).l activate $i
  $dlg(win).l select anchor $i
  $dlg(win).l select set anchor $i
  $dlg(win).l see $i
}

proc lstdlg_selnext {} {
  global dlg

  set i [lindex [$dlg(win).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).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 .

  frame $w.t -bd 1 -relief raised
  pack $w.t -fill x
  label $w.t.l -text $text
  pack $w.t.l -fill both -expand 1
  frame $w.b -bd 1 -relief raised
  pack $w.b -fill x -side bottom
  frame $w.b.fok -relief sunken -bd 2
  button $w.b.ok -text OK -command "set dlg(ok) 1"
  button $w.b.cancel -text Cancel -command "set dlg(ok) 0"
  pack $w.b.fok -padx 10 -pady 10 -side left
  pack $w.b.ok -padx 5 -pady 5 -in $w.b.fok 
  pack $w.b.cancel -padx 10 -pady 10 -side left

  scrollbar $w.s -command "$w.l yview"
  pack $w.s -side right -fill y
  listbox $w.l -relief sunken -bd 2 -yscrollcommand "$w.s set" -font fixed
  pack $w.l -side left -fill both -expand true

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

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