#!/usr/local/bin/wishx -f

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


# 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

# 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 [id user]

set cur {}
set lda {}
set currentFile {}

set cmdIdx  0
set cmdLast 0
for {set i 0} {$i < 10} {incr i} {
  set cmdRing($i) ""
}

wm title    . "Windowing Oracle SQL"
wm iconname . "Wosql"



########################
#
# 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] ]
  set s [eval list $s]
  return [string trim [lindex $s 0].[lindex $s 1]]
}


########################
#
# getSignOn
#
#   the first window, get logon info and trys 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 minsize  . 300 300

  frame .s
  message .s.m -justify center  -text "Oracle Server Sign on" -aspect 6000 \
		-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 2000

  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 5
  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.b     -side bottom -fill x -expand 1
  pack .s.b.ok  -side left -fill x -expand 1
  pack .s.b.can -side left -fill x -expand 1

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

  pack .s.err   -side top -fill x 

  .s.i.uid insert 0 $uid

  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.p.pw

  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"

  # make arrow keys work in Entry and Text widgets
  bind Entry <Left> {%W cursor [expr {[%W index cursor] - 1}]}
  bind Entry <Right> {%W cursor [expr {[%W index cursor] + 1}]}
  bind Text <Control-u> {%W delete 1.0 end}
  bind Text <Left> {%W mark set insert insert-1char}
  bind Text <Right> {%W mark set insert insert+1char}
  bind Text <Up> {%W mark set insert insert-1line}
  bind Text <Down> {%W mark set insert insert+1line}


  # 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}
  }
  bind Text <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
#
#   create the main window
#

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

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

  # 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 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 "fileBox .Open * \"\" \"\" 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 "fileBox .Save_As * \"\" \"\" doSaveAs"
  .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 "fileBox .Save_Results * \"\" \"\" 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


  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  -side top -fill x
  pack .m.mb.file .m.mb.out .m.mb.op .m.mb.ob .m.mb.exec -side left
  pack .m.mb.help -side right

  # create a frame listing sql code

  frame .m.s -relief raised -borderwidth 2
  pack .m.s -side top -fill both

  label .m.s.l -text "SQL (noname)" 
  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"
  bind .m.s.sql <Shift-Return>   ".m.mb.exec invoke"
  bind .m.s.sql <Shift-Up>       "prevSql -1"
  bind .m.s.sql <Control-Up>     "prevSql -1"
  bind .m.s.sql <Shift-Down>     "prevSql  1"
  bind .m.s.sql <Control-Down>   "prevSql  1"

  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


  # create a frame listing sql output

  frame .m.o -relief raised
  pack .m.o -side top -fill both -expand 1

  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 \
          -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 top -fill x

  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

  mkDialog .Confirm_Exit {-text "Really Exit?"} \
    "{Yes, damnit}  {oralogoff $lda; destroy .; exit}" "Cancel {}"
}

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

  .m.s.sql delete 1.0 end
  .m.s.l   configure -text "SQL (noname)"
  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 {win filename} {

  global currentFile
  global cmdIdx
  global cmdLast
  set cmdIdx $cmdLast

  if [file isfile $filename] {
    clearsql
    clearoutput
    set currentFile [file tail $filename]
    .m.s.l   configure -text "SQL (${currentFile})"
    set result_lines [exec cat -s $filename]
    .m.s.sql insert 1.0 "$result_lines"
    setMsg "$filename loaded"
    destroy $win
  } else {
    setMsg "$filename not found"
  }
  focus .m.s.sql

}




########################
#
# doSaveAs
#
#    save the sql code
#

proc doSaveAs {win filename} {
  global currentFile
  global cmdIdx
  global cmdLast
  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
  .m.s.l   configure -text "SQL (${currentFile})"

  puts $f [.m.s.sql get 1.0 end]
  close $f
  setMsg "SQL saved to $currentFile"

  destroy $win
}



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

proc doSaveOut {win filename} {
  global cmdIdx
  global cmdLast
  set cmdIdx $cmdLast

  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"
  destroy $win
}




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

proc doPrint {} {

  
  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"
  }
  
  setMsg [exec lp << $out_lines]

}



########################
#
# 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} {
    fileBox .Save * "" "" doSaveAs
  } else {
    set f [open $currentFile w]
    puts $f [.m.s.sql get 1.0 end]
    close $f
    setMsg "saved to $currentFile"
  }

}




#######################################################################
# procs to support a file selection dialog box

########################
#
# fillLst
#
#    fill the fillBox listbox with selection entries
#

proc fillLst {win filt dir} {
  
  $win.l.lst delete 0 end

  cd $dir

  set dir [pwd]
  
  if {[string length $filt] == 0} {
    set filt *
  }
  set all_list [lsort [glob -nocomplain $dir/$filt]]

  set dlist  "$dir/../"
  set flist ""

  foreach f $all_list {
    if [file isfile $f] {
      lappend flist $f
    }
    if [file isdirectory $f] {
      lappend dlist ${f}/
    }
  }

  foreach d $dlist {
    $win.l.lst insert end $d
  }
  foreach f $flist {
    $win.l.lst insert end $f
  }

  $win.l.lst yview 0

  set idx [expr [string length [file dirname [file dirname $dir]] ]+1]

  $win.l.lst xview $idx
}


########################
#
# selInsert
#
#   insert into a selection entry, scroll to root name
#
proc selInsert {win pathname} {

  $win.sel delete 0 end
  $win.sel insert 0 $pathname
  set idx [expr [string length [file dirname [file dirname $pathname]] ]+1]
  $win.sel view $idx
  $win.sel select from 0
}


########################
#
# fileOK
#
#   do the OK processing for fileBox
#

proc fileOK {win execproc} {
  
  # might not have a valid selection, so catch the selection
  catch {  selInsert $win [lindex [selection get] 0] }

  set f [lindex [$win.sel get] 0]
  if [file isdirectory $f] {
    #set f [file dirname $f]
    #set f [file dirname $f]
    cd $f
    set f [pwd]
    fillLst $win [$win.fil get] $f
  } else {
    # we don't know if a file is really there or not, let the execproc
    # figure it out.  also, window is passed if execproc wants to kill it.
    $execproc $win $f 
  }
}

########################
#
# fileBox
#
#   put up a file selection box
#    win - name of toplevel to use
#    filt - initial file selection filter 
#    initfile - initial file selection 
#    startdir - initial starting dir
#    execproc - proc to exec with selected file name
#
proc fileBox {win filt initfile startdir execproc} {

  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]

  wm geom $win 300x500
  wm minsize $win 300 500

  if {[string length $startdir] == 0} {
    set startdir [pwd]
  }

  label $win.l1   -text "File Filter" -anchor w
  entry $win.fil  -relief sunken
  $win.fil insert 0 $filt
  label $win.l2   -text "Files" -anchor w
  frame $win.l  
  scrollbar $win.l.hor -orient horizontal -command "$win.l.lst xview" \
	    -relief sunken
  scrollbar $win.l.ver -orient vertical   -command "$win.l.lst yview" \
	    -relief sunken
  listbox $win.l.lst -yscroll "$win.l.ver set" -xscroll "$win.l.hor set" \
	    -relief sunken
  selection handle $win.l.lst "handleList $win.l.lst NoFilterProc"
  label $win.l3   -text "Selection" -anchor w
  scrollbar $win.scrl -orient horizontal -relief sunken \
                      -command "$win.sel view"
  entry $win.sel  -relief sunken -scroll "$win.scrl set"
  selInsert $win $initfile
  frame $win.o  -relief sunken -border 1
  button $win.o.ok -text "Ok" -command "fileOK $win $execproc"
  button $win.filter -text "Filter" \
	  -command "fillLst $win \[$win.fil get\] \[pwd\]"
  button $win.can    -text "Cancel" -command "destroy $win"

  pack $win.l1 -side top -fill x
  pack $win.fil -side top -pady 15 -fill x
  pack $win.l2 $win.l  $win.l3 -side top -fill x
  pack $win.sel -side top -pady 15 -fill x
  pack $win.scrl -side top -fill x
  pack $win.o $win.filter $win.can  -side left -expand 1 -padx 20

  pack $win.l.ver -side right -fill y
  pack $win.l.hor -side bottom -fill x
  pack $win.l.lst -side left   -fill both  -expand 1

  pack $win.o.ok -side left -expand 1 -padx 20 -pady 20

  bind $win.fil <KeyPress-Return> "$win.filter invoke"
  bind $win.sel <KeyPress-Return> "$win.o.ok   invoke"
  bind $win.l.lst <ButtonRelease-1> \
   "+selInsert $win \[%W get \[ %W nearest %y \] \] "
  bind $win.l.lst <Double-1> \
   "selInsert $win \[lindex \[selection get\] 0\];  $win.o.ok invoke"
  bind $win.l.lst <Button1-Motion> ""
  bind $win.l.lst <Shift-Button1-Motion> ""
  #bogus any-button1-motion, "" does not seem to work (bind patch might fix)
  bind $win.l.lst <Any-Button1-Motion> "$win.l.lst size"
  bind $win <1> "$win.o.ok config -relief sunken"
  bind $win <ButtonRelease-1> \
	"$win.o.ok invoke ; $win.o.ok deactivate"
  bind $win <Return> "$win.o.ok invoke "
  bind $win.o <Enter> "$win.o.ok activate"
  bind $win.o <Leave> "$win.o.ok deactivate"


  fillLst $win $filt $startdir
  selection own $win
  focus $win.sel

}

#
# end of the file selection box stuff
###########################################################################



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

  clearoutput
  clearsql

  setMsg ""
  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

  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
  if {$cmdLast > 9} {
    set cmdLast 0
  }

}

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

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


  set i 0
  set result_lines ""

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

    if {$cmdIdx < 0} {
      set cmdIdx 9
    }
    if {$cmdIdx > 9} {
      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"
  }

}


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

proc doPl {} {
  global cur
  global oramsg

  # first make a dash line, 256 chars long
  set d [replicate "----------------" 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 [replicate "----------------" 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"
  set dbret [catch {orasql $cur $sql_filt}]

  if $dbret==1 {
    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

}



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

  set row [orafetch $cur]

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

    set n [lindex $row 0]
    set t [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)
    }
    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]
    set row [orafetch $cur]

  }

  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 }

  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 .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'  "

  set row [orafetch $cur]

  if {$oramsg(rc) == 0} {
    set row [lindex $row 0]
    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 ""
}





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

  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 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 "

  set row [orafetch $cur]

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

  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 }

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

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

  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 "%-12.12s %-30.30s %-30.30s" \
      [lindex $row 0] [lindex $row 1] [lindex $row 2]]
    set row [orafetch $cur]
  }

  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 "%-12.12s %-30.30s %-30.30s" \
      [lindex $row 0] [lindex $row 1] "[lindex $row 2]:[lindex $row 3]"]
    set row [orafetch $cur]
  }

  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 {} {
  mkDialog .General_Help {-text "Windowing Oracle SQL is an\
  interactive SQL environment for Oracle databases. "} {OK {}}
}

proc menuHelpFile {} {
  mkDialog .General_Help {-text "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\
  "} {OK {}}
}

proc menuHelpOut {} {
  mkDialog .General_Help {-text "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\
  "} {OK {}}
}


proc menuHelpOpts {} {
  mkDialog .General_Help {-text "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\
  "} {OK {}}
}

proc menuHelpObjs {} {
  mkDialog .General_Help {-text "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.
  "} {OK {}}
}

proc menuHelpExec {} {
  mkDialog .General_Help {-text "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.\
  "} {OK {}}
}

proc aboutHelp {} {
  mkDialog .General_Help {-text "Windowing Oracle SQL\nVersion 2.0\n\
  \nNovember, 1993\n\nTom Poindexter"} {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 [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 from 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"
}



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

proc mkDialog {w msgArgs args} {
  set win_title $w
  regsub -all {_} $win_title " " win_title
  set w [translit A-Z a-z $w]
  
  catch {destroy $w}
  toplevel $w -class Dialog
  wm title $w [string range $win_title 1 end]

    # 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 1
    
    # Create the message widget and arrange for it to be centered in the
    # top frame.
    
    eval message $w.top.msg -justify center \
	    -font -*-times-medium-r-normal--*-180* $msgArgs
    pack $w.top.msg -side top -expand 1 -padx 5 -pady 5
    
    # 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 1 -padx 20 -pady 20
	button $w.bot.0.button -text [lindex $arg 0] \
		-command "[lindex $arg 1]; destroy $w"
	pack $w.bot.0.button -expand 1 -padx 12 -pady 12
	bind $w.top <Enter> "$w.bot.0.button activate"
	bind $w.top.msg <Enter> "$w.bot.0.button activate"
	bind $w.bot <Enter> "$w.bot.0.button activate"
	bind $w.top <Leave> "$w.bot.0.button deactivate"
	bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
	bind $w.bot <Leave> "$w.bot.0.button deactivate"
	bind $w <1> "$w.bot.0.button config -relief sunken"
	bind $w <ButtonRelease-1> \
		"[lindex $arg 1]; $w.bot.0.button deactivate; destroy $w"
	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 1 -padx 20
	    set i [expr $i+1]
	}
    }
}

