#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  README.demo focus_demo.tk focus_util.tk dialog.tk
# Wrapped by vanandel@rsf on Tue Aug 10 15:16:05 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README.demo' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README.demo'\"
else
echo shar: Extracting \"'README.demo'\" \(381 characters\)
sed "s/^X//" >'README.demo' <<'END_OF_FILE'
XHere is a demonstration of some code that I've written to validate what
Xa user enters in "entry" widgets.  In the demonstration, 2 fields only
Xallow integer input, the 3rd field allows floating point numbers in a
Xspecified range.  As part of this package, I also show how to shift the
Xfocus from one entry to the next via the "tab" key.
X
XJoe VanAndel (vanandel@ncar.ucar.edu)
X    
END_OF_FILE
if test 381 -ne `wc -c <'README.demo'`; then
    echo shar: \"'README.demo'\" unpacked with wrong size!
fi
# end of 'README.demo'
fi
if test -f 'focus_demo.tk' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'focus_demo.tk'\"
else
echo shar: Extracting \"'focus_demo.tk'\" \(2925 characters\)
sed "s/^X//" >'focus_demo.tk' <<'END_OF_FILE'
X#!/usr/local/bin/wish -f
X# Demonstration of focus handling and entry validation
X#
X#
Xsource focus_util.tk
Xsource dialog.tk
X
Xframe .f1 -relief sunken
Xlabel .f1.l1 -text "Start"
XSetKeyToWidget ATT_START [entry .f1.astart -relief sunken -textvariable Att_start]
Xlabel .f1.l2 -text "End"
XSetKeyToWidget ATT_END [entry .f1.aend -relief sunken -textvariable Att_end]
Xlabel .f1.l3 -text "Increment"
XSetKeyToWidget ATT_STEP [entry .f1.aincr -relief sunken -textvariable Att_incr]
X
Xpack append . [label .l1 -text "Entry Demo"] top \
X	[message .m1 -text "Start and End accept integers, Increment accepts floating point values > 0 and < 10" -width 600] {top fillx} \
X	.f1 top \
X	[button .q1 -text "Quit" -command {destroy .}] top
X
Xpack append .f1 \
X    .f1.l1 {left} \
X    .f1.astart {left} \
X    .f1.l2 {left} \
X    .f1.aend {left} \
X    .f1.l3 {left} \
X    .f1.aincr {left} 
X
X# before we set the focus sequence, set default values
Xset Att_start 10
Xset Att_end 120
Xset Att_incr 5
Xset Att_incr_max 10
X
XSetNextFocusWidget ATT_START ATT_END
XSetNextFocusWidget ATT_END ATT_STEP
XSetNextFocusWidget  ATT_STEP ATT_START
X
Xbind_int_entry [KeyToWidget ATT_END]
Xbind_int_entry [KeyToWidget ATT_START]
Xbind_float_entry [KeyToWidget ATT_STEP]
X
X
Xset Att_min 0
Xset Att_max 120
X
XSetLostFocusNotify ATT_START validate_start
XSetLostFocusNotify ATT_END validate_end
X
XSetLostFocusNotify ATT_STEP validate_incr
X
X# validate the contents of the start entry,
Xproc validate_start {w} {
X#    puts stderr "validate_start called with $w"
X    global Att_start Att_end Att_min
X    if {($Att_start<$Att_min)||($Att_start>=$Att_end)} {
X        warnDialog "value must be >=$Att_min and < $Att_end"
X# sorry, have to restore the old value
X	set old_name [get_oldtextvarname $w]
X	set varname [get_textvarname $w ]
X        set old_value [eval [list  uplevel #0 set $old_name]]
X        eval [list  uplevel #0 set $varname $old_value]
X	# force the focus to stay here
X	error "re-enter"
X    } 
X}
X# validate the ending value
Xproc validate_end {w} {
X#    puts stderr "validate_start called with $w"
X    global Att_start Att_end Att_max
X    if {($Att_end>$Att_max)||($Att_start>=$Att_end)} {
X        warnDialog "value must be > $Att_start and <=$Att_max"
X
X        set old_name [get_oldtextvarname $w]
X        set old_value [eval [list  uplevel #0 set $old_name]]
X        set varname [get_textvarname $w ]
X        eval [list  uplevel #0 set $varname $old_value]
X	# force the focus to stay here
X	error "re-enter"
X    }
X}
X# validate the ending value
Xproc validate_incr {w} {
X    global Att_incr Att_incr_max
X    if {($Att_incr<0)||($Att_incr>=$Att_incr_max)} {
X        warnDialog "value must be > 0 and <=$Att_incr_max"
X
X        set old_name [get_oldtextvarname $w]
X        set old_value [eval [list  uplevel #0 set $old_name]]
X        set varname [get_textvarname $w ]
X        eval [list  uplevel #0 set $varname $old_value]
X	# force the focus to stay here
X	error "re-enter"
X    }
X}
END_OF_FILE
if test 2925 -ne `wc -c <'focus_demo.tk'`; then
    echo shar: \"'focus_demo.tk'\" unpacked with wrong size!
fi
chmod +x 'focus_demo.tk'
# end of 'focus_demo.tk'
fi
if test -f 'focus_util.tk' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'focus_util.tk'\"
else
echo shar: Extracting \"'focus_util.tk'\" \(6176 characters\)
sed "s/^X//" >'focus_util.tk' <<'END_OF_FILE'
X#
X# This software has been tested with tk 3.2 and tcl 6.7
X#
X# Copyright 1993 University Corporation for Atmospheric Research
X#
X# Permission to use, copy, modify, and distribute this
X# software and its documentation for any purpose and without
X#  fee is hereby granted, provided that the above copyright
X# notice appear in all copies.  The University Corporation for Atmospheric
X# Research makes no representations about the suitability of this
X# software for any purpose.  It is provided "as is" without
X# express or implied warranty.
X#
X#
X#
X# please send comments or suggestions to vanandel@ncar.ucar.edu
X#
X#
X# focus management and input validation utility routines.
X#
X# 1) Focus Management:
X# Tk lacks a built in mechanism for aiding a user in navigating through
X# a set of entry widgets.
X# We provide such a mechanism by registering the next widget to be entered
X# in a global array, and providing procedures to set/get these values.
X#
X# 2) Input validation
X# we provide a mechanism by which the contents of an entry widget can
X# be validated.  The programmer registers a procedure to be called when
X# the focus changes - either by "mousing" another entry widget, or by
X# striking a key to navigate to the next widget - typically "Tab".
X
X#
X
X
X# translate a key (symbolic name) (e.g AZ_LEFT) to a widget pathname
X
Xproc KeyToWidget {key} {
X    global _WidgetNames
X    return $_WidgetNames($key) 
X}
X
X# set the mapping between key (symbolic name) and widget pathname
Xproc SetKeyToWidget {key value} {
X    global _WidgetNames
X
X    set _WidgetNames($key) $value
X}
X
X# retrieve the next widget that should get the focus.
X#
X# first, check for a simple mapping of current to next widget.  
X#
X# if there isn't a next value  
X# then set the focus to the current widget
X#
Xproc GetNextFocusWidget {current} {
X    global _FocusSequence
X    if { [catch {set _FocusSequence($current)} value] == 0}  then {
X	return $value
X    } else {
X	return $current
X    }
X}
X#
X# set up 1 link in the focus chain of entry widgets
X#
X# SIDE EFFECT - sets a global variable old_XXX  that will contain
X# a previous value for the entry widget, allowing validation
X# procedures to restore the previous value.  
X#
X# We assume that each  entry widget has an associated "textvariable", 
X# that will correspond to its value.
X#
Xproc SetNextFocusWidget { currentKey nextKey} {
X    global _FocusSequence
X#    puts stderr "SetNextFocus called\n"
X    set current [KeyToWidget $currentKey]
X    bind $current <Tab> "next_sequence %W "
X     bind $current <1> {%W icursor @%x; new_focus %W; %W select from @%x}
X
X#    now, set the old value of the variable to the current value
X    set old_name [get_oldtextvarname $current]
X    eval [list uplevel #0 set $old_name \{ [get_textvarvalue  \
X	[get_textvarname $current ]] \} ] 
X
X
X    set next [KeyToWidget $nextKey]
X#    puts stderr "set focus from $current to $next"
X    set _FocusSequence($current) $next
X}
X#
X# register a procedure to be called when this widget loses the focus
X#
Xproc SetLostFocusNotify {key args} {
X    global _LostFocusNotify
X    set current [KeyToWidget $key]
X    set _LostFocusNotify($current) $args
X}
X
X
X# this procedure is bound to keystrokes that move from one entry widget to
X# the next
X#
Xproc next_sequence {w} {
X#    puts stderr "next_sequence $w"
X    new_focus [GetNextFocusWidget $w]
X}
X# procedure called when focus is shifted to a new entry widget
X
Xproc new_focus {next_widget} {
X    global _LostFocusNotify
X    set current [focus]
X    global errorInfo
X# verify that someone has the focus
X    if { $current != "none" } then {
X#	puts stderr "focus currently at $current"
X# if the widget has registered a notification procedure,
X# then invoke it
X#
X# if the notification procedure returns an error, we don't change the
X# focus, since we want the user to correct the input error
X#
X	set notify_exists [catch {set _LostFocusNotify($current)} notify_proc]
X	if {$notify_exists == 0} then {
X# since notify_proc may itself be a list, build a single list
X# that contains the name of the command and all arguments
X	    set cmd [concat eval $notify_proc $current]
X	    set valid [catch $cmd msg]
X	    if {$valid != 0} {
X## reset the focus, since we may have invoked a dialog
X		focus $current	
X		return
X	    } 
X	}
X    }
X# give up the focus to the new widget
X#    _select_all $next_widget
X    focus $next_widget
X}
X# get the value of the associated text variable for a widget
Xproc get_textvarname {w} {
X    set vlist [$w config -textvariable]
X    set value_name [lindex $vlist [expr {[llength $vlist]-1}]]
X
X#    puts stderr " textvariable is $value_name"
X    return $value_name
X}
X
Xproc get_oldtextvarname {w} {
X    set vlist [$w config -textvariable]
X    set value_name [lindex $vlist [expr {[llength $vlist]-1}]]
X
X#    puts stderr " textvariable is old_$value_name"
X    return old_$value_name
X}
Xproc get_textvarvalue {value_name} {
X    return [eval [list uplevel #0 set $value_name]]
X}
X
Xproc demo_handler {w} {
X    set varname [get_textvarname $w ]   
X    set new_value   [get_textvarvalue   $varname]   
X    set old_name [get_oldtextvarname $w]
X    set old_value [eval [list  uplevel #0 set $old_name]]
X
X    puts stderr "$w just lost the focus, $varname = $new_value, was $old_value"
X    # after validation
X    eval [list uplevel #0 set $old_name  $new_value ]
X}
X
X# delete the selection, if it exists
Xproc _delete_sel {widget} {
X    catch {$widget delete sel.first sel.last}
X}
X
X# set field for numeric integer entry
Xproc bind_int_entry {args} {
X# retrieve the class bindings for an entry
X    set ekeys [bind Entry]
X    foreach w $args {
X	foreach key { 0 1 2 3 4 5 6 7 8 9 } {
X	    bind $w $key { _delete_sel %W ; %W insert insert "%A"}
X	}
X# restore the class bindings, so delete, etc work
X	foreach key $ekeys {
X#	    echo "bind $w $key [bind Entry $key]"
X	    bind $w $key [bind Entry $key]
X	}
X# but now, over-ride any-key binding
X	bind $w <Any-Key> {_null_proc %W}
X    }
X}
Xproc bind_float_entry {args} {
X#puts stderr "bind_float_entry called for $args"
X# retrieve the class bindings for an entry
X    bind_int_entry $args
X
X    foreach w $args {
X	foreach key { + - . } {
X	    bind $w $key { _delete_sel %W ; %W insert insert "%A"}
X	}
X    }
X}
Xproc _null_proc {w} {
X}
END_OF_FILE
if test 6176 -ne `wc -c <'focus_util.tk'`; then
    echo shar: \"'focus_util.tk'\" unpacked with wrong size!
fi
# end of 'focus_util.tk'
fi
if test -f 'dialog.tk' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'dialog.tk'\"
else
echo shar: Extracting \"'dialog.tk'\" \(4223 characters\)
sed "s/^X//" >'dialog.tk' <<'END_OF_FILE'
X
X# Create a dialog box.  Takes three or more arguments.  The first is
X# the name of the window to use for the dialog box.  The second is a set
X# of arguments for use in creating the message of the dialog box.  The
X# third and following arguments consist of two-element lists, each
X# describing one button.  The first element gives the text to be displayed
X# in the button, the second gives the command to be invoked when the
X# button is invoked.
X#
X# example: 
X#    mkDialog .confirm  [list -text "ARE YOU SURE " ]  {"YES"  really_yes } \
X#    {NO really_no }
X#
X# NOTE: you can't just pass the message text itself, you must pass it as
X# 	-text "the message text"
X#
X
X
Xproc mkDialog {w msgArgs args} {
X    global DButton
X    catch {destroy $w}
X    toplevel $w -class Dialog
X    wm iconname $w Dialog
X
X    # Create two frames in the main window. The top frame will hold the
X    # message and the bottom one will hold the buttons.  Arrange them
X    # one above the other, with any extra vertical space split between
X    # them.
X
X    frame $w.top -relief raised -border 1
X    frame $w.bot -relief raised -border 1
X    pack append $w $w.top {top fill expand} $w.bot {top fill expand}
X    
X    # Create the message widget and arrange for it to be centered in the
X    # top frame.
X    
X    eval message $w.top.msg -width 3i -justify center \
X	    -font -*-times-medium-r-normal--*-180* $msgArgs
X    pack append $w.top $w.top.msg {top expand padx 5 pady 5}
X    
X    # Create as many buttons as needed and arrange them from left to right
X    # in the bottom frame.  Embed the left button in an additional sunken
X    # frame to indicate that it is the default button, and arrange for that
X    # button to be invoked as the default action for clicks and returns in
X    # the dialog.
X
X    if {[llength $args] > 0} {
X	set arg [lindex $args 0]
X	frame $w.bot.0 -relief sunken -border 1
X	pack append $w.bot $w.bot.0 {left expand padx 20 pady 20}
X	button $w.bot.0.button -text [lindex $arg 0] \
X		-command "[lindex $arg 1]; set DButton $w"
X	pack append $w.bot.0 $w.bot.0.button {expand padx 12 pady 12}
X	bind $w.top <Enter> "$w.bot.0.button activate"
X	bind $w.top.msg <Enter> "$w.bot.0.button activate"
X	bind $w.bot <Enter> "$w.bot.0.button activate"
X	bind $w.top <Leave> "$w.bot.0.button deactivate"
X	bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
X	bind $w.bot <Leave> "$w.bot.0.button deactivate"
X	bind $w <1> "$w.bot.0.button config -relief sunken"
X	bind $w <ButtonRelease-1> \
X		"[lindex $arg 1]; $w.bot.0.button deactivate; set DButton $w"
X	bind $w <Return> "[lindex $arg 1]; set DButton $w"
X
X	set i 1
X	foreach arg [lrange $args 1 end] {
X	    button $w.bot.$i -text [lindex $arg 0] \
X		    -command "[lindex $arg 1]; set DButton $w"
X	    pack append $w.bot $w.bot.$i {left expand padx 20}
X	    set i [expr $i+1]
X	}
X    }
X    set oldFocus [focus]
X    dialogPos $w
X#    puts stderr "waiting on DButton"
X    tkwait variable DButton
X#    puts stderr "tkwait returned"
X    destroy $w
X    focus $oldFocus
X}
X#
X#
Xproc dialogPos {w {width 200} {height 200}} {
X# get parent's location
X    wm transient $w .
X    wm deiconify $w
X#    update
X    set width [winfo reqwidth $w]
X    set height [winfo reqheight $w]
X    set swidth [winfo screenwidth $w]
X    set sheight [winfo screenheight $w]
X
X
X#    puts stderr "width=$width height = $height"
X    set pw [winfo parent $w]
X    set px [winfo rootx $pw]
X    set py [winfo rooty $pw]
X# get parent's size
X    set pwidth [winfo width $pw]
X    set pheight [winfo height $pw]
X# calculate center of parent
X#    set cx [expr {$px + ($pwidth / 2)}]
X#    set cy [expr {$py + ($pheight / 2)}]
X#    print "parent's center $cx $cy\n"
X# calculate our upper left 
X#    set x [expr {$cx - ($width  / 2)}]
X#    set y [expr {$cy - ($height / 2)}]
X    set x [expr "($swidth-$width)/2"]
X    set y [expr "($sheight-$height)/2"]
X
X#    print "our upper left $x $y"
X    
X    wm geometry $w +${x}+${y}
X    update
X# TWM seems to need this hint
X    wm positionfrom $w user
X# take the focus for ease of keyboard use
X    grab $w
X    focus $w
X#    wm group $w $pw
X}
X#--------------
X
X
X# create a simple warning dialog, that the user just
X# acknowledges
X
Xproc warnDialog {text} {
X    mkDialog .warn [list -text $text]  {OK ""} 
X}
END_OF_FILE
if test 4223 -ne `wc -c <'dialog.tk'`; then
    echo shar: \"'dialog.tk'\" unpacked with wrong size!
fi
chmod +x 'dialog.tk'
# end of 'dialog.tk'
fi
echo shar: End of shell archive.
exit 0
