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

 #
 # Regexpfield
 # ----------------------------------------------------------------------
 # Implements a text entry widget which accepts input that matches its
 # regular expression, and invalidates input which doesn't.
 #
 #
 # ----------------------------------------------------------------------
 #   AUTHOR:  John A. Tucker           E-mail: jatucker@austin.dsccc.com
 #
 # ----------------------------------------------------------------------
 #            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 Regexpfield {
     keep -background -borderwidth -cursor -foreground -highlightcolor \
 	 -highlightthickness -insertbackground -insertborderwidth \
 	 -insertofftime -insertontime -insertwidth -labelfont \
 	 -selectbackground -selectborderwidth -selectforeground \
 	 -textbackground -textfont
 }

 # ------------------------------------------------------------------
 #                            ENTRYFIELD
 # ------------------------------------------------------------------
 itcl::class iwidgets::Regexpfield {
     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 -regexp regexp Regexp {.*}
     itk_option define -nocase nocase Nocase 0

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

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

     private {
 	method _peek {char}
     }
 }

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

 # ------------------------------------------------------------------
 #                        CONSTRUCTOR
 # ------------------------------------------------------------------
 itcl::body iwidgets::Regexpfield::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)

     #
     # Regexpfield 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::Regexpfield::command {}

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

 # ------------------------------------------------------------------
 # OPTION: -regexp
 #
 # Specify a regular expression to use in performing validation
 # of the content of the entry widget.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Regexpfield::regexp {
 }

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

 # ------------------------------------------------------------------
 # 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::Regexpfield::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::Regexpfield::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"
 	}
     }
 }
 # ------------------------------------------------------------------
 # OPTION: -nocase
 #
 # Specifies whether or not lowercase characters can match either
 # lowercase or uppercase letters in string.
 # ------------------------------------------------------------------
 itcl::configbody iwidgets::Regexpfield::nocase {

     switch $itk_option(-nocase) {
 	0 - 1 {

 	}

 	default {
 	    error "bad nocase option \"$itk_option(-nocase)\":\
 		    should be 0 or 1"
 	}
     }
 }

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

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

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

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

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

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

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

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

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

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

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

 # ------------------------------------------------------------------
 # PRIVATE METHOD: _peek char
 #
 # The peek procedure returns the value of the Regexpfield with the
 # char inserted at the insert position.
 # ------------------------------------------------------------------
 itcl::body iwidgets::Regexpfield::_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]

     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::Regexpfield::_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::Regexpfield::_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.
     #
     if {($char == "") || \
 	    ($state == 4) || ($state == 8) || \
 	    ($state == 36) || ($state == 40)} {
 	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
 	}
     }

     set flags ""

     #
     # Get the new value of the Regexpfield with the char inserted at the
     # insert position.
     #
     # If the new value doesn't match up with the pattern stored in the
     # -regexp option, then the invalid procedure is called.
     #
     # If the value of the "-nocase" option is true, then add the
     # "-nocase" flag to the list of flags.
     #
     set newVal [_peek $char]

     if {$itk_option(-nocase)} {
 	set valid [::regexp -nocase -- $itk_option(-regexp) $newVal]
     } else {
 	set valid [::regexp $itk_option(-regexp) $newVal]
     }

     if {!$valid} {
 	uplevel #0 $itk_option(-invalid)
 	return -code break 0
     }

     return -code continue 1
 }
	#
	# Regexpfield
	# ----------------------------------------------------------------------
	# Implements a text entry widget which accepts input that matches its
	# regular expression, and invalidates input which doesn't.
	#
	#
	# ----------------------------------------------------------------------
	# AUTHOR: John A. Tucker E-mail: jatucker@austin.dsccc.com
	#
	# ----------------------------------------------------------------------
	# 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 Regexpfield {
	keep -background -borderwidth -cursor -foreground -highlightcolor \
	-highlightthickness -insertbackground -insertborderwidth \
	-insertofftime -insertontime -insertwidth -labelfont \
	-selectbackground -selectborderwidth -selectforeground \
	-textbackground -textfont
	}

	# ------------------------------------------------------------------
	# ENTRYFIELD
	# ------------------------------------------------------------------
	itcl::class iwidgets::Regexpfield {
	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 -regexp regexp Regexp {.*}
	itk_option define -nocase nocase Nocase 0

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

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

	private {
	method _peek {char}
	}
	}

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

	# ------------------------------------------------------------------
	# CONSTRUCTOR
	# ------------------------------------------------------------------
	itcl::body iwidgets::Regexpfield::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)

	#
	# Regexpfield 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::Regexpfield::command {}

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

	# ------------------------------------------------------------------
	# OPTION: -regexp
	#
	# Specify a regular expression to use in performing validation
	# of the content of the entry widget.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Regexpfield::regexp {
	}

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

	# ------------------------------------------------------------------
	# 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::Regexpfield::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::Regexpfield::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"
	}
	}
	}
	# ------------------------------------------------------------------
	# OPTION: -nocase
	#
	# Specifies whether or not lowercase characters can match either
	# lowercase or uppercase letters in string.
	# ------------------------------------------------------------------
	itcl::configbody iwidgets::Regexpfield::nocase {

	switch $itk_option(-nocase) {
	0 - 1 {

	}

	default {
	error "bad nocase option \"$itk_option(-nocase)\":\
	should be 0 or 1"
	}
	}
	}

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

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

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

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

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

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

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

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

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

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

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

	# ------------------------------------------------------------------
	# PRIVATE METHOD: _peek char
	#
	# The peek procedure returns the value of the Regexpfield with the
	# char inserted at the insert position.
	# ------------------------------------------------------------------
	itcl::body iwidgets::Regexpfield::_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]

	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::Regexpfield::_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::Regexpfield::_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.
	#
	if {($char == "") \|\| \
	($state == 4) \|\| ($state == 8) \|\| \
	($state == 36) \|\| ($state == 40)} {
	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
	}
	}

	set flags ""

	#
	# Get the new value of the Regexpfield with the char inserted at the
	# insert position.
	#
	# If the new value doesn't match up with the pattern stored in the
	# -regexp option, then the invalid procedure is called.
	#
	# If the value of the "-nocase" option is true, then add the
	# "-nocase" flag to the list of flags.
	#
	set newVal [_peek $char]

	if {$itk_option(-nocase)} {
	set valid [::regexp -nocase -- $itk_option(-regexp) $newVal]
	} else {
	set valid [::regexp $itk_option(-regexp) $newVal]
	}

	if {!$valid} {
	uplevel #0 $itk_option(-invalid)
	return -code break 0
	}

	return -code continue 1
	}