[Nscldaq-cvscommits] clients/slowControls/widgets tngTest.tcl, NONE, 1.1 typeNGo.tcl, 1.2, 1.3

[Ron F. <ro...@us...>]

Update of /cvsroot/nscldaq/clients/slowControls/widgets
In directory sc8-pr-cvs7.sourceforge.net:/tmp/cvs-serv32220

Modified Files:
	typeNGo.tcl 
Added Files:
	tngTest.tcl 
Log Message:
Added entry validation, and test for typengo (tngTest.tcl)



Index: typeNGo.tcl
===================================================================
RCS file: /cvsroot/nscldaq/clients/slowControls/widgets/typeNGo.tcl,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** typeNGo.tcl	18 Oct 2006 18:53:42 -0000	1.2
--- typeNGo.tcl	19 Oct 2006 11:46:42 -0000	1.3
***************
*** 23,29 ****
  # Options:
  #    All label options are delegated to the label widget.
- #    -command is delegated to the button widget
  #    -text    is delegated to the button widget.
  #
  # Methods:
  #   Get   - Gets the value of the entry widget.
--- 23,46 ----
  # Options:
  #    All label options are delegated to the label widget.
  #    -text    is delegated to the button widget.
  #
+ #    -command  provides a script that will be invoked when
+ #              the entry has been accepted and validated
+ #              (see below).
+ #    -validate provides a script to validate the entry
+ #              This script is called prior to 
+ #              invoking the -command option.
+ #              If the result of the script is 1,
+ #              The entry is assumed to be valid, and the
+ #              -command script is invoked.  If the
+ #              result of the script is 0, the entry
+ #              is assumed to be invalid and the
+ #              -command script will not be invoked.
+ # Substitutions:
+ #   For both -command and -validate the following substitutions
+ #   are defined:
+ #    %W   - The widget id
+ #    %V   - The contents of the entry widget.
+ #
  # Methods:
  #   Get   - Gets the value of the entry widget.
***************
*** 43,54 ****
  
  snit::widget controlwidget::typeNGo {
-     delegate option -command to button
      delegate option -text    to button
      delegate option -label   to label as -text
      delegate option  *        to label
  
      constructor args {
  	install label  as label $win.label
! 	install button as button $win.button
  	entry $win.entry
  
--- 60,73 ----
  
  snit::widget controlwidget::typeNGo {
      delegate option -text    to button
      delegate option -label   to label as -text
      delegate option  *        to label
  
+     option   -command  [list]
+     option   -validate [list]
+ 
      constructor args {
  	install label  as label $win.label
! 	install button as button $win.button -command [mymethod onClick]
  	entry $win.entry
  
***************
*** 71,75 ****
      }
      #
!     #  Set the value of the entry widget.
      #
      method Set {value} {
--- 90,94 ----
      }
      #
!     #  Set the value of the entry widget... does not commit.
      #
      method Set {value} {
***************
*** 84,86 ****
--- 103,140 ----
  	$win.button invoke;		# Fire the script.
      }
+     #
+     #   Private methods/procs
+ 
+     # onClick is invoked by the button when it is clicked
+     # or by the <Return> (which after all just invokes the button.
+     # If there is a validation script, we dispatch it
+     # and require a true result...
+     # If there is no validation script or if the validation script
+     # returned a true, then we dispatch the -command script if it's
+     # defined.
+     #  Note that the dispatch method does all substitutions.
+     #
+     method onClick {} {
+ 	set ok 1
+ 	if {$options(-validate) ne ""} {
+ 	    set ok [$self dispatch -validate]
+ 	}
+ 	if {$ok} {
+ 	    $self dispatch -command
+ 	}
+     }
+     # dispatch - dispatches a script, doing appropriate substitutions.
+     # The value of the script is returned if defined, else the return
+     # value is not well defined.
+     # 
+     #
+     method dispatch {opt} {
+ 	set script $options($opt)
+ 	if {$script ne ""} {
+ 	    set value [$self Get]
+ 	    set script [string map [list %W $win %V [list $value]] $script]
+ 	    return [eval $script]
+ 	}
+     }
+ 
  }
\ No newline at end of file

--- NEW FILE: tngTest.tcl ---
source typeNGo.tcl
set george 0

proc limit value {
    if {($value >= 0) && ($value <= 6)} {
	return 1
    }
    tk_messageBox -icon error -title {Bad value} -message {Values must be in [0,6]}
    return 0
}

proc commit {widget value} {
    global george
    set george $value
    $widget Set ""
}

controlwidget::typeNGo  .test -command [list commit %W %V] -validate [list limit %V] \
    -textvariable george -text Commit
pack .test