share/iwidgets4.0.1/scripts/entryfield.itk - toolchains/skids - Git at Google

 #
 # Entryfield
 # ----------------------------------------------------------------------
 # Implements an enhanced text entry widget.
 #
 # ----------------------------------------------------------------------
 #   AUTHOR:  Sue Yockey               E-mail: yockey@acm.org
 #            Mark L. Ulferts          E-mail: mulferts@austin.dsccc.com
 #
 #   @(#) $Id: entryfield.itk,v 1.6 2001/09/17 19:24:46 smithc Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1995 DSC Technologies Corporation
 # ======================================================================
 # Permission to use, copy, modify, distribute and license this software
 # and its documentation for any purpose, and without fee or written
 # agreement with DSC, is hereby granted, provided that the above copyright
 # notice appears in all copies and that both the copyright notice and
 # warranty disclaimer below appear in supporting documentation, and that
 # the names of DSC Technologies Corporation or DSC Communications
 # Corporation not be used in advertising or publicity pertaining to the
 # software without specific, written prior permission.
 #
 # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
 # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
 # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
 # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
 # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
 # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
 # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
 # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
 # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
 # SOFTWARE.
 # ======================================================================

 #
 # Usual options.
 #
 itk::usual Entryfield {
     keep -background -borderwidth -cursor -foreground -highlightcolor \
 	 -highlightthickness -insertbackground -insertborderwidth \
 	 -insertofftime -insertontime -insertwidth -labelfont \
 	 -selectbackground -selectborderwidth -selectforeground \
 	 -textbackground -textfont
 }

 # ------------------------------------------------------------------
 #                            ENTRYFIELD
 # ------------------------------------------------------------------
 itcl::class iwidgets::Entryfield {
     inherit iwidgets::Labeledwidget

     constructor {args} {}

     itk_option define -childsitepos childSitePos Position e
     itk_option define -command command Command {}
     itk_option define -fixed fixed Fixed 0
     itk_option define -focuscommand focusCommand Command {}
     itk_option define -invalid invalid Command {bell}
     itk_option define -pasting pasting Behavior 1
     itk_option define -validate validate Command {}

     public {
 	method childsite {}
 	method get {}
 	method delete {args}
 	method icursor {args}
 	method index {args}
 	method insert {args}
 	method scan {args}
 	method selection {args}
 	method xview {args}
 	method clear {}
     }

     proc numeric {char} {}
     proc integer {string} {}
     proc alphabetic {char} {}
     proc alphanumeric {char} {}
     proc hexidecimal {string} {}
     proc real {string} {}

     protected {
 	method _focusCommand {}
 	method _keyPress {char sym state}
     }

     private method _peek {char}
     private method _checkLength {}
 }

 #
 # Provide a lowercased access method for the Entryfield class.
 #
 proc ::iwidgets::entryfield {pathName args} {
     uplevel ::iwidgets::Entryfield $pathName $args
 }

 # ------------------------------------------------------------------
 #                        CONSTRUCTOR
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::constructor {args} {
     component hull configure -borderwidth 0

     itk_component add entry {
 	entry $itk_interior.entry
     } {
 	keep -borderwidth -cursor -exportselection \
 		-foreground -highlightcolor \
 		-highlightthickness -insertbackground -insertborderwidth \
 		-insertofftime -insertontime -insertwidth -justify \
 		-relief -selectbackground -selectborderwidth \
 		-selectforeground -show -state -textvariable -width

 	rename -font -textfont textFont Font
 	rename -highlightbackground -background background Background
 	rename -background -textbackground textBackground Background
     }

     #
     # Create the child site widget.
     #
     itk_component add -protected efchildsite {
 	frame $itk_interior.efchildsite
     }
     set itk_interior $itk_component(efchildsite)

     #
     # Entryfield instance bindings.
     #
     bind $itk_component(entry) <KeyPress> [itcl::code $this _keyPress %A %K %s]
     bind $itk_component(entry) <FocusIn> [itcl::code $this _focusCommand]

     #
     # Initialize the widget based on the command line options.
     #
     eval itk_initialize $args
 }

 # ------------------------------------------------------------------
 #                             OPTIONS
 # ------------------------------------------------------------------

 # ------------------------------------------------------------------
 # OPTION: -command
 #
 # Command associated upon detection of Return key press event
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::command {}

 # ------------------------------------------------------------------
 # OPTION: -focuscommand
 #
 # Command associated upon detection of focus.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::focuscommand {}

 # ------------------------------------------------------------------
 # OPTION: -validate
 #
 # Specify a command to executed for the validation of Entryfields.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::validate {
     switch $itk_option(-validate) {
 	{} {
 	    set itk_option(-validate) {}
 	}
 	numeric {
 	    set itk_option(-validate) "::iwidgets::Entryfield::numeric %c"
 	}
 	integer {
 	    set itk_option(-validate) "::iwidgets::Entryfield::integer %P"
 	}
 	hexidecimal {
 	    set itk_option(-validate) "::iwidgets::Entryfield::hexidecimal %P"
 	}
 	real {
 	    set itk_option(-validate) "::iwidgets::Entryfield::real %P"
 	}
 	alphabetic {
 	    set itk_option(-validate) "::iwidgets::Entryfield::alphabetic %c"
 	}
 	alphanumeric {
 	    set itk_option(-validate) "::iwidgets::Entryfield::alphanumeric %c"
 	}
     }
 }

 # ------------------------------------------------------------------
 # OPTION: -invalid
 #
 # Specify a command to executed should the current Entryfield contents
 # be proven invalid.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::invalid {}

 # ------------------------------------------------------------------
 # OPTION: -pasting
 #
 # Allows the developer to enable and disable pasting into the entry
 # component of the entryfield.  This is done to avoid potential stack
 # dumps when using the -validate configuration option.  Plus, it's just
 # a good idea to have complete control over what you allow the user
 # to enter into the entryfield.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::pasting {
   set oldtags [bindtags $itk_component(entry)]
   if {[lindex $oldtags 0] != "pastetag"} {
     bindtags $itk_component(entry) [linsert $oldtags 0 pastetag]
   }

   if ($itk_option(-pasting)) {
     bind pastetag <ButtonRelease-2> [itcl::code $this _checkLength]
     bind pastetag <Control-v> [itcl::code $this _checkLength]
     bind pastetag <Insert> [itcl::code $this _checkLength]
     bind pastetag <KeyPress> {}
   } else {
     bind pastetag <ButtonRelease-2> {break}
     bind pastetag <Control-v> {break}
     bind pastetag <Insert> {break}
     bind pastetag <KeyPress> {
       # Disable function keys > F9.
       if {[regexp {^F[1,2][0-9]+$} "%K"]} {
 	break
       }
     }
   }
 }

 # ------------------------------------------------------------------
 # OPTION: -fixed
 #
 # Restrict entry to 0 (unlimited) chars.  The value is the maximum
 # number of chars the user may type into the field, regardles of
 # field width, i.e. the field width may be 20, but the user will
 # only be able to type -fixed number of characters into it (or
 # unlimited if -fixed = 0).
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::fixed {
     if {[regexp {[^0-9]} $itk_option(-fixed)] || \
 	    ($itk_option(-fixed) < 0)} {
 	error "bad fixed option \"$itk_option(-fixed)\",\
 		should be positive integer"
     }
 }

 # ------------------------------------------------------------------
 # OPTION: -childsitepos
 #
 # Specifies the position of the child site in the widget.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Entryfield::childsitepos {
     set parent [winfo parent $itk_component(entry)]

     switch $itk_option(-childsitepos) {
 	n {
 	    grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew
 	    grid $itk_component(entry) -row 1 -column 0 -sticky nsew

 	    grid rowconfigure $parent 0 -weight 0
 	    grid rowconfigure $parent 1 -weight 1
 	    grid columnconfigure $parent 0 -weight 1
 	    grid columnconfigure $parent 1 -weight 0
 	}

 	e {
 	    grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns
 	    grid $itk_component(entry) -row 0 -column 0 -sticky nsew

 	    grid rowconfigure $parent 0 -weight 1
 	    grid rowconfigure $parent 1 -weight 0
 	    grid columnconfigure $parent 0 -weight 1
 	    grid columnconfigure $parent 1 -weight 0
 	}

 	s {
 	    grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew
 	    grid $itk_component(entry) -row 0 -column 0 -sticky nsew

 	    grid rowconfigure $parent 0 -weight 1
 	    grid rowconfigure $parent 1 -weight 0
 	    grid columnconfigure $parent 0 -weight 1
 	    grid columnconfigure $parent 1 -weight 0
 	}

 	w {
 	    grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns
 	    grid $itk_component(entry) -row 0 -column 1 -sticky nsew

 	    grid rowconfigure $parent 0 -weight 1
 	    grid rowconfigure $parent 1 -weight 0
 	    grid columnconfigure $parent 0 -weight 0
 	    grid columnconfigure $parent 1 -weight 1
 	}

 	default {
 	    error "bad childsite option\
 		    \"$itk_option(-childsitepos)\":\
 		    should be n, e, s, or w"
 	}
     }
 }

 # ------------------------------------------------------------------
 #                            METHODS
 # ------------------------------------------------------------------

 # ------------------------------------------------------------------
 # METHOD: childsite
 #
 # Returns the path name of the child site widget.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::childsite {} {
     return $itk_component(efchildsite)
 }

 # ------------------------------------------------------------------
 # METHOD: get
 #
 # Thin wrap of the standard entry widget get method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::get {} {
     return [$itk_component(entry) get]
 }

 # ------------------------------------------------------------------
 # METHOD: delete
 #
 # Thin wrap of the standard entry widget delete method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::delete {args} {
     return [eval $itk_component(entry) delete $args]
 }

 # ------------------------------------------------------------------
 # METHOD: icursor
 #
 # Thin wrap of the standard entry widget icursor method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::icursor {args} {
     return [eval $itk_component(entry) icursor $args]
 }

 # ------------------------------------------------------------------
 # METHOD: index
 #
 # Thin wrap of the standard entry widget index method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::index {args} {
     return [eval $itk_component(entry) index $args]
 }

 # ------------------------------------------------------------------
 # METHOD: insert
 #
 # Thin wrap of the standard entry widget index method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::insert {args} {
     return [eval $itk_component(entry) insert $args]
 }

 # ------------------------------------------------------------------
 # METHOD: scan
 #
 # Thin wrap of the standard entry widget scan method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::scan {args} {
     return [eval $itk_component(entry) scan $args]
 }

 # ------------------------------------------------------------------
 # METHOD: selection
 #
 # Thin wrap of the standard entry widget selection method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::selection {args} {
     return [eval $itk_component(entry) selection $args]
 }

 # ------------------------------------------------------------------
 # METHOD: xview
 #
 # Thin wrap of the standard entry widget xview method.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::xview {args} {
     return [eval $itk_component(entry) xview $args]
 }

 # ------------------------------------------------------------------
 # METHOD: clear
 #
 # Delete the current entry contents.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::clear {} {
     $itk_component(entry) delete 0 end
     icursor 0
 }

 # ------------------------------------------------------------------
 # PROCEDURE: numeric char
 #
 # The numeric procedure validates character input for a given
 # Entryfield to be numeric and returns the result.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::numeric {char} {
     return [regexp {[0-9]} $char]
 }

 # ------------------------------------------------------------------
 # PROCEDURE: integer string
 #
 # The integer procedure validates character input for a given
 # Entryfield to be integer and returns the result.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::integer {string} {
     return [regexp {^[-+]?[0-9]*$} $string]
 }

 # ------------------------------------------------------------------
 # PROCEDURE: alphabetic char
 #
 # The alphabetic procedure validates character input for a given
 # Entryfield to be alphabetic and returns the result.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::alphabetic {char} {
     return [regexp -nocase {[a-z]} $char]
 }

 # ------------------------------------------------------------------
 # PROCEDURE: alphanumeric char
 #
 # The alphanumeric procedure validates character input for a given
 # Entryfield to be alphanumeric and returns the result.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::alphanumeric {char} {
     return [regexp -nocase {[0-9a-z]} $char]
 }

 # ------------------------------------------------------------------
 # PROCEDURE: hexadecimal string
 #
 # The hexidecimal procedure validates character input for a given
 # Entryfield to be hexidecimal and returns the result.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::hexidecimal {string} {
     return [regexp {^(0x)?[0-9a-fA-F]*$} $string]
 }

 # ------------------------------------------------------------------
 # PROCEDURE: real string
 #
 # The real procedure validates character input for a given Entryfield
 # to be real and returns the result.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::real {string} {
     return [regexp {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string]
 }

 # ------------------------------------------------------------------
 # PRIVATE METHOD: _peek char
 #
 # The peek procedure returns the value of the Entryfield with the
 # char inserted at the insert position.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::_peek {char} {
     set str [get]

     set insertPos [index insert]
     set firstPart [string range $str 0 [expr {$insertPos - 1}]]
     set lastPart [string range $str $insertPos end]

     regsub -all {\\} "$char" {\\\\} char
     append rtnVal $firstPart $char $lastPart
     return $rtnVal
 }

 # ------------------------------------------------------------------
 # PROTECTED METHOD: _focusCommand
 #
 # Method bound to focus event which evaluates the current command
 # specified in the focuscommand option
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::_focusCommand {} {
     uplevel #0 $itk_option(-focuscommand)
 }

 # ------------------------------------------------------------------
 # PROTECTED METHOD: _keyPress
 #
 # Monitor the key press event checking for return keys, fixed width
 # specification, and optional validation procedures.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::_keyPress {char sym state} {
     #
     # A Return key invokes the optionally specified command option.
     #
     if {$sym == "Return"} {
 	uplevel #0 $itk_option(-command)
 	return -code break 1
     }

     #
     # Tabs, BackSpace, and Delete are passed on for other bindings.
     #
     if {($sym == "Tab") || ($sym == "BackSpace") || ($sym == "Delete")} {
 	return -code continue 1
     }

     #
     # Character is not printable or the state is greater than one which
     # means a modifier was used such as a control, meta key, or control
     # or meta key with numlock down.
     #
     #-----------------------------------------------------------
     # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/15/99
     #-----------------------------------------------------------
     # The following conditional used to hardcode specific state values, such
     # as "4" and "8".  These values are used to detect <Ctrl>, <Shift>, etc.
     # key combinations.  On the windows platform, the <Alt> key is state
     # 16, and on the unix platform, the <Alt> key is state 8.  All <Ctrl>
     # and <Alt> combinations should be masked out, regardless of the
     # <NumLock> or <CapsLock> status, and regardless of platform.
     #-----------------------------------------------------------
     set CTRL 4
     global tcl_platform
     if {$tcl_platform(platform) == "unix"} {
       set ALT 8
     } elseif {$tcl_platform(platform) == "windows"} {
       set ALT 16
     } else {
       # This is something other than UNIX or WINDOWS.  Default to the
       # old behavior (UNIX).
       set ALT 8
     }
     # Thanks to Rolf Schroedter for the following elegant conditional.  This
     # masks out all <Ctrl> and <Alt> key combinations.
     if {($char == "") || ($state & ($CTRL | $ALT))} {
       return -code continue 1
     }

     #
     # If the fixed length option is not zero, then verify that the
     # current length plus one will not exceed the limit.  If so then
     # invoke the invalid command procedure.
     #
     if {$itk_option(-fixed) != 0} {
 	if {[string length [get]] >= $itk_option(-fixed)} {
 	    uplevel #0 $itk_option(-invalid)
 	    return -code break 0
 	}
     }

     #
     # The validate option may contain a keyword (numeric, alphabetic),
     # the name of a procedure, or nothing.  The numeric and alphabetic
     # keywords engage typical base level checks.  If a command procedure
     # is specified, then invoke it with the object and character passed
     # as arguments.  If the validate procedure returns false, then the
     # invalid procedure is called.
     #
     if {$itk_option(-validate) != {}} {
 	set cmd $itk_option(-validate)

 	regsub -all "%W" "$cmd" $itk_component(hull) cmd
 	regsub -all "%P" "$cmd" [list [_peek $char]] cmd
 	regsub -all "%S" "$cmd" [list [get]] cmd
 	regsub -all "%c" "$cmd" [list $char] cmd
         regsub -all {\\} "$cmd" {\\\\} cmd

 	set valid [uplevel #0 $cmd]

 	if {($valid == "") || ([regexp 0|false|off|no $valid])} {
 	    uplevel #0 $itk_option(-invalid)
 	    return -code break 0
 	}
     }

     return -code continue 1
 }

 # ------------------------------------------------------------------
 # PRIVATE METHOD: _checkLength
 #
 # This method was added by csmith for SF ticket 227912. We need to
 # to check the clipboard content before allowing any pasting into
 # the entryfield to disallow text that is longer than the value
 # specified by the -fixed option.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Entryfield::_checkLength {} {
   if {$itk_option(-fixed) != 0} {
     if [catch {::selection get -selection CLIPBOARD} pending] {
       # Nothing in the clipboard.  Check the primary selection.
       if [catch {::selection get -selection PRIMARY} pending] {
         # Nothing here either.  Goodbye.
         return
       }
     }
     set len [expr {[string length $pending] + [string length [get]]}]
     if {$len > $itk_option(-fixed)} {
       uplevel #0 $itk_option(-invalid)
       return -code break 0
     }
   }
 }
	#
	# Entryfield
	# ----------------------------------------------------------------------
	# Implements an enhanced text entry widget.
	#
	# ----------------------------------------------------------------------
	# AUTHOR: Sue Yockey E-mail: yockey@acm.org
	# Mark L. Ulferts E-mail: mulferts@austin.dsccc.com
	#
	# @(#) $Id: entryfield.itk,v 1.6 2001/09/17 19:24:46 smithc Exp $
	# ----------------------------------------------------------------------
	# Copyright (c) 1995 DSC Technologies Corporation
	# ======================================================================
	# Permission to use, copy, modify, distribute and license this software
	# and its documentation for any purpose, and without fee or written
	# agreement with DSC, is hereby granted, provided that the above copyright
	# notice appears in all copies and that both the copyright notice and
	# warranty disclaimer below appear in supporting documentation, and that
	# the names of DSC Technologies Corporation or DSC Communications
	# Corporation not be used in advertising or publicity pertaining to the
	# software without specific, written prior permission.
	#
	# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
	# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
	# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
	# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
	# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
	# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
	# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
	# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
	# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
	# SOFTWARE.
	# ======================================================================

	#
	# Usual options.
	#
	itk::usual Entryfield {
	keep -background -borderwidth -cursor -foreground -highlightcolor \
	-highlightthickness -insertbackground -insertborderwidth \
	-insertofftime -insertontime -insertwidth -labelfont \
	-selectbackground -selectborderwidth -selectforeground \
	-textbackground -textfont
	}

	# ------------------------------------------------------------------
	# ENTRYFIELD
	# ------------------------------------------------------------------
	itcl::class iwidgets::Entryfield {
	inherit iwidgets::Labeledwidget

	constructor {args} {}

	itk_option define -childsitepos childSitePos Position e
	itk_option define -command command Command {}
	itk_option define -fixed fixed Fixed 0
	itk_option define -focuscommand focusCommand Command {}
	itk_option define -invalid invalid Command {bell}
	itk_option define -pasting pasting Behavior 1
	itk_option define -validate validate Command {}

	public {
	method childsite {}
	method get {}
	method delete {args}
	method icursor {args}
	method index {args}
	method insert {args}
	method scan {args}
	method selection {args}
	method xview {args}
	method clear {}
	}

	proc numeric {char} {}
	proc integer {string} {}
	proc alphabetic {char} {}
	proc alphanumeric {char} {}
	proc hexidecimal {string} {}
	proc real {string} {}

	protected {
	method _focusCommand {}
	method _keyPress {char sym state}
	}

	private method _peek {char}
	private method _checkLength {}
	}

	#
	# Provide a lowercased access method for the Entryfield class.
	#
	proc ::iwidgets::entryfield {pathName args} {
	uplevel ::iwidgets::Entryfield $pathName $args
	}

	# ------------------------------------------------------------------
	# CONSTRUCTOR
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::constructor {args} {
	component hull configure -borderwidth 0

	itk_component add entry {
	entry $itk_interior.entry
	} {
	keep -borderwidth -cursor -exportselection \
	-foreground -highlightcolor \
	-highlightthickness -insertbackground -insertborderwidth \
	-insertofftime -insertontime -insertwidth -justify \
	-relief -selectbackground -selectborderwidth \
	-selectforeground -show -state -textvariable -width

	rename -font -textfont textFont Font
	rename -highlightbackground -background background Background
	rename -background -textbackground textBackground Background
	}

	#
	# Create the child site widget.
	#
	itk_component add -protected efchildsite {
	frame $itk_interior.efchildsite
	}
	set itk_interior $itk_component(efchildsite)

	#
	# Entryfield instance bindings.
	#
	bind $itk_component(entry) <KeyPress> [itcl::code $this _keyPress %A %K %s]
	bind $itk_component(entry) <FocusIn> [itcl::code $this _focusCommand]

	#
	# Initialize the widget based on the command line options.
	#
	eval itk_initialize $args
	}

	# ------------------------------------------------------------------
	# OPTIONS
	# ------------------------------------------------------------------

	# ------------------------------------------------------------------
	# OPTION: -command
	#
	# Command associated upon detection of Return key press event
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::command {}

	# ------------------------------------------------------------------
	# OPTION: -focuscommand
	#
	# Command associated upon detection of focus.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::focuscommand {}

	# ------------------------------------------------------------------
	# OPTION: -validate
	#
	# Specify a command to executed for the validation of Entryfields.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::validate {
	switch $itk_option(-validate) {
	{} {
	set itk_option(-validate) {}
	}
	numeric {
	set itk_option(-validate) "::iwidgets::Entryfield::numeric %c"
	}
	integer {
	set itk_option(-validate) "::iwidgets::Entryfield::integer %P"
	}
	hexidecimal {
	set itk_option(-validate) "::iwidgets::Entryfield::hexidecimal %P"
	}
	real {
	set itk_option(-validate) "::iwidgets::Entryfield::real %P"
	}
	alphabetic {
	set itk_option(-validate) "::iwidgets::Entryfield::alphabetic %c"
	}
	alphanumeric {
	set itk_option(-validate) "::iwidgets::Entryfield::alphanumeric %c"
	}
	}
	}

	# ------------------------------------------------------------------
	# OPTION: -invalid
	#
	# Specify a command to executed should the current Entryfield contents
	# be proven invalid.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::invalid {}

	# ------------------------------------------------------------------
	# OPTION: -pasting
	#
	# Allows the developer to enable and disable pasting into the entry
	# component of the entryfield. This is done to avoid potential stack
	# dumps when using the -validate configuration option. Plus, it's just
	# a good idea to have complete control over what you allow the user
	# to enter into the entryfield.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::pasting {
	set oldtags [bindtags $itk_component(entry)]
	if {[lindex $oldtags 0] != "pastetag"} {
	bindtags $itk_component(entry) [linsert $oldtags 0 pastetag]
	}

	if ($itk_option(-pasting)) {
	bind pastetag <ButtonRelease-2> [itcl::code $this _checkLength]
	bind pastetag <Control-v> [itcl::code $this _checkLength]
	bind pastetag <Insert> [itcl::code $this _checkLength]
	bind pastetag <KeyPress> {}
	} else {
	bind pastetag <ButtonRelease-2> {break}
	bind pastetag <Control-v> {break}
	bind pastetag <Insert> {break}
	bind pastetag <KeyPress> {
	# Disable function keys > F9.
	if {[regexp {^F[1,2][0-9]+$} "%K"]} {
	break
	}
	}
	}
	}

	# ------------------------------------------------------------------
	# OPTION: -fixed
	#
	# Restrict entry to 0 (unlimited) chars. The value is the maximum
	# number of chars the user may type into the field, regardles of
	# field width, i.e. the field width may be 20, but the user will
	# only be able to type -fixed number of characters into it (or
	# unlimited if -fixed = 0).
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::fixed {
	if {[regexp {[^0-9]} $itk_option(-fixed)] \|\| \
	($itk_option(-fixed) < 0)} {
	error "bad fixed option \"$itk_option(-fixed)\",\
	should be positive integer"
	}
	}

	# ------------------------------------------------------------------
	# OPTION: -childsitepos
	#
	# Specifies the position of the child site in the widget.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Entryfield::childsitepos {
	set parent [winfo parent $itk_component(entry)]

	switch $itk_option(-childsitepos) {
	n {
	grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew
	grid $itk_component(entry) -row 1 -column 0 -sticky nsew

	grid rowconfigure $parent 0 -weight 0
	grid rowconfigure $parent 1 -weight 1
	grid columnconfigure $parent 0 -weight 1
	grid columnconfigure $parent 1 -weight 0
	}

	e {
	grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns
	grid $itk_component(entry) -row 0 -column 0 -sticky nsew

	grid rowconfigure $parent 0 -weight 1
	grid rowconfigure $parent 1 -weight 0
	grid columnconfigure $parent 0 -weight 1
	grid columnconfigure $parent 1 -weight 0
	}

	s {
	grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew
	grid $itk_component(entry) -row 0 -column 0 -sticky nsew

	grid rowconfigure $parent 0 -weight 1
	grid rowconfigure $parent 1 -weight 0
	grid columnconfigure $parent 0 -weight 1
	grid columnconfigure $parent 1 -weight 0
	}

	w {
	grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns
	grid $itk_component(entry) -row 0 -column 1 -sticky nsew

	grid rowconfigure $parent 0 -weight 1
	grid rowconfigure $parent 1 -weight 0
	grid columnconfigure $parent 0 -weight 0
	grid columnconfigure $parent 1 -weight 1
	}

	default {
	error "bad childsite option\
	\"$itk_option(-childsitepos)\":\
	should be n, e, s, or w"
	}
	}
	}

	# ------------------------------------------------------------------
	# METHODS
	# ------------------------------------------------------------------

	# ------------------------------------------------------------------
	# METHOD: childsite
	#
	# Returns the path name of the child site widget.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::childsite {} {
	return $itk_component(efchildsite)
	}

	# ------------------------------------------------------------------
	# METHOD: get
	#
	# Thin wrap of the standard entry widget get method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::get {} {
	return [$itk_component(entry) get]
	}

	# ------------------------------------------------------------------
	# METHOD: delete
	#
	# Thin wrap of the standard entry widget delete method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::delete {args} {
	return [eval $itk_component(entry) delete $args]
	}

	# ------------------------------------------------------------------
	# METHOD: icursor
	#
	# Thin wrap of the standard entry widget icursor method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::icursor {args} {
	return [eval $itk_component(entry) icursor $args]
	}

	# ------------------------------------------------------------------
	# METHOD: index
	#
	# Thin wrap of the standard entry widget index method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::index {args} {
	return [eval $itk_component(entry) index $args]
	}

	# ------------------------------------------------------------------
	# METHOD: insert
	#
	# Thin wrap of the standard entry widget index method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::insert {args} {
	return [eval $itk_component(entry) insert $args]
	}

	# ------------------------------------------------------------------
	# METHOD: scan
	#
	# Thin wrap of the standard entry widget scan method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::scan {args} {
	return [eval $itk_component(entry) scan $args]
	}

	# ------------------------------------------------------------------
	# METHOD: selection
	#
	# Thin wrap of the standard entry widget selection method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::selection {args} {
	return [eval $itk_component(entry) selection $args]
	}

	# ------------------------------------------------------------------
	# METHOD: xview
	#
	# Thin wrap of the standard entry widget xview method.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::xview {args} {
	return [eval $itk_component(entry) xview $args]
	}

	# ------------------------------------------------------------------
	# METHOD: clear
	#
	# Delete the current entry contents.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::clear {} {
	$itk_component(entry) delete 0 end
	icursor 0
	}

	# ------------------------------------------------------------------
	# PROCEDURE: numeric char
	#
	# The numeric procedure validates character input for a given
	# Entryfield to be numeric and returns the result.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::numeric {char} {
	return [regexp {[0-9]} $char]
	}

	# ------------------------------------------------------------------
	# PROCEDURE: integer string
	#
	# The integer procedure validates character input for a given
	# Entryfield to be integer and returns the result.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::integer {string} {
	return [regexp {^[-+]?[0-9]*$} $string]
	}

	# ------------------------------------------------------------------
	# PROCEDURE: alphabetic char
	#
	# The alphabetic procedure validates character input for a given
	# Entryfield to be alphabetic and returns the result.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::alphabetic {char} {
	return [regexp -nocase {[a-z]} $char]
	}

	# ------------------------------------------------------------------
	# PROCEDURE: alphanumeric char
	#
	# The alphanumeric procedure validates character input for a given
	# Entryfield to be alphanumeric and returns the result.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::alphanumeric {char} {
	return [regexp -nocase {[0-9a-z]} $char]
	}

	# ------------------------------------------------------------------
	# PROCEDURE: hexadecimal string
	#
	# The hexidecimal procedure validates character input for a given
	# Entryfield to be hexidecimal and returns the result.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::hexidecimal {string} {
	return [regexp {^(0x)?[0-9a-fA-F]*$} $string]
	}

	# ------------------------------------------------------------------
	# PROCEDURE: real string
	#
	# The real procedure validates character input for a given Entryfield
	# to be real and returns the result.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::real {string} {
	return [regexp {^[-+]?[0-9]\.?[0-9]([0-9]\.?[eE][-+]?[0-9]*)?$} $string]
	}

	# ------------------------------------------------------------------
	# PRIVATE METHOD: _peek char
	#
	# The peek procedure returns the value of the Entryfield with the
	# char inserted at the insert position.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::_peek {char} {
	set str [get]

	set insertPos [index insert]
	set firstPart [string range $str 0 [expr {$insertPos - 1}]]
	set lastPart [string range $str $insertPos end]

	regsub -all {\\} "$char" {\\\\} char
	append rtnVal $firstPart $char $lastPart
	return $rtnVal
	}

	# ------------------------------------------------------------------
	# PROTECTED METHOD: _focusCommand
	#
	# Method bound to focus event which evaluates the current command
	# specified in the focuscommand option
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::_focusCommand {} {
	uplevel #0 $itk_option(-focuscommand)
	}

	# ------------------------------------------------------------------
	# PROTECTED METHOD: _keyPress
	#
	# Monitor the key press event checking for return keys, fixed width
	# specification, and optional validation procedures.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::_keyPress {char sym state} {
	#
	# A Return key invokes the optionally specified command option.
	#
	if {$sym == "Return"} {
	uplevel #0 $itk_option(-command)
	return -code break 1
	}

	#
	# Tabs, BackSpace, and Delete are passed on for other bindings.
	#
	if {($sym == "Tab") \|\| ($sym == "BackSpace") \|\| ($sym == "Delete")} {
	return -code continue 1
	}

	#
	# Character is not printable or the state is greater than one which
	# means a modifier was used such as a control, meta key, or control
	# or meta key with numlock down.
	#
	#-----------------------------------------------------------
	# BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/15/99
	#-----------------------------------------------------------
	# The following conditional used to hardcode specific state values, such
	# as "4" and "8". These values are used to detect <Ctrl>, <Shift>, etc.
	# key combinations. On the windows platform, the <Alt> key is state
	# 16, and on the unix platform, the <Alt> key is state 8. All <Ctrl>
	# and <Alt> combinations should be masked out, regardless of the
	# <NumLock> or <CapsLock> status, and regardless of platform.
	#-----------------------------------------------------------
	set CTRL 4
	global tcl_platform
	if {$tcl_platform(platform) == "unix"} {
	set ALT 8
	} elseif {$tcl_platform(platform) == "windows"} {
	set ALT 16
	} else {
	# This is something other than UNIX or WINDOWS. Default to the
	# old behavior (UNIX).
	set ALT 8
	}
	# Thanks to Rolf Schroedter for the following elegant conditional. This
	# masks out all <Ctrl> and <Alt> key combinations.
	if {($char == "") \|\| ($state & ($CTRL \| $ALT))} {
	return -code continue 1
	}

	#
	# If the fixed length option is not zero, then verify that the
	# current length plus one will not exceed the limit. If so then
	# invoke the invalid command procedure.
	#
	if {$itk_option(-fixed) != 0} {
	if {[string length [get]] >= $itk_option(-fixed)} {
	uplevel #0 $itk_option(-invalid)
	return -code break 0
	}
	}

	#
	# The validate option may contain a keyword (numeric, alphabetic),
	# the name of a procedure, or nothing. The numeric and alphabetic
	# keywords engage typical base level checks. If a command procedure
	# is specified, then invoke it with the object and character passed
	# as arguments. If the validate procedure returns false, then the
	# invalid procedure is called.
	#
	if {$itk_option(-validate) != {}} {
	set cmd $itk_option(-validate)

	regsub -all "%W" "$cmd" $itk_component(hull) cmd
	regsub -all "%P" "$cmd" [list [_peek $char]] cmd
	regsub -all "%S" "$cmd" [list [get]] cmd
	regsub -all "%c" "$cmd" [list $char] cmd
	regsub -all {\\} "$cmd" {\\\\} cmd

	set valid [uplevel #0 $cmd]

	if {($valid == "") \|\| ([regexp 0\|false\|off\|no $valid])} {
	uplevel #0 $itk_option(-invalid)
	return -code break 0
	}
	}

	return -code continue 1
	}

	# ------------------------------------------------------------------
	# PRIVATE METHOD: _checkLength
	#
	# This method was added by csmith for SF ticket 227912. We need to
	# to check the clipboard content before allowing any pasting into
	# the entryfield to disallow text that is longer than the value
	# specified by the -fixed option.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Entryfield::_checkLength {} {
	if {$itk_option(-fixed) != 0} {
	if [catch {::selection get -selection CLIPBOARD} pending] {
	# Nothing in the clipboard. Check the primary selection.
	if [catch {::selection get -selection PRIMARY} pending] {
	# Nothing here either. Goodbye.
	return
	}
	}
	set len [expr {[string length $pending] + [string length [get]]}]
	if {$len > $itk_option(-fixed)} {
	uplevel #0 $itk_option(-invalid)
	return -code break 0
	}
	}
	}