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

#  wisql
# 	
#  Copyright 1992 Tom Poindexter.
#
#  a windowing version of the sybase isql command  
#  uses extended tcl, tk, and sybtcl interface
#
#  usage: wisql
#
#  version 1.1 - change sql input to use tk2.2 text widget.
#                handle text columns a little better - break into lines.
#                add getObjs to view other objects.
#                allow comments '#' and 'go's in sql.
#                add count of all rows returned by server
#  version 1.2 - change showFields to display 30 chars for field name
#                using hand coded sql instead of sp_help.
#                add sybmsg(msgno) to error messages.
#                change .m.msg to a message (used to be a label) so that all
#                the text of a message will be displayed.
#                add some arrow key bindings for Entry and Text classes.
#                add shift-return and control-return binding to execute sql.
#                added a menu for selecting a server on signon window.
#                fix pickList OK command when nothing selected.
#                a few other cosmetics changes.
#  version 1.3 - change a few things for newer versions of Tk & TclX,
#                toplevel pathnames must start with lower case, wishx
#                command interpreter instead of wish.
#                if SYBASE environment variable is not set, check for 
#                user sybase home directory in "ypcat passwd" or /etc/passwd
#                make the execute button a cancel button while execing sql
#


# define global names in use
global sybmsg
global uid
global syb
global currentFile
global server
global fontSize
global execCmd

# set what command Execute button should do
set execCmd doSql

set fontSize 14

set uid [id user]

set syb {}
set currentFile {}

wm title    . "Windowing ISQL"
wm iconname . "Wisql"


proc getSignOn {} {
  global uid
  global env
  global matchInfo

  # get valid servers from interfaces file
  set syb_home [lsearch [array names env] SYBASE] 

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

  if {[string length $syb_home] > 0} {
    set intFile $syb_home/interfaces
    set serverList ""
    if [file isfile $intFile] {
      set fd [open $intFile]
      set sc [scancontext create]
      scanmatch -nocase $sc {^[a-z]} {lappend serverList $matchInfo(line)}
      scanfile $sc $fd
      close $fd
    } else {
      set serverList SYBASE
    }
  } else {
    set serverList SYBASE
  }
  
  wm geom     . 300x300
  frame .s
  message .s.m -justify center  -text "SQL Server Sign on" -aspect 2000 \
		-font -*-helvetica-bold-o-*-*-20-*-*-*-*-*-*-*
  frame .s.i
  entry .s.i.uid -relief sunken  -width 10 
  label .s.i.id  -text "  User Id" -anchor e
  frame .s.p
  entry .s.p.pw  -relief sunken -width 10 \
		 -font -*-symbol-*-r-*--20-*-*-*-*-*-*-*
  label .s.p.p   -text "  Password" -anchor e

  frame .s.s
  entry .s.s.ser -relief sunken -width 10 
  menubutton .s.s.s -text " Server  " -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 -expand 1 -fill both
  pack .s.m     -side top -fill x  -pady 20
  pack .s.i     -side top -pady 20 -anchor e
  pack .s.i.uid -side right -expand 1 -padx 20
  pack .s.i.id  -side left
  pack .s.p     -side top   -pady 20 -anchor e
  pack .s.p.pw  -side right -expand 1 -padx 20 
  pack .s.p.p   -side left

  pack .s.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
  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] DSQUERY] >= 0} {
    .s.s.ser insert 0 $env(DSQUERY)
  } else {
    .s.s.ser insert 0 SYBASE
  }
  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
  # (thanks to Eric Jacobshagen)
  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}

}

# kick off the entire process

getSignOn


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

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

proc tryConnect {id pw ser} {
  global sybmsg
  global syb
  global server

  set server $ser

  set retcode [catch {set syb [sybconnect $id $pw $ser]}]

  if $retcode==0 {
    destroy .s
    createMain
  } else  {
    .s.err configure -text $sybmsg(dberrstr)
    focus .s.p.pw
  }
}


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

proc createMain {} {
  global syb
  global sybmsg
  global currentFile

  wm geom    . 800x700
  wm minsize . 400 370

  # 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
  menu .m.mb.file.m
  .m.mb.file.m add command -label "New" -command doNew
  .m.mb.file.m add command -label "Open..." \
			   -command "fileBox .Open * \"\" \"\" tryOpen"
  .m.mb.file.m add command -label "Save" -command doSave 
  .m.mb.file.m add command -label "Save as..." \
			   -command "fileBox .Save * \"\" \"\" doSaveAs"
  .m.mb.file.m add separator
  .m.mb.file.m add command -label "Exit"  -command confirmExit 

  menubutton .m.mb.out -text "Results" -menu .m.mb.out.m
  menu .m.mb.out.m
  .m.mb.out.m add command -label "Clear" -command clearoutput
  .m.mb.out.m add command -label "Save as..." \
		  -command "fileBox .Save_Results * \"\" \"\" doSaveOut"
  .m.mb.out.m add command -label "Print" -command doPrint
  .m.mb.out.m add cascade -label "Font Size  " -menu .m.mb.out.m.f
  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.db -text "Databases" -menu .m.mb.db.m
  menu .m.mb.db.m
  sybsql $syb "sp_helpdb"
  set dbname [lindex [sybnext $syb] 0]
  while {[string compare $sybmsg(nextrow) REG_ROW] == 0} {
    if {[string match model $dbname] == 0} {
      .m.mb.db.m add command -label $dbname -command "useDB $dbname"
    }
    set dbname [lindex [sybnext $syb] 0]
  }

  menubutton .m.mb.ob -text "Objects" -menu .m.mb.ob.m
  menu .m.mb.ob.m
  .m.mb.ob.m add command  -label "Tables"   -command showTables
  .m.mb.ob.m add command  -label "Views"    -command "showObjs Views V"
  .m.mb.ob.m add command  -label "Procs"    -command "showObjs Procedures P"
  .m.mb.ob.m add command  -label "Rules"    -command "showObjs Rules R"
  .m.mb.ob.m add command  -label "Triggers" -command "showObjs Triggers TR"

  # execCmd is normally "doSql", except while in doSql, then it is Cancel
  button .m.mb.exec  -text "Execute" -command {eval $execCmd}   -relief flat

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

  menu .m.mb.help.m.m
  .m.mb.help.m.m add command -label "File"   -command menuHelpFile
  .m.mb.help.m.m add command -label "Results"   -command menuHelpOut
  .m.mb.help.m.m add command -label "Databases" -command menuHelpDB
  .m.mb.help.m.m add command -label "Objects" -command menuHelpObjs
  .m.mb.help.m.m add command -label "Execute" -command menuHelpExec

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

  tk_bindForTraversal .m.mb
  tk_menuBar .m.mb .m.mb.file .m.mb.out .m.mb.db \
		    .m.mb.ob .m.mb.exec .m.mb.help 

  # create a top title

  label .m.title -text "dbname" -relief raised \
		-font -*-helvetica-bold-o-*-*-20-*-*-*-*-*-*-*

  pack .m.title -side top

  # 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 .m.s.sql <Control-Return> ".m.mb.exec invoke"
  bind .m.s.sql <Shift-Return>   ".m.mb.exec invoke"
  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"
  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

  #label .m.msg -text "" -width 40 -relief sunken 
  message .m.msg -text "" -justify center -aspect 1000 -relief sunken \
	-font -*-helvetica-bold-o-*-*-17-*-*-*-*-*-*-*
    
  pack .m.msg -side bottom -fill x

  focus .m.s.sql

  useDB [sybuse $syb]

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

}



########################
#
# useDB
#
#   use a database
#

proc useDB {dbname} {
  global syb
  global server

  catch {sybuse $syb $dbname}
  set dbname [sybuse $syb]
  .m.title configure -text "server: $server - database: $dbname"
  setMsg "database changed to $dbname"

}


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

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

########################
#
# clearsql
#
#   clear the sql code window
#
proc clearsql {} {
  global currentFile

  .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

  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

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

  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


  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  -bg red
  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
  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

}

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



########################
#
# doNew
#
#   clear windows
#
proc doNew {} {
  global currentFile

  clearoutput
  clearsql

  setMsg ""
  focus .m.s.sql

  set currentFile ""
}



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

proc chkMsg {} {
  global sybmsg

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

}



########################
#
# doSql
#
#   exec existing sql source
#
proc doSql {} {
  global syb
  global sybmsg
  global execCmd
  global contFlag

  set contFlag 1

  set execCmd "set contFlag 0"
  .m.mb.exec configure -text "Cancel" -state active
 
  # 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 ""

  clearoutput

  # filter out lines beginning with "#" or lines with "go"
  foreach f [split $sql_str \n] {
    # filter out comments
    set  ex1 [regexp -nocase "^#.*$|^ *#.*$" $f]
    # filter out "go"s
    set  ex2 [regexp -nocase "^go.*$|^ *go.*$" $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 active
    return
  }

  setMsg "Running SQL"
  set dbret [catch {sybsql $syb $sql_filt}]

  if $dbret==1 {
    setMsg "Error: line $sybmsg(line): $sybmsg(msgno) : $sybmsg(msgtext)"
    set execCmd doSql
    .m.mb.exec configure -text "Execute" -state active
    return
  } else {
    setMsg "SQL finished, getting results"
    chkMsg
  }

  set fmt ""
  if {[string compare $sybmsg(nextrow) NO_MORE_ROWS] != 0} {
    set row [sybnext $syb]
    chkMsg
  }
  set lastnext $sybmsg(nextrow)

  while {$contFlag && \
	 (([string compare $sybmsg(nextrow) NO_MORE_RESULTS] != 0) || \
          ([string length $sybmsg(retstatus)] > 0) ) }  {

    if {[string length $sybmsg(retstatus)] > 0} {
      set row [sybretval $syb]
      chkMsg
      set fmt ""
    }

    if {[string length $fmt] == 0} {
      set col_names [sybcols $syb]
      chkMsg
      # extract text columns into separate areas
      set i [lsearch $sybmsg(coltypes) text]
      while {$i >= 0} {
	lappend txtindx $i
	lappend txtcols [lvarpop col_names $i]
	lappend txtlens [lvarpop sybmsg(collengths) $i]
	lvarpop sybmsg(coltypes) $i
        set i [lsearch $sybmsg(coltypes) text]
      }
      set fmt [formatCols $col_names $sybmsg(coltypes) $sybmsg(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 "" 
	}
      }
    }

    set row [sybnext $syb]  
    chkMsg
    if {[string compare $lastnext $sybmsg(nextrow)] != 0} {
      set fmt ""
      set txtindx ""
      set txtcols ""
      set txtdata ""
      set txtlens ""
      set lastnext $sybmsg(nextrow)
    }

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


  }

  if {$contFlag == 1} {
    setMsg "SQL finished, $cnt rows returned "
  } else {
    setMsg "SQL interrupted, $cnt rows returned "
  }

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

}



########################
#
# 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 {
      {int}   {set len 12 ; set just "" }
      {tinyint}   {set len 4 ; set just "" }
      {smallint}   {set len 6 ; set just "" }
      {float real}   {set len 12 ; set just "" }
      {*money} {set len 17 ; 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 {tab} {
  global syb
  global sybmsg

  set plist ""
  set dbname [sybuse $syb]

  # use to use "sp_help tabname", changed to get the info directly from
  # system tables, now shows full column name to 30 characters
  # (thanks to Paul Friberg for this change)

  sybsql $syb "select syscolumns.name, systypes.name, syscolumns.length \
	       from syscolumns, sysobjects, systypes \
	       where  syscolumns.id=sysobjects.id and sysobjects.name= '$tab' \
	       and syscolumns.usertype= systypes.usertype "


  set row [sybnext $syb]

  while {[string compare $sybmsg(nextrow) REG_ROW] == 0} {
    set n [lindex $row 0]
    set t [lindex $row 1]
    if {[string match "*char" $t]} {
      set t ${t}([lindex $row 2])
    }
    lappend plist [format "%-30.30s %-15.15s" $n $t]
    set row [sybnext $syb]
  }

  if {[llength $plist] == 0} {
    setMsg "No fields in table $tab"
    return
  }
  pickList .$dbname:$tab Fields 430x300 $plist ""
}



########################
#
# showTables
#
#   create a toplevel window with user tables
#
proc showTables {} {
  global syb
  global sybmsg

  set plist ""
  set dbname [sybuse $syb]
  sybsql $syb "select name from sysobjects where type = 'U'"

  set row [sybnext $syb]
  while {[string compare $sybmsg(nextrow) REG_ROW] == 0} {
    lappend plist $row
    set row [sybnext $syb]
  }

  if {[llength $plist] == 0} {
    setMsg "No user tables in $dbname"
    return
  }
  pickList .$dbname:Tables Tables 200x400 [lsort $plist] showFields
}



########################
#
# getObj
#
#   create a toplevel window with user object text
#
proc getObj {objname} {
  global syb
  global sybmsg

  set dbname [sybuse $syb]
  sybsql $syb "select text from syscomments \
		      where id = object_id(\"$objname\")"

  set plist ""
  set row [lindex [sybnext $syb] 0]
  while {[string compare $sybmsg(nextrow) REG_ROW] == 0} {
    eval lappend plist [split $row \n]
    set row [lindex [sybnext $syb] 0]
  }
  pickList .$dbname:$objname "Object Text" 600x300 $plist ""
}



########################
#
# showObjs
#
#   create a toplevel window with user objects
#
proc showObjs {objclass objtype} {
  global syb
  global sybmsg

  setMsg ""
  set plist ""
  set dbname [sybuse $syb]
  sybsql $syb "select name from sysobjects where type= '$objtype' order by name"

  set row [sybnext $syb]
  while {[string compare $sybmsg(nextrow) REG_ROW] == 0} {
    lappend plist $row
    set row [sybnext $syb]
  }

  if {[llength $plist] == 0} {
    setMsg "No $objclass in $dbname"
    return
  }
  pickList .$dbname:$objclass $objclass 200x250 $plist getObj
}



proc generalHelp {} {
  mkDialog .General_Help {-text "Windowing ISQL is a subset of the \
  Sybase ISQL command. "} {OK {}}
}

proc menuHelpFile {} {
  mkDialog .General_Help {-text "File Menu\n\n\
  New - Clears SQL and Result windows, allows entry of SQL code. \n \
  Open - Prompts for a file containing SQL code.\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 ISQL 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 to the 'lp' command.\n\
  Font Size - Set the size of the Results window font.\n\
  "} {OK {}}
}


proc menuHelpDB {} {
  mkDialog .General_Help {-text "Database Menu\n\n\
  All available databases in the server are displayed.  Selecting a \
  database will cause that database to be used. \
  "} {OK {}}
}

proc menuHelpObjs {} {
  mkDialog .General_Help {-text "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 will display the detail of \
  the selected object. \
  "} {OK {}}
}

proc menuHelpExec {} {
  mkDialog .General_Help {-text "Execute Menu\n\n\
  The currently displayed SQL code is executed.  Results are displayed \
  in the Results window.\n\nLines beginning with \
  a pound sign \"#\" are treated as comments.  \"go\" is not required \
  and is treated as a comment.\n\n\
  Any error messages associated with the \
  SQL code is displayed in the message area. \n\n\
  Control-Return and Shift-Return in the SQL window are bound as accelerator \
  keys for Execute. \
  "} {OK {}}
}

proc aboutHelp {} {
  mkDialog .General_Help {-text "Windowing ISQL\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} {
  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]

  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] + [lindex [lindex $topgeom 0] 0]} ]
  set newy [expr {[lindex $topgeom 2] + 10}]
  #set newy [expr {[lindex $topgeom 2] + [lindex [lindex $topgeom 0] 1]} ]

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

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

  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-*-*-*-*-*-*-*" 
  
  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 \[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

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

