entry.tcl

The BWidget Toolkit is a high-level Widget Set for Tcl/Tk built using native Tcl/Tk 8.x namespaces.

# ------------------------------------------------------------------------------
#  entry.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: entry.tcl,v 1.20 2003/11/17 20:15:59 hobbs Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Entry::create
#     - Entry::configure
#     - Entry::cget
#     - Entry::_destroy
#     - Entry::_init_drag_cmd
#     - Entry::_end_drag_cmd
#     - Entry::_drop_cmd
#     - Entry::_over_cmd
#     - Entry::_auto_scroll
#     - Entry::_scroll
# ------------------------------------------------------------------------------

namespace eval Entry {
    Widget::define Entry entry DragSite DropSite DynamicHelp

    # Note:  -textvariable is pulled off of the tk entry and put onto the
    # BW Entry so that we avoid the TkResource test for it, which screws up
    # the existance/non-existance bits of the -textvariable.
    Widget::tkinclude Entry entry :cmd \
    	remove { -state -background -foreground -textvariable
    		 -disabledforeground -disabledbackground }

    set declare [list \
	    [list -background   TkResource  ""	   0  entry] \
	    [list -foreground   TkResource  ""	   0  entry] \
	    [list -state        Enum        normal 0  [list normal disabled]] \
	    [list -text         String      ""	   0] \
	    [list -textvariable String      ""     0] \
	    [list -editable     Boolean     1      0] \
	    [list -command      String      ""     0] \
	    [list -relief       TkResource  ""     0  entry] \
	    [list -borderwidth  TkResource  ""     0  entry] \
	    [list -fg           Synonym     -foreground] \
	    [list -bg           Synonym     -background] \
	    [list -bd           Synonym     -borderwidth] \
	]

    if {![package vsatisfies [package provide Tk] 8.4]} {
	## If we're not running version 8.4 or higher, get our
	## disabled resources from the button widget.
	lappend declare [list -disabledforeground TkResource "" 0 button]
	lappend declare [list -disabledbackground TkResource "" 0 \
							{button -background}]
    } else {
	lappend declare [list -disabledforeground TkResource "" 0 entry]
	lappend declare [list -disabledbackground TkResource "" 0 entry]
    }

    Widget::declare Entry $declare
    Widget::addmap Entry "" :cmd { -textvariable {} }

    DynamicHelp::include Entry balloon
    DragSite::include    Entry "" 3
    DropSite::include    Entry {
        TEXT    {move {}}
        FGCOLOR {move {}}
        BGCOLOR {move {}}
        COLOR   {move {}}
    }

    foreach event [bind Entry] {
        bind BwEntry $event [bind Entry $event]
    }

    # Copy is kind of a special event.  It should be enabled when the
    # widget is editable but not disabled, and not when the widget is disabled.
    # To make this a bit easier to manage, we will handle it separately.

    bind BwEntry <<Copy>> {}
    bind BwEditableEntry <<Copy>> [bind Entry <<Copy>>]

    bind BwEntry <Return>          [list Entry::invoke %W]
    bind BwEntry <Destroy>         [list Entry::_destroy %W]
    bind BwDisabledEntry <Destroy> [list Entry::_destroy %W]
}


# ------------------------------------------------------------------------------
#  Command Entry::create
# ------------------------------------------------------------------------------
proc Entry::create { path args } {
    variable $path
    upvar 0 $path data

    array set maps [list Entry {} :cmd {}]
    array set maps [Widget::parseArgs Entry $args]

    set data(afterid) ""
    eval [list entry $path] $maps(:cmd)
    Widget::initFromODB Entry $path $maps(Entry)
    set state    [Widget::getMegawidgetOption $path -state]
    set editable [Widget::getMegawidgetOption $path -editable]
    set text     [Widget::getMegawidgetOption $path -text]
    if { $editable && [string equal $state "normal"] } {
        bindtags $path [list $path BwEntry [winfo toplevel $path] all]
        $path configure -takefocus 1
    } else {
        bindtags $path [list $path BwDisabledEntry [winfo toplevel $path] all]
        $path configure -takefocus 0
    }
    if { $editable == 0 } {
        $path configure -cursor left_ptr
    }
    if { [string equal $state "disabled"] } {
        $path configure \
            -foreground [Widget::getMegawidgetOption $path -disabledforeground] \
            -background [Widget::getMegawidgetOption $path -disabledbackground]
    } else {
	$path configure \
                -foreground [Widget::getMegawidgetOption $path -foreground] \
                -background [Widget::getMegawidgetOption $path -background]
                
	bindtags $path [linsert [bindtags $path] 2 BwEditableEntry] 
    }
    if { [string length $text] } {
	set varName [$path cget -textvariable]
	if { ![string equal $varName ""] } {
	    uplevel \#0 [list set $varName [Widget::cget $path -text]]
	} else {
	    set validateState [$path cget -validate]
	    $path configure -validate none
	    $path delete 0 end
	    $path configure -validate $validateState
	    $path insert 0 [Widget::getMegawidgetOption $path -text]
	}
    }	

    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd 1
    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd 1
    DynamicHelp::sethelp $path $path 1

    Widget::create Entry $path
    proc ::$path { cmd args } \
    	"return \[Entry::_path_command $path \$cmd \$args\]"
    return $path
}


# ------------------------------------------------------------------------------
#  Command Entry::configure
# ------------------------------------------------------------------------------
proc Entry::configure { path args } {
    # Cheat by setting the -text value to the current contents of the entry
    # This might be better hidden behind a function in ::Widget.
    set Widget::Entry::${path}:opt(-text) [$path:cmd get]

    set res [Widget::configure $path $args]

    # Extract the modified bits that we are interested in.
    set vars [list chstate cheditable chfg chdfg chbg chdbg chtext]
    set opts [list -state -editable -foreground -disabledforeground \
                -background -disabledbackground -text]
    foreach $vars [eval Widget::hasChangedX $path $opts] { break }

    if { $chstate || $cheditable } {
	set state [Widget::getMegawidgetOption $path -state]
	set editable [Widget::getMegawidgetOption $path -editable]
        set btags [bindtags $path]
        if { $editable && [string equal $state "normal"] } {
            set idx [lsearch $btags BwDisabledEntry]
            if { $idx != -1 } {
                bindtags $path [lreplace $btags $idx $idx BwEntry]
            }
            $path:cmd configure -takefocus 1
        } else {
            set idx [lsearch $btags BwEntry]
            if { $idx != -1 } {
                bindtags $path [lreplace $btags $idx $idx BwDisabledEntry]
            }
            $path:cmd configure -takefocus 0
            if { [string equal [focus] $path] } {
                focus .
            }
        }
    }

    if { $chstate || $chfg || $chdfg || $chbg || $chdbg } {
	set state [Widget::getMegawidgetOption $path -state]
        if { [string equal $state "disabled"] } {
            $path:cmd configure \
                -fg [Widget::cget $path -disabledforeground] \
                -bg [Widget::cget $path -disabledbackground]
        } else {
            $path:cmd configure \
                -fg [Widget::cget $path -foreground] \
                -bg [Widget::cget $path -background]
        }
    }
    if { $chstate } {
	if { [string equal $state "disabled"] } {
	    set idx [lsearch -exact [bindtags $path] BwEditableEntry]
	    if { $idx != -1 } {
		bindtags $path [lreplace [bindtags $path] $idx $idx]
	    }
	} else {
	    set idx [expr {[lsearch [bindtags $path] Bw*Entry] + 1}]
	    bindtags $path [linsert [bindtags $path] $idx BwEditableEntry]
	}
    }

    if { $cheditable } {
        if { $editable } {
            $path:cmd configure -cursor xterm
        } else {
            $path:cmd configure -cursor left_ptr
        }
    }

    if { $chtext } {
	# Oh my lordee-ba-goordee
	# Do some magic to prevent multiple validation command firings.
	# If there is a textvariable, set that to the right value; if not,
	# disable validation, delete the old text, enable, then set the text.
	set varName [$path:cmd cget -textvariable]
	if { ![string equal $varName ""] } {
	    uplevel \#0 [list set $varName \
		    [Widget::getMegawidgetOption $path -text]]
	} else {
	    set validateState [$path:cmd cget -validate]
	    $path:cmd configure -validate none
	    $path:cmd delete 0 end
	    $path:cmd configure -validate $validateState
	    $path:cmd insert 0 [Widget::getMegawidgetOption $path -text]
	}
    }

    DragSite::setdrag $path $path Entry::_init_drag_cmd Entry::_end_drag_cmd
    DropSite::setdrop $path $path Entry::_over_cmd Entry::_drop_cmd
    DynamicHelp::sethelp $path $path