#!/usr/local/bin/wishx

#  iud execution
# 
#  Insert Update Delete
#
#  iud_maker   Copyright 1993 Tom Poindexter
#
#  version 2.0 - change all pack's to new syntax
#  version 2.1 - fixes from Neil Walker
#     . removed obsolete right/left arrow bindings from Entry
#     . added extra space in " and" to allow multiple searches
#     . changed width of displayed datefields to 11
#     . removed trailing newlines from Oracle error messages

package require Tcl
package require Tk
package require Tclx
package require Oratcl

catch {oralogon}


# first, set two variables that hold the static execution code
global iud_header
global iud_body

# main iud_maker code: look for CONTINUE


set iud_header \
{#!/usr/local/bin/wishx

#  iud execution
# 
#  Insert Update Delete
#
#  created by iud_maker   Copyright 1993 Tom Poindexter
#

package require Tcl
package require Tk
package require Tclx
package require Oratcl

catch {oralogon}

# define global names in use
global idpass
global tabFields
global srchFields
global lda
global cur
global sel_rec
global col_names
global oramsg
global listfmt
global tablename
global sel_rowid
global listfmt

# set tablename
set tablename DUMMY

# entry fields: column name, label, width, relx, rely, 
#               type(1=num,2=char,3=date), display only (0=no, 1=yes),
#               required (0=no,1=yes)

set tabFields { \
   {dummy} \
}


# search fields: column name, label, width, type 
#
set srchFields { \
   {dummy}  \
}

###################################################################
# iud_maker insert variables next
###################################################################

}

set iud_body \
{

set idpass $argv

set sel_rec   ""
set sel_rowid ""


# login to oracle server

#set retcode [catch {set lda [oralogon $idpass]}]
#
#if $retcode==0 {
#  set cur [oraopen $lda]
#} else  {
#  puts stdout "Database login failed."
#  puts stdout $oramsg(errortxt)
#  exit
#}



########################
#
# getSignOn
#
#   the first window, get logon info and trys to connect to the server
#

proc getSignOn {} {
  global env
  global matchInfo
  global tablename

  # set ORACLE_HOME if not already set
  set ora_home [lsearch [array names env] ORACLE_HOME] 

  if {$ora_home == -1} {
      set ora_home ""
      catch {set ora_home [exec ypcat passwd | egrep  ^oracle: ]}
      if {[string length $ora_home] > 0} {
	  set ora_home [lindex [split $ora_home :] 5]
      } else {
	  set ora_home [exec egrep ^oracle: < /etc/passwd ]
	  if {[string length $ora_home] > 0} {
	      set ora_home [lindex [split $ora_home :] 5]
	  } else {
	      set ora_home ""
	  }
      }
      set $env(ORACLE_HOME) $ora_home
  } else {
      set ora_home $env(ORACLE_HOME)
  }

  # get valid servers from various files
  set serverList ""

  # set ones from /etc/oratab - local servers
  set intFile /etc/oratab
  if [file isfile $intFile] {
    set fd [open $intFile]
    set sc [scancontext create]
    scanmatch -nocase $sc {^[a-z]} \
     {lappend serverList [lindex [split $matchInfo(line) :] 0] }
    scanfile $sc $fd
    close $fd
  }
  # set ones from /etc/sqlnet - remote names
  set intFile /etc/sqlnet
  if [file isfile $intFile] {
    set fd [open $intFile]
    set sc [scancontext create]
    scanmatch -nocase $sc {^[a-z]} \
     {lappend serverList "@[lindex $matchInfo(line) 0]" }
    scanfile $sc $fd
    close $fd
  }
  # set ones from $HOME/.sqlnet - remote names
  set intFile $env(HOME)/.sqlnet
  if [file isfile $intFile] {
    set fd [open $intFile]
    set sc [scancontext create]
    scanmatch -nocase $sc {^[a-z]} \
     {lappend serverList "@[lindex $matchInfo(line) 0]" }
    scanfile $sc $fd
    close $fd
  }

  # nothing found? put in serverList what names should look like
  if {[llength $serverList] == 0} {
    lappend serverList "(localdb)"
    lappend serverList "(@remote_alias)"
    lappend serverList "(@T:host:remotedb)"
  }
  
  wm title    . "$tablename IUD"
  wm iconname . "$tablename"

  wm geom     . 300x300
  frame .s
  message .s.m -justify center  -text "Oracle Server Sign on" -aspect 2000 \
		-font -*-helvetica-bold-o-*-*-20-*-*-*-*-*-*-*
  frame .s.i
  entry .s.i.uid -relief sunken  -width 10 
  label .s.i.id  -text "  User Id" -anchor e
  frame .s.p
  entry .s.p.pw  -relief sunken -width 10 \
		 -font -*-symbol-*-r-*--20-*-*-*-*-*-*-*
  label .s.p.p   -text "  Password" -anchor e

  frame .s.s
  entry .s.s.ser -relief sunken -width 15
  menubutton .s.s.s -text " Servers  " -anchor e -menu .s.s.s.m \
		    -relief raised
  menu .s.s.s.m
  foreach s $serverList {
    .s.s.s.m add command -label $s \
		  -command ".s.s.ser delete 0 end; .s.s.ser insert 0 $s "
  }

  message .s.err -text "" -justify center -aspect 500

  frame .s.b
  button .s.b.ok  -text "Sign on" \
      -command {tryConnect [.s.i.uid get] [.s.p.pw get] [.s.s.ser get]}
  button .s.b.can -text "Cancel" -command "destroy ."

  pack .s    -side top -fill both -expand 1
  pack .s.m  -side top -fill x    -pady 20
  pack .s.i  -side top -pady 20 -anchor e
  pack .s.i.uid -side right -expand 1 -padx 20
  pack .s.i.id  -side left
  pack .s.p     -side top -pady 20 -anchor e
  pack .s.p.pw  -side right -expand 1 -padx 20
  pack .s.p.p   -side left

  pack .s.err  -side top -fill x -expand 1
  pack .s.b    -side bottom -fill x
  pack .s.b.ok .s.b.can -side left -fill x -expand 1

  pack .s.s     -side bottom -pady 20 -anchor e
  pack .s.s.ser -side right -expand 1 -padx 20
  pack .s.s.s   -side left

  if {[lsearch [array names env] ORACLE_SID] >= 0} {
    .s.s.ser insert 0 $env(ORACLE_SID)
  } else {
    .s.s.ser insert 0 [lindex $serverList 0]
  }
  focus .s.i.uid

  bind .s.i.uid <KeyPress-Return> "focus .s.p.pw"
  bind .s.p.pw  <KeyPress-Return> ".s.b.ok invoke"
  bind .s.s.ser <KeyPress-Return> ".s.b.ok invoke"


  # allow Entry and Text to paste selections
  bind Entry <ButtonRelease-2> {
    set tk_s_rc [catch {set tk_s_s [selection get]} ]
    if {$tk_s_rc == 0} {%W insert insert $tk_s_s}
  }

}

# kick off the entire process

getSignOn


############################################################################
# all procs follow

########################
#
# tryConnect
#
#   try a connection to the oracle server
#

proc tryConnect {id pw ser} {
  global env
  global oramsg
  global lda
  global cur
  global server


  # check for remote db spec
  if {[string first @ $ser] == 0} {
    set server $ser
  } else {
    set server $ser
    set env(ORACLE_SID) $ser
    set ser ""
  }
  

  set retcode [catch {set lda [oralogon ${id}/${pw}${ser}]}]

  if $retcode==0 {
    oraautocom $lda on
    set cur [oraopen $lda]
    destroy .s
    createMain
  } else  {
    .s.err configure -text $oramsg(errortxt)
    focus .s.p.pw
  }
}



########################
#
# createMain
#
#   create the main iud window
#

proc createMain {} {
  global tablename
  global tabFields
  global srchFields
  global listfmt

  wm title    . "$tablename IUD"
  wm iconname . "$tablename"
  wm geom    . 650x700
  wm minsize . 650 700

  # create a top level frame

  frame .m -relief flat

  pack .m -side top -fill both -expand 1

  # create a menu bar with some menu buttons

  frame .m.mb -relief flat -borderwidth 2

  button .m.mb.search -text "Search" -command doSearch    -width 20
  button .m.mb.quit   -text "Quit"   -command confirmExit -width 20
  pack .m.mb        -side top -fill x
  pack .m.mb.search -side left
  pack .m.mb.quit   -side right

  # create a search label frame
  frame .m.ll -relief flat

  label .m.ll.l -text "" -anchor w \
	    -font "-*-courier-*-r-*-*-12-*-*-*-*-*-*-*" 

  pack .m.ll   -side top -fill x
  pack .m.ll.l -side left

  # create a search field frame
  frame .m.sr -relief flat
  set i 0
  set f_max [llength $srchFields]

  foreach f $srchFields {
    set fld [lindex $f 0]
    set lab [lindex $f 1]
    set wid [lindex $f 2]
    set typ [lindex $f 3]
    entry .m.sr.$fld       -relief sunken -width $wid \
	    -font "-*-courier-*-r-*-*-12-*-*-*-*-*-*-*"  -borderwidth 1
    pack .m.sr.$fld -side left

    incr i
    if {$i == $f_max} {set i 0}
    bind .m.sr.$fld <KeyPress-Return> \
	  ".m.mb.search invoke"
    bind .m.sr.$fld <KeyPress-Tab> \
	  "focus .m.sr.[lindex [lindex $srchFields $i] 0]"

    if {$typ==1} {
      set just ""
    } else {
      set just "-"
    }
    set    fstr "%${just}${wid}.${wid}s  "
    append fmt  $fstr
    append scol [format $fstr $lab] 
  }

  # set list format str, including leading rowid and trailing spaces
  set listfmt "%-18.18s  $fmt %-80.80s"

  .m.ll.l configure -text " $scol"

  pack .m.sr -side top -fill x

  # create sel list frame
  frame .m.sl -relief raised -borderwidth 2
  scrollbar .m.sl.s -orient vertical -command ".m.sl.l yview" \
            -relief sunken
  listbox .m.sl.l -yscroll ".m.sl.s set" -relief sunken \
	    -font "-*-courier-*-r-*-*-12-*-*-*-*-*-*-*" 

  bind .m.sl.l <Double-1> +getRow

  pack .m.sl   -side top -fill x
  pack .m.sl.s -side right -fill both
  pack .m.sl.l -side left -fill both -expand 1

  # create a frame and fixed entry fields

  frame .m.r -relief raised -borderwidth 2
  pack .m.r -side top -fill both -expand 1

  set i 0
  set f_max [llength $tabFields]

  foreach f $tabFields {
    set fld [lindex $f 0]
    set lab [lindex $f 1]
    set wid [lindex $f 2]
    set rxx [lindex $f 3]
    set ryy [lindex $f 4]

    label .m.r.lab_${fld} -text $lab -anchor e
    entry .m.r.$fld       -relief sunken -width $wid
    place .m.r.lab_${fld} -in .m.r -relx $rxx -rely $ryy -anchor ne
    place .m.r.$fld       -in .m.r -relx $rxx -rely $ryy -anchor nw

    incr i
    if {$i == $f_max} {set i 0}
    bind .m.r.$fld <KeyPress-Return> \
	  "focus .m.r.[lindex [lindex $tabFields $i] 0]"
    bind .m.r.$fld <KeyPress-Tab> \
	  "focus .m.r.[lindex [lindex $tabFields $i] 0]"

  }

  # create a frame and description "text"
  frame .m.a -relief raised -borderwidth 2

  button .m.a.add  -text "Insert"       -command doInsert
  button .m.a.up   -text "Update"       -command doUpdate
  button .m.a.del  -text "Delete"       -command doDelete
  button .m.a.clr  -text "Clear Fields" -command clearFields 

  pack .m.a -side top -fill x
  pack .m.a.add .m.a.up .m.a.del .m.a.clr -side left -expand 1 -fill x


  # create a message at the bottom

  label .m.msg -text "" -width 40 -relief raised -borderwidth 2 \
	-font -*-helvetica-bold-o-*-*-16-*-*-*-*-*-*-*
    
  pack .m.msg -side bottom -fill x

  .m.msg configure -text "At your service....."

}



########################
#
# setMsg
#
#   set the text for the label at bottom of screen
#

proc setMsg {msg_text}  {
  .m.msg configure -text [string trim $msg_text]
  update
}


########################
#
# clearFields
#
#   clear the entry fields in the window
#

proc clearFields {} {
  global tabFields
  global srchFields
  global sel_rec
  global sel_rowid

  set sel_rec ""
  set sel_rowid ""

  foreach f $tabFields {
    set fld [lindex $f 0]
    .m.r.$fld delete 0 end
  }

  foreach f $srchFields {
    set fld [lindex $f 0]
    .m.sr.$fld delete 0 end
  }

  .m.sl.l delete 0 end

  setMsg ""
}




########################
#
# doInsert
#
#   insert a new row
#

proc doInsert {} {
  global oramsg
  global cur
  global tabFields
  global tablename


  set comma ""
  set fld_list (
  set val_list (
  foreach f $tabFields {
    set fld [lindex $f 0]
    set typ [lindex $f 5]

    set val [.m.r.$fld get]
    # check if not null
    if [string length $val] {
      append fld_list $comma $fld
      if {$typ==2 || $typ==3} {
	append val_list "$comma '[concat $val]'" 
      } else {
	if "[catch {format %f $val}] == 1" {
	  setMsg "[lindex $f 1] must be numeric"
	  return
	}
	append val_list $comma $val 
      }
      set comma ", "
    } else {
      if [lindex $f 7] {
        setMsg "[lindex $f 1] is a required field "
        return
      }
    }
  }

  append fld_list )
  append val_list )

  set dbret [catch {orasql $cur [concat insert into $tablename  \
                    $fld_list values $val_list] } ]

  if $dbret==1 {
    setMsg "SQL error: $oramsg(errortxt)"
  } else {
      setMsg "Row inserted"
  }

}


########################
#
# doUpdate
#
#   update an existing row
#

proc doUpdate {} {
  global oramsg
  global cur
  global tabFields
  global tablename
  global sel_rec
  global sel_rowid


  if [string length $sel_rowid]==0 {
    setMsg "You must first select a row to update"
    return
  }

  set comma ""
  set fld_list ""
  foreach f $tabFields {
    set fld [lindex $f 0]
    set typ [lindex $f 5]

    set val [.m.r.$fld get]
    # check if not null
    if [string length $val] {
      append fld_list $comma " $fld =  "
      set comma ", "
      if {$typ==2 || $typ==3} {
	append fld_list "'[concat $val]'" 
      } else {
	if "[catch {format %f $val}] == 1" {
	  setMsg "[lindex $f 1] must be numeric"
	  return
	}
	append fld_list $val
      }
    }
  }

  set dbret [catch {orasql $cur [concat update $tablename set  \
           $fld_list where rowid = '$sel_rowid' ] } ]

  if $dbret==1 {
    setMsg "SQL error: $oramsg(errortxt)"
  } else {
    setMsg "Row updated"
  }

}

########################
#
# doDelete
#
#   delete an existing row
#

proc doDelete {} {
  global oramsg
  global cur
  global tablename
  global sel_rowid


  if [string length $sel_rowid]==0 {
    setMsg "You must first select a row to delete"
    return
  }

  set dbret [catch {orasql $cur "delete from $tablename \
		 where rowid = '$sel_rowid'" } ]

  if {$oramsg(rc) == 0} {
    setMsg "Row deleted"
    .m.sl.l delete [lindex [.m.sl.l curselection] 0]
  } else {
    setMsg "SQL error: $oramsg(errortxt)"
  }
}



########################
#
# doSearch
#
#   select the table on fields entered
#

proc doSearch {} {
  global sel_rec
  global cur
  global oramsg
  global tabFields
  global srchFields
  global col_names
  global tablename
  global sel_rowid
  global listfmt

  setMsg "Searching..."

  .m.sl.l delete 0 end
 
  set sel_rowid ""

  set sql_str "select rowid "

  set and ""
  set val_list ""
  foreach f $srchFields {
    set fld [lindex $f 0]
    set typ [lindex $f 3]

    append sql_str ", $fld"

    set val [string trim [.m.sr.$fld get]]
    if {[string length $val] == 0} {
      continue
    }
    if {$typ==1} {
      # if numeric and starts with operator, use the entered val
      if {[lsearch {{=} {<} {>}} [string range $val 0 0]] >= 0} {
        append val_list "$and $fld   ${val}"
      } else {
        append val_list "$and $fld = ${val}"
      }
    } else {
      append val_list "$and $fld like '${val}%'"
    }
    set and " and"
  }

  if {[string length $val_list] > 0} {
    append sql_str " from $tablename where $val_list"
  } else {
    append sql_str " from $tablename "
  }

  set dbret [catch {orasql $cur "$sql_str"}]

  if $dbret!=0 {
    setMsg "SQL error: $oramsg(errortxt)"
    return
  }


  set num_recs 0

  set sel_rec [orafetch $cur]
  if {$oramsg(rc) != 0} {
    setMsg "No existing Names match your search criteria"
    return
  }

  while {$oramsg(rc) == 0} {

    incr num_recs
    .m.sl.l insert end "[eval format {$listfmt} $sel_rec {{ }}]"

    set sel_rec [orafetch $cur]
  }

  #scroll right 20 chars to hide rowid

  .m.sl.l xview 20

  setMsg "Found $num_recs rows"


}


########################
#
# getRow
#
#   select a row from a double click
#

proc getRow {} {
  global cur
  global oramsg
  global sel_rec
  global col_names
  global sel_rowid
  global tablename

  set idx [string trim [.m.sl.l get [lindex [.m.sl.l curselection] 0 ] ] ]

  set idx [lindex $idx 0 ]
  set sel_rowid $idx

  orasql $cur "select * from $tablename where rowid = '$idx'"

  set col_names [string tolower [oracols $cur] ]

  set sel_rec [orafetch $cur]
  populateMain $sel_rec
}


########################
#
# populateMain
#
#   populate the request window entries with a dbrec
#

proc populateMain {dbrec} {
  global tabFields
  global col_names
  global cur
  global oramsg

  # populate regulare form fields
  foreach f $tabFields {
    set fld [lindex $f 0]
    .m.r.$fld delete 0 end
    set idx [lsearch $col_names $fld]
    if $idx>=0 {
      .m.r.$fld insert 0 [lindex $dbrec $idx]
    }
  }

}


########################
#
# confirmExit
#
#   really exit
#

proc confirmExit {} {
  
  mkDialog .confirm {-text "Really Exit?"} \
	   "{Yes, damn it}  {destroy . ; exit}" "Cancel {}"
}





###########################################################################
#
# stolen from ousterhout's widget demo
#


# mkDialog w msgArgs list list ...
#
# Create a dialog box with a message and any number of buttons at
# the bottom.
#
# Arguments:
#    w -	Name to use for new top-level window.
#    msgArgs -	List of arguments to use when creating the message of the
#		dialog box (e.g. text, justifcation, etc.)
#    list -	A two-element list that describes one of the buttons that
#		will appear at the bottom of the dialog.  The first element
#		gives the text to be displayed in the button and the second
#		gives the command to be invoked when the button is invoked.
#
# @(#) mkDialog.tcl 1.1 94/08/10 15:35:00

proc mkDialog {w msgArgs args} {
    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w "Dialog box"
    wm iconname $w "Dialog"

    # Create two frames in the main window. The top frame will hold the
    # message and the bottom one will hold the buttons.  Arrange them
    # one above the other, with any extra vertical space split between
    # them.

    frame $w.top -relief raised -border 1
    frame $w.bot -relief raised -border 1
    pack $w.top $w.bot -side top -fill both -expand yes

    # Create the message widget and arrange for it to be centered in the
    # top frame.
    
    eval message $w.top.msg -justify center \
	    -font -Adobe-times-medium-r-normal--*-180-*-*-*-*-*-* $msgArgs
    pack $w.top.msg -side top -expand yes -padx 3 -pady 3

    # Create as many buttons as needed and arrange them from left to right
    # in the bottom frame.  Embed the left button in an additional sunken
    # frame to indicate that it is the default button, and arrange for that
    # button to be invoked as the default action for clicks and returns in
    # the dialog.

    if {[llength $args] > 0} {
	set arg [lindex $args 0]
	frame $w.bot.0 -relief sunken -border 1
	pack $w.bot.0 -side left -expand yes -padx 10 -pady 10
	button $w.bot.0.button -text [lindex $arg 0] \
		-command "[lindex $arg 1]; destroy $w"
	pack $w.bot.0.button -expand yes -padx 6 -pady 6
	bind $w <Return> "[lindex $arg 1]; destroy $w"
	focus $w

	set i 1
	foreach arg [lrange $args 1 end] {
	    button $w.bot.$i -text [lindex $arg 0] \
		    -command "[lindex $arg 1]; destroy $w"
	    pack $w.bot.$i -side left -expand yes -padx 10
	    set i [expr $i+1]
	}
    }
    bind $w <Any-Enter> [list focus $w]
    focus $w
}



}


####################################################################
# CONTINUE iud_maker
####################################################################


global lda cur server
global tablename tabFields srchFields
global col_list

set tablename ""
set tabFields ""
set srchFields ""


########################
#
# getSignOn
#
#   the first window, get logon info and try to connect to the server
#

proc getSignOn {} {
  global uid
  global env
  global matchInfo

  # set ORACLE_HOME if not already set
  set ora_home [lsearch [array names env] ORACLE_HOME] 

  if {$ora_home == -1} {
      set ora_home ""
      catch {set ora_home [exec ypcat passwd | egrep  ^oracle: ]}
      if {[string length $ora_home] > 0} {
	  set ora_home [lindex [split $ora_home :] 5]
      } else {
	  set ora_home [exec egrep ^oracle: < /etc/passwd ]
	  if {[string length $ora_home] > 0} {
	      set ora_home [lindex [split $ora_home :] 5]
	  } else {
	      set ora_home ""
	  }
      }
      set $env(ORACLE_HOME) $ora_home
  } else {
      set ora_home $env(ORACLE_HOME)
  }

  # get valid servers from various files
  set serverList ""

  # set ones from /etc/oratab - local servers
  set intFile /etc/oratab
  if [file isfile $intFile] {
    set fd [open $intFile]
    set sc [scancontext create]
    scanmatch -nocase $sc {^[a-z]} \
     {lappend serverList [lindex [split $matchInfo(line) :] 0] }
    scanfile $sc $fd
    close $fd
  }
  # set ones from /etc/sqlnet - remote names
  set intFile /etc/sqlnet
  if [file isfile $intFile] {
    set fd [open $intFile]
    set sc [scancontext create]
    scanmatch -nocase $sc {^[a-z]} \
     {lappend serverList "@[lindex $matchInfo(line) 0]" }
    scanfile $sc $fd
    close $fd
  }
  # set ones from $HOME/.sqlnet - remote names
  set intFile $env(HOME)/.sqlnet
  if [file isfile $intFile] {
    set fd [open $intFile]
    set sc [scancontext create]
    scanmatch -nocase $sc {^[a-z]} \
     {lappend serverList "@[lindex $matchInfo(line) 0]" }
    scanfile $sc $fd
    close $fd
  }

  # nothing found? put in serverList what names should look like
  if {[llength $serverList] == 0} {
    lappend serverList "(localdb)"
    lappend serverList "(@remote_alias)"
    lappend serverList "(@T:host:remotedb)"
  }
  
  wm geom     . 300x300
  wm title    . "Insert-Update-Delete Maker"
  wm iconname . "IUD Maker"
  frame .s
  message .s.m -justify center  -text "Oracle Server Sign on" -aspect 2000 \
		-font -*-helvetica-bold-o-*-*-20-*-*-*-*-*-*-*
  frame .s.i
  entry .s.i.uid -relief sunken  -width 10 
  label .s.i.id  -text "  User Id" -anchor e
  frame .s.p
  entry .s.p.pw  -relief sunken -width 10 \
		 -font -*-symbol-*-r-*--20-*-*-*-*-*-*-*
  label .s.p.p   -text "  Password" -anchor e

  frame .s.s
  entry .s.s.ser -relief sunken -width 15
  menubutton .s.s.s -text " Servers  " -anchor e -menu .s.s.s.m \
		    -relief raised
  menu .s.s.s.m
  foreach s $serverList {
    .s.s.s.m add command -label $s \
		  -command ".s.s.ser delete 0 end; .s.s.ser insert 0 $s "
  }

  message .s.err -text "" -justify center -aspect 500

  frame .s.b
  button .s.b.ok  -text "Sign on" \
      -command {tryConnect [.s.i.uid get] [.s.p.pw get] [.s.s.ser get]}
  button .s.b.can -text "Cancel" -command "destroy ."

  pack .s    -side top -fill both -expand 1
  pack .s.m  -side top -fill x -pady 20
  pack .s.i  -side top -pady 20 -anchor e
  pack .s.i.uid -side right -expand 1 -padx 20 
  pack .s.i.id  -side left
  pack .s.p  -side top -pady 20 -anchor e
  pack .s.p.pw  -side right -expand 1 -padx 20
  pack .s.p.p   -side left

  pack .s.err   -side top -fill x -expand 1
  pack .s.b     -side bottom -fill x
  pack .s.b.ok .s.b.can -side left -fill x -expand 1

  pack .s.s     -side bottom -pady 20 -anchor e
  pack .s.s.ser -side right -expand 1 -padx 20
  pack .s.s.s   -side left

  if {[lsearch [array names env] ORACLE_SID] >= 0} {
    .s.s.ser insert 0 $env(ORACLE_SID)
  } else {
    .s.s.ser insert 0 [lindex $serverList 0]
  }
  focus .s.i.uid

  bind .s.i.uid <KeyPress-Return> "focus .s.p.pw"
  bind .s.p.pw  <KeyPress-Return> ".s.b.ok invoke"
  bind .s.s.ser <KeyPress-Return> ".s.b.ok invoke"


  # allow Entry and Text to paste selections
  bind Entry <ButtonRelease-2> {
    set tk_s_rc [catch {set tk_s_s [selection get]} ]
    if {$tk_s_rc == 0} {%W insert insert $tk_s_s}
  }

}

# kick off the entire process

getSignOn


############################################################################
# all procs follow

########################
#
# tryConnect
#
#   try a connection to the oracle server
#

proc tryConnect {id pw ser} {
  global env
  global oramsg
  global lda
  global cur
  global server


  # check for remote db spec
  if {[string first @ $ser] == 0} {
    set server $ser
  } else {
    set server $ser
    set env(ORACLE_SID) $ser
    set ser ""
  }
  

  set retcode [catch {set lda [oralogon ${id}/${pw}${ser}]}]

  if $retcode==0 {
    set cur [oraopen $lda]
    destroy .s
    createMain
  } else  {
    .s.err configure -text $oramsg(errortxt)
    focus .s.p.pw
  }
}


########################
#
# createMain
#
#   
#

proc createMain  {} {
  global tablename tabFields srchFields
  global col_list plist
  global lda cur

  wm title    . "Insert-Update-Delete Maker"
  wm iconname . "IUD Maker"
  wm geom     . 650x700
  wm minsize  . 650 700

  # create frames we need
  frame .f  
  frame .f.m 
  frame .f.t 
  frame .f.b 
  frame .f.b.l 
  frame .f.b.r 
  frame .f.c 

  pack .f    -side top -fill both -expand 1
  pack .f.m  -side top -fill x
  pack .f.t  -side top -fill x

  pack .f.b.l -side left -fill both -expand 1
  pack .f.b.r -side left -fill both -expand 1
  pack .f.b   -side top  -fill both -expand 1
  pack .f.c   -side top  -fill x

  message .f.msg -font "-*-helvetica-*-o-*-*-16-*-*-*-*-*-*-*" \
		 -aspect 2000 -text "Ready"
  pack .f.msg -side top -fill x -pady 5

  # create command buttons
  button .f.m.gen -text " Generate " -command doGen
  button .f.m.srh -text " Add to Search" -command addSrch
  button .f.m.det -text " Add to Detail" -command addDet
  button .f.m.all -text " Add all columns to Detail " -command addAll
  button .f.m.hlp -text " Help " -command helpWin
  button .f.m.quit -text " Quit-No Save " -command "oralogoff $lda;destroy ."

  pack .f.m.gen .f.m.srh .f.m.det .f.m.all -side left
  pack .f.m.quit .f.m.hlp -side right

  # create the table field list
  message .f.t.m1 -aspect 2000 -text "Table: (none) "
  listbox .f.t.l -yscroll ".f.t.v set"  -exportselection no -relief sunken \
	   -font "-*-courier-*-r-*-*-14-*-*-*-*-*-*-*"
  scrollbar .f.t.v  -orient vertical -command ".f.t.l yview" \
			  -relief sunken

  bind .f.t.l <B1-Motion> "set a 0"
  bind .f.t.l <Double-1> "addDet"

  pack .f.t.m1 -side top -fill x
  pack .f.t.v  -side right -fill both
  pack .f.t.l  -side left -fill both -expand 1

  # create the search field list
  message .f.b.l.m1 -aspect 2000 -text "Search Fields "
  listbox .f.b.l.l -yscroll ".f.b.l.v set" -exportselection no  -relief sunken \
	   -font "-*-courier-*-r-*-*-14-*-*-*-*-*-*-*"
  scrollbar .f.b.l.v  -orient vertical -command ".f.b.l.l yview" \
			  -relief sunken

  bind .f.b.l.l <B1-Motion> "set a 0"
  # bind .f.b.l.l <Double-1> "editSrch"

  pack .f.b.l.m1 -side top -fill x
  pack .f.b.l.v  -side right -fill both
  pack .f.b.l.l  -side left  -fill both -expand 1

  # create the detail field list
  message .f.b.r.m1 -aspect 2000 -text "Detail Fields "
  listbox .f.b.r.l -yscroll ".f.b.r.v set" -exportselection no -relief sunken \
	   -font "-*-courier-*-r-*-*-14-*-*-*-*-*-*-*"
  scrollbar .f.b.r.v  -orient vertical -command ".f.b.r.l yview" \
			  -relief sunken

  bind .f.b.r.l <B1-Motion> "set a 0"
  # bind .f.b.r.l <Double-1> "editDetail"

  pack .f.b.r.m1 -side top -fill x
  pack .f.b.r.v  -side right -fill both
  pack .f.b.r.l  -side left -fill both -expand 1

  
  # create list command buttons
  button .f.c.sdel -text " Delete Search Column " -command "delCol .f.b.l.l"
  button .f.c.smov -text " Move to bottom "       -command "movCol .f.b.l.l"
  button .f.c.tdel -text " Delete Detail Column " -command "delCol .f.b.r.l"
  button .f.c.tmov -text " Move to bottom "       -command "movCol .f.b.r.l"

  pack .f.c.sdel .f.c.smov  -side left
  pack .f.c.tmov .f.c.tdel  -side right



  # let user pick a table
  showTables
  update

  grab .select_a_table
  tkwait window .select_a_table

  if {[string length $tablename] == 0} {
    oralogoff $lda
    destroy .
  }
  
  # get fields from that table

  showFields [lindex [split $tablename .] 0] [lindex [split $tablename .] 1]
  
  .f.t.m1 configure -text "Table: $tablename"
  eval .f.t.l  insert 0 $plist
  .f.t.l select set 0
  

}

proc selEnt {w {idx 0}} {
  catch {$w select adjust $idx}
}

proc delCol {w} {
   global srchFields tabFields

   set idx -1
   catch {set idx [$w curselection]}
   set idx [lindex $idx 0]
   if {$idx == ""} {return}
   set ent [$w get $idx]
   catch {$w delete $idx}
   selEnt $w

   # delete column name from srchFields or tabFields via lreplace
   if {$w == ".f.b.l.l"} {
     set delEnt [lindex $ent 1]
     set i [lsearch  $srchFields $delEnt]
     set srchFields [lreplace $srchFields $i $i]
   } else {
     set delEnt [lindex $ent 1]
     set i [lsearch  $tabFields $delEnt]
     set tabFields [lreplace $tabFields $i $i]
   }
}

proc movCol {w} {
   set idx -1
   catch {set idx [$w curselection]}
   set idx [lindex $idx 0]
   if {$idx == -1} {return}
   set ent [$w get $idx]
   $w delete $idx
   $w insert end "$ent"
   selEnt $w end
}

proc getType {col} {
  global col_list

  foreach f $col_list {
    set n [lindex $f 0]
    set t [lindex $f 1]
    if {$col == $n} {
      case $t {
	NUMBER  {set type 1}
	DATE    {set type 3}
	default {set type 2}
      }
      return $type
    }
  }
  echo couldn't find $col in $col_list
  return {error}
}

proc doGen {} {
  global iud_header iud_body
  global col_list
  global tablename srchFields tabFields
  global lda

  set filename [string tolower $tablename].iud

  if [file isfile $filename] {
    .f.msg configure -text "Can't create script $filename, file exists"
    return
  }

  if [llength $srchFields]==0 {
    .f.msg configure -text "No search columns defined, at least one needed"
    return
  }
  if [llength $tabFields]==0 {
    .f.msg configure -text "No detail columns defined, at least one needed"
    return
  }

  set t $tablename
  regsub -all \\$ $t \\\\$ t
  set name_spec "set tablename \"$t\""
  set det_spec  "set tabFields  \{ \\\n"
  set srch_spec "set srchFields \{ \\\n"
  set y 0.00
  set x 0.20

  # compose srchFields
  for {set idx 0} {$idx < [.f.b.l.l size]} {incr idx} {
    set ent [.f.b.l.l get $idx]
    set disp [lindex $ent 0]
    set name [lindex $ent 1]
    set type [getType $name]
    set line [format "\{%s %10.10s %s %s\} " \
		 [string tolower $name] $name $disp $type ]
    append srch_spec $line \\\n
  }
  # compose tabFields
  for {set idx 0} {$idx < [.f.b.r.l size]} {incr idx} {
    set ent [.f.b.r.l get $idx]
    set disp [lindex $ent 0]
    set name [lindex $ent 1]
    set type [getType $name]

    set line [format "\{%-30.30s %-10.10s  %5d %3.2f %3.2f %3d 0 0\} " \
		 [string tolower $name] $name $disp $x $y $type ]
    append det_spec $line \\\n
    if {$x == 0.60} {
      set x 0.20
      set y [expr "$y + 0.10"]
    } else {
      set x 0.60
    }
  }


  append det_spec  "\} "
  append srch_spec "\} "



  set fd [open $filename w]

  puts $fd $iud_header
  puts $fd $name_spec
  puts $fd $det_spec
  puts $fd $srch_spec
  puts $fd $iud_body

  close $fd

  puts stdout "IUD application written to $filename"
  oralogoff $lda
  destroy .


}

proc addSrch {} {
  global col_list
  global srchFields 

  set idx [.f.t.l curselection]
  set col_ent [lindex $col_list $idx]
  set name [lindex $col_ent 0]
  if {[lsearch $srchFields $name] >= 0} {
    .f.msg configure -text "Column already in search list"; return
  }
  set disp [lindex $col_ent 2]
  set disp [min 10 $disp]
  lappend srchFields $name
  .f.b.l.l insert end [format "%3s %-30.30s" $disp $name]
  selEnt .f.b.l.l 
  if {[llength $srchFields] > 5} {
    .f.msg configure -text "Warning: search list has more than 5 columns"
  } else {
    .f.msg configure -text "Search column added"
  }
}

proc addDetEnt {idx} {
  global col_list
  global tabFields 

  set col_ent [lindex $col_list $idx]
  set name [lindex $col_ent 0]
  set type [lindex $col_ent 1]
  if {[lsearch $tabFields $name] >= 0} {
    .f.msg configure -text "Column already in detail list"; return
  }
  set disp [lindex $col_ent 2]
  if {$type == "DATE"} {set disp 11}
  set disp [min 20 $disp]
  lappend tabFields $name
  .f.b.r.l insert end [format "%3s %-30.30s" $disp $name]
  selEnt .f.b.r.l 
  if {[llength $tabFields] > 20} {
    .f.msg configure -text "Warning: detail list has more than 20 columns"
  } else {
    .f.msg configure -text "Detail column added"
  }
}

proc addDet {} {

  set idx [.f.t.l curselection]
  addDetEnt $idx

}

proc addAll {} {
  for {set idx 0} {$idx < [.f.t.l size]} {incr idx} {
    addDetEnt $idx
  }
}

proc helpWin {} {
  
  catch {destroy .h}
  toplevel .h
  wm title .h "IUD Help"
  wm minsize .h 200 200

  message .h.h -aspect 150 -font "-*-helvetica-*-r-*-*-14-*-*-*-*-*-*-*" \
	       -justify left -text "
  IUD Maker builds single table Insert, Update, Delete applications.\n\n\
  First step is to select a table from the available list.\
  Next, choose columns to be used in the search and detail portions of\
  the application.  Pressing \"Add all columns to Detail\" will insert all\
  columns into the Detail list.  Highlighting a column and pressing \
  \"Add column to Detail\" will add a single column.  Double click with button\
  1 will also add a single column.  Search fields should be added by \
  highlighting the column list and pressing \"Add to Search\".\n\n\
  The Search and Detail column lists may be manipulated by deleting columns\
  from either list, or causing the column to be moved to the bottom of the\
  list.  Columns in the Search and Detail lists are preceeded by the length\
  of the display width choosen for the column.\n\n\
  IUD Maker requires at least one column in each of the Search and Detail\
  list.  No more than 5 search columns should be specified, and no more than\
  20 Detail columns should be specified.\n\n\
  After choosing all the columns, pressing \"Generate\" will create the IUD\
  application by writing to a file named (tablename).iud. \n\n\
  If more than 20 Detail columns are selected, the .iud application \
  should be edited for column placement.\n\n\
  IUD Maker uses the column order in the Search and Detail list for placement\
  of entry fields in the created application.  Search fields are created\
  left-to-right, Detail fields are create left-to-right, top-to-bottom.\n\n\
  IUD Maker does very little in ensuring the created application will run\
  in all cases.  Notably, if columns marked as NOT NULL are omitted from \
  the Detail list, the application will be unable to Insert new rows.\n\n\
  The created IUD application will display a list box of matching rows when\
  \"Search\" button is pressed.  The Search fields can be used to limit the\
  search.  Numeric search fields can be preceeded by \">\" or \"<\" to\
  indicate greater-than or less-than.  Character search fields have \"%\"\
  appended, and use the SQL \"LIKE\" clause for searching.\n\n\
  When a search list is retrieved, individual rows are retreived by\
  double-clicking on the row, causing the detail portion of the window\
  to be populated.  Once the row detail is displayed, the row can be deleted\
  by pressing \"Delete\", or updated by entering new values in the detail\
  fields and pressing \"Update\".  New rows can be added at any time by\
  entering detail information and pressing \"Insert\".\n\n\
  SQL errors are reported in the bottom message line.\
  "

  button .h.c  -text Cancel -command "destroy .h"

  pack .h.h  -side top -fill both -expand 1
  pack .h.c  -side top -fill x
}

proc setTabname {args} {
  global tablename

  # args get a list of list; break out
  eval set args $args
  set owner [lindex $args 0]
  set tab   [lindex $args 1]

  set tablename $owner.$tab

  destroy .select_a_table

}



########################
#
# showFields
#
#   create a toplevel window with a table's fields
#
proc showFields {owner tab} {
  global cur
  global oramsg
  global col_list plist


  set plist ""
  set col_list ""

  orasql $cur "select column_name, data_type, data_length, \
               data_precision, data_scale, nullable \
	       from all_tab_columns \
	       where  table_name = '$tab' and owner = '$owner'  \
	       order by column_id  "

  set row [orafetch $cur]

  while {$oramsg(rc) == 0} {

    set n [lindex $row 0]
    set t [lindex $row 1]
    set typ [lindex $row 1]
    set l [lindex $row 2]
    set p [lindex $row 3]
    set s [lindex $row 4]
    set b [lindex $row 5]
    if {[string match "*CHAR*" $t]} {
      set t ${t}($l)
      set len $l
    }
    if {[string match "NUMBER" $t]} {
      if {$p + $s > 0}  {
        set t ${t}(${p},${s})
      }
      set len [expr "$p + $s + 1"]
    }
    if $len=="" {set len 0}
    if {[string compare $b Y] == 0} {
      set nl " "
    } else {
      set nl "NOT NULL"
    }
    lappend plist [format "%-30.30s %-15.15s %-8.8s" $n $t $nl]
    lappend col_list "$n $typ $len $b"

    set row [orafetch $cur]

  }

  if {[llength $plist] == 0} {
    setMsg "No fields in table $owner.$tab"
    return
  }

}



########################
#
# showTables
#
#   create a toplevel window with user accesable tables
#
proc showTables {} {
  global cur
  global oramsg

  set plist ""
  orasql $cur {select owner, table_name from all_tables \
	       order by owner, table_name }

  set row [orafetch $cur]
  while {$oramsg(rc) == 0} {
    lappend plist [format "%-12.12s %-30.30s" [lindex $row 0] [lindex $row 1]]
    set row [orafetch $cur]
  }

  if {[llength $plist] == 0} {
    setMsg "No user tables available"
    return
  }
  pickList .Select_a_Table "Owner        Tables" 500x400 $plist setTabname
}



########################
#
# pickList
#
#   return a selection from a listbox by calling a proc
#

proc pickList {win heading geom plist callproc {filtproc NoFilterProc}} {

  set win_title $win
  regsub -all {:} $win_title .   win_title

  set win [translit A-Z a-z $win]
  
  catch {destroy $win}
  toplevel $win
  wm title $win [string range $win_title 1 end]

  # find if callproc is a valid command
  set doproc [string length [info commands $callproc]]
 
  # try to place window away from the main toplevel
  set topgeom [split [split [winfo geom .] x] +]

  set newx [expr {[lindex $topgeom 1] +  50 } ]
  set newy [expr {[lindex $topgeom 2] + 150 } ]

  wm geom $win ${geom}+${newx}+$newy
  set w [lindex [split $geom x] 0]
  set h [lindex [split $geom x] 1]
  wm minsize $win 120 120

  frame $win.l 
  frame $win.f 
  frame $win.b -relief sunken -borderwidth 1 

  label $win.l.l -text $heading -anchor w \
		 -font "-*-courier-*-r-*-*-14-*-*-*-*-*-*-*" 
  scrollbar $win.f.vert -orient vertical -command "$win.f.box yview" \
			-relief sunken
  listbox $win.f.box -yscroll "$win.f.vert set"  -relief sunken \
	 -font "-*-courier-*-r-*-*-14-*-*-*-*-*-*-*" 
  selection handle $win.f.box "handleList $win.f.box $filtproc"
  
  if $doproc {
    bind $win.f.box <Double-1> "$win.b.ok invoke"
  }

  foreach lem $plist {
    $win.f.box insert end $lem
  }

  if $doproc {
    button $win.b.ok  -text "OK"  -relief raised -borderwidth 2 -command \
       "catch \{ $callproc \[$win.f.box get \[$win.f.box curselection\]\] \}"
		#-command "catch \{ $callproc \[selection get\]  \} "
		# -command "$callproc \[selection get\] "
		# -command "$callproc \[selection get\] ; destroy $win "
  }
  button $win.b.can -text "Cancel" -relief raised -borderwidth 2 \
		-command "destroy $win"

  pack $win.l -side top -fill x
  pack $win.f -side top -fill both -expand 1
  pack $win.b -side bottom -fill x

  pack $win.l.l    -side top -fill x -anchor nw
  pack $win.f.vert -side right -fill both
  pack $win.f.box  -side left -fill both -expand 1

  if $doproc {
    pack $win.b.ok -side left -fill x -expand 1
  }
  pack $win.b.can  -side right -fill x -expand 1

  $win.f.box select set 0

  # redefine motion to a dummy; avoids multiple selections
  #bind $win.f.box <Any-Button1-Motion> "$win.f.box size"
  #bind $win.f.box <Any-Button2-Motion> "$win.f.box size"
}

