entry.tcl

entry.tcl
This file is part of Unifix BWidget Toolkit
$Id: entry.tcl,v 1.16 2001/06/11 23:58:40 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


Entry
Comments  
Arguments  
Used by  
Uses  
namespace eval Entry {

    # 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.
    set remove  [list -state -cursor -foreground -textvariable]
    set declare [list \
        [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 vcompare [package provide Tk] 8.4] >= 0} {
    #
    #   Tk 8.4 added -disabledforeground and -disabledbackground
    #   resources to the entry widget, but the BWidget Entry
    #   handles the 'disabled' state in a different way.
    #
    lappend remove -disabledforeground -disabledbackground
    lappend declare \
        [list -disabledforeground    TkResource    ""    0 entry]
    } else {
    lappend declare \
        [list -disabledforeground    TkResource    ""    0 button]
    }

    Widget::tkinclude Entry entry :cmd remove $remove
    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>  {Entry::invoke %W}
    bind BwEntry <Destroy> {Entry::_destroy %W}
    bind BwDisabledEntry <Destroy> {Entry::_destroy %W}

    interp alias {} ::Entry {} ::Entry::create
    proc use {} {}
}


Entry::_auto_scroll
Comments Command Entry::_auto_scroll
Arguments path
x
Used by  
Uses DropSite::setcursor
proc Entry::_auto_scroll { path x } {
    variable $path
    upvar 0  $path data

    set xmax [winfo width $path]
    if { $x <= 10 && [$path:cmd index @0] > 0 } {
        if { $data(afterid) == "" } {
            set data(afterid) [after 100 "Entry::_scroll $path -1 $x $xmax"]
            DropSite::setcursor sb_left_arrow
        }
        return 1
    } else {
        if { $x >= $xmax-10 && [$path:cmd index @$xmax] < [$path:cmd index end] } {
            if { $data(afterid) == "" } {
                set data(afterid) [after 100 "Entry::_scroll $path 1 $x $xmax"]
                DropSite::setcursor sb_right_arrow
            }
            return 1
        } else {
            if { $data(afterid) != "" } {
                after cancel $data(afterid)
                set data(afterid) ""
            }
        }
    }
    return 0
}


Entry::_destroy
Comments Command Entry::_destroy
Arguments path
Used by  
Uses Widget::destroy
proc Entry::_destroy { path } {
    variable $path
    upvar 0 $path data

    Widget::destroy $path
    rename $path {}
    unset data
}


Entry::_drop_cmd
Comments Command Entry::_drop_cmd
Arguments path
source
X
Y
op
type
dnddata
Used by Entry::create
Entry::configure
Uses Widget::getoption
proc Entry::_drop_cmd { path source X Y op type dnddata } {
    variable $path
    upvar 0  $path data

    if { $data(afterid) != "" } {
        after cancel $data(afterid)
        set data(afterid) ""
    }
    if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
        set idx [$path:cmd index @[expr {$X-[winfo rootx $path]}]]
        return [uplevel \#0 $cmd [list $path $source $idx $op $type $dnddata]]
    }
    if { $type == "COLOR" || $type == "FGCOLOR" } {
        configure $path -foreground $dnddata
    } elseif { $type == "BGCOLOR" } {
        configure $path -background $dnddata
    } else {
        $path:cmd icursor @[expr {$X-[winfo rootx $path]}]
        if { $op == "move" && $path == $source } {
            $path:cmd delete $data(dragstart) $data(dragend)
        }
        set sel0 [$path index insert]
        $path:cmd insert insert $dnddata
        set sel1 [$path index insert]
        $path:cmd selection range $sel0 $sel1
    }
    return 1
}


Entry::_end_drag_cmd
Comments Command Entry::_end_drag_cmd
Arguments path
target
op
type
dnddata
result
Used by Entry::configure
Entry::create
Uses Widget::getoption
proc Entry::_end_drag_cmd { path target op type dnddata result } {
    variable $path
    upvar 0  $path data

    if { [set cmd [Widget::getoption $path -dragendcmd]] != "" } {
        return [uplevel \#0 $cmd [list $path $target $op $type $dnddata $result]]
    }
    if { $result && $op == "move" && $path != $target } {
        $path:cmd delete $data(dragstart) $data(dragend)
    }
}


Entry::_init_drag_cmd
Comments Command Entry::_init_drag_cmd
Arguments path
X
Y
top
Used by Entry::create
Entry::configure
Uses Widget::getoption
proc Entry::_init_drag_cmd { path X Y top } {
    variable $path
    upvar 0  $path data

    if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
        return [uplevel \#0 $cmd [list $path $X $Y $top]]
    }
    set type [Widget::getoption $path -dragtype]
    if { $type == "" } {
        set type "TEXT"
    }
    if { [set drag [$path get]] != "" } {
        if { [$path:cmd selection present] } {
            set idx  [$path:cmd index @[expr {$X-[winfo rootx $path]}]]
            set sel0 [$path:cmd index sel.first]
            set sel1 [expr {[$path:cmd index sel.last]-1}]
            if { $idx >=  $sel0 && $idx <= $sel1 } {
                set drag [string range $drag $sel0 $sel1]
                set data(dragstart) $sel0
                set data(dragend)   [expr {$sel1+1}]
                if { ![Widget::getoption $path -editable] ||
                     [Widget::getoption $path -state] == "disabled" } {
                    return [list $type {copy} $drag]
                } else {
                    return [list $type {copy move} $drag]
                }
            }
        } else {
            set data(dragstart) 0
            set data(dragend)   end
            if { ![Widget::getoption $path -editable] ||
                 [Widget::getoption $path -state] == "disabled" } {
                return [list $type {copy} $drag]
            } else {
                return [list $type {copy move} $drag]
            }
        }
    }
}


Entry::_over_cmd
Comments Command Entry::_over_cmd
Arguments path
source
event
X
Y
op
type
dnddata
Used by Entry::configure
Entry::create
Uses DropSite::setcursor
Widget::getoption
proc Entry::_over_cmd { path source event X Y op type dnddata } {
    variable $path
    upvar 0  $path data

    set x [expr {$X-[winfo rootx $path]}]
    if { ![string compare $event "leave"] } {
        if { [string length $data(afterid)] } {
            after cancel $data(afterid)
            set data(afterid) ""
        }
    } elseif { [_auto_scroll $path $x] } {
        return 2
    }

    if { [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
        set x   [expr {$X-[winfo rootx $path]}]
        set idx [$path:cmd index @$x]
        set res [uplevel \#0 $cmd [list $path $source $event $idx $op $type $dnddata]]
        return $res
    }

    if { ![string compare $type "COLOR"]   ||
         ![string compare $type "FGCOLOR"] ||
         ![string compare $type "BGCOLOR"] } {
        DropSite::setcursor based_arrow_down
        return 1
    }
    if { [Widget::getoption $path -editable] && ![string compare [Widget::getoption $path -state] "normal"] } {
        if { [string compare $event "leave"] } {
            $path:cmd selection clear
            $path:cmd icursor @$x
            DropSite::setcursor based_arrow_down
            return 3
        }
    }
    DropSite::setcursor dot
    return 0
}


Entry::_path_command
Comments Command Entry::_path_command
Arguments path
cmd
larg
Used by Entry::create
Uses  
proc Entry::_path_command { path cmd larg } {
    if { ![string compare $cmd "configure"] || ![string compare $cmd "cget"] } {
        return [eval Entry::$cmd $path $larg]
    } else {
        return [eval $path:cmd $cmd $larg]
    }
}


Entry::_scroll
Comments Command Entry::_scroll
Arguments path
dir
x
xmax
Used by  
Uses DropSite::setcursor
proc Entry::_scroll { path dir x xmax } {
    variable $path
    upvar 0  $path data

    $path:cmd xview scroll $dir units
    $path:cmd icursor @$x
    if { ($dir == -1 && [$path:cmd index @0] > 0) ||
         ($dir == 1  && [$path:cmd index @$xmax] < [$path:cmd index end]) } {
        set data(afterid) [after 100 "Entry::_scroll $path $dir $x $xmax"]
    } else {
        set data(afterid) ""
        DropSite::setcursor dot
    }
}


Entry::cget
Comments Command Entry::cget
Arguments path
option
Used by ComboBox::setvalue
SpinBox::create
ComboBox::_focus_in
SpinBox::getvalue
ComboBox::_mapliste
SpinBox::setvalue
ComboBox::getvalue
Uses Widget::cget
proc Entry::cget { path option } {
    if { [string equal "-text" $option] } {
    return [$path:cmd get]
    }
    Widget::cget $path $option
}


Entry::configure
Comments Command Entry::configure
Arguments path
args
Used by SpinBox::setvalue
ComboBox::setvalue
ComboBox::create
SpinBox::create
ComboBox::configure
Uses Entry::_init_drag_cmd
Entry::_end_drag_cmd
DragSite::setdrag
Widget::configure
Entry::_over_cmd
Widget::hasChangedX
Widget::getMegawidgetOption
DynamicHelp::sethelp
Widget::cget
DropSite::setdrop
Entry::_drop_cmd
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.
    foreach {chstate cheditable chfg chdfg chtext} [Widget::hasChangedX $path \
        -state -editable -foreground -disabledforeground -text] break

    if { $chstate || $cheditable } {
    set state [Widget::getMegawidgetOption $path -state]
    set editable [Widget::getMegawidgetOption $path -editable]
        set btags [bindtags $path]
        if { $editable && ![string compare $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 compare [focus] $path] } {
                focus .
            }
        }
    }

    if { $chstate || $chfg || $chdfg } {
    set state [Widget::getMegawidgetOption $path -state]
        if { ![string compare $state "disabled"] } {
        set dfg [Widget::cget $path -disabledforeground]
            $path:cmd configure -fg $dfg
        } else {
        set fg [Widget::cget $path -foreground]
            $path:cmd configure -fg $fg
        }
    }
    if { $chstate } {
    if { ![string compare $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

    return $res
}


Entry::create
Comments Command Entry::create
Arguments path
args
Used by LabelEntry::create
ComboBox::create
SpinBox::create
Uses Entry::_drop_cmd
Entry::_init_drag_cmd
DynamicHelp::sethelp
Entry::_path_command
DragSite::setdrag
Widget::parseArgs
Widget::getMegawidgetOption
DropSite::setdrop
Widget::initFromODB
Entry::_over_cmd
Widget::cget
Entry::_end_drag_cmd
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 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 compare $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 compare $state "disabled"] } {
        $path configure -foreground \
        [Widget::getMegawidgetOption $path -disabledforeground]
    } else {
    $path configure -foreground \
        [Widget::getMegawidgetOption $path -foreground]
    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

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

    return $path
}


Entry::invoke
Comments Command Entry::invoke
Arguments path
Used by  
Uses Widget::getMegawidgetOption
proc Entry::invoke { path } {
    if { [set cmd [Widget::getMegawidgetOption $path -command]] != "" } {
        uplevel \#0 $cmd
    }
}
generated by zdoc.tcl on 2003-03-06 00:21:54