# table.tcl --
#
# Version align with tkTable 2.7, jeff.hobbs@acm.org
# This file defines the default bindings for Tk table widgets
# and provides procedures that help in implementing those bindings.
#

#--------------------------------------------------------------------------
# ::tk::table::Priv elements used in this file:
#
# x && y -		Coords in widget
# afterId -		Token returned by "after" for autoscanning.
# tablePrev -		The last element to be selected or deselected
#			during a selection operation.
# mouseMoved -		Boolean to indicate whether mouse moved while
#			the button was pressed.
#--------------------------------------------------------------------------

namespace eval ::tk::table {
    # Ensure that a namespace is created for us
    variable Priv
    array set Priv { x 0 y 0 afterId {} mouseMoved 0 }
}

# ::tk::table::ClipboardKeysyms --
# This procedure is invoked to identify the keys that correspond to
# the "copy", "cut", and "paste" functions for the clipboard.
#
# Arguments:
# copy -	Name of the key (keysym name plus modifiers, if any,
#		such as "Meta-y") used for the copy operation.
# cut -		Name of the key used for the cut operation.
# paste -	Name of the key used for the paste operation.

proc ::tk::table::ClipboardKeysyms {copy cut paste} {
    bind Table <$copy>	{tk_tableCopy %W}
    bind Table <$cut>	{tk_tableCut %W}
    bind Table <$paste>	{tk_tablePaste %W}
}
::tk::table::ClipboardKeysyms <Copy> <Cut> <Paste>

## Interactive cell resizing, affected by -resizeborders option
##
bind Table <3>		{
    ## You might want to check for cell returned if you want to
    ## restrict the resizing of certain cells
    %W border mark %x %y
}
bind Table <B3-Motion>	{ %W border dragto %x %y }

## Button events

bind Table <1> {
    if {[winfo exists %W]} {
	::tk::table::BeginSelect %W [%W index @%x,%y]
	focus %W
    }
    array set ::tk::table::Priv {x %x y %y}
    set ::tk::table::Priv(mouseMoved) 0
}
bind Table <B1-Motion> {
    # If we already had motion, or we moved more than 1 pixel,
    # then we start the Motion routine
    if {
	$::tk::table::Priv(mouseMoved)
	|| abs(%x-$::tk::table::Priv(x)) > 1
	|| abs(%y-$::tk::table::Priv(y)) > 1
    } {
	set ::tk::table::Priv(mouseMoved) 1
    }
    if {$::tk::table::Priv(mouseMoved)} {
	::tk::table::Motion %W [%W index @%x,%y]
    }
}
bind Table <Double-1> {
    # empty
}
bind Table <ButtonRelease-1> {
    if {[winfo exists %W]} {
	::tk::table::CancelRepeat
	%W activate @%x,%y
    }
}

bind Table <Shift-1>	{::tk::table::BeginExtend %W [%W index @%x,%y]}
bind Table <Control-1>	{::tk::table::BeginToggle %W [%W index @%x,%y]}
bind Table <B1-Enter>	{::tk::table::CancelRepeat}
bind Table <B1-Leave>	{
    array set ::tk::table::Priv {x %x y %y}
    ::tk::table::AutoScan %W
}
bind Table <2> {
    %W scan mark %x %y
    array set ::tk::table::Priv {x %x y %y}
    set ::tk::table::Priv(mouseMoved) 0
}
bind Table <B2-Motion> {
    if {(%x != $::tk::table::Priv(x)) || (%y != $::tk::table::Priv(y))} {
	set ::tk::table::Priv(mouseMoved) 1
    }
    if {$::tk::table::Priv(mouseMoved)} { %W scan dragto %x %y }
}
bind Table <ButtonRelease-2> {
    if {!$::tk::table::Priv(mouseMoved)} { tk_tablePaste %W [%W index @%x,%y] }
}

## Key events

# This forces a cell commit if an active cell exists
bind Table <<Table_Commit>> {
    catch {%W activate active}
}
# Remove this if you don't want cell commit to occur on every
# Leave of the table.  Another possible choice is <FocusOut>.
event add <<Table_Commit>> <Leave>

bind Table <Shift-Up>		{::tk::table::ExtendSelect %W -1  0}
bind Table <Shift-Down>		{::tk::table::ExtendSelect %W  1  0}
bind Table <Shift-Left>		{::tk::table::ExtendSelect %W  0 -1}
bind Table <Shift-Right>	{::tk::table::ExtendSelect %W  0  1}
bind Table <Prior>		{%W yview scroll -1 pages; %W activate @0,0}
bind Table <Next>		{%W yview scroll  1 pages; %W activate @0,0}
bind Table <Control-Prior>	{%W xview scroll -1 pages}
bind Table <Control-Next>	{%W xview scroll  1 pages}
bind Table <Home>		{%W see origin}
bind Table <End>		{%W see end}
bind Table <Control-Home> {
    %W selection clear all
    %W activate origin
    %W selection set active
    %W see active
}
bind Table <Control-End> {
    %W selection clear all
    %W activate end
    %W selection set active
    %W see active
}
bind Table <Shift-Control-Home>	{::tk::table::DataExtend %W origin}
bind Table <Shift-Control-End>	{::tk::table::DataExtend %W end}
bind Table <Select>		{::tk::table::BeginSelect %W [%W index active]}
bind Table <Shift-Select>	{::tk::table::BeginExtend %W [%W index active]}
bind Table <Control-slash>	{::tk::table::SelectAll %W}
bind Table <Control-backslash> {
    if {[string match browse [%W cget -selectmode]]} {%W selection clear all}
}
bind Table <Up>			{::tk::table::MoveCell %W -1  0}
bind Table <Down>		{::tk::table::MoveCell %W  1  0}
bind Table <Left>		{::tk::table::MoveCell %W  0 -1}
bind Table <Right>		{::tk::table::MoveCell %W  0  1}
bind Table <KeyPress>		{::tk::table::Insert %W %A}
bind Table <BackSpace>		{::tk::table::BackSpace %W}
bind Table <Delete>		{%W delete active insert}
bind Table <Escape>		{%W reread}

#bind Table <Return>		{::tk::table::MoveCell %W 1 0}
bind Table <Return>		{::tk::table::Insert %W "\n"}

bind Table <Control-Left>	{%W icursor [expr {[%W icursor]-1}]}
bind Table <Control-Right>	{%W icursor [expr {[%W icursor]+1}]}
bind Table <Control-e>		{%W icursor end}
bind Table <Control-a>		{%W icursor 0}
bind Table <Control-k>		{%W delete active insert end}
bind Table <Control-equal>	{::tk::table::ChangeWidth %W active  1}
bind Table <Control-minus>	{::tk::table::ChangeWidth %W active -1}

# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
# Otherwise, if a widget binding for one of these is defined, the
# <KeyPress> class binding will also fire and insert the character,
# which is wrong.  Ditto for Tab.

bind Table <Alt-KeyPress>	{# nothing}
bind Table <Meta-KeyPress>	{# nothing}
bind Table <Control-KeyPress>	{# nothing}
bind Table <Any-Tab>		{# nothing}
if {[string match "macintosh" $tcl_platform(platform)]} {
    bind Table <Command-KeyPress> {# nothing}
}

# ::tk::table::GetSelection --
#   This tries to obtain the default selection.  On Unix, we first try
#   and get a UTF8_STRING, a type supported by modern Unix apps for
#   passing Unicode data safely.  We fall back on the default STRING
#   type otherwise.  On Windows, only the STRING type is necessary.
# Arguments:
#   w	The widget for which the selection will be retrieved.
#	Important for the -displayof property.
#   sel	The source of the selection (PRIMARY or CLIPBOARD)
# Results:
#   Returns the selection, or an error if none could be found
#
if {[string compare $tcl_platform(platform) "unix"] == 0} {
    proc ::tk::table::GetSelection {w {sel PRIMARY}} {
	if {[catch {selection get -displayof $w -selection $sel \
		-type UTF8_STRING} txt] \
		&& [catch {selection get -displayof $w -selection $sel} txt]} {
	    return -code error "could not find default selection"
	} else {
	    return $txt
	}
    }
} else {
    proc ::tk::table::GetSelection {w {sel PRIMARY}} {
	if {[catch {selection get -displayof $w -selection $sel} txt]} {
	    return -code error "could not find default selection"
	} else {
	    return $txt
	}
    }
}

# ::tk::table::CancelRepeat --
# A copy of tkCancelRepeat, just in case it's not available or changes.
# This procedure is invoked to cancel an auto-repeat action described
# by ::tk::table::Priv(afterId).  It's used by several widgets to auto-scroll
# the widget when the mouse is dragged out of the widget with a
# button pressed.
#
# Arguments:
# None.

proc ::tk::table::CancelRepeat {} {
    variable Priv
    after cancel $Priv(afterId)
    set Priv(afterId) {}
}

# ::tk::table::Insert --
#
#   Insert into the active cell
#
# Arguments:
#   w	- the table widget
#   s	- the string to insert
# Results:
#   Returns nothing
#
proc ::tk::table::Insert {w s} {
    if {[string compare $s {}]} {
	$w insert active insert $s
    }
}

# ::tk::table::BackSpace --
#
#   BackSpace in the current cell
#
# Arguments:
#   w	- the table widget
# Results:
#   Returns nothing
#
proc ::tk::table::BackSpace {w} {
    set cur [$w icursor]
    if {[string compare {} $cur] && $cur} {
	$w delete active [expr {$cur-1}]
    }
}

# ::tk::table::BeginSelect --
#
# This procedure is typically invoked on button-1 presses. It begins
# the process of making a selection in the table. Its exact behavior
# depends on the selection mode currently in effect for the table;
# see the Motif documentation for details.
#
# Arguments:
# w	- The table widget.
# el	- The element for the selection operation (typically the
#	one under the pointer).  Must be in row,col form.

proc ::tk::table::BeginSelect {w el} {
    variable Priv
    if {[scan $el %d,%d r c] != 2} return
    switch [$w cget -selectmode] {
	multiple {
	    if {[$w tag includes title $el]} {
		## in the title area
		if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
		    ## We're in a column header
		    if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
			## We're in the topleft title area
			set inc topleft
			set el2 end
		    } else {
			set inc [$w index topleft row],$c
			set el2 [$w index end row],$c
		    }
		} else {
		    ## We're in a row header
		    set inc $r,[$w index topleft col]
		    set el2 $r,[$w index end col]
		}
	    } else {
		set inc $el
		set el2 $el
	    }
	    if {[$w selection includes $inc]} {
		$w selection clear $el $el2
	    } else {
		$w selection set $el $el2
	    }
	}
	extended {
	    $w selection clear all
	    if {[$w tag includes title $el]} {
		if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
		    ## We're in a column header
		    if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
			## We're in the topleft title area
			$w selection set $el end
		    } else {
			$w selection set $el [$w index end row],$c
		    }
		} else {
		    ## We're in a row header
		    $w selection set $el $r,[$w index end col]
		}
	    } else {
		$w selection set $el
	    }
	    $w selection anchor $el
	    set Priv(tablePrev) $el
	}
	default {
	    if {![$w tag includes title $el]} {
		$w selection clear all
		$w selection set $el
		set Priv(tablePrev) $el
	    }
	    $w selection anchor $el
	}
    }
}

# ::tk::table::Motion --
#
# This procedure is called to process mouse motion events while
# button 1 is down. It may move or extend the selection, depending
# on the table's selection mode.
#
# Arguments:
# w	- The table widget.
# el	- The element under the pointer (must be in row,col form).

proc ::tk::table::Motion {w el} {
    variable Priv
    if {![info exists Priv(tablePrev)]} {
	set Priv(tablePrev) $el
	return
    }
    if {[string match $Priv(tablePrev) $el]} return
    switch [$w cget -selectmode] {
	browse {
	    $w selection clear all
	    $w selection set $el
	    set Priv(tablePrev) $el
	}
	extended {
	    scan $Priv(tablePrev) %d,%d r c
	    scan $el %d,%d elr elc
	    if {[$w tag includes title $el]} {
		if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
		    ## We're in a column header
		    if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
			## We're in the topleft title area
			$w selection clear anchor end
		    } else {
			$w selection clear anchor [$w index end row],$c
		    }
		    $w selection set anchor [$w index end row],$elc
		} else {
		    ## We're in a row header
		    $w selection clear anchor $r,[$w index end col]
		    $w selection set anchor $elr,[$w index end col]
		}
	    } else {
		$w selection clear anchor $Priv(tablePrev)
		$w selection set anchor $el
	    }
	    set Priv(tablePrev) $el
	}
    }
}

# ::tk::table::BeginExtend --
#
# This procedure is typically invoked on shift-button-1 presses. It
# begins the process of extending a selection in the table. Its
# exact behavior depends on the selection mode currently in effect
# for the table; see the Motif documentation for details.
#
# Arguments:
# w - The table widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.

proc ::tk::table::BeginExtend {w el} {
    if {[string match extended [$w cget -selectmode]] &&
	[$w selection includes anchor]} {
	::tk::table::Motion $w $el
    }
}

# ::tk::table::BeginToggle --
#
# This procedure is typically invoked on control-button-1 presses. It
# begins the process of toggling a selection in the table. Its
# exact behavior depends on the selection mode currently in effect
# for the table; see the Motif documentation for details.
#
# Arguments:
# w - The table widget.
# el - The element for the selection operation (typically the
# one under the pointer). Must be in numerical form.

proc ::tk::table::BeginToggle {w el} {
    if {[string match extended [$w cget -selectmode]]} {
	variable Priv
	set Priv(tablePrev) $el
	$w selection anchor $el
	if {[$w tag includes title $el]} {
	    scan $el %d,%d r c
	    if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
		## We're in a column header
		if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
		    ## We're in the topleft title area
		    set end end
		} else {
		    set end [$w index end row],$c
		}
	    } else {
		## We're in a row header
		set end $r,[$w index end col]
	    }
	} else {
	    ## We're in a non-title cell
	    set end $el
	}
	if {[$w selection includes  $end]} {
	    $w selection clear $el $end
	} else {
	    $w selection set   $el $end
        }
    }
}

# ::tk::table::AutoScan --
# This procedure is invoked when the mouse leaves an table window
# with button 1 down. It scrolls the window up, down, left, or
# right, depending on where the mouse left the window, and reschedules
# itself as an "after" command so that the window continues to scroll until
# the mouse moves back into the window or the mouse button is released.
#
# Arguments:
# w - The table window.

proc ::tk::table::AutoScan {w} {
    if {![winfo exists $w]} return
    variable Priv
    set x $Priv(x)
    set y $Priv(y)
    if {$y >= [winfo height $w]} {
	$w yview scroll 1 units
    } elseif {$y < 0} {
	$w yview scroll -1 units
    } elseif {$x >= [winfo width $w]} {
	$w xview scroll 1 units
    } elseif {$x < 0} {
	$w xview scroll -1 units
    } else {
	return
    }
    ::tk::table::Motion $w [$w index @$x,$y]
    set Priv(afterId) [after 50 ::tk::table::AutoScan $w]
}

# ::tk::table::MoveCell --
#
# Moves the location cursor (active element) by the specified number
# of cells and changes the selection if we're in browse or extended
# selection mode.  If the new cell is "hidden", we skip to the next
# visible cell if possible, otherwise just abort.
#
# Arguments:
# w - The table widget.
# x - +1 to move down one cell, -1 to move up one cell.
# y - +1 to move right one cell, -1 to move left one cell.

proc ::tk::table::MoveCell {w x y} {
    if {[catch {$w index active row} r]} return
    set c [$w index active col]
    set cell [$w index [incr r $x],[incr c $y]]
    while {[string compare [set true [$w hidden $cell]] {}]} {
	# The cell is in some way hidden
	if {[string compare $true [$w index active]]} {
	    # The span cell wasn't the previous cell, so go to that
	    set cell $true
	    break
	}
	if {$x > 0} {incr r} elseif {$x < 0} {incr r -1}
	if {$y > 0} {incr c} elseif {$y < 0} {incr c -1}
	if {[string compare $cell [$w index $r,$c]]} {
	    set cell [$w index $r,$c]
	} else {
	    # We couldn't find a non-hidden cell, just don't move
	    return
	}
    }
    $w activate $cell
    $w see active
    switch [$w cget -selectmode] {
	browse {
	    $w selection clear all
	    $w selection set active
	}
	extended {
	    variable Priv
	    $w selection clear all
	    $w selection set active
	    $w selection anchor active
	    set Priv(tablePrev) [$w index active]
	}
    }
}

# ::tk::table::ExtendSelect --
#
# Does nothing unless we're in extended selection mode; in this
# case it moves the location cursor (active element) by the specified
# number of cells, and extends the selection to that point.
#
# Arguments:
# w - The table widget.
# x - +1 to move down one cell, -1 to move up one cell.
# y - +1 to move right one cell, -1 to move left one cell.

proc ::tk::table::ExtendSelect {w x y} {
    if {[string compare extended [$w cget -selectmode]] ||
	[catch {$w index active row} r]} return
    set c [$w index active col]
    $w activate [incr r $x],[incr c $y]
    $w see active
    ::tk::table::Motion $w [$w index active]
}

# ::tk::table::DataExtend
#
# This procedure is called for key-presses such as Shift-KEndData.
# If the selection mode isnt multiple or extend then it does nothing.
# Otherwise it moves the active element to el and, if we're in
# extended mode, extends the selection to that point.
#
# Arguments:
# w - The table widget.
# el - An integer cell number.

proc ::tk::table::DataExtend {w el} {
    set mode [$w cget -selectmode]
    if {[string match extended $mode]} {
	$w activate $el
	$w see $el
	if {[$w selection includes anchor]} {::tk::table::Motion $w $el}
    } elseif {[string match multiple $mode]} {
	$w activate $el
	$w see $el
    }
}

# ::tk::table::SelectAll
#
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
#
# Arguments:
# w - The table widget.

proc ::tk::table::SelectAll {w} {
    if {[regexp {^(single|browse)$} [$w cget -selectmode]]} {
	$w selection clear all
	$w selection set active
	::tk::table::HandleType $w [$w index active]
    } elseif {[$w cget -selecttitles]} {
	$w selection set [$w cget -roworigin],[$w cget -colorigin] end
    } else {
	$w selection set origin end
    }
}

# ::tk::table::ChangeWidth --
# Adjust the widget of the specified cell by $a.
#
# Arguments:
# w - The table widget.
# i - cell index
# a - amount to adjust by

proc ::tk::table::ChangeWidth {w i a} {
    set tmp [$w index $i col]
    if {[set width [$w width $tmp]] >= 0} {
	$w width $tmp [incr width $a]
    } else {
	$w width $tmp [incr width [expr {-$a}]]
    }
}

# tk_tableCopy --
# This procedure copies the selection from a table widget into the
# clipboard.
#
# Arguments:
# w -		Name of a table widget.

proc tk_tableCopy w {
    if {[selection own -displayof $w] == "$w"} {
	clipboard clear -displayof $w
	catch {clipboard append -displayof $w [::tk::table::GetSelection $w]}
    }
}

# tk_tableCut --
# This procedure copies the selection from a table widget into the
# clipboard, then deletes the selection (if it exists in the given
# widget).
#
# Arguments:
# w -		Name of a table widget.

proc tk_tableCut w {
    if {[selection own -displayof $w] == "$w"} {
	clipboard clear -displayof $w
	catch {
	    clipboard append -displayof $w [::tk::table::GetSelection $w]
	    $w cursel {}
	    $w selection clear all
	}
    }
}

# tk_tablePaste --
# This procedure pastes the contents of the clipboard to the specified
# cell (active by default) in a table widget.
#
# Arguments:
# w -		Name of a table widget.
# cell -	Cell to start pasting in.

proc tk_tablePaste {w {cell {}}} {
    if {[string compare {} $cell]} {
	if {[catch {::tk::table::GetSelection $w} data]} return
    } else {
	if {[catch {::tk::table::GetSelection $w CLIPBOARD} data]} {
	    return
	}
	set cell active
    }
    tk_tablePasteHandler $w [$w index $cell] $data
    if {[$w cget -state] == "normal"} {focus $w}
}

# tk_tablePasteHandler --
# This procedure handles how data is pasted into the table widget.
# This handles data in the default table selection form.
# NOTE: this allows pasting into all cells, even those with -state disabled
#
# Arguments:
# w -		Name of a table widget.
# cell -	Cell to start pasting in.

proc tk_tablePasteHandler {w cell data} {
    set rows	[expr {[$w cget -rows]-[$w cget -roworigin]}]
    set cols	[expr {[$w cget -cols]-[$w cget -colorigin]}]
    set r	[$w index $cell row]
    set c	[$w index $cell col]
    set rsep	[$w cget -rowseparator]
    set csep	[$w cget -colseparator]
    ## Assume separate rows are split by row separator if specified
    ## If you were to want multi-character row separators, you would need:
    # regsub -all $rsep $data <newline> data
    # set data [join $data <newline>]
    if {[string comp {} $rsep]} { set data [split $data $rsep] }
    set row	$r
    foreach line $data {
	if {$row > $rows} break
	set col	$c
	## Assume separate cols are split by col separator if specified
	## Unless a -separator was specified
	if {[string comp {} $csep]} { set line [split $line $csep] }
	## If you were to want multi-character col separators, you would need:
	# regsub -all $csep $line <newline> line
	# set line [join $line <newline>]
	foreach item $line {
	    if {$col > $cols} break
	    $w set $row,$col $item
	    incr col
	}
	incr row
    }
}
