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

#
#  mmon -- Mini-Monitor
# 	
#  $Id: mmon,v 1.50 1995/06/06 14:25:25 hs Rel $
#------------------------------------------------------------------------
#  Copyright (c) 1992-1994 Hakan Soderstrom and Tom Poindexter
# 
#  Permission to use, copy, modify, distribute, and sell this software
#  and its documentation for any purpose is hereby granted without fee,
#  provided that the above copyright notice and this permission notice
#  appear in all copies of the software and related documentation.
#  
#  THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND,
#  EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
#  WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
#
#  IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD
#  AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL
#  DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
#  OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY
#  OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN
#  CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#------------------------------------------------------------------------
#  This is the debris of Tom Poindexter's creation wisqlite 2.2
#  after adaption to mSQL by Hakan Soderstrom.
#------------------------------------------------------------------------
#
#  DESCRIPTION
#
#  A window-based, interactive monitor for mSQL.
#  ASSUMPTION, RESTRICTIONS: Requires TclX. Runs with pre-7.4 Tk only.
#  Tested with mSQL 1.0.6. Should be backward compatible.
#
#  USAGE:
#  mmon
#   or
#  msqlwish -f mmon &
#
#  Environment variable MSQL_HOSTS may contain a colon-separated list of
#  host names.
#  Environment variable MMON_CONNECT may contain a host name and a
#  database name separated by a colon.
#  If so, mmon will attempt to connect to the host and use the database.
#
#  NOTE: At the end of the file you may configure mmon for either Motif
#  or Emacs-like bindings in text and entry widgets.
#  Especially the Emacs bindings may be a bit shaky.
#  There is no point in trying to fix it since it's taken care of in Tk 4.x.
#  All the special binding code is expected to go away.
#

#
# CONTENTS:
# A large chunk of code follows.
# It is used to create class bindings for the Entry and Text classes.
# After this chunk follows procs handling a file selection dialog box.
# (Search for '## FILE'.)
# The main program logic follows after the file selection stuff.
# It begins with a section setting a number of configurable parameters.
# (Search for '## MAIN'.)
# There is a section for the on-line help.
# (Search for '## HELP'.)
# Some dialog box code follows the help section.
#

############################################################################
# include bindings.tk from TkMail (Thanks Paul!)
############################################################################
#
#COPYRIGHT:
#     Copyright 1993 by Paul Raines (raines@bohr.physics.upenn.edu)
#
#     Permission to use, copy, modify, and distribute this
#     software and its documentation for any purpose and without
#     fee is hereby granted, provided that the above copyright
#     notice appear in all copies.  The University of Pennsylvania
#     makes no representations about the suitability of this
#     software for any purpose.  It is provided "as is" without
#     express or implied warranty.
#

# Gives more motif-like ands emacs-like bindings to Text and Entry Widgets
global bind_xnd btp

# USER SETTINGS

# maximum number of kills to save in ring
set btp(maxkill) 10
# maximum number of marks to save in ring
set btp(maxmark) 10
# syntax for letter not part of a "word"
set btp(not-word) {[^a-zA-Z_0-9]}
# procedure to use for errors
set btp(error) error
# procedure to use for beeping
set btp(beep) ""
# whether to bind Escape prefix commands also to the Meta modifier
set btp(use-meta) 1
# column at which to line wrap
set btp(fillcol) 0
# prefix for line wrapping (NOT REALLY WORKING YET)
set btp(fillprefix) ""

# PRIVATE SETTINGS

set btp(lastkill) 0.0
set btp(killring) ""
set btp(killptr) 0
set btp(killlen) 0
set btp(arg) def

proc tk_entryForwspace w {
     set x [expr [$w index insert] - 1]
     catch {$w delete $x}
}

# selection_if_any - return selection if it exists, else {}
#   this is from kjx@comp.vuw.ac.nz (R. James Noble)
proc selection_if_any {} {
  if {[catch {selection get} s]} {return ""} {return $s}
}

proc bind_cleanup { w } {
    global btp
    catch {unset btp($w,markring)}
}

proc bt:current-line { w } {
    return [lindex [split [$w index insert] .] 0]
}

proc bt:current-col { w } {
    return [lindex [split [$w index insert] .] 1]
}

proc bt:move-line { w {num 1} } {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$btp(prevcmd) != "move-line"} {
        set btp(goalcol) [lindex [split [$w index insert] .] 1]
    }
    if {$num > -1} {set num "+$num"}
    $w tag remove sel 1.0 end
    set ndx [$w index "insert $num line lineend"]
    set goalndx [lindex [split $ndx .] 0].$btp(goalcol)
    if {$btp(goalcol) < [lindex [split $ndx .] 1]} {
        $w mark set insert $goalndx
    } else {
        $w mark set insert $ndx
    }
    $w yview -pickplace insert
    set btp(prevcmd) move-line
}

proc bt:move-char { w {num 1} } {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$num > -1} {set num "+$num"}
    $w tag remove sel 1.0 end
    $w mark set insert "insert $num char"
    $w yview -pickplace insert
    set btp(prevcmd) "move-char"
}

proc bt:move-word {w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$num > 0} {
        for {set i 0} {$i < $num } {incr i} {
	    while {[regexp $btp(not-word) [$w get insert]]} {
	        $w mark set insert insert+1c
	    } 
	    $w mark set insert {insert wordend}
	}
    } else {
        for {set i 0} {$i > $num } {incr i -1} {
	    $w mark set insert insert-1c
	    while {[regexp $btp(not-word) [$w get insert]]} {
	        $w mark set insert insert-1c
	    } 
	    $w mark set insert {insert wordstart}
	}
    }
    $w yview -pickplace insert
    set btp(prevcmd) "move-word"
}

proc bt:begin-line { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$num != 0} {set num [expr $num-1]}
    bt:move-line $w $num
    $w mark set insert {insert linestart}
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) "begin-line"
}

proc bt:end-line { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$num != 0} {set num [expr $num-1]}
    bt:move-line $w $num
    $w mark set insert {insert lineend}
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) end-line
}

proc bt:begin-buffer { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    bt:set-mark $w
    set ndx [expr 1+[lindex [split [$w index end] .] 0]*$num/10]
    $w mark set insert $ndx.0
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) begin-buffer
}

proc bt:end-buffer { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    bt:set-mark $w
    set ndx [expr [lindex [split [$w index end] .] 0]*$num/10]
    $w mark set insert "end - $ndx lines"
    $w tag remove sel 1.0 end
    $w yview -pickplace insert
    set btp(prevcmd) end-buffer
}

proc bt:scroll-next { w {num 1}} {
    global  btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    $w tag remove sel 1.0 end
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    $w mark set insert [lindex [$scr get] 3].0
    $w yview insert-1l
    set btp(prevcmd) scroll-next
}

proc bt:scroll-prior { w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    $w tag remove sel 1.0 end
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    set tndx [expr [lindex [$scr get] 2]-[lindex [$scr get] 1]+5].0
    if {$tndx < 1.0} {set tndx 1.0}
    $w mark set insert $tndx
    $w yview insert-1l
    set btp(prevcmd) scroll-prior
}

proc bt:delete-word { w {num 1}} {
    global btp
    $w tag remove sel 1.0 end
    if {[$w compare $btp(lastkill) == insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    bt:move-word $w $num
    puts "$num : $beg [$w index insert]"
    if {$beg < [$w index insert]} {
        bt:push-cut "$lastcut[$w get $beg insert]"
        $w delete $beg insert
    } else {
        bt:push-cut "[$w get insert $beg]$lastcut"
        $w delete insert $beg
    }
    set btp(lastkill) [$w index insert]
    $w yview -pickplace insert
    set btp(prevcmd) delete-word
}

proc bt:delete-line { w {num 0}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {[$w compare $btp(lastkill) == insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut ""}
    while {[$w get insert] == " "} {
	$w mark set insert insert+1c
    } 
    if {[$w compare insert == "insert lineend"] && $num == 0} { set num 1 }
    set beg [$w index insert]
    if {$num != 0} {
	bt:move-line $w $num
	bt:begin-line $w
	if {$beg < [$w index insert]} {
	    bt:push-cut "$lastcut[$w get $beg insert]"
	    $w delete $beg insert
	} else {
	    bt:push-cut "[$w get insert $beg]$lastcut"
	    $w delete insert $beg
	}
    } else {
      bt:push-cut "$lastcut[$w get insert {insert lineend}]"
      $w delete insert {insert lineend};
      $w yview -pickplace insert
    }
    $w yview -pickplace insert
    set btp(lastkill) [$w index insert]
    set btp(prevcmd) delete-line
}

proc bt:delete-back-char-or-sel { w {num 1} } {
    global btp
    if {$btp(arg) != "def"} {
        set num $btp(arg)
    } else {set btp(lastkill) 0.0}
    set num [expr -1*$num]
    if {$num > -1} {set num "+$num"}
    if {[$w compare $btp(lastkill) == insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut ""}
    if [catch {set tmp [$w get sel.first sel.last]}] {
        if {$btp(arg) != "def"} {
	    if {$num < 0} {
		bt:push-cut "[$w get "insert $num char" insert]$lastcut"
	        $w delete "insert $num char" insert
	    } else {
		bt:push-cut "$lastcut[$w get insert "insert $num char"]"
	        $w delete insert "insert $num char"
	    }
	    set btp(lastkill) [$w index insert]
        } else {
	    if {$num < 0} {
	        $w delete "insert $num char" insert
	    } else {
	        $w delete insert "insert $num char"
	    }
	    set btp(lastkill) 0.0
        }
    } else {
	$w delete sel.first sel.last
	bt:push-cut $tmp
        set btp(lastkill) 0.0
    }
    set btp(arg) def
    $w yview -pickplace insert
    set btp(prevcmd) delete-back-char-or-sel
}

proc bt:delete-region-or-sel { w } {
    global btp

    if {[catch {set tmp [$w get sel.first sel.last]}]} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!"
	}
        if {[$w compare $btp(lastkill) == insert]} {
	    set lastcut [bt:pop-cut]
        } else { set lastcut ""}
	if {[$w compare emacs < insert]} {
	    bt:push-cut "$lastcut[$w get emacs insert]"
	    $w delete emacs insert
	} else {
	    bt:push-cut "[$w get insert emacs]$lastcut"
	    $w delete insert emacs
	}
        set btp(lastkill) [$w index insert]
    } else {
	$w delete sel.first sel.last
	bt:push-cut $tmp
        set btp(lastkill) 0.0
    }
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

proc bt:copy-region-or-sel { w } {
    global btp

    if {[catch {set tmp [$w get sel.first sel.last]}]} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!"
	}
        if {[$w compare $btp(lastkill) == insert]} {
	    set lastcut [bt:pop-cut]
        } else { set lastcut ""}
	if {[$w compare emacs < insert]} {
	    bt:push-cut "$lastcut[$w get emacs insert]"
	} else {
	    bt:push-cut "[$w get insert emacs]$lastcut"
	}
	bt:exchange-point-and-mark $w
	after 200 bt:exchange-point-and-mark $w
    } else {
	bt:push-cut $tmp
    }
    set btp(arg) def
    set btp(lastkill) 0.0
    set btp(prevcmd) copy-region-or-sel
}

proc bt:append-next-kill { w } {
    global btp
    set btp(lastkill) [$w index insert]
}

proc bt:push-cut { txt } {
    global btp

    set btp(killlen) [llength [lappend btp(killring) $txt]]
    if { $btp(killlen) > $btp(maxkill)} {
	set btp(killring) [lreplace $btp(killring) 0 0]
	incr btp(killlen) -1
    }
    set btp(killptr) 0
}

proc bt:pop-cut { } {
    global btp

    if {$btp(killlen) == 0} {return ""}
    set txt [bt:get-cut 1]
    set ndx [expr $btp(killlen)-1]
    set btp(killring) [lreplace $btp(killring) $ndx $ndx ]
    incr btp(killlen) -1
    set btp(killptr) 0
    return $txt
}

proc bt:get-cut { {ndx 1} } {
    global btp

    set ndx [expr $ndx+$btp(killptr)]
    set btp(killptr) [expr $ndx-1]
    set ndx [expr $ndx%$btp(killlen)]
    if {$ndx == 0} {set ndx $btp(killlen)}
    return [lindex $btp(killring) [expr $btp(killlen)-$ndx]]

}

proc bt:yank { w {num 1}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set btp(lastkill) 0.0
    set tmp [$w index insert]
    $w insert insert [bt:get-cut $num]
    $w mark set emacs $tmp
    $w yview -pickplace insert
    set btp(prevcmd) yank
}

proc bt:yank-pop { w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$btp(prevcmd) != "yank"} return
    $w tag remove sel 1.0 end
    $w delete emacs insert
    set tmp [$w index insert]
    $w insert insert [bt:get-cut [expr $num+1]]
    $w mark set emacs $tmp
    $w yview -pickplace insert
}

proc bt:pop-mark { w } {
    global btp
    set ndx [expr [llength $btp($w,markring)]-1]
    set oldmark [lindex $btp($w,markring) $ndx]
    $w mark set emacs $oldmark
    set btp($w,markring) [concat $oldmark [lreplace $btp($w,markring) $ndx $ndx]]
}

proc bt:push-mark { w ndx } {
    global btp
    lappend btp($w,markring) $ndx
}
 
proc bt:set-mark { w {num def}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$num != "def"} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!"
	}
        $w yview -pickplace insert
        bt:pop-mark $w
        $w mark set insert emacs
    } else {
	bt:push-mark $w [$w index insert]
        $w mark set emacs insert
    }
    set btp(lastkill) 0.0
    set btp(prevcmd) set-mark
}

proc bt:exchange-point-and-mark { w } {
    global btp
    if {[catch "$w index emacs"]} {
	$btp(error) "No emacs mark has been set yet!"
    }
    set tmp [$w index insert]
    $w mark set insert emacs
    $w mark set emacs $tmp
    set btp(lastkill) 0.0
    set btp(prevcmd) set-mark
}

proc bt:open-line {w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    catch {$w delete sel.first sel.last}
    for {set i 0} {$i < $num } {incr i} {
        $w insert insert \n
    }
    $w mark set insert insert-1c
    $w yview -pickplace insert
    set btp(prevcmd) open-line
}

proc bt:argkey { w a } {
    global btp
    set btp(arg) $a
} 

proc bt:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
	catch {%W delete sel.first sel.last}
	$w insert insert $a
	if {$btp(fillcol) && [bt:current-col $w] >= $btp(fillcol)} {
	    bt:wrap-word $w
	}
	$w yview -pickplace insert
	set btp(lastkill) 0.0
	set btp(prevcmd) self-insert
    } else {
	if {$a == "-"} {
	    if {$btp(arg) == "-"} { 
		set btp(arg) "0" 
	    } elseif {$btp(arg) == "0"} {
		set btp(arg) "-"
	    } else {
		set btp(arg) [expr -1*$btp(arg)]
	    }
	} else {
	    append btp(arg) $a
	}
    }
} 

proc bt:univ-arg { w } {
    global btp
    if {$btp(arg) == "def"} {
	set btp(arg) 4
    } else {
	if {$btp(arg) == "-"} { 
	    set btp(arg) "-4" 
	} else {
	    set btp(arg) [expr 4*$btp(arg)]
	}
    }
}

proc bt:wrap-word { w } {
    global btp

    bt:move-word $w -1
    $w insert insert \n
    bt:end-line $w
}

proc bt:set-fill-col { w {num 0}} {
    global btp
    if {$btp(arg) == "def"} {
	if {$num < 1} {
	    set btp(fillcol) [bt:current-col $w]
	} else {
	    set btp(fillcol) $num
	}
    } else {
	if {$btp(arg) < 1} {
	    set btp(fillcol) [bt:current-col $w]
	} else {
	    set btp(fillcol) $btp(arg)
	}
    }
    set btp(arg) def
    set btp(lastkill) 0.0
    set btp(prevcmd) set-fill-col
}

proc bind_motiftext { tw } {
    global bind_xnd

    bind $tw <Control-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }

    # Some better bindings for text and entry
    bind $tw <Up> {bt:move-line %W -1}
    bind $tw <Down> {bt:move-line %W 1}
    bind $tw <Left> {bt:move-char %W -1}
    bind $tw <Right> {bt:move-char %W 1}
    bind $tw <Home> {bt:begin-line %W}
    bind $tw <End> {bt:end-line %W}
    bind $tw <Control-Home> {bt:begin-buffer %W}
    bind $tw <Control-End> {bt:end-buffer %W}
    bind $tw <Control-Left> {bt:move-word %W -1}
    bind $tw <Control-Right> {bt:move-word %W 1}
    bind $tw <Next> {bt:scroll-next %W}
    bind $tw <Prior> {bt:scroll-prior %W}

    bind $tw <Any-KeyPress> {
	global btp
	set num 1
	if {"%A" != ""} {
	    if {$btp(arg) != "def"} {
		set num $btp(arg)
		set btp(arg) def
	    }
	    catch {%W delete sel.first sel.last}
	    for {set i 0} { $i < $num} {incr i} {%W insert insert %A}
	    if {$btp(fillcol) && [bt:current-col %W] >= $btp(fillcol)} {
		if {"%A" == " "} {
		    %W insert insert \n
		} elseif {"%A" == "\t"} {
		    %W insert insert \n\t
		} else {
		    bt:wrap-word %W
		}
	    }
	    %W yview -pickplace insert
	    set btp(lastkill) 0.0
	    set btp(prevcmd) self-insert
	}
    }

    bind $tw <KeyPress-Return> {
	global btp
        catch {%W delete sel.first sel.last}
	set num 1
	if {$btp(arg) != "def"} {
	    set num $btp(arg)
	    set btp(arg) def
	}
        for {set i 0} { $i < $num} {incr i} {%W insert insert "\n"}
        %W yview -pickplace insert
	set btp(lastkill) 0.0
	set btp(prevcmd) newline
    }

    bind $tw <KeyPress-Delete> {bt:delete-back-char-or-sel %W 1}
    bind $tw <KeyPress-BackSpace> {bt:delete-back-char-or-sel %W 1}

    bind $tw <1> "[bind Text <1>]; \
                  global btp; set btp(lastkill) 0.0; \
		  set btp(prevcmd) mouse-set"
    bind $tw <3> {%W tag remove sel 1.0 end}
    bind $tw <B1-Motion> {bind_textB1motion %W @%x,%y}

    set bind_xnd(b2-time) 0
    set bind_xnd(b2-y) 0
    bind $tw <2> {
        global bind_xnd
        %W scan mark %y
        set bind_xnd(b2-time) %t
        set bind_xnd(b2-y) %y
    }
    bind $tw <ButtonRelease-2> {
        global bind_xnd
	if {[expr %t-$bind_xnd(b2-time)]<1000} {
	    %W insert insert [selection_if_any]
 	    global btp
	    set btp(lastkill) 0.0
	    set btp(prevcmd) mouse-insert
        }
    }

    # only one mouse, so no need have separate vars for each widget
    set bind_xnd(txnd) 0
    set bind_xnd(xdelay) 100
    proc bind_textB1motion  { w loc } {
	global bind_xnd

	set ypos [lindex [split $loc ","] 1]
	if {$ypos > [winfo height $w]} {
		if {!$bind_xnd(txnd)} {after $bind_xnd(xdelay) bind_textExtend $w}
		set bind_xnd(txnd) 1
		set bind_xnd(direction) down
	} elseif {$ypos < 0} {
		if {!$bind_xnd(txnd)} {after $bind_xnd(xdelay) bind_textExtend $w}
		set bind_xnd(txnd) 1
		set bind_xnd(direction) up
	} else {
		set bind_xnd(txnd) 0
		set bind_xnd(direction) 0
	}

	if {!$bind_xnd(txnd)} {
		tk_textSelectTo $w $loc
	}

    }

    bind $tw <ButtonRelease-1> { 
        global bind_xnd btp
        set bind_xnd(txnd) 0
	set btp(lastkill) 0.0
	set btp(prevcmd) mouse-select
    }

    proc bind_textExtend { w } {
	 global bind_xnd

	 if {$bind_xnd(txnd)} {
	     if {$bind_xnd(direction) == "down"} {
		 tk_textSelectTo $w sel.last+1l
		 $w yview -pickplace sel.last+1l
	     } elseif {$bind_xnd(direction) == "up"} {
		 tk_textSelectTo $w sel.first-1l
		 $w yview -pickplace sel.first-1l
	     } else { return }
	     after $bind_xnd(xdelay) bind_textExtend $w
	 }
    }

}

proc bind_emacstext { tw } {
    global btp

    # make Escape key simulate a state Alt key
    bind $tw <Escape> { }
    bind $tw <Escape><Any-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }

    bind $tw <Control-a> {bt:begin-line %W}
    bind $tw <Control-e> {bt:end-line %W}
    bind $tw <Control-f> {bt:move-char %W 1}
    bind $tw <Control-b> {bt:move-char %W -1}
    bind $tw <Escape><f> {bt:move-word %W 1}
    bind $tw <Escape><b> {bt:move-word %W -1}

    bind $tw <Control-n> {bt:move-line %W 1}
    bind $tw <Control-p> {bt:move-line %W -1}
    bind $tw <Control-l> {
	%W yview -pickplace insert
    }
    bind $tw <Control-o> {bt:open-line %W 1}
    bind $tw <Control-d> {bt:delete-back-char-or-sel %W -1}
    bind $tw <Escape><d> {bt:delete-word %W 1}

    bind $tw <Control-h> {bt:delete-back-char-or-sel %W -1}

    bind $tw <Control-k> {bt:delete-line %W 0}
    bind $tw <Control-w> {bt:delete-region-or-sel %W}
    bind $tw <Escape><w> {bt:copy-region-or-sel %W}
    bind $tw <Control-y> {bt:yank %W}
    bind $tw <Escape><y> {bt:yank-pop %W}
    bind $tw <Control-space> {bt:set-mark %W}

    bind $tw <Control-u> {bt:univ-arg %W}
    bind $tw <KeyPress-0> {bt:numkey %W %A}
    bind $tw <KeyPress-1> {bt:numkey %W %A}
    bind $tw <KeyPress-2> {bt:numkey %W %A}
    bind $tw <KeyPress-3> {bt:numkey %W %A}
    bind $tw <KeyPress-4> {bt:numkey %W %A}
    bind $tw <KeyPress-5> {bt:numkey %W %A}
    bind $tw <KeyPress-6> {bt:numkey %W %A}
    bind $tw <KeyPress-7> {bt:numkey %W %A}
    bind $tw <KeyPress-8> {bt:numkey %W %A}
    bind $tw <KeyPress-9> {bt:numkey %W %A}

    bind $tw <Escape><KeyPress-0> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-1> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-2> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-3> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-4> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-5> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-6> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-7> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-8> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-9> {bt:argkey %W %A}
    bind $tw <Escape><KeyPress-minus> {bt:argkey %W %A}

    # make C-x key a state
    bind $tw <Control-x> { }
    bind $tw <Control-x><Any-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }
    bind $tw <Control-x><Control-x> {bt:exchange-point-and-mark %W}
    bind $tw <Control-x><KeyPress-f> {bt:set-fill-col %W}

    # Make Meta key like and Escape prefix
    if {$btp(use-meta)} {
	bind $tw <Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}
	bind $tw <Control-Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}

	bind $tw <Meta-f> {bt:move-word %W 1}
	bind $tw <Meta-b> {bt:move-word %W -1}
	bind $tw <Meta-d> {bt:delete-word %W 1}
	bind $tw <Meta-w> {bt:copy-region-or-sel %W}
	bind $tw <Meta-y> {bt:yank-pop %W}

	bind $tw <Meta-0> {bt:argkey %W %A}
	bind $tw <Meta-1> {bt:argkey %W %A}
	bind $tw <Meta-2> {bt:argkey %W %A}
	bind $tw <Meta-3> {bt:argkey %W %A}
	bind $tw <Meta-4> {bt:argkey %W %A}
	bind $tw <Meta-5> {bt:argkey %W %A}
	bind $tw <Meta-6> {bt:argkey %W %A}
	bind $tw <Meta-7> {bt:argkey %W %A}
	bind $tw <Meta-8> {bt:argkey %W %A}
	bind $tw <Meta-9> {bt:argkey %W %A}
	bind $tw <Meta-minus> {bt:argkey %W %A}
    }
}

##############
# ENTRY WIDGET
##############

proc be:move-char {w {num 1} } {
    global btp
    set btp(lastkill-entry) -1
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    $w select clear
    $w icursor [expr {[$w index insert] + $num}]
    tk_entrySeeCaret $w
    set btp(prevcmd) move-char
}

proc be:move-word {w {num 1}} {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$num > 0} {
        for {set i 0} {$i < $num } {incr i} {
	    set endx [expr [$w index insert]+1]
	    set estr [$w get]
	    while {$endx < [string length $estr] &&
	      [regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx
	    }
	    while {$endx < [string length $estr] &&
	      ![regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx
	    } 
	    $w icursor $endx
	}
    } else {
        for {set i 0} {$i > $num } {incr i -1} {
	    set endx [expr [$w index insert]-2]
	    set estr [$w get]
	    while {$endx > 0 &&
	       [regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx -1
	    }
	    while {$endx > 0 &&
	       ![regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx -1
	    }
	    if {$endx > 1} {incr endx}
	    $w icursor $endx
	}
    }
    tk_entrySeeCaret $w
    set btp(prevcmd) "move-word"
}

proc be:begin-line { w } {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    $w icursor 0
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) begin-line
}

proc be:end-line { w } {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    $w icursor end
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) end-line
}

proc be:delete-back-char-or-sel { w {num 1} } {
    global btp
    set btp(lastkill-entry) -1
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {[catch {$w delete sel.first sel.last}] != 0} {
        set x [expr [$w index insert] - $num]
        catch {$w delete $x}
	tk_entrySeeCaret $w
    }
    set btp(prevcmd) delete-back-char-or-sel
}

proc be:delete-word { w {num 1}} {
    global btp
    $w select clear
    if {$btp(lastkill-entry) == [$w index insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    be:move-word $w $num
    set endx [$w index insert]
    if {$beg < $endx} {
	incr endx -1
	bt:push-cut "$lastcut[string range [$w get] $beg $endx]"
	$w delete $beg $endx
    } else {
	incr beg -1
	bt:push-cut "[string range [$w get] $endx $beg]$lastcut"
	$w delete $endx $beg
    }
    set btp(lastkill-entry) [$w index insert]
    tk_entrySeeCaret $w
    set btp(prevcmd) delete-word
}

proc be:delete-line { w } {
    global btp
    if {$btp(lastkill-entry) == [$w index insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    $w select clear
    bt:push-cut "$lastcut[string range [$w get] [$w index insert] end]"
    $w delete [$w index insert] end
    set btp(lastkill-entry) [$w index insert]
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) delete-line
}

proc be:delete-region-or-sel { w } {
    global btp
    if {[catch "$w index sel.first"]} {
	$btp(error) "Sorry! No emacs mark for entries yet!"
    } else {
	bt:push-cut [selection_if_any]
	$w delete sel.first sel.last
    }
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

proc be:copy-region-or-sel { w } {
    global btp
    if {[catch "$w index sel.first"]} {
	$btp(error) "Sorry! No emacs mark for entries yet!"
    } else {
	bt:push-cut [selection_if_any]
	$w select clear
    }
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(arg) def
    set btp(prevcmd) copy-region-or-sel
}

proc be:append-next-kill { w } {
    global btp
    set btp(lastkill-entry) [$w index insert]
}

proc be:yank { w {num 1}} {
    global btp
    $w select clear
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set btp(lastkill-entry) -1
    set btp(entry-yank-mark) [$w index insert]
    $w insert insert [bt:get-cut $num]
    tk_entrySeeCaret $w
    set btp(prevcmd) yank
}

proc be:yank-pop { w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$btp(prevcmd) != "yank"} return
    $w select clear
    $w delete $btp(entry-yank-mark) [expr [$w index insert]-1]
    $w insert insert [bt:get-cut [expr $num+1]]
    tk_entrySeeCaret $w
}

proc be:set-mark { w } {
    global btp
    $btp(error) "Sorry! No emacs mark for entries yet!"
}


proc be:exchange-point-and-mark { w } {
    global btp
    $btp(error) "Sorry! No emacs mark for entries yet!"
}

proc be:argkey { w a } {
    global btp
    set btp(arg) $a
} 

proc be:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
	catch {%W delete sel.first sel.last}
	$w insert insert $a
	tk_entrySeeCaret $w
	set btp(lastkill-entry) -1
	set btp(prevcmd) self-insert
    } else {
	if {$a == "-"} {
	    if {$btp(arg) == "-"} { 
		set btp(arg) "0" 
	    } elseif {$btp(arg) == "0"} {
		set btp(arg) "-"
	    } else {
		set btp(arg) [expr -1*$btp(arg)]
	    }
	} else {
	    append btp(arg) $a
	}
    }
} 

proc be:univ-arg { w } {
    global btp
    if {$btp(arg) == "def"} {
	set btp(arg) 4
    } else {
	if {$btp(arg) == "-"} { 
	    set btp(arg) "-4" 
	} else {
	    set btp(arg) [expr 4*$btp(arg)]
	}
    }
}

proc bind_motifentry { ew } {
    global bind_xnd

    bind $ew <Control-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }

    bind $ew <Delete> {be:delete-back-char-or-sel %W 1}
    bind $ew <BackSpace> {be:delete-back-char-or-sel %W 1}
    bind $ew <Left> {be:move-char %W -1}
    bind $ew <Right> {be:move-char %W 1}
    bind $ew <Control-Left> {be:move-word %W -1}
    bind $ew <Control-Right> {be:move-word %W 1}
    bind $ew <Home> {be:begin-line %W}
    bind $ew <End> {be:end-line %W}

    bind $ew <Any-KeyPress> {
        global btp
	if {"%A" != ""} {
	    catch {%W delete sel.first sel.last}
	    %W insert insert %A
	    tk_entrySeeCaret %W
	    set btp(lastkill-entry) -1
	    set btp(prevcmd) self-insert
	}
    }

    bind $ew <1> "[bind Entry <1>]; \
                  global btp; set btp(lastkill-entry) -1; \
		  set btp(prevcmd) mouse-set"
    bind $ew <Double-Button-1> {%W select from 0; %W select to end}
    bind $ew <3> {%W select clear}
    bind $ew <Shift-2> {%W scan mark %x}
    bind $ew <Shift-B2-Motion> {%W scan dragto %x}

    set bind_xnd(b2-time) 0
    bind $ew <2> {
        global bind_xnd
        %W scan mark %x
        set bind_xnd(b2-time) %t
    }
    bind $ew <ButtonRelease-2> {
        global bind_xnd btp
	if {[expr %t-$bind_xnd(b2-time)]<1000} {
	    set btp(lastkill-entry) -1
	    %W insert insert [selection_if_any]
 	    set btp(prevcmd) mouse-insert
        }
    }

}

proc bind_emacsentry { ew } {
    global btp

    # make Escape key simulate Alt key
    bind $ew <Escape> { }
    bind $ew <Escape><Any-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }

    bind $ew <KeyPress-0> {be:numkey %W %A}
    bind $ew <KeyPress-1> {be:numkey %W %A}
    bind $ew <KeyPress-2> {be:numkey %W %A}
    bind $ew <KeyPress-3> {be:numkey %W %A}
    bind $ew <KeyPress-4> {be:numkey %W %A}
    bind $ew <KeyPress-5> {be:numkey %W %A}
    bind $ew <KeyPress-6> {be:numkey %W %A}
    bind $ew <KeyPress-7> {be:numkey %W %A}
    bind $ew <KeyPress-8> {be:numkey %W %A}
    bind $ew <KeyPress-9> {be:numkey %W %A}

    bind $ew <Control-u> {be:univ-arg %W}
    bind $ew <Escape><KeyPress-0> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-1> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-2> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-3> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-4> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-5> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-6> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-7> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-8> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-9> {be:argkey %W %A}
    bind $ew <Escape><KeyPress-minus> {be:argkey %W %A}

    bind $ew <Control-a> {be:begin-line %W}
    bind $ew <Control-e> {be:end-line %W}
    bind $ew <Control-b> {be:move-char %W -1}
    bind $ew <Control-f> {be:move-char %W 1}
    bind $ew <Escape><b> {be:move-word %W -1}
    bind $ew <Escape><f> {be:move-word %W 1}

    bind $ew <Control-l> {
	tk_entrySeeCaret %W
    }

    bind $ew <Control-d> {be:delete-back-char-or-sel %W 0}
    bind $ew <Escape><KeyPress-d> {be:delete-word %W 1}
    bind $ew <Control-k> {be:delete-line %W}
    bind $ew <Control-w> {be:delete-region-or-sel %W}
    bind $ew <Escape><KeyPress-w> {be:copy-region-or-sel %W}
    bind $ew <Control-y> {be:yank %W}
    bind $ew <Escape><KeyPress-y> {be:yank-pop %W}
    bind $ew <Control-space> {be:set-mark %W}

    bind $ew <Control-h> {be:delete-back-char-or-sel %W 1}

    # make C-x key a state
    bind $ew <Control-x> { }
    bind $ew <Control-x><Any-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }
    bind $ew <Control-x><Control-x> {be:exchange-point-and-mark %W}

    # Make Meta key like and Escape prefix
    if {$btp(use-meta)} {
	bind $ew <Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}
	bind $ew <Control-Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}
        bind $ew <Meta-b> {be:move-word %W -1}
        bind $ew <Meta-f> {be:move-word %W 1}
        bind $ew <Meta-d> {be:delete-word %W 1}
	bind $ew <Meta-w> {be:copy-region-or-sel %W}
	bind $ew <Meta-y> {be:yank-pop %W}

	bind $ew <Meta-0> {be:argkey %W %A}
	bind $ew <Meta-1> {be:argkey %W %A}
	bind $ew <Meta-2> {be:argkey %W %A}
	bind $ew <Meta-3> {be:argkey %W %A}
	bind $ew <Meta-4> {be:argkey %W %A}
	bind $ew <Meta-5> {be:argkey %W %A}
	bind $ew <Meta-6> {be:argkey %W %A}
	bind $ew <Meta-7> {be:argkey %W %A}
	bind $ew <Meta-8> {be:argkey %W %A}
	bind $ew <Meta-9> {be:argkey %W %A}
	bind $ew <Meta-minus> {be:argkey %W %A}
    }
}

############################################################################
############################################################################
############################################################################
## FILE SELECTION DIALOG BOX PROCS

########################
#
# 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 transient $win .
  set xpos [expr [winfo rootx .]+[winfo width .]/6]
  set ypos [expr [winfo rooty .]+[winfo height .]/6]

  wm geom $win 300x500+${xpos}+$ypos
  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 file selection box stuff
###########################################################################

############################################################################
## MAIN PROGRAM LOGIC ##


########################
#
# mmonInit
#
#   Initialize globals and other initial state stuff.
#   'style' may be either 'emacs' or 'motif' or empty.
#   It sets the Entry and Text class bindings to one of these styles,
#   where the empty style is the default Tk bindings.
#

proc mmon_Init {{style {}}} {
  # GLOBAL VARIABLE DESCRIPTIONS.

  # Database handle.
  global msql

  # Monitor state (except the command ring).
  global mmon
  # The following entries are used:
  # mmon(actPrefix)	-- action prefix.
  # mmon(cmtPrefix)	-- comment prefix.
  # mmon(colMaxLen)	-- (integer) max column length in result text;
  #				zero means no limit.
  # mmon(dbname)	-- database name; or empty if no current database.
  # mmon(execCmd)	-- proc to be invoked by "Execute" menu option.
  # mmon(dlgFont)	-- main font for dialog boxes made by 'mkDialog'.
  # mmon(helpEmph)	-- emphasized help text font.
  # mmon(helpHead)	-- heading help text font.
  # mmon(helpPlain)	-- plain help text font.
  # mmon(interrupt)	-- (boolean) interrupt flag.
  # mmon(largeNFont)	-- large, normal font.
  # mmon(largeSFont)	-- large, slanted font.
  # mmon(lboxFont)	-- font used in listboxes.
  # mmon(messFont)	-- font used for the message window.
  # mmon(printCmd)	-- print command: must be a command that prints its
  #				standard input.
  # mmon(resClear)	-- (boolean) clear result text each query if true;
  #				append otherwise.
  # mmon(resFontForm)	-- result text font format (a font spec containing '%s'
  #			   for the size).
  # mmon(resFontSize)	-- result text font size.
  # mmon(resMaxLines)	-- (integer) max result lines before promting user;
  #				zero means no limit.
  # mmon(server)	-- server name; or empty when unconnected.
  # mmon(sqlFile)	-- SQL file name; or empty string.
  # mmon(sqlTerm)	-- SQL statement terminator (reg. expr).
  # mmon(version)	-- Mini-Monitor version.
  # mmon(white)		-- our definition of white space (reg. expr).

  # State variables which need to be global because they are used in the
  # user interface.
  global mmui

  # Command ring.
  global cmdRing

  # SET INITIAL VALUES.
  set msql {}

  set mmon(actPrefix)	{#>}
  set mmon(cmtPrefix)	{#}
  set mmon(colMaxLen)	0
  set mmon(dbname)	{}
  set mmon(dlgFont)	{-*-times-medium-r-*--*-180-*-*-*-*-iso8859-1}
  set mmon(execCmd)	submitSql
  set mmon(helpEmph)	{-*-times-bold-r-*--16-*-*-*-*-*-iso8859-1}
  set mmon(helpHead)	{-*-times-bold-r-*--20-*-*-*-*-*-iso8859-1}
  set mmon(helpPlain)	{-*-times-medium-r-*--16-*-*-*-*-*-iso8859-1}
  set mmon(largeNFont)	{-*-helvetica-bold-r-*-*-20-*-*-*-*-*-iso8859-1}
  set mmon(largeSFont)	{-*-helvetica-bold-o-*-*-20-*-*-*-*-*-iso8859-1}
  set mmon(lboxFont)	{-*-courier-*-r-*-*-14-*-*-*-*-*-iso8859-1}
  set mmon(messFont)	{-*-helvetica-bold-r-*-*-17-*-*-*-*-*-iso8859-1}
  set mmon(printCmd)	a2ps
  set mmon(resClear)	1
  set mmon(resFontForm)	{-*-courier-*-r-*-*-%s-*-*-*-*-*-iso8859-1}
  set mmon(resFontSize)	14
  set mmon(resMaxLines)	0
  set mmon(server)	{}
  set mmon(sqlFile)	{}
  set mmon(sqlTerm)	{;$}
  set mmon(version)	{$Revision: 1.50 $}
  set mmon(white)	{[ 	]*}

  set mmui(dummy) {}

  # Initialize command ring.

  set cmdRing(IDX)  0
  set cmdRing(LAST) 0
  for {set i 0} {$i < 10} {incr i} {
    set cmdRing($i) ""
  }

  # Entry and Text class bindings.

  if {$style == "emacs"} {
    bind_emacsentry Entry
    bind_emacstext  Text
  } elseif {$style == "motif"} {
    bind_motifentry Entry
    bind_motiftext  Text
  }
}


########################
#
# mmon_KickOff
#
#   Starts the application; ASSUMES initializations have been done.
#

proc mmon_KickOff {} {
  global env

  createMain
  # Creating the main window is slow; wait a little to prevent it from
  # appearing over the server connect window.
  tkwait visibility .
  set auto [lsearch [array names env] MMON_CONNECT]

  if {$auto >= 0} {
    if {[llength [set auto [split $env(MMON_CONNECT) :]]] == 2} {
      set host [lindex $auto 0]
      set dbname [lindex $auto 1]
      if {[tryConnect $host]} {
        set success 0
      } elseif {[useDB $dbname]} {
        set success 0
      } else {
        set success 1
      }
    } else {
      set success 0
    }
  } else {
    set success 0
  }

  if {!$success} setServer
}


########################
#
# setServer
#
#   Connect to an mSQL server
#

proc setServer {} {
  global env
  global msql
  global mmon

  # get valid servers
  set msql_home [lsearch [array names env] MSQL_HOSTS]

  if {$msql_home < 0} {
      set serverList {}
  } else {
      set serverList [split $env(MSQL_HOSTS) :]
  }
  
  catch {destroy .conn}
  toplevel .conn	
  wm title    .conn "Connection"
  wm iconname .conn "Connection"
  #-- Title message
  message .conn.m -justify center  -text "mSQL Server Connection" \
	-aspect 2000 -font $mmon(largeSFont)
  #-- Current state
  frame .conn.c
  frame .conn.c.fl
  label .conn.c.l -text "Current state:"
  label .conn.c.st
  frame .conn.c.fr
  if {[msqlstate -numeric $msql] > 1} {
    .conn.c.st configure -text "Connected to [msqlinfo $msql host]"
  } else {
    .conn.c.st configure -text "Not connected"
  }
  #-- Server entry
  frame .conn.s
  frame .conn.s.fl
  entry .conn.s.ser -relief sunken -width 10 
  if {$serverList != {}} {
    menubutton .conn.s.s -text "Server" -anchor e -menu .conn.s.s.m \
	-relief raised
    menu .conn.s.s.m
    foreach s $serverList {
      .conn.s.s.m add command -label $s \
        -command ".conn.s.ser delete 0 end; .conn.s.ser insert 0 $s "
    }
  } else {
    label .conn.s.s -text "Server" -anchor e
  }
  frame .conn.s.fr
  #-- Error message
  message .conn.err -text "(omitted server name means local host)" \
	-justify center -aspect 2000
  #-- Connect and Cancel buttons
  frame .conn.b
  button .conn.b.ok  -text "Connect" \
      -command {cbConnect [.conn.s.ser get]}
  button .conn.b.can -text "Cancel" -command "destroy .conn"
  #-- Pack and bind
  pack .conn.m .conn.c .conn.s .conn.err -side top -fill x -pady 5
  pack .conn.c.fl -side left -expand yes
  pack .conn.c.l .conn.c.st -side left
  pack .conn.c.fr -side right -expand yes
  pack .conn.s.fl -side left -expand yes
  pack .conn.s.s .conn.s.ser -side left
  pack .conn.s.fr -side right -expand yes
  pack .conn.b -side top -fill x
  pack .conn.b.ok .conn.b.can -side left -fill x -expand yes

  bind .conn.s.ser <KeyPress-Return> ".conn.b.ok invoke"
}


########################
#
# setDatabase
#
#   Select a database on the current server
#

proc setDatabase {} {
  global msql
  global mmon

  if {[checkConnect 2]} {
    return
  } elseif {[catch {msqlinfo $msql databases} dblist]} {
    setMsg $dblist
  } else {
    pickList .setdb Databases 20x7 $dblist cbUseDb
  }
}


########################
#
# cbConnect
#
#   Connect callback from toplevel .conn
#

proc cbConnect {ser} {
  global msqlstatus

  if {[tryConnect $ser quiet]} {
    .conn.err configure -text $msqlstatus(message)
  } else {
    destroy .conn
  }
}


########################
#
# cbUseDb
#
#   Callback for setting database from toplevel .setdb
#

proc cbUseDb {dbname} {
  global msqlstatus

  if {[useDB $dbname]} {
    setMsg
  }
  destroy .setdb
}


########################
#
# tryConnect
#
#   Try a connection to the mSQL server.
#   'ser' must be a server name.
#   'quiet' must be non-null to prevent the main status area to be set
#   in case of conflict.
#   RETURNS 0 on success, 1 on conflict.
#   SIDE EFFECT: Close the previous connection, if any.
#

proc tryConnect {ser {quiet {}}} {
  global msql
  global msqlstatus
  global mmon

  set message {}

  # Save current connection.
  set old_msql $msql

  # Attempt connection.
  set retcode [catch {set msql [msqlconnect $ser]}]

  if $retcode==0 {
    if {[msqlstate -numeric $old_msql] > 1} {
      msqlclose $old_msql
    }
    set mmon(server) [msqlinfo $msql host]
    if {[string length $quiet] == 0} {
      set message "New connection to: $mmon(server)"
    }
    set res 0
  } else {
    if {[string length $quiet] == 0} {
      set message $msqlstatus(message)
    }
    set msql $old_msql
    set res 1
  }
  setMsg $message
  return $res
}


########################
#
# checkConnect
#
#   Checks the current connection state
#   RETURNS 1 if the connection is NOT ok; 0 otherwise.
#

proc checkConnect {min_state} {
  global msql

  if {[msqlstate -numeric $msql] < $min_state} {
    setMsg "Connection state [msqlstate $msql] insufficient"
    return 1
  } else {
    return 0
  }
}


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

proc createMain {} {
  global msql
  global msqlstatus
  global mmon

  wm title    . "Mini-Monitor for mSQL"
  wm iconname . "mmon"
  wm geom    . 600x500
  wm minsize . 400 370

  #-- 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 "SQL" -menu .m.mb.file.m -underline 0
  menu .m.mb.file.m
  .m.mb.file.m add command -label "Clear" -command doNew -underline 0
  .m.mb.file.m add command -label "Hilite Off" \
	-command {.m.s.sql tag delete statement} -underline 0
  .m.mb.file.m add command -label "Open..." \
		   -command "fileBox .Open * \"\" \"\" tryOpen" -underline 0
  .m.mb.file.m add command -label "Save" -command doSave  -underline 0
  .m.mb.file.m add command -label "Save as..." \
		   -command "fileBox .Save * \"\" \"\" doSaveAs" -underline 5
  .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 mmon(resClear) \
   -value 0  -command "set mmon(resClear) 0"
  .m.mb.out.m add radiobutton -label "Clear results" -variable mmon(resClear) \
   -value 1  -command "set mmon(resClear) 1"
  .m.mb.out.m add separator

  .m.mb.out.m add command -label "Clear" -command clearoutput -underline 0
  .m.mb.out.m add command -label "Save as..." \
	  -command "fileBox .Save_Results * \"\" \"\" doSaveOut" -underline 0
  .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 -value  8 -label " 8" \
    -variable mmon(resFontSize) -command {setResultFont 8}
  .m.mb.out.m.f add radiobutton -value 10 -label "10" \
    -variable mmon(resFontSize) -command {setResultFont 10}
  .m.mb.out.m.f add radiobutton -value 12 -label "12" \
    -variable mmon(resFontSize) -command {setResultFont 12}
  .m.mb.out.m.f add radiobutton -value 14 -label "14" \
    -variable mmon(resFontSize) -command {setResultFont 14}
  .m.mb.out.m.f add radiobutton -value 18 -label "18" \
    -variable mmon(resFontSize) -command {setResultFont 18}
  .m.mb.out.m.f add radiobutton -value 20 -label "20" \
    -variable mmon(resFontSize) -command {setResultFont 20}

  .m.mb.out.m add command -label "Limit result ..."  -command setResultLimit \
                         -underline 0
  .m.mb.out.m add command -label "Null value ..."  -command setNullvalue \
                         -underline 0

  menubutton .m.mb.cn -text "Connection" -menu .m.mb.cn.m -underline 0
  menu .m.mb.cn.m
  .m.mb.cn.m add command -label "Database" -command setDatabase
  .m.mb.cn.m add command -label "Server" -command setServer

  button .m.mb.ob -text "Tables" -command showTables -relief raised

  # mmon(execCmd) is normally "submitSql", except while in submitSql,
  # then it is Cancel.
  button .m.mb.exec  -text "Execute" -command {eval $mmon(execCmd)} \
	-relief raised
  button .m.mb.hloff -text "Hilite Off" \
	-command {.m.s.sql tag delete statement} -relief raised

  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/Buttons" -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 "SQL" -command menuHelpSQL -underline 0
  .m.mb.help.m.m add command -label "Results" -command menuHelpRes -underline 0
  .m.mb.help.m.m add command -label "Connection" -command menuHelpConn \
	-underline 0
  .m.mb.help.m.m add command -label "Tables" -command menuHelpTables \
	-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.cn .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.cn \
		    .m.mb.ob .m.mb.exec .m.mb.help 

  #-- Server and database names

  frame .m.tt
  label .m.tt.sl -text "Server:" -relief flat -font $mmon(largeSFont)
  entry .m.tt.se -state disabled -relief raised -font $mmon(largeNFont) \
	-textvariable mmon(server)
  label .m.tt.dl -text "  Database:" -relief flat -font $mmon(largeSFont)
  entry .m.tt.de -state disabled -relief raised -font $mmon(largeNFont) \
	-textvariable mmon(dbname)

  pack .m.tt -side top -fill x
  pack .m.tt.sl .m.tt.se -side left -padx 1
  pack .m.tt.de .m.tt.dl -side right -padx 1

  # 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 input (noname)" 
  scrollbar .m.s.vert -relief sunken -command ".m.s.sql yview" \
	  -orient vertical
  text .m.s.sql -font [format $mmon(resFontForm) 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"
  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"
  bind .m.s.sql <Control-Delete> ".m.s.sql tag delete statement"

  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 \
	  -yscroll ".m.o.vert set" -xscroll ".m.o.horz set"
  setResultFont 14

  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 $mmon(messFont)
    
  pack .m.msg -side bottom -fill x

  focus .m.s.sql

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

}


########################
#
# sqlInsert
#
#   Insert text into the SQL text window.
#   'text' must be the text to process; only the first word is inserted.
#

proc sqlInsert {text} {
	if {[string length $text] > 0} {
		.m.s.sql insert insert [lindex $text 0]
	}
}


########################
#
# useDB
#
#   Use a database.
#   RETURNS 0 on success, 1 on conflict.
#

proc useDB {dbname} {
  global msql
  global mmon

  if {[catch {msqluse $msql $dbname}]} {
    setMsg "Could not use database ($dbname)"
    set res 1
  } else {
    set mmon(dbname) [msqlinfo $msql dbname]
    setMsg "Database changed to: $mmon(dbname)"
    set res 0
  }
  return $res
}


########################
#
# setMsg
#
#   Set the text for the label at bottom of results window.
#   Gets the message from msqlstatus if no args.
#

proc setMsg {{txt {}}}  {
  global msqlstatus

  if {[string length $txt] == 0} {
    if {$msqlstatus(code) > 0} {
      set txt [format "Error %s: %s" $msqlstatus(code) $msqlstatus(message)]
    } else {
      set txt $msqlstatus(message)
    }
  }

  .m.msg configure -text $txt
  update
}


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

proc confirmExit {} {

  mkDialog .Confirm_Exit {-text "Really Exit?"} \
	     "{Sure}  {destroy . ; exit}" "{No, don't exit} {}"
}


########################
#
# clearsql
#
#   clear the sql code window
#

proc clearsql {} {
  global mmon
  global cmdRing

  set cmdRing(IDX) $cmdRing(LAST)

  .m.s.sql delete 1.0 end
  .m.s.l   configure -text "SQL (noname)"
  set mmon(sqlFile) ""
  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 mmon
  global cmdRing
  set cmdRing(IDX) $cmdRing(LAST)

  if [file isfile $filename] {
    clearsql
    clearoutput
    set mmon(sqlFile) [file tail $filename]
    .m.s.l   configure -text "SQL ($mmon(sqlFile))"
    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 mmon
  global cmdRing
  set cmdRing(IDX) $cmdRing(LAST)

  set openrc [catch {set f [open $filename w]}]
  
  if $openrc==1 {
    setMsg "Error: $filename could not be opened, not saved"
    return
  }

  set mmon(sqlFile) $filename
  .m.s.l   configure -text "SQL ($mmon(sqlFile))"

  puts $f [.m.s.sql get 1.0 end]
  close $f
  setMsg "SQL saved to $mmon(sqlFile)"

  destroy $win
}



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

proc doSaveOut {win filename} {
  global cmdRing
  set cmdRing(IDX) $cmdRing(LAST)

  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 {} {
  global mmon
  
  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"
  }
  
  # Print: have standard out and standard error both appear in the
  # message area.
  setMsg [exec $mmon(printCmd) << $out_lines |& cat]
}


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

proc doSave {} {
  global mmon
  global cmdRing
  set cmdRing(IDX) $cmdRing(LAST)

  if {[string length $mmon(sqlFile)] == 0} {
    fileBox .Save * "" "" doSaveAs
  } else {
    set f [open $mmon(sqlFile) w]
    puts $f [.m.s.sql get 1.0 end]
    close $f
    setMsg "Saved to $mmon(sqlFile)"
  }
}


########################
#
# doNew
#
#   clear windows
#
proc doNew {} {
  global mmon
  global cmdRing
  set cmdRing(IDX) $cmdRing(LAST)

  clearoutput
  clearsql

  setMsg {}
  focus .m.s.sql

  set mmon(sqlFile) {}
}


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

proc insSql {} {
  global cmdRing

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

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

  set cmdRing($cmdRing(LAST)) $currentSql

  set cmdRing(IDX) $cmdRing(LAST)

  incr cmdRing(LAST)
  if {$cmdRing(LAST) > 9} {
    set cmdRing(LAST) 0
  }

}


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

proc prevSql {dir} {
  global cmdRing

  set i 0
  set result_lines ""

  while {$i < 10 && [string length $result_lines] == 0} {
    incr cmdRing(IDX) $dir

    if {$cmdRing(IDX) < 0} {
      set cmdRing(IDX) 9
    }
    if {$cmdRing(IDX) > 9} {
      set cmdRing(IDX) 0
    }
    set result_lines $cmdRing($cmdRing(IDX))
    incr i
  }

  if {[string length $result_lines] > 0} {
    .m.s.sql delete 1.0 end
    .m.s.sql insert 1.0 "$result_lines"
  }

}


########################
#
# interruptEnable
#
#   Sets (resets) the SQL execution mode to 'Execute' ('Cancel').
#

proc interruptEnable {flag} {
  global mmon

  if {$flag} {
    set mmon(interrupt) 0
    set mmon(execCmd) "set mmon(interrupt) 1"
    .m.mb.exec configure -text "Cancel"
  } else {
    set mmon(execCmd) submitSql
    .m.mb.exec configure -text "Execute"
  }
}


########################
#
# submitSql
#
#   Submit SQL script for execution.
#

proc submitSql {} {
  global mmon

  interruptEnable 1
  .m.s.sql tag delete statement
  if $mmon(resClear) clearoutput
  insSql
  set conflict 0

  # mSQL only accepts one SQL statement at a time. We must parse the script.

  # Find the number of lines in the SQL script.
  scan [.m.s.sql index end] %d lineCount
  .m.s.sql mark unset first last

  # Parse the SQL script for "statements" in a line-oriented way.
  # For each turn the marks 'first', 'last' identify the statement text.
  # It is also tagged by a tag named 'statement'.
  set idx 1.0
  # The pattern to find the last line of an SQL statement.
  set sqlpat [format {.*%s} $mmon(sqlTerm)]

  while {!$mmon(interrupt)} {
    # Extract the next line.
    .m.s.sql mark set first $idx
    .m.s.sql mark set last "$idx lineend"
    set lastidx [.m.s.sql index last]
    set stm [.m.s.sql get first last]

    # Check what kind of line this is.
    if {[regexp -indices "^$mmon(white)$mmon(actPrefix)" $stm hit]} {
      # Sets mmon(interrupt) and the message in case of conflict.
      execAction \
        [string trim [string range $stm [expr [lindex $hit 1] +1] end]]
    } elseif {[regexp -indices "^$mmon(white)$mmon(cmtPrefix)" $stm hit]} {
      #puts [format {*** comment>%s<} $stm]
    } elseif {[regexp "^$mmon(white)\$" $stm]} {
      #puts [format {*** white space>%s<} $stm]
    } else {
      #puts [format {*** SQL>%s<} $stm]
      # Seems to be an SQL statement; find its last line.
      while {![regexp $sqlpat $stm]} {
        set try [.m.s.sql index "last lineend + 1 char"]
        if {$try <= $lastidx} break
        .m.s.sql mark set last "$try lineend"
        set lastidx [.m.s.sql index last]
        set stm [.m.s.sql get first last]
      }
      if {[catch {execSql $stm} has_result]} {
        setMsg
        set conflict 1
        set mmon(interrupt) 1
        break
      }
      if {$has_result} {
        if {[catch {getResult}]} {
          setMsg
          set conflict 1
          set mmon(interrupt) 1
          break
        }
      }
    }
    # Adjust 'idx' to next line, if any.
    set idx [.m.s.sql index "last lineend + 1 char"]
    if {$idx <= $lastidx} break
  }

  if {$conflict} {
    # Highlight and show the trouble spot.
    .m.s.sql tag add statement first last
    .m.s.sql tag configure statement -background red -foreground white
    .m.s.sql yview first
    .m.s.sql mark set insert last
    update
  }

  interruptEnable 0
}


########################
#
# execSql
#
#   Exec an SQL statement.
#   'stm' must be a single non-empty SQL statement.
#   It usually has a semicolon at the end.
#   RETURNS 1 if the statement leaves one or more result rows;
#   0 otherwise.
#   ASSUMES this proc is invoked through 'catch'.
#

proc execSql {stm} {
  global msql

  setMsg "Executing SQL"
  set stm [string trimright $stm { ;}]

  # We will get -1 if the statement is non-SELECT.
  set dbret [msqlsel $msql $stm]

  if {$dbret < 0} {
    setMsg "Non-SELECT execution completed"
  } elseif {$dbret > 0} {
    setMsg "Query completed; getting results"
  } else {
    setMsg "Query completed; no result rows"
  }

  return [expr $dbret > 0]
}


########################
#
# getResult
#
#   Gets and displays the rows retrieved by a previous SELECT query.
#   ASSUMES this proc is invoked through 'catch'.
#   Does NOT manage the Execute/Cancel toggle.
#

proc getResult {} {
  global msql
  global mmon

  set slist [formatCols [msqlcol $msql -current name type length]]
  set fmt [lindex $slist 0]
  .m.o.out insert end [lindex $slist 1]
  set cnt 0

  while {!$mmon(interrupt) && [msqlresult $msql rows] > 0} {

    set row [msqlnext $msql]
    incr cnt

    if {[string length $row] == 0} {
      .m.o.out insert end ""
    }  else {
      .m.o.out insert end [eval format \"$fmt\" $row]
    }

    if {$mmon(resMaxLines) > 0} {
      if {$cnt % $mmon(resMaxLines) == 0} {
        moreResult $cnt
      }
    } elseif {$cnt % 50 == 0} {
      setMsg "$cnt rows so far..."
      update
    }
  }

  if {$mmon(interrupt) == 0} {
    setMsg "SQL finished, $cnt rows displayed "
  } else {
    setMsg "SQL interrupted, $cnt rows displayed "
  }
}


########################
#
# moreResult
#
#   Pause getting query results and asks for confirmation.
#   'cnt' must be the number of rows so far.
#

proc moreResult {cnt} {
  global mmon

  catch {destroy .more}
  toplevel .more
  wm transient .more .
  set xpos [expr [winfo rootx .]+[winfo width .]/4]
  set ypos [expr [winfo rooty .]+[winfo height .]/5]
  wm geom .more +${xpos}+$ypos
  wm title .more "Get More Result Rows?"

  message .more.msg -aspect 1200 -text "$cnt result rows so far; continue?"

  frame .more.b
  button .more.b.goon -text "Go On" -command {destroy .more}
  button .more.b.stop -text "Stop It" \
    -command {set mmon(interrupt) 1; destroy .more}

  pack .more.msg -side top -pady 7
  pack .more.b -side top -fill x
  pack .more.b.goon .more.b.stop -fill x -expand 1 -side left

  grab .more
  tkwait window .more
}


########################
#
# formatCols
#
#   'col_data' must be a list of three lists containing column names,
#     types, and lenghts, respectively
#   ASSUMES char columns can be truncated to 'mmon(colMaxLen)' if not zero.
#
#   RETURN a list of two components
#   (0) Format string for printing the column.
#   (1) Heading string.
#

proc formatCols {col_data} {
  global mmon

  set cName [lindex $col_data 0]
  set cType [lindex $col_data 1]
  set cLength [lindex $col_data 2]
  set idx -1
  set fmt ""
  set hdr ""

  foreach item $cName {
    incr idx
    set len0 [lindex $cLength $idx]
    switch [lindex $cType $idx] {
      {int}	{set len 12 ; set just "" }
      {real}	{set len 12 ; set just "" }
      {char}	{if {$mmon(colMaxLen) > 0} {
		  set len [min $len0 $mmon(colMaxLen)]
                } else {
		  set len $len0
		}
		set just - }
      {default} {set len 32 ; set just - }
    }

    # make sure length is as long as colunm name 
    set len [max $len [string length $item]]
    append fmt "%${just}${len}.${len}s "
    append hdr $item [replicate - [expr $len - [string length $item]]] { }
  }
  return [list $fmt $hdr]
}


########################
#
# execAction
#
#   Execute an action: a Mini-Monitor command.
#   'stm' must be the command.
#   SIDE EFFECT: Sets mmon(interrupt) on conflict.
#   NOTE: Not implemented yet.

proc execAction {stm} {
#      puts [format {*** action >%s<} $stm]
}


########################
#
# showFields
#
#   create a toplevel window with a table's fields
#

proc showFields {tab} {
  global msql
  global msqlstatus
  global mmon

  if {[checkConnect 3]} return

  set plist ""

  if {[catch {msqlcol $msql $tab \
	{name type length prim_key non_null}} info]} {
    setMsg
    return
  }

  foreach item $info {
    set nm [lindex $item 0]
    if {[set tp [lindex $item 1]] == "char"} {
      append tp ([lindex $item 2])
    }
    if {[lindex $item 3]} {
      set pk PK
    } else {
      set pk "  "
    }
    if {[lindex $item 4]} {
      set nn NN
    } else {
      set nn "  "
    }

    lappend plist [format "%-24.24s %-11.11s %s %s" $nm $tp $pk $nn]
  }

  if {[llength $plist] == 0} {
    setMsg "No fields in table $tab"
    return
  }
  pickList .$mmon(dbname):$tab Columns 42x10 $plist {} sqlInsert
}


########################
#
# showTables
#
#   create a toplevel window with user tables
#

proc showTables {} {
  global msql
  global msqlstatus
  global mmon

  if {[checkConnect 3]} return

  if {[catch {msqlinfo $msql tables} plist]} {
    setMsg
    return
  } elseif {[llength $plist] == 0} {
    setMsg "No user tables in $mmon(dbname)"
    return
  }
  pickList .$mmon(dbname):Tables Tables 20x20 [lsort $plist] \
	showFields sqlInsert
}


############################################################################
## HELP ##


proc mkHelp {win} {
# Creates a window suitable for displaying help text.
# 'win' must be the name of the new window (no leading dot).
# It is also used for the window title.
# RETURNS the name of the new window.
global mmon
	regsub -all {_} $win { } title
	set win [string tolower .$win]
	catch {destroy $win}
	toplevel $win
	wm withdraw $win
	wm title $win $title
	wm transient $win .
	set xpos [expr [winfo rootx .]+[winfo width .]/9]
	set ypos [expr [winfo rooty .]+[winfo height .]/5]
	wm geom $win +${xpos}+$ypos

	frame $win.f -relief ridge  -borderwidth 3
	scrollbar $win.f.s -command "$win.f.t yview" -orient vertical
	text $win.f.t -height 17 -width 70 -relief flat -wrap word \
		-font $mmon(helpPlain) -yscroll "$win.f.s set"
	button $win.ok -text Dismiss -command "destroy $win"
	pack $win.f -side top
	pack $win.f.s -side right -fill y
	pack $win.f.t -side left -fill both -expand 1
	pack $win.ok -fill x -expand 1
	$win.f.t tag configure body -font $mmon(helpPlain)
	$win.f.t tag configure head -font $mmon(helpHead) \
		-foreground SteelBlue3
	$win.f.t tag configure emph -font $mmon(helpEmph) \
		-foreground IndianRed3
	return $win
}


proc addHelpText {win tag txt} {
# Adds text to a help window.
# 'win' must be the name of a window created by 'mkHelp'.
# 'tag' may be a tag name, or empty.
# 'txt' must be the text to add; use a trailing space.
	set tbeg [$win.f.t index end]
	$win.f.t insert end $txt
	if {$tag != {}} {
		set tend [$win.f.t index "end - 1 char"]
		$win.f.t tag add $tag $tbeg $tend
	}
}


proc addHelpPar {win par} {
# Add a new paragraph to the help text.
# 'win' must be the name of a window created by 'mkHelp'.
# 'par' must be the text of the paragraph.
# The proc adds newlines before the paragraph text.
	$win.f.t insert end "\n$par\n"
}


proc addHelpSubj {win head} {
# Adds a heading.
# 'win' must be the name of a window created by 'mkHelp'.
# 'head' must be the heading text.
	$win.f.t insert end "\n"
	addHelpText $win head "$head "
}


proc newHelp {win head} {
# Creates a new help window with a heading.
# 'head' must be the heading text.
# The proc adds newlines after the heading text.
  set w [mkHelp $win]
  addHelpText $w head "$head\n"
  return $w
}


proc showHelp {win} {
# Must be invoked to show the otherwise invisible help window.
	$win.f.t configure -state disabled
	wm deiconify $win
}


proc generalHelp {} {
  set w [newHelp General_Help {MINI-MONITOR INTRODUCTION}]
  addHelpPar $w "The Mini-Monitor basically lets you enter and edit\
Mini-SQL commands, have them executed, and manage the result.\
Several useful features simplify this basic process.\
The following paragraphs describe what you see on the main screen."
  addHelpSubj $w {Menu Bar}
  addHelpPar $w "The menu bar is the topmost area of the main screen.\
In addition to menus the menu bar contains two buttons."
  addHelpSubj $w {Connection Display}
  addHelpPar $w "The area below the menu bar displays the host and\
database you are connected to (if any). Use the 'Connection' menu to\
connect to another host or database."
  addHelpSubj $w {SQL Input Window}
  addHelpPar $w "The SQL input window is used to enter and edit Mini-SQL\
commands.\
You may enter text from the keyboard or from a file.\
Use the 'SQL' menu to get text from a file, or to save the current text."
  addHelpPar $w "Execute the contents of the SQL input window by pushing the\
'Execute' button, or by pressing Ctrl-Return (or Shift-Return)."
  addHelpPar $w "There is also a history mechanism.\
Press Ctrl-UpArrow one or more times to go back to previously executed\
commands, Ctrl-DownArrow to go forwards.\
(Shift-UpArrow and Shift-DownArrow have the same functions.)"
  addHelpPar $w "The SQL input window may contain more than one\
Mini-SQL statement.\
The Mini-Monitor divides the input into statements and sends them one by one\
to the mSQL database engine.\
For this to be possible a semicolon must terminate each statement, and\
each new statement must begin on a new line.\
(The last statement need not end with semicolon.)\
Comments (lines beginning with '#') and empty lines are also allowed."
  addHelpSubj $w {Results Window}
  addHelpPar $w "The Results window displays the result of executing SQL\
input."

  showHelp $w
}

proc menuHelpSQL {} {
  set w [newHelp SQL_Help {'SQL' MENU}]
  addHelpPar $w "The 'SQL' menu is mainly concerned with the contents of the\
SQL input window."
  addHelpSubj $w {Clear}
  addHelpPar $w "Clears the SQL input window and the Results window."
  addHelpSubj $w {Hilite Off}
  addHelpPar $w "Reverts any highlighted SQL statement back to normal.\
This is equivalent to Control-Delete.\
Highlighting occurs if a conflict is detected during SQL execution."
  addHelpSubj $w {Open}
  addHelpPar $w "Displays a file selection dialog box.\
You may select a file for copying into the SQL input window.\
The window is cleared before copying."
  addHelpSubj $w {Save}
  addHelpPar $w "Saves the contents of the SQL input window into the\
current file name.\
The current file name is displayed above the SQL input window."
  addHelpSubj $w {Save As}
  addHelpPar $w "Displays a file selection dialog box.\
You may specify a new or existing file for saving the contents of the\
SQL input window."
  addHelpSubj $w {Exit}
  addHelpPar $w "Displays a dialog box which allows you to exit the\
Mini-Monitor."

  showHelp $w
}

proc menuHelpRes {} {
  set w [newHelp Results_Help {'RESULTS' MENU}]
  addHelpPar $w "The 'Results' menu controls how query results are displayed\
in the Results window and allows you to save or print its contents."
  addHelpSubj $w {Append results -- Clear results}
  addHelpPar $w "You may toggle between append mode and clear mode.\
In append mode the result of each query is appended to the end of whatever\
the Results window contains.\
In clear mode the Results window is cleared for each query."
  addHelpSubj $w {Save As}
  addHelpPar $w "Displays a file selection box.\
You may specify a new or existing file for saving the contents of the\
Results window."
  addHelpSubj $w {Print}
  addHelpPar $w "Prints the contents of the Results window."
  addHelpSubj $w {Font size}
  addHelpPar $w "Sets the size of the Results window font."
  addHelpSubj $w {Limit result}
  addHelpPar $w "Displays a dialog box that allows you to limit query results\
in two different ways:"
  addHelpPar $w "You may limit the number of characters displayed for any\
column.\
Columns longer than the limit you set will be truncated.\
Zero means no truncation."
  addHelpPar $w "You may impose a limit on the number of rows returned\
before the Mini-Monitor asks for your confirmation to continue.\
Zero means no confirmation is requested.\
You may always use the 'Cancel' button."
  addHelpSubj $w {Null value}
  addHelpPar $w "You may set the string to represent NULL in query results.\
Initially the empty string is used."

  showHelp $w
}

proc menuHelpConn {} {
  set w [newHelp Connection_Help {'CONNECTION' MENU}]
  addHelpPar $w "The 'Connection' menu is used to connect to a database\
server and a database.\
If the MMON_CONNECT environment variable is set to a host name and a\
database name separated by a colon,\
the Mini-Monitor tries to quick-start by connecting to this host and\
database. (Omit host name to indicate the local host.)"
  addHelpSubj $w {Database}
  addHelpPar $w "Displays a dialog box of databases available on the server\
you are connected to.\
Double clicking (button 1) on a database name is a quick way of selecting\
a database.\
The name of the currently selected database is shown in the Connection\
Display."
  addHelpSubj $w {Server}
  addHelpPar $w "Displays a dialog box where you may select an mSQL\
server host.\
If you push the 'Connect' button with an empty 'Server' entry a connection\
is attempted to the local host.\
If the MSQL_HOSTS environment variable is defined\
(as a colon-separated list of host names)\
the 'Server' entry label is, in fact, a menu button from which you may\
select a host name.\
You may always fill in the host name manually."
  addHelpPar $w "The name of the host you are connected to is shown in\
the Connection Display."

  showHelp $w
}

proc menuHelpTables {} {
  set w [newHelp Tables_Help {'TABLES' MENU BAR BUTTON}]
  addHelpPar $w "Displays a dialog box containing the names of the tables of\
the current database."
  addHelpSubj $w {The Tables Dialog Box}
  addHelpPar $w "The window title contains the database name.\
After selecting a table name (single button 1 click) you may,"
  addHelpPar $w "-- Click on the 'Select' button to obtain a new dialog box\
containing data about the columns of the selected table.\
(Double click with button 1 is a short cut.)\
This dialog box is further described below."
  addHelpPar $w "-- Click on the 'Insert' button to insert the table name\
into the SQL input window.\
This may be handy when you write queries.\
(Button 3 click is a short cut.)"
  addHelpSubj $w {The Columns Dialog Box}
  addHelpPar $w "The window title contains the database and table names.\
The listbox shows name and datatype of each column.\
'PK' or 'NN' at the end of an entry signify 'Primary Key' and 'Not Null',\
respectively.\
As with the tables dialog box you may quickly insert a column name into the\
SQL input window by clicking with button 3,\
or clicking on the 'Insert' button."

  showHelp $w
}

proc menuHelpExec {} {
  set w [newHelp Execute_Help {'EXECUTE' MENU BAR BUTTON}]
  addHelpPar $w "Sends the contents of the SQL input window to the database\
server.\
Any error messages are displayed in the message area.\
The statement causing the conflict is highlighted.\
(Control-Delete reverts the highlighted text to normal.)\
See also Help->General about the SQL input window."
  addHelpPar $w "While execution is active, the 'Execute' button turns into\
a 'Cancel' button.\
You may use this button to interrupt execution at any time."

  showHelp $w
}

proc aboutHelp {} {
  global mmon
  set w [newHelp About_Mini-Monitor "Mini-Monitor $mmon(version)"]
  addHelpPar $w "Author: Hakan Soderstrom adapted original work\
done by Tom Poindexter."

  showHelp $w
}


########################
#
# lboxSel
#
#   Given a listbox returns its currently selected item, or empty string.
#

proc lboxSel {lbox} {
	set idx [lindex [$lbox curselection] 0]
	if {[string length $idx] > 0} {
		return [$lbox get $idx]
	} else {
		return {}
	}
}


########################
#
# pickList
#
#   Return a selection from a listbox by calling a proc.
#   'win' must be the the new window name.
#   'heading' will appear as a heading over the listbox.
#   'geom' must be the desired geometry of the listbox itself.
#   The unit is characters.
#   'plist' must be the list whose items should appear in the listbox.
#   'callproc' may be a proc name or empty.
#   If non-empty a "Select" button will be created which invokes the proc.
#   The selected list item will be passed to the proc.
#   'insert' may be a proc name or empty.
#   If it is a proc a third button (Insert) will be created (similar to
#   callproc) and button <3> will be activated.
#

proc pickList {win heading geom plist {callproc {}} {insert {}}} {
  global mmon

  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]

  # 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}]
  wm geom $win +${newx}+$newy

  # Build the window.
  frame $win.l 
  frame $win.f 
  frame $win.b -relief sunken -borderwidth 1 -bg blue

  label $win.l.l -text $heading -anchor w

  scrollbar $win.f.vert -orient vertical -command "$win.f.box yview" \
			-relief sunken
  listbox $win.f.box -yscroll "$win.f.vert set"  -relief sunken \
	  -geometry $geom -font $mmon(lboxFont)

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

  # Is 'callproc' there?
  set doproc [string length [info commands $callproc]]
  if $doproc {
    button $win.b.ok -text "Select" -relief raised -borderwidth 2 \
		-command "$callproc \[lboxSel $win.f.box\]"
    bind $win.f.box <Double-1> "$win.b.ok invoke"
  }

  # Is 'insert' there?
  set doinsert [string length [info commands $insert]]
  if {[string length $insert] > 0} {
    button $win.b.ins -text "Insert" -relief raised -borderwidth 2 \
		-command "$insert \[lboxSel $win.f.box\]"
    bind $win.f.box <3> \
	"%W select from \[%W nearest %y\]; $insert \[lboxSel %W\]"
  }

  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
  }

  if $doinsert {
    pack $win.b.ins -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} {
  global mmon

  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]
  wm transient $w .
  set xpos [expr [winfo rootx .]+[winfo width .]/3]
  set ypos [expr [winfo rooty .]+[winfo height .]/3]
  wm geom $w +${xpos}+$ypos


    # 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 $mmon(dlgFont) $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]
	}
    }
}


proc setResultFont {size} {
# Sets the font of the result text window.
global mmon
  set font [format $mmon(resFontForm) $size]
  .m.o.out configure -font $font
}


proc setResultLimit {} {
  global mmon
  global mmui

  set mmui(colMaxLen) $mmon(colMaxLen)
  set mmui(resMaxLines) $mmon(resMaxLines)

  catch {destroy .srlim}
  toplevel .srlim -class Dialog
  wm transient .srlim .
  set xpos [expr [winfo rootx .]+[winfo width .]/3]
  set ypos [expr [winfo rooty .]+[winfo height .]/3]
  wm geom .srlim +${xpos}+$ypos
  wm title .srlim "Set Result Limits"

  message .srlim.m1 -aspect 1200 -text \
    {Truncate long columns in the result window; 0 means no truncation}

  frame .srlim.col
  button .srlim.col.res -text "Reset" \
	-command {set mmui(colMaxLen) 0; .srlim.col.sc set 0}
  scale .srlim.col.sc -label "Number of characters" -orient horizontal \
	-from 0 -to 100 -tickinterval 20 -length 220  -relief groove \
	-command {set mmui(colMaxLen)}
  .srlim.col.sc set $mmui(colMaxLen)
  frame .srlim.col.a
  button .srlim.col.a.dec -text " < " \
	-command {incr mmui(colMaxLen) -1; .srlim.col.sc set $mmui(colMaxLen)}
  button .srlim.col.a.inc -text " > " \
	-command {incr mmui(colMaxLen); .srlim.col.sc set $mmui(colMaxLen)}
  button .srlim.col.a.round -text "Round" \
    -command {set mmui(colMaxLen) [expr round([.srlim.col.sc get].0/10)*10]; \
      .srlim.col.sc set $mmui(colMaxLen)}

  frame .srlim.fil1 -height 25

  message .srlim.m2 -aspect 1200 -text \
    {Confirmation requested for voluminous results; 0 means never ask}

  frame .srlim.lin
  button .srlim.lin.res -text "Reset" \
	-command {set mmui(resMaxLines) 0; .srlim.lin.sc set 0}
  scale .srlim.lin.sc -label "Number of rows" -orient horizontal \
	-from 0 -to 1000 -tickinterval 200 -length 220 -relief groove \
	-command {set mmui(resMaxLines)}
  .srlim.lin.sc set $mmui(resMaxLines)
  frame .srlim.lin.a
  button .srlim.lin.a.dec -text " < " \
    -command {incr mmui(resMaxLines) -1; .srlim.lin.sc set $mmui(resMaxLines)}
  button .srlim.lin.a.inc -text " > " \
    -command {incr mmui(resMaxLines); .srlim.lin.sc set $mmui(resMaxLines)}
  button .srlim.lin.a.round -text "Round" \
    -command {set mmui(resMaxLines) [expr round([.srlim.lin.sc get].0/10)*10];\
      .srlim.lin.sc set $mmui(resMaxLines)}

  frame .srlim.b
  button .srlim.b.apply -text Apply -command {\
    destroy .srlim; \
    set mmon(colMaxLen) $mmui(colMaxLen); \
    set mmon(resMaxLines) $mmui(resMaxLines)}
  button .srlim.b.cancel -text Cancel -command {destroy .srlim}

  frame .srlim.fil2 -height 25

  # Add some 'Shift' acceleration.
  bind .srlim.col.a.dec <Shift-1> \
    {incr mmui(colMaxLen) -5; .srlim.col.sc set $mmui(colMaxLen)}
  bind .srlim.col.a.inc <Shift-1> \
    {incr mmui(colMaxLen) 5; .srlim.col.sc set $mmui(colMaxLen)}
  bind .srlim.lin.a.dec <Shift-1> \
    {incr mmui(resMaxLines) -5; .srlim.lin.sc set $mmui(resMaxLines)}
  bind .srlim.lin.a.inc <Shift-1> \
    {incr mmui(resMaxLines) 5; .srlim.lin.sc set $mmui(resMaxLines)}

  pack .srlim.m1 .srlim.col .srlim.fil1 .srlim.m2 .srlim.lin .srlim.fil2 \
    -side top
  pack .srlim.b -fill x
  pack .srlim.col.res .srlim.col.sc .srlim.col.a -side left -padx 7
  pack .srlim.col.a.dec .srlim.col.a.inc .srlim.col.a.round -side left
  pack .srlim.lin.res .srlim.lin.sc .srlim.lin.a -side left -padx 7
  pack .srlim.lin.a.dec .srlim.lin.a.inc .srlim.lin.a.round -side left
  pack .srlim.b.apply .srlim.b.cancel -fill x -expand 1 -side left

  grab .srlim
  tkwait window .srlim
}


proc setNullvalue {} {
  global mmui
  global msqlstatus

  set mmui(nullvalue) $msqlstatus(nullvalue)

  catch {destroy .nullv}
  toplevel .nullv -class Dialog
  wm transient .nullv .
  set xpos [expr [winfo rootx .]+[winfo width .]/3]
  set ypos [expr [winfo rooty .]+[winfo height .]/3]
  wm geom .nullv +${xpos}+$ypos
  wm title .nullv "Null Value"

  message .nullv.m1 -aspect 500 -justify center -text \
    {You may set the string to display when a NULL value is returned from a query}

  frame .nullv.c
  label .nullv.c.l -text "Current setting:" -width 18
  label .nullv.c.t -text [format {"%s"} $msqlstatus(nullvalue)]

  frame .nullv.n
  label .nullv.n.l -text "New setting:" -width 18
  entry .nullv.n.t -relief sunken -width 20 -textvariable mmui(nullvalue)
  # This can be changed in Tk 4.0
  .nullv.n.t select from 0
  .nullv.n.t select adjust end

  frame .nullv.b
  button .nullv.b.apply -text Apply -command {\
    destroy .nullv; \
    set msqlstatus(nullvalue) $mmui(nullvalue)}
  button .nullv.b.cancel -text Cancel -command {destroy .nullv}

  pack .nullv.c.l -side left -anchor e
  pack .nullv.c.t -side left
  pack .nullv.n.l -side left -anchor e
  pack .nullv.n.t -side left
  pack .nullv.b.apply .nullv.b.cancel -side left -fill x -expand yes
  pack .nullv.m1 .nullv.c .nullv.n -side top -pady 10 -fill x
  pack .nullv.b -side top -fill x -expand yes
  bind .nullv.n.t <KeyPress-Return> ".nullv.b.apply invoke"
  focus .nullv.n.t

  grab .nullv
  tkwait window .nullv
}

############################################################################
# Kick off the entire process.
# This is where you configure mmon for Emacs of Motif bindings.
# The argument to 'mmonInit' may be one of,
# emacs -- for Emacs bindings,
# motif -- for Motif bindings,
# (nothing) -- for default Tk bindings.

if {!$tcl_interactive} {
  mmon_Init motif
  mmon_KickOff
}
