#!/usr/local/bin/wish

#  wosql
# 	
#  Copyright 1993 Tom Poindexter.
#
#  a windowing version of the oracle sql command  
#  uses extended tcl, tk, and oratcl interface
#
#  wosql doesn't have any of the formatting commands of sqlplus;
#  if you really want nifty reports, use sqlplus.
#
#  usage: wosql
#
#  version 1.0 - start with a hack of Sybtcl's wisql.  major enhancements from
#      wisql are: -command history buffer (use Control or Shift with Up or Down)
#                 -PL/SQL execution with :variables bound to values (see 
#                  "Options...Proc Exec")
#                 -LONG column read or write to files (needs a properly 
#                  formatted rowid, e.g. "select rowid from table where x=y", 
#                  then paste the rowid into the LONG I/O dialog entry.)
#                 -highlighted lines from the "DB Objects...Tables or Views" 
#                  can be pasted into the SQL window with Button 2; one or
#                  more lines from the Table Columns listbox can also be pasted.
#
#  version 2.0 - change all pack's to tk3.3 syntax
#  version 2.1 - use orafetch ?commands? option; use Paul Raines (TkMail)
#                bindings for Entry and Text widgets.
#  version 2.2 - add dialog box to set nullvalue
#  version 2.3 - change various to support tk4.0
#  version 2.4 - change various to support tk4.1, package require commands
#  version 2.41 - add server names from tnsnames,thanks Patricia Rodriguez-Tome
#  version 2.5 - use Tk 4.2 builtin procs for dialog, file handling, elminate
#                dependence on tclx; several improvements from 
#                George A. Kiewicz
#

package require Tk 
package require Oratcl

# cause Oratcl to be loaded right away
catch {oralogon}

# define global names in use
global oramsg
global uid
global cur
global lda
global currentFile
global server
global fontSize
global execCmd
global longFN
global cmdRing
global cmdIdx
global cmdLast
global appendclear


# Added 8/25/97 by GAK
global cmdMax

# set what the Execute button should first do
set execCmd doSql

# default result font size, set by menu
set fontSize 14

# default autocommit state, set by menu
set autocom off

# default result append or clear
set appendclear 1

set uid ""

if {[info exist env(USER)]} {
  set uid $env(USER)
} else {
  if {[info exist env(HOME)]} {
    set uid [file tail $env(HOME)]
  } else {
    set uid ""
  }
}

set cur {}
set lda {}
set currentFile "noname"

set cmdIdx  0
set cmdLast 0

# Added 8/25/97 by GAK
set cmdMax  150

for {set i 0} {$i <= $cmdMax} {incr i} {
  set cmdRing($i) ""
}


# Added 8/25/97 by GAK
wm title    . "Windowing Oracle SQL"
wm iconname . "Wosql"

########################
#
# getFile
#
#  read a file, return contents as string
 
proc getFile {afile} {
  set contents ""
  catch { set fd [open $afile]
        set contents [read $fd]
        close $fd }
  return $contents
}
 
 
########################
#
# putFile
#
#  write a file from a string
 
proc putFile {afile contents} {
  catch { set fd [open $afile w]
        puts -nonewline $fd $contents
        close $fd }
}
 

########################
#
# handleList
#
#  called during a request for primary selection for listboxes and text
#  that bind the "selection get" command for button-2
#

proc handleList {w filtproc offset max} {
  set doproc [string length [info commands $filtproc]]
  if $doproc {
    set s "[$filtproc $w]"
  } else {
    # set s [$w get [lindex [$w curselection] 0] ]
    set i [$w curselection]  
    set n ""
    set s ""
    foreach r $i {
      set l [$w get $r] 
      append s "${n}$l"
      set n "\n"
    }

  } 
  return [string range $s $offset $max]
}

########################
#
# filtCols
#
#  a special filtproc to return a column list
#

proc filtCols {w} {
  set i [$w curselection]  
  set n ""
  set s ""
  foreach r $i {
    set l [$w get $r] 
    set l [eval list $l]
    append s "${n}[lindex $l 0]"
    set n ", "
  }
  return "$s"
}

########################
#
# filtTab
#
#  a special filtproc to return word 1 "." word 2
#

proc filtTab {w} {
  set s [$w get [lindex [$w curselection] 0] ]
  regsub -all \\$ $s \\\\$ s
  set s [eval list $s]
  return [string trim [lindex $s 0].[lindex $s 1]]
}


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

proc getSignOn {} {
  global uid
  global env
  global matchInfo
  global tcl_platform
  global lda

  if {"$lda" != ""} {
    set reconnect 1
  } else { 
    set reconnect 0
  } 

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

  if {$ora_home == -1} {
      set ora_home ""
      if {$tcl_platform(platform) == "unix"} {
        catch {set ora_home [exec ypcat passwd | egrep  ^oracle: ]}
      }
      if {[string length $ora_home] > 0} {
	  set ora_home [lindex [split $ora_home :] 5]
      } else {
	  if {$tcl_platform(platform) == "unix"} {
	    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 ""

# foreach {ffile fremote} [list /etc/oratab 0 /etc/sqlnet 1 $env(HOME)/.sqlnet 1 $env(ORACLE_HOME)/network/admin/tnsnames.ora 1 $env(HOME)/.tnsnames.ora 1] 
  foreach {ffile fremote} [list /etc/oratab 0 /etc/sqlnet 1 $env(HOME)/.sqlnet 1 $env(HOME)/.tnsnames.ora 1] {
  
    set lines ""
    if {[file isfile $ffile]} {
      set ifile [split [getFile $ffile] \n]
      foreach line $ifile {
	if {[regexp -nocase "(^\[a-z_]\[^ \t\r]*).*$" $line m s1]} {
	  if {$fremote} {
	    lappend serverList @$s1
	  } else {
	    set s1 [lindex [split $s1 :] 0]
	    lappend serverList $s1
	  }
	}
      }
    }

  }

  # 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"
  }
  
  if {$reconnect} {
    catch {destroy .r}
    toplevel .r
    set win .r
  } else {
    set win .
  }
  wm geom     $win 300x300
  wm minsize  $win 300 300
  wm title $win "Sign On"

  if {"$win" == "."} {set win ""}

  frame $win.s
  message $win.s.m -justify center  -text "Oracle Server Sign on" -aspect 6000 \
		-font -*-helvetica-bold-o-*-*-20-*-*-*-*-*-*-*
  frame $win.s.i
  entry $win.s.i.uid -relief sunken  -width 10 
  label $win.s.i.id  -text "  User Id" -anchor e
  frame $win.s.p
  entry $win.s.p.pw  -relief sunken -width 10 -show * -exportselection false
		 
  label $win.s.p.p   -text "  Password" -anchor e

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

  message $win.s.err -text " " -justify center -aspect 2000

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

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

  pack $win.s.b.ok  -side left -fill x -expand 1
  pack $win.s.b.can -side left -fill x -expand 1
  pack $win.s.b     -side bottom -fill x -expand 1

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

  pack $win.s.err   -side top -fill x  

  pack $win.s       -side top -fill both -expand 1
  $win.s.i.uid insert 0 $uid

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

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


}

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

  if {"$lda" != ""} {
    set reconnect 1
  } else { 
    set reconnect 0
  } 

  # 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_tmp [oralogon ${id}/${pw}${ser}]}]

  if {$reconnect} {
    set win .r
  } else {
    set win ""
  }

  if {$retcode==0} {
    if {$reconnect} {
      oralogoff $lda
    }
    set lda $lda_tmp
    set cur [oraopen $lda]
    if {$reconnect} {
      destroy $win
      wm title    . "Windowing Oracle SQL : $server"
    } else {
      destroy .s
      createMain
    }
  } else  {
    $win.s.err configure -text $oramsg(errortxt)
    focus $win.s.p.pw
  }
}


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

proc createMain {} {
  global lda
  global cur
  global oramsg
  global currentFile
  global server
  global cmdIdx

  wm geom    . 600x500
  wm minsize . 400 370
  wm title    . "Windowing Oracle SQL : $server"

  # create a top level frame

  frame .m -relief flat

  # create a menu bar with some menu buttons

  frame .m.mb -relief raised -borderwidth 2
  menubutton .m.mb.file -text "File" -menu .m.mb.file.m -underline 0
  menu .m.mb.file.m
  .m.mb.file.m add command -label "New" -command doNew -underline 0
  .m.mb.file.m add command -label "Open..." -underline 0 \
			   -command "tryOpen"
  .m.mb.file.m add command -label "Save" -command doSave -underline 0 
  .m.mb.file.m add command -label "Save As..." -underline 5 \
			   -command "doSaveAs"
  .m.mb.file.m add separator
  .m.mb.file.m add command  -label "ReConnect" -command getSignOn   -underline 0
  global edwin
  set edwin 8
  .m.mb.file.m add radio -label "Small Edit Window" -variable edwin -value 8 -command ".m.s.sql configure -height 8"  -underline 1
  .m.mb.file.m add radio -label "Large Edit Window" -variable edwin -value 16 -command ".m.s.sql configure -height 16" -underline 0

  .m.mb.file.m add separator
  .m.mb.file.m add command -label "Exit"  -command confirmExit -underline 0

  menubutton .m.mb.out -text "Results" -menu .m.mb.out.m -underline 0
  menu .m.mb.out.m
  .m.mb.out.m add radiobutton -label "Append results" -variable appendclear \
   -value 0  -command "set appendclear 0"
  .m.mb.out.m add radiobutton -label "Clear results" -variable appendclear \
   -value 1  -command "set appendclear 1"
  .m.mb.out.m add separator
  .m.mb.out.m add command -label "Clear now" -command clearoutput -underline 0
  .m.mb.out.m add command -label "Save As..." -underline 0 \
		  -command "doSaveOut"
  .m.mb.out.m add command -label "Print" -command doPrint -underline 0
  .m.mb.out.m add cascade -label "Font Size   " -menu .m.mb.out.m.f \
			  -underline 0
  menu .m.mb.out.m.f
  .m.mb.out.m.f add radiobutton -variable fontSize -value  8 -label " 8" \
   -command ".m.o.out configure -font -*-courier-*-r-*-*-8-*-*-*-*-*-*-*"
  .m.mb.out.m.f add radiobutton -variable fontSize -value 10 -label "10" \
   -command ".m.o.out configure -font -*-courier-*-r-*-*-10-*-*-*-*-*-*-*"
  .m.mb.out.m.f add radiobutton -variable fontSize -value 12 -label "12" \
   -command ".m.o.out configure -font -*-courier-*-r-*-*-12-*-*-*-*-*-*-*"
  .m.mb.out.m.f add radiobutton -variable fontSize -value 14 -label "14" \
   -command ".m.o.out configure -font -*-courier-*-r-*-*-14-*-*-*-*-*-*-*"
  .m.mb.out.m.f add radiobutton -variable fontSize -value 17 -label "17" \
   -command ".m.o.out configure -font -*-courier-*-r-*-*-17-*-*-*-*-*-*-*"
  .m.mb.out.m.f add radiobutton -variable fontSize -value 20 -label "20" \
   -command ".m.o.out configure -font -*-courier-*-r-*-*-20-*-*-*-*-*-*-*"

  menubutton .m.mb.op -text "Options" -menu .m.mb.op.m -underline 0
  menu .m.mb.op.m
  .m.mb.op.m add cascade -label "Autocommit    " -menu .m.mb.op.m.a \
			 -underline 0
  .m.mb.op.m add command -label "Commit now" -underline 0     \
			 -command {oracommit $lda; setMsg "Committed" }
  .m.mb.op.m add command -label "Rollback now"   -underline 4 \
			 -command {oraroll $lda; setMsg "Rolled back" }
  .m.mb.op.m add sep
  .m.mb.op.m add command -label "Write Long Col..." -command "longFile Write" \
			 -underline 0 
  .m.mb.op.m add command -label "Read Long Col..."  -command "longFile Read" \
			 -underline 0
  .m.mb.op.m add sep
  .m.mb.op.m add command -label "Procedure Exec..."  -command plExec \
			 -underline 0
  .m.mb.op.m add sep
  .m.mb.op.m add command -label "Set Null Value..."  -command setNull \
			 -underline 0


  menu .m.mb.op.m.a
  .m.mb.op.m.a add radio -label "On" -value on -variable autocom \
			 -command {oraautocom $lda on; setMsg "Autocommit on"}
  .m.mb.op.m.a add radio -label "Off" -value off -variable autocom \
			 -command {oraautocom $lda off; setMsg "Autocommit off"}

  menubutton .m.mb.ob -text "DB Objects" -menu .m.mb.ob.m -underline 0
  menu .m.mb.ob.m
  .m.mb.ob.m add command  -label "Tables"   -command showTables  -underline 0
  .m.mb.ob.m add command  -label "Views"    -command showViews   -underline 0
  .m.mb.ob.m add command  -label "Indexes"  -command showIndexes -underline 0
  .m.mb.ob.m add command  -label "Procedures" -command showSrc   -underline 0
  .m.mb.ob.m add command  -label "Triggers" -command showTrigs   -underline 1


# global variable execCmd is set by doSql in order to allow cancel
  button .m.mb.exec  -text "Execute" -command {eval $execCmd}  -relief flat

  menubutton .m.mb.help -text "Help" -menu .m.mb.help.m -underline 0
  menu .m.mb.help.m
  .m.mb.help.m add command -label "General"   -command generalHelp -underline 0
  .m.mb.help.m add cascade -label "Menus    " -menu .m.mb.help.m.m -underline 0
  .m.mb.help.m add command -label "About"     -command aboutHelp   -underline 0

  menu .m.mb.help.m.m
  .m.mb.help.m.m add command -label "File"    -command menuHelpFile -underline 0
  .m.mb.help.m.m add command -label "Results" -command menuHelpOut  -underline 0
  .m.mb.help.m.m add command -label "Options" -command menuHelpOpts -underline 0
  .m.mb.help.m.m add command -label "DB Objects" -command menuHelpObjs \
								    -underline 0
  .m.mb.help.m.m add command -label "Execute" -command menuHelpExec -underline 0

  pack .m.mb.file .m.mb.out .m.mb.op .m.mb.ob .m.mb.exec -side left
  pack .m.mb.help  -side right
  pack .m.mb  -side top -fill x

  # create a frame listing sql code

  frame .m.s -relief raised -borderwidth 2

  label .m.s.l -text "$cmdIdx: SQL (${currentFile})" 
  scrollbar .m.s.vert -relief sunken -command ".m.s.sql yview" \
	  -orient vertical
  text .m.s.sql -font -*-courier-*-r-*-*-14-*-*-*-*-*-*-* -relief sunken \
	  -height 8 -width 80 -yscroll ".m.s.vert set"  -wrap word \
	  -borderwidth 2

  # bind some shortcut keys to the text window
  bind .m.s.sql <Control-Return> ".m.mb.exec invoke; break"
  bind .m.s.sql <Shift-Return>   ".m.mb.exec invoke; break"
  bind .m.s.sql <Shift-Up>       "prevSql -1; break"
  bind .m.s.sql <Control-Up>     "prevSql -1; break"
  bind .m.s.sql <Shift-Down>     "prevSql  1; break"
  bind .m.s.sql <Control-Down>   "prevSql  1; break"

  pack .m.s.l    -side top -fill x
  pack .m.s.vert -side right -fill y
  pack .m.s.sql  -side left -fill both -expand 1

  pack .m.s -side top -fill both

  # create a frame listing sql output

  frame .m.o -relief raised

  label .m.o.l -text "Results"
  scrollbar .m.o.vert -relief sunken -command ".m.o.out yview" \
	  -orient vertical
  scrollbar .m.o.horz -relief sunken -command ".m.o.out xview" \
	  -orient horizontal
  listbox .m.o.out -relief sunken -selectmode extended \
          -font -*-courier-*-r-*-*-14-*-*-*-*-*-*-*  \
	  -yscroll ".m.o.vert set" -xscroll ".m.o.horz set"
  selection handle .m.o.out "handleList .m.o.out NoFilterProc"
  pack .m.o.l    -side top    -fill x
  pack .m.o.vert -side right  -fill y
  pack .m.o.horz -side bottom -fill x
  pack .m.o.out  -side left   -fill both -expand 1


  # create a message at the bottom

  message .m.msg -text "" -justify center -aspect 1500 -relief sunken \
	-font -*-helvetica-bold-o-*-*-17-*-*-*-*-*-*-*
    
  pack .m.msg -side bottom -fill x
  pack .m.o -side top -fill both -expand 1

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

  focus .m.s.sql

  # set menu bar traversal 
  tk_bindForTraversal .m.mb .m.s.sql 
  tk_menuBar .m.mb .m.mb.file .m.mb.out .m.mb.op .m.mb.ob .m.mb.help

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

}




########################
#
# setMsg
#
#   set the text for the label at bottom of results window
#

proc setMsg {msg_text}  {
  .m.msg configure -text $msg_text
  update
}


########################
#
# confirmExit
#
#   really exit
#
proc confirmExit {} {
  global lda

  if {[tk_dialog .confirm_exit  "Confirm Exit" "Really Exit?"  ""  0 \
	"Sure, why not?"  "Cancel" ] == 0} {
    oralogoff $lda 
    destroy .
  }
}

########################
#
# clearsql
#
#   clear the sql code window
#
proc clearsql {} {
  global currentFile
  global cmdIdx
  global cmdLast
  global cmdMax
  set cmdIdx $cmdLast

  .m.s.sql delete 1.0 end

  # Added 8/25/97 by GAK
  .m.s.l   configure -text "$cmdIdx: SQL (${currentFile})"
  set currentFile ""
  setMsg ""
  focus .m.s.sql
}


########################
#
# clearoutput
#
#   clear the output listbox
#
proc clearoutput {} {

  .m.o.out delete 0 end
  setMsg ""
  focus .m.s.sql
}


########################
#
# tryOpen
#
#    try to open the file passed by fileBox stuff
#

proc tryOpen {} {

  global currentFile
  global cmdIdx
  global cmdLast

  # Added 8/25/97 by GAK
  global cmdMax
  set cmdIdx $cmdLast
 
  set types {
        {{SQL Files}     {*.sql} }
        {{All Files}     {*} }
  }
  set filename [tk_getOpenFile -title Open -filetypes $types]
  if {$filename == ""} return
 
  if {[file isfile $filename]} {
    clearsql
    clearoutput
    set currentFile [file tail $filename]
    .m.s.l   configure -text "$cmdIdx: SQL (${currentFile})"
    set result_lines [getFile $filename]
    .m.s.sql insert 1.0 "$result_lines"
    setMsg "$filename loaded"
  } else {
    setMsg "$filename not found"
  }
  focus .m.s.sql

}




########################
#
# doSaveAs

#    save the sql code
#

proc doSaveAs {} {
  global currentFile
  global cmdIdx
  global cmdLast

  # Added 8/25/97 by GAK
  global cmdMax
  set cmdIdx $cmdLast
 
  set types {
        {{SQL Files}     {*.sql} }
        {{All Files}     {*} }
  }
  set filename [tk_getSaveFile -title "Save As" -initialfile $currentFile -filetypes $types]
  if {$filename == ""} return
 
  set cmdIdx $cmdLast
  set openrc [catch {set f [open $filename w]}]
 
  if {$openrc==1} {
    setMsg "Error: $filename could not be opened, not saved"
    return
  }
 
  set currentFile $filename

  # Added 8/25/97 by GAK
  set cmdIdx $cmdLast
  .m.s.l   configure -text "$cmdIdx: SQL (${currentFile})"
 
  puts $f [.m.s.sql get 1.0 end]
  close $f
  setMsg "SQL saved to $currentFile"

}



########################
#
# doSaveOut
#
#    save the sql results
#

proc doSaveOut {} {
  global cmdIdx
  global cmdLast

  # Added 8/25/97 by GAK
  global cmdMax
  global currentFile
  set cmdIdx $cmdLast
 
  set resFile ""
  if {[string length $currentFile] > 0} {
    set resFile [split $currentFile .]
    if {[llength $resFile] > 1} {
      set resFile "[lindex $resFile 0].out"
    } else {
      set resFile ${currentFile}.out
    }
  }
 
  set types {
        {{Out Files}     {*.out} }
        {{Data Files}    {*.dat} }
        {{Text Files}    {*.txt} }
        {{All Files}     {*} }
  }
  set filename [tk_getSaveFile -title "Save Results" -initialfile $resFile -filetypes $types]
  if {$filename == ""} return
 
  set openrc [catch {set f [open $filename w]}]
 
  if {$openrc==1} {
    setMsg "Error: $filename could not be opened, not saved"
    return
  }
 
  if [.m.o.out size]==0 {
    setMsg "No output to save"
    close $f
    return
  }
 
  for {set i 0} {$i < [.m.o.out size]} {incr i} {
    puts $f [.m.o.out get $i]
  }
  close $f
  setMsg "Results saved to $filename"

}




########################
#
# doPrint
#
#    print the sql results
#

proc doPrint {} {

  global tcl_platform
  
  if [.m.o.out size]==0 {
    setMsg "No output to print"
    return
  }

  for {set i 0} {$i < [.m.o.out size]} {incr i} {
    append out_lines "[.m.o.out get $i]\n"
  }
  
  switch $tcl_platform(platform) {
    unix {setMsg [exec lp << $out_lines]}
    windows  {putFile wosql.prn $out_lines; 
              catch {exec print wosql.prn};
              setMsg printed}
    default {setMsg "don't know how to print on $tcl_platform(platform)";return}
  }

}



########################
#
# doSave
#
#    save the sql code to currentFile or use filebox
#

proc doSave {} {
  global currentFile
  global cmdIdx
  global cmdLast
  set cmdIdx $cmdLast
 
  if {[string length $currentFile] == 0} {
    doSaveAs
  } else {
    set f [open $currentFile w]
    puts $f [.m.s.sql get 1.0 end]
    close $f
    setMsg "saved to $currentFile"
  }

}





########################
#
# doNew
#
#   clear windows
#
proc doNew {} {
  global currentFile
    global cmdIdx
  global cmdLast
  set cmdIdx $cmdLast

  clearoutput
  clearsql

  setMsg ""
  .m.s.l   configure -text "$cmdIdx: SQL (${currentFile})"
  focus .m.s.sql

  set currentFile ""
}



########################
#
# chkMsg
#
#   check for server message, add to result window if not null
#

proc chkMsg {} {
  global oramsg

  if {[string length $oramsg(errortxt)] > 0} {
    set msgs [split $oramsg(errortxt) \n]
    set msgn [split $oramsg(rc)   \n]
    set i 0
    foreach f $msgs {
      set msgno ""
      catch {set msgno [lindex $msgn $i]}
      .m.o.out insert end "$msgno: $f"
      incr i
    }
  }

}



########################
#
# plExec
#
#   plexec existing sql window with bind variables
#

proc plExec {} {

  catch {destroy .pl}
  toplevel .pl
  wm title .pl  "PL/SQL Execute"

  wm geom .pl 500x160
  wm minsize .pl 500 160

  set help_txt {-justify left -text \{
  PL/SQL Execute allows execution of the SQL text window with binding\n\
  of values to :variable names.  The SQL text window may contain either\n\
  a complete PL/SQL block, or may be an anonymous block to call\n\
  a stored procedure (Version 7)\n\n\
  The Bind Variables entry should be used to bind values to the :variables.\n\
  Enter the name of a :variable (with leading colon) followed by the \n\
  value to bind.  If a value contains spaces, place double quotes around\n\
  the value.  If a :variable is output only, a dummy value is required.\n\ 
  For example, if the SQL window contained a call to a stored procedure\n\n\
  BEGIN \n\
    assign_emp(:name, :age, :salary, :dept);\n\
  END;\n\n\
  then an appropriate entry might be\n\n\
  :name \"John Doe\"  :age 42  :salary 4.25  :dept \"Widget Mfg.\" \} }

  label .pl.l -text "Bind Variables:" -relief flat -anchor w
  entry .pl.e  -relief sunken 
  frame .pl.f
  button .pl.f.exec -text "Bind & Execute" -command doPl
  button .pl.f.can  -text "Cancel"  -command "destroy .pl"
  button .pl.f.help -text "Help"    \
		  -command "mkDialog .PL/SQL_Execute_Help \"$help_txt\" {OK {}}"

  pack .pl.f.exec .pl.f.can  .pl.f.help -side left -expand 1 -fill both

  pack .pl.l -side top -pady 20 -fill x
  pack .pl.e -side top -padx 20 -fill both
  pack .pl.f -side top -pady 10 -fill x

  focus .pl.e

  bind .pl.e <KeyPress-Return> ".pl.f.exec invoke"

}


########################
#
# insSql
#
#   insert the current Sql into the cmdRing
#

proc insSql {} {
  global cmdRing
  global cmdIdx
  global cmdLast

  # Added 8/25/97 by GAK
  global cmdMax
  global currentFile

  set currentSql [.m.s.sql get 1.0 end]

  # don't save null buffers
  if {[string length [string trim $currentSql]] == 0} {
    return
  }

  set cmdRing($cmdLast) $currentSql

  set cmdIdx $cmdLast

  incr cmdLast

  # Added 8/25/97 by GAK
  if {$cmdLast >= $cmdMax} {
    set cmdLast 0
  }
  .m.s.l   configure -text "$cmdIdx: SQL (${currentFile})"

}

########################
#
# prevSql
#
#   save current sql window, replace with previous (dir=-1) or next (dir=1) 
#

proc prevSql {dir} {
  global cmdRing
  global cmdIdx
  global cmdLast

  # Added 8/25/97 by GAK
  global cmdMax
  global currentFile


  set i 0
  set result_lines ""

  while {$i < $cmdMax && [string length $result_lines] == 0} {
    incr cmdIdx $dir

    if {$cmdIdx < 0} {
      set cmdIdx $cmdMax
      incr cmdIdx -1
    }
    if {$cmdIdx >= $cmdMax} {
      set cmdIdx 0
    }
    set result_lines $cmdRing($cmdIdx)
    incr i
  }

  if {[string length $result_lines] > 0} {
    .m.s.sql delete 1.0 end
    .m.s.sql insert 1.0 "$result_lines"
  }
  .m.s.l   configure -text "$cmdIdx: SQL (${currentFile})"

}

########################
#
# repl_str
#
#   replicate a string n times
#
proc repl_str {str n} {
  set s $str
  for {set i 1} {$i < $n} {incr i} {
    append s $str
  }
  return $s
}

proc max {x y} {
  return [expr $x > $y ? $x : $y]
}
 

########################
#
# doPl
#
#   do the plExec bind
#

proc doPl {} {
  global cur
  global oramsg

  # first make a dash line, 256 chars long
  set d [repl_str "----------------" 16]

  set row ""
  set sql_str [.m.s.sql get 1.0 end]
  set sql_filt ""

  clearoutput

  # filter out lines beginning with "#" or ";"
  foreach f [split $sql_str \n] {
    # filter out comments
    set  ex1 [regexp -nocase "^#.*$|^ *#.*$" $f]
    # filter out "go"s
    set  ex2 [regexp -nocase "^;.*$|^ *;.*$" $f]
    if !$ex1$ex2 {
      append sql_filt "$f\n"
    } else {
      append sql_filt "\n"
    }
  }

  if {[string length $sql_filt] == 0} {
    setMsg "No SQL to execute"
    return
  }

  insSql

  set bind_vars [.pl.e get]

  setMsg "Running PL/SQL"
  set dbret [catch {set row [eval oraplexec $cur \"$sql_filt\" $bind_vars]}]

  set rc $oramsg(rc)

  chkMsg
  set col_names [oracols $cur]

  set c_lengs ""
  set r_lengs ""

  foreach c $col_names {
    lappend c_lengs [string length $c]
  }
  foreach c $row {
    lappend r_lengs [string length $c]
  }

  set fmt ""

  for {set i 0} {$i < [llength $c_lengs]} {incr i} {
    set len [max [lindex $c_lengs $i] [lindex $r_lengs $i] ]
    append fmt "%-${len}.${len}s "
  }

  .m.o.out insert end [eval format \"$fmt\" $col_names]
  set dash $col_names
  for {set i 0} {$i < [llength $dash]} {incr i} {
    set dash [lreplace $dash $i $i $d]
  }
  .m.o.out insert end [eval format \"$fmt\" $dash]
  .m.o.out insert end [eval format \"$fmt\" $row]

  setMsg "PL/SQL Execute done, return code = $rc"
}



########################
#
# doSql
#
#   exec existing sql source
#
proc doSql {} {
  global cur
  global oramsg
  global contFlag 
  global stopFlag
  global appendclear

  set contFlag 1
  set stopFlag 1
  global execCmd
  set execCmd "set contFlag 0; set stopFlag 0"
  .m.mb.exec configure  -text "Cancel"  -state active

  set NO_MORE_ROWS 1403
 
  # first make a dash line, 256 chars long
  set d [repl_str "----------------" 16]

  set txtindx ""
  set txtcols ""
  set txtdata ""
  set txtlens ""
  set row ""
  set cnt 0
  set sql_str [.m.s.sql get 1.0 end]
  set sql_filt ""
  set rpc_rows 0

  if $appendclear clearoutput

  # filter out lines beginning with "#" or ";"
  foreach f [split $sql_str \n] {
    # filter out comments
    set  ex1 [regexp -nocase "^#.*$|^ *#.*$" $f]
    # filter out "go"s
    set  ex2 [regexp -nocase "^;.*$|^ *;.*$" $f]
    if !$ex1$ex2 {
      append sql_filt "$f\n"
    } else {
      append sql_filt "\n"
    }
  }

  if {[string length $sql_filt] == 0} {
    setMsg "No SQL to execute"
    set execCmd doSql
    .m.mb.exec configure  -text "Execute" -state normal
    return
  }

  insSql
  setMsg "Running SQL"
  catch {.m.s.sql tag delete peo}
  set dbret [catch {orasql $cur $sql_filt}]

  if {$dbret==1} {
      .m.s.sql tag add peo "1.0 + $oramsg(peo) chars" "1.0 + $oramsg(peo) chars wordend"
      .m.s.sql tag configure peo -foreground red -background white
      setMsg "Error: $oramsg(rc) : $oramsg(errortxt)"
    set execCmd doSql
    .m.mb.exec configure  -text "Execute" -state active
    return
  } else {
    set rpc_rows $oramsg(rows)
    setMsg "SQL finished, getting results"
    chkMsg
  }

  set fmt ""
  if {$oramsg(rc) != $NO_MORE_ROWS} {
    set row [orafetch $cur]
    chkMsg
  }
  set lastnext $oramsg(rc)
  if {[string length $row] == 0} {
    set contFlag 0
  }

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

    set rpc_rows $oramsg(rows)
    if {[string length $fmt] == 0} {
      set col_names [oracols $cur]
      chkMsg
      # extract long columns into separate areas
      set i [lsearch $oramsg(coltypes) long]
      while {$i >= 0} {
	lappend txtindx $i
	lappend txtcols [lvarpop col_names $i]
	lappend txtlens [lvarpop oramsg(collengths) $i]
	lvarpop oramsg(coltypes) $i
        set i [lsearch $oramsg(coltypes) long]
      }
      set fmt [formatCols $col_names $oramsg(coltypes) $oramsg(collengths)]
      .m.o.out insert end [eval format \"$fmt\" $col_names]
      set dash $col_names
      for {set i 0} {$i < [llength $dash]} {incr i} {
	set dash [lreplace $dash $i $i $d]
      }
      .m.o.out insert end [eval format \"$fmt\" $dash]
    }

    if {[string length $row] == 0} {
      set fmt ""
    }  else {
      set txtdata ""
      foreach i $txtindx {
        lappend txtdata [lvarpop row $i]
      }
      .m.o.out insert end [eval format \"$fmt\" $row]
      incr cnt
      if {[llength $txtindx] > 0} {
	set i 0
	foreach t $txtcols {
	  .m.o.out insert end "" [lindex $txtcols $i]
	  .m.o.out insert end [string range $d 0 30]
	  eval .m.o.out insert end [split [lindex $txtdata $i] \n]
	  .m.o.out insert end "" 
	}
      }
    }

    if {$cnt % 20 == 0} {
      setMsg "$cnt rows so far...."
      update
    }

    set row [orafetch $cur]  
    chkMsg


  }

  if $stopFlag {
    setMsg "SQL finished, $cnt rows returned, $rpc_rows rows affected "
  } else {
    setMsg "SQL interrupted, $cnt rows returned "
  }

  set execCmd doSql
  .m.mb.exec configure  -text "Execute" -state normal

}


########################
#
# lempty and lvarpop tcl-only implementations
#

proc lempty {l} {
  return [expr [llength $l] == 0 ? 1 : 0] 
}

proc lvarpop {v args} {
  upvar $v mylist
  set argl [llength $args]
  if {$argl >=1} {
      set idx [lindex $args 0]
  } else {
      set idx 0
  }
  set ret [lindex $mylist $idx]
  if {$argl >= 2} {
      set mylist [lreplace $mylist $idx $idx [lindex $args 1]]
  } else {
      set mylist [lreplace $mylist $idx $idx]
  }
  return $ret
}



########################
#
# formatCols
#
#   return a format to use in column printing
#   names, types, and lengths are lists of equal size
#
proc formatCols {names types lengths} {

  set fmt ""
 
  while {! [lempty $names] } {
    set t [lvarpop types]
    set l [lvarpop lengths]
    set n [lvarpop names]

    # set a length based on type
    # text, image, and binary get defaults

    case $t {
      {number}   {set len 18 ; set just "" }
      {rowid}  {set len 19 ; set just "" }
      {*date}  {set len 26 ; set just - }
      {*char*}  {set len $l ; set just - }
      {default} {set len 32 ; set just - }
    }

    # make sure length is as long as colunm name 
    set len [max $len [string length $n]]

    append fmt "%${just}${len}.${len}s "

  }
  return $fmt
}


########################
#
# showFields
#
#   create a toplevel window with a table's fields
#
proc showFields {args} {
  global cur
  global oramsg

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

  set plist ""

  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  "


  orafetch $cur {
    set n @1
    set t @2
    set l @3
    set p @4
    set s @5
    set b @6
    if {[string match "*CHAR*" $t]} {
      set t ${t}($l)
    }
    if {[string match "NUMBER" $t]} {
      if {$p + $s > 0}  {
        set t ${t}(${p},${s})
      }
    }
    if {[string compare $b Y] == 0} {
      set nl " "
    } else {
      set nl "NOT NULL"
    }
    lappend plist [format "%-30.20s %-15.15s %-8.8s" $n $t $nl]
  }

  if {[llength $plist] == 0} {
    setMsg "No fields in table $owner.$tab"
    return
  }
  set win .${owner}:${tab}
  regsub -all {\$} .${owner}:${tab} _ win
  pickList $win Columns 550x300 $plist "" filtCols
}



########################
#
# 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 }

  orafetch $cur { lappend plist [format "%-25.25s %-30.30s" @1 @2] }

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


########################
#
# showViewtxt
#
#   create a toplevel window with a view's text
#
proc showViewtxt {args} {
  global cur
  global oramsg

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

  set plist ""

  orasql $cur "select text
	       from all_views \
	       where  view_name = '$tab' and owner = '$owner'  "

  orafetch $cur {
    set row @1
    set l [split $row \n]
    foreach r $l {
      lappend plist $r
    }
  }

  if {[llength $plist] == 0} {
    setMsg "No text in view $owner.$tab"
    return
  }
  set win .${owner}:${tab}
  regsub -all {\$} .${owner}:${tab} _ win
  pickList $win Text  550x300 $plist ""
}



########################
#
# showHelp
#
#   create a toplevel window with Help topics
#
proc showHelp {} {
  global cur
  global oramsg

  set plist ""
  orasql $cur {select distinct topic from system.help \
	       order by upper(topic) }

  orafetch $cur { lappend plist [format "%-50.50s" @1] }

  if {[llength $plist] == 0} {
    setMsg "No Help available"
    return
  }
  pickList .Helptopic "Topic" 500x400 $plist showHelpInfo
}


########################
#
# showHelpInfo
#
#   create a toplevel window with a Help topic's info
#
proc showHelpInfo {args} {
  global cur
  global oramsg

  # args get a list of list; break out
  eval set args $args
  #set topic [lindex $args 0]
  set topic [string trimright $args]

  set plist ""

  orasql $cur "select info
	       from system.help \
	       where  topic = '${topic}' order by topic,seq  "

  orafetch $cur {
    set row @1
    set l [split $row \n]
    foreach r $l {
      lappend plist $r
    }
  }

  if {[llength $plist] == 0} {
    setMsg "No topic $topic in system.help"
    return
  }
  set win .${topic}
  regsub -all { } .${topic} _ win
  pickList $win Text  768x768 $plist ""
}


########################
#
# showViews
#
#   create a toplevel window with user accesable views
#
proc showViews {} {
  global cur
  global oramsg

  set plist ""
  orasql $cur {select owner, view_name from all_views \
	       order by owner, view_name }

  orafetch $cur { lappend plist [format "%-25.25s %-30.30s" @1 @2] }

  if {[llength $plist] == 0} {
    setMsg "No user views available"
    return
  }
  
  pickList .Views "Owner                     Views" 500x300 $plist showViewtxt filtTab
}


########################
#
# showIndtxt
#
#   create a toplevel window with a index fields
#
proc showIndtxt {args} {
  global cur
  global oramsg

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

  set plist ""


  orasql $cur "select * from all_indexes  \
	       where  index_name = '$tab' and owner = '$owner' "

  set uniq [lindex [orafetch $cur] 5]

  oracancel $cur
	       
  orasql $cur "select column_name \
	       from all_ind_columns \
	       where  index_name = '$tab' and index_owner = '$owner' \
	       order by column_position "

  orafetch $cur {lappend plist @0}

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

  set win .${owner}:${tab}
  regsub -all {\$} .${owner}:${tab} _ win
  pickList $win "$uniq $obj Columns"  320x250 $plist "" 
}



########################
#
# showIndexes
#
#   create a toplevel window with user accesable indexes
#
proc showIndexes {} {
  global cur
  global oramsg

  set plist ""
  orasql $cur {select distinct index_owner, index_name, table_owner, \
	       table_name \
	       from all_ind_columns  \
	       order by index_owner, index_name, table_owner, table_name }

  orafetch $cur {
    lappend plist [format "%-25.25s %-30.30s %-30.30s" \
      [lindex @0 0] [lindex @0 1] "[lindex @0 2]:[lindex @0 3]"]
  }

  if {[llength $plist] == 0} {
    setMsg "No user indexes available"
    return
  }
  
  pickList .Indexes "Owner                     Index                      on table" \
	    600x300 $plist showIndtxt
}



########################
#
# getSrc
#
#   create a toplevel window with user source text
#
proc getSrc {args} {
  global cur
  global oramsg

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

  set plist ""

  orasql $cur "select text from all_source \
			   where owner = '$owner' and name = '$tab' \
			   order by line"

  set row [orafetch $cur]
  while {$oramsg(rc) == 0} {
    lappend plist [lindex $row 0]
    set row [orafetch $cur]
  }
  orafetch $cur {lappend plist @1}

  set win .${owner}:${tab}
  regsub -all {\$} .${owner}:${tab} _ win
  pickList $win "Source Text" 600x300 $plist ""
}



########################
#
# showSrc
#
#   create a toplevel window with user source procedures, functions, packages
#
proc showSrc {} {
  global cur
  global oramsg

  setMsg ""
  set plist ""

  set sql_filt "select distinct owner, name, type from all_source \
					  order by owner, name"

  set dbret [catch {orasql $cur $sql_filt}]

  if $dbret==1 {
    setMsg "Data Dictionary access failed (Version 7?)"
    return
  }

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

  if {[llength $plist] == 0} {
    setMsg "No Procedures/Functions/Packages"
    return
  }
  pickList .Procedures "Owner                     Name                              Type" \
           600x350 $plist getSrc
}



########################
#
# showTrigtxt
#
#   create a toplevel window with a trigger description
#
proc showTrigtxt {args} {
  global cur
  global oramsg

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

  set plist ""



  orasql $cur "select \
                      owner, trigger_name, trigger_type, triggering_event, 
                      table_owner, table_name, referencing_names, when_clause, 
                      status, description, trigger_body
               from all_triggers  \
	       where  trigger_name = '$tab' and owner = '$owner' "

  set row [orafetch $cur]

  set type     [lindex $row 2]
  set event    [lindex $row 3]
  set tab_own  [lindex $row 4]
  set tab_name [lindex $row 5]
  set ref      [lindex $row 6]
  set when     [lindex $row 7]
  set enab     [lindex $row 8]
  set desc     [lindex $row 9]
  set body     [lindex $row 10]

  lappend plist "DESCRIPTION:"
  set l [split $desc \n]
  foreach r $l {
    lappend plist "  $r"
  }
  lappend plist "WHEN:"
  set l [split $when \n]
  foreach r $l {
    lappend plist "  $r"
  }
  lappend plist "$ref"
  lappend plist "BODY:"
  set l [split $body \n]
  foreach r $l {
    lappend plist "  $r"
  }

  set win .${owner}:${tab}
  regsub -all {\$} .${owner}:${tab} _ win
  pickList $win "On Table: $tab_own.$tab_name $enab"  450x350 $plist ""
}



########################
#
# showTrigs
#
#   create a toplevel window with user accesable triggers
#
proc showTrigs {} {
  global cur
  global oramsg

  set plist ""
  set sql_filt "select distinct owner, trigger_name, table_owner, table_name \
		    from all_triggers
                    order by  owner, trigger_name, table_owner, table_name "

			

  set dbret [catch {orasql $cur $sql_filt}]

  if $dbret==1 {
    setMsg "Data Dictionary access failed (Version 7?)"
    return
  }

  set row [orafetch $cur]
  while {$oramsg(rc) == 0} {
    lappend plist [format "%-25.25s %-30.30s %-30.30s" \
      [lindex $row 0] [lindex $row 1] "[lindex $row 2]:[lindex $row 3]"]
    set row [orafetch $cur]
  }
  orafetch $cur {
    lappend plist [format "%-25.25s %-30.30s %-30.30s" \
      @1 @2 "[lindex @0 2]:[lindex @0 3]"]
  }

  if {[llength $plist] == 0} {
    setMsg "No user triggers available"
    return
  }
  
  pickList .Triggers "Owner                     Trigger                    on table" \
	    600x300 $plist showTrigtxt
}



########################
#
# pickFN
#
#   receive a filebox entry of filename, set longFN
#
proc pickFN {win fn} {
  global longFN

  set longFN $fn
  destroy $win
}


########################
#
# doLong
#
#   do the long column operation
#
proc doLong {io} {
  global cur

  set tab [string trim [.l.f1.t get]]
  if {[string length $tab] == 0} {
    .l.msg configure -text "\n\nTable must be specified!\n\n"
    return
  }

  set col [string trim [.l.f2.c get]]
  if {[string length $col] == 0} {
    .l.msg configure -text "\n\nColumn must be specified!\n\n"
    return
  }

  set row [string trim [.l.f3.r get]]
  if {[string length $row] == 0} {
    .l.msg configure -text "\n\nRowid must be specified!\n\n"
    return
  }

  set fil [string trim [.l.f4.f get]]
  if {[string length $fil] == 0} {
    .l.msg configure -text "\n\nFilename must be specified!\n\n"
    return
  }

  
  if {[string compare $io Read] == 0} {
    set extra "into file $fil from $tab.$col"
    set dbret [catch {orareadlong $cur $row $tab $col $fil} result]
  } else {
    set extra "into $tab.$col from file $fil"
    if [file isfile $fil] { 
      set dbret [catch {orawritelong $cur $row $tab $col $fil} result]
    } else {
      .l.msg configure -text "\n\nError: $fil file not found\n\n"
      return
    }
  }

  if {$dbret==1} {
    .l.msg configure \
	 -text "\n\nError: $result\n\n(bad table, column, or rowid?)\n\n"
  } else {
    .l.msg configure -text "\n\n$result bytes transferred\n$extra\n\n"
  }

}



########################
#
# longFile
#
#   create a toplevel window to read write longs to/from files
#
proc longFile {io} {
  global longFN

  set longFN ""

  catch {destroy .l}

  toplevel .l
  wm title .l "Long Column $io"

  if {[string compare $io Write] == 0} {
     set mtext "\n\nWrite a Long Column from a file\n\n"
  } else {
     set mtext "\n\nRead a Long Column and write to a file\n\n"
  }

  message .l.msg -aspect 1000  -text  $mtext -relief flat

  frame .l.f1
  frame .l.f2
  frame .l.f3
  frame .l.f4
  frame .l.f5

  label .l.f1.l1 -text "Table:"     -width 8 -anchor e
  label .l.f2.l2 -text "Column:"    -width 8 -anchor e
  label .l.f3.l3 -text "Row ID:"    -width 8 -anchor e
  label .l.f4.l4 -text "File:"      -width 8 -anchor e

  entry .l.f1.t -relief sunken -width 30
  entry .l.f2.c -relief sunken -width 30
  entry .l.f3.r -relief sunken -width 30
  entry .l.f4.f -relief sunken -width 30 -textvariable longFN 
  button .l.f4.b  -text " Pick File " \
			   -command "fileBox .Pick_File * \"\" \"\" pickFN"

  bind .l.f1.t <KeyPress-Return> "focus .l.f2.c"
  bind .l.f2.c <KeyPress-Return> "focus .l.f3.r"
  bind .l.f3.r <KeyPress-Return> "focus .l.f4.f"
  bind .l.f4.f <KeyPress-Return> "focus .l.f1.t"

  bind .l.f1.t <KeyPress-Tab> "focus .l.f2.c"
  bind .l.f2.c <KeyPress-Tab> "focus .l.f3.r"
  bind .l.f3.r <KeyPress-Tab> "focus .l.f4.f"
  bind .l.f4.f <KeyPress-Tab> "focus .l.f1.t"
 
  button .l.f5.ok -text "Execute" -command "doLong $io"
  button .l.f5.can -text "Cancel" -command "destroy .l"
  
  pack .l.f1.l1 -side left 
  pack .l.f1.t  -side left -fill x -expand 1
  pack .l.f2.l2 -side left
  pack .l.f2.c  -side left -fill x -expand 1
  pack .l.f3.l3 -side left
  pack .l.f3.r  -side left -fill x -expand 1
  pack .l.f4.l4 -side left
  pack .l.f4.f  -side left -fill x -expand 1
  pack .l.f4.b  -side right -fill x -expand 1
  pack .l.f5.ok -side left -fill x -expand 1 -anchor s
  pack .l.f5.can -side right -fill x -expand 1 -anchor s


  pack .l.msg -side top -fill x
  pack .l.f1 .l.f2 .l.f3 .l.f4 -side top -fill x -pady 8
  pack .l.f5 -side top -fill x -pady 20

  focus .l.f1.t

}




proc generalHelp {} {
  tk_dialog .general_help "General Help"  "Windowing Oracle SQL is an\
  interactive SQL environment for Oracle databases. " "" 0 OK
}

proc menuHelpFile {} {
  tk_dialog .general_help "Help - File Menu" "File Menu\n\n\
  New - Clears SQL and Result windows, allows entry of an SQL statement.\n \
  Open - Prompts for a file containing SQL statements , and loads the\
  file into the SQL window.\n\
  Save - Saves the contents of the SQL window into the current filename.\n\
  Save As - Saves the contents of the SQL window, prompting for filename.\n\n\
  Exit - Exits Windowing Oracle SQL with confirmation.\n\
  " "" 0 OK
}

proc menuHelpOut {} {
  tk_dialog .general_help "Help - Results Menu" "Results Menu\n\n\
  Clear - Clears the Results window.\n\
  Save As - Saves the contents of the Results window into a file.\n\
  Print - Prints the contents of the Results window using the 'lp' command.\n\
  Font Size - Sets the size of the Results window font.\n\
  " "" 0 OK
}


proc menuHelpOpts {} {
  tk_dialog .general_help "Help - Options Menu" "Options Menu\n\n\
  Autocommit - sets autocommit feature on or off (default is off).\n\
  Commit now - commits any previous transactions.\n\
  Rollback now - rollback any previous transactions.\n\
  Long Write Col - starts dialog to write a Long column from a file.\n\
  Long Read Col - starts dialog to read a Long column and write to a file.\n\
  Execute Proc - starts dialog to execute a stored procedure with\
  variable substition.\n\
  " "" 0 OK

}

proc menuHelpObjs {} {
  tk_dialog .general_help "Help - Objects Menu" "DB Objects Menu\n\n\
  Selecting a object type will display a list of objects\
  present in the database. \n\n\
  Selecting an object in the display list by double clicking, or \
  highlighting and pressing \"OK\" will display the detail of\
  the selected object. \n\n\
  A selected line from the Tables or Views display, or multiple lines\
  from the Column display can be pasted into the SQL text entry with Button-2.
  " "" 0 OK
}

proc menuHelpExec {} {
  tk_dialog .general_help "Help - Execute Menu" "Execute Menu\n\n\
  The currently displayed SQL statement is executed.  Results are displayed\
  in the Results window.\n\nLines beginning with\
  a pound sign \"#\" or semicolon \";\" are treated as comments.\n\n\
  While a SQL command is being executed, the \"Execute\" button changes\
  to \"Cancel\"; pressing it will interrupt the\
  SQL command.\n\n\
  PL/SQL blocks may be executed.  Use \"Options - Procedure Exec\" to\
  bind values to :variables.\n\n\
  Any error messages associated with the\
  SQL statement are displayed in the message area. \n\n\
  Control-Return and Shift-Return in the SQL window are accelerator\
  keys for Execute and Cancel. \n
  Control-Up, Shift-Up, Control-Down, Shift-Down access\
  the SQL save buffer to recall previous commands.\
  " "" 0 OK
}

proc aboutHelp {} {
  tk_dialog .general_help "About"  "Windowing Oracle SQL\nVersion 2.5\n\
  \nAugust, 1997\n\nTom Poindexter" "" 0 OK
}



########################
#
# 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 [string tolower $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 \
	 -selectmode extended \
	 -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.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

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

  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

}




proc setNull {} {
  global oramsg
  global doExp
  global nullVal
  set doExp 0

  set nullVal $oramsg(nullvalue)

  catch {destroy .snull}
  toplevel .snull -class Dialog

  wm transient .snull .
  set xpos [expr [winfo rootx .]+[winfo width .]/3]
  set ypos [expr [winfo rooty .]+[winfo height .]/3]
  wm geom .snull +${xpos}+$ypos
  wm title .snull "Set Null Value"

  frame .snull.f1 -relief sunken -borderwidth 1

  label .snull.f1.l -text " Value "
  entry .snull.f1.e -width 30 -relief sunken -textvariable nullVal
  bind  .snull.f1.e <KeyPress-Return> { set doExp 1 }

  pack .snull.f1.l -side left 
  pack .snull.f1.e -side left -fill x -expand 1

  message .snull.f2 -text {(use "default" for default behavior)} -aspect 1200

  frame .snull.f3 -relief sunken -borderwidth 1
  button .snull.f3.app -width 10 -text "Set" \
                                      -command { set doExp 1 }
  button .snull.f3.can -width 10 -text "Cancel" \
                                      -command { set doExp 0 }

  pack .snull.f3.app .snull.f3.can -side left -expand 1 -fill x

  pack  .snull.f1 .snull.f2 .snull.f3  -side top -padx 10 -pady 5 -fill both

  grab .snull
  tkwait variable doExp
  destroy .snull

  if {$doExp == 0} return

  set oramsg(nullvalue) [string trim $nullVal]

}



