entry.tcl

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

    return $res
}


# ------------------------------------------------------------------------------
#  Command Entry::cget
# ------------------------------------------------------------------------------
proc Entry::cget { path option } {
    if { [string equal "-text" $option] } {
	return [$path:cmd get]
    }
    Widget::cget $path $option
}


# ------------------------------------------------------------------------------
#  Command Entry::invoke
# ------------------------------------------------------------------------------
proc Entry::invoke { path } {
    if { [set cmd [Widget::getMegawidgetOption $path -command]] != "" } {
        uplevel \#0 $cmd
    }
}


# ------------------------------------------------------------------------------
#  Command Entry::_path_command
# ------------------------------------------------------------------------------
proc Entry::_path_command { path cmd larg } {
    if {[string equal $cmd "configure"] || [string equal $cmd "cget"]} {
        return [eval [list Entry::$cmd $path] $larg]
    } else {
        return [eval [list $path:cmd $cmd] $larg]
    }
}


# ------------------------------------------------------------------------------
#  Command Entry::_init_drag_cmd
# ------------------------------------------------------------------------------
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]
            }
        }
    }
}


# ------------------------------------------------------------------------------
#  Command Entry::_end_drag_cmd
# ------------------------------------------------------------------------------
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)
    }
}


# ------------------------------------------------------------------------------
#  Command Entry::_drop_cmd
# ------------------------------------------------------------------------------
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
}


# ------------------------------------------------------------------------------
#  Command Entry::_over_cmd
# ------------------------------------------------------------------------------
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 equal $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 equal $type "COLOR"]   ||
         [string equal $type "FGCOLOR"] ||
         [string equal $type "BGCOLOR"] } {
        DropSite::setcursor based_arrow_down
        return 1
    }
    if { [Widget::getoption $path -editable]
	&& [string equal [Widget::getoption $path -state] "normal"] } {
        if { ![string equal $event "leave"] } {
            $path:cmd selection clear
            $path:cmd icursor @$x
            DropSite::setcursor based_arrow_down
            return 3
        }
    }
    DropSite::setcursor dot
    return 0
}


# ------------------------------------------------------------------------------
#  Command Entry::_auto_scroll
# ------------------------------------------------------------------------------
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
}


# ------------------------------------------------------------------------------
#  Command Entry::_scroll
# ------------------------------------------------------------------------------
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
    }
}


# ------------------------------------------------------------------------------
#  Command Entry::_destroy
# ------------------------------------------------------------------------------
proc Entry::_destroy { path } {
    variable $path
    upvar 0 $path data
    Widget::destroy $path
    unset data
}