entryfield.itk

windows下的GDB insight前端

#
# Entryfield
# ----------------------------------------------------------------------
# Implements an enhanced text entry widget.
#
# ----------------------------------------------------------------------
#   AUTHOR:  Sue Yockey               E-mail: [e-mail]
#            Mark L. Ulferts          E-mail: [e-mail]
#
#   @(#) $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"
	}
    }
}