Subversion Repositories or1k

"proc tkTableClipboardKeysyms {copy cut paste} {\n"
"    bind Table <$copy>	{tk_tableCopy %W}\n"
"    bind Table <$cut>	{tk_tableCut %W}\n"
"    bind Table <$paste>	{tk_tablePaste %W}\n"
"}\n"
"bind Table <3>		{\n"
"    ## You might want to check for row returned if you want to\n"
"    ## restrict the resizing of certain rows\n"
"    %W border mark %x %y\n"
"}\n"
"bind Table <B3-Motion>	{ %W border dragto %x %y }\n"
"bind Table <1> {\n"
"    if {[winfo exists %W]} {\n"
"	tkTableBeginSelect %W [%W index @%x,%y]\n"
"	focus %W\n"
"    }\n"
"}\n"
"bind Table <B1-Motion> {\n"
"    array set tkPriv {x %x y %y}\n"
"    tkTableMotion %W [%W index @%x,%y]\n"
"}\n"
"bind Table <Double-1> {\n"
"    # empty\n"
"}\n"
"bind Table <ButtonRelease-1> {\n"
"    if {[winfo exists %W]} {\n"
"	tkCancelRepeat\n"
"	%W activate @%x,%y\n"
"    }\n"
"}\n"
"bind Table <Shift-1>	{tkTableBeginExtend %W [%W index @%x,%y]}\n"
"bind Table <Control-1>	{tkTableBeginToggle %W [%W index @%x,%y]}\n"
"bind Table <B1-Enter>	{tkCancelRepeat}\n"
"bind Table <B1-Leave>	{\n"
"    array set tkPriv {x %x y %y}\n"
"    tkTableAutoScan %W\n"
"}\n"
"bind Table <2> {\n"
"    %W scan mark %x %y\n"
"    array set tkPriv {x %x y %y}\n"
"    set tkPriv(mouseMoved) 0\n"
"}\n"
"bind Table <B2-Motion> {\n"
"    if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} { set tkPriv(mouseMoved) 1 }\n"
"    if $tkPriv(mouseMoved) { %W scan dragto %x %y }\n"
"}\n"
"bind Table <ButtonRelease-2> {\n"
"    if {!$tkPriv(mouseMoved)} { tk_tablePaste %W [%W index @%x,%y] }\n"
"}\n"
"if {[string comp {} [info command event]]} {\n"
"    tkTableClipboardKeysyms <Copy> <Cut> <Paste>\n"
"} else {\n"
"    tkTableClipboardKeysyms Control-c Control-x Control-v\n"
"}\n"
"bind Table <Any-Tab> {\n"
"    # empty to allow Tk focus movement\n"
"}\n"
"bind Table <FocusOut> {\n"
"    catch {%W activate active}\n"
"}\n"
"bind Table <Shift-Up>		{tkTableExtendSelect %W -1  0}\n"
"bind Table <Shift-Down>		{tkTableExtendSelect %W  1  0}\n"
"bind Table <Shift-Left>		{tkTableExtendSelect %W  0 -1}\n"
"bind Table <Shift-Right>	{tkTableExtendSelect %W  0  1}\n"
"bind Table <Prior>		{%W yview scroll -1 pages; %W activate @0,0}\n"
"bind Table <Next>		{%W yview scroll  1 pages; %W activate @0,0}\n"
"bind Table <Control-Prior>	{%W xview scroll -1 pages}\n"
"bind Table <Control-Next>	{%W xview scroll  1 pages}\n"
"bind Table <Home>		{%W see origin}\n"
"bind Table <End>		{%W see end}\n"
"bind Table <Control-Home> {\n"
"    %W selection clear all\n"
"    %W activate origin\n"
"    %W selection set active\n"
"    %W see active\n"
"}\n"
"bind Table <Control-End> {\n"
"    %W selection clear all\n"
"    %W activate end\n"
"    %W selection set active\n"
"    %W see active\n"
"}\n"
"bind Table <Shift-Control-Home>	{tkTableDataExtend %W origin}\n"
"bind Table <Shift-Control-End>	{tkTableDataExtend %W end}\n"
"bind Table <Select>		{tkTableBeginSelect %W [%W index active]}\n"
"bind Table <Shift-Select>	{tkTableBeginExtend %W [%W index active]}\n"
"bind Table <Control-slash>	{tkTableSelectAll %W}\n"
"bind Table <Control-backslash> {\n"
"    if {[string match browse [%W cget -selectmode]]} {%W selection clear all}\n"
"}\n"
"bind Table <Up>			{tkTableMoveCell %W -1  0}\n"
"bind Table <Down>		{tkTableMoveCell %W  1  0}\n"
"bind Table <Left>		{tkTableMoveCell %W  0 -1}\n"
"bind Table <Right>		{tkTableMoveCell %W  0  1}\n"
"bind Table <Any-KeyPress> {\n"
"    if {[string compare {} %A]} { %W insert active insert %A }\n"
"}\n"
"bind Table <BackSpace> {\n"
"    set tkPriv(junk) [%W icursor]\n"
"    if {[string compare {} $tkPriv(junk)] && $tkPriv(junk)} {\n"
"	%W delete active [expr {$tkPriv(junk)-1}]\n"
"    }\n"
"}\n"
"bind Table <Delete>		{%W delete active insert}\n"
"bind Table <Escape>		{%W reread}\n"
"bind Table <Return> {\n"
"    %W insert active insert \"\n\"\n"
"}\n"
"bind Table <Control-Left>	{%W icursor [expr {[%W icursor]-1}]}\n"
"bind Table <Control-Right>	{%W icursor [expr {[%W icursor]+1}]}\n"
"bind Table <Control-e>		{%W icursor end}\n"
"bind Table <Control-a>		{%W icursor 0}\n"
"bind Table <Control-k>		{%W delete active insert end}\n"
"bind Table <Control-equal>	{tkTableChangeWidth %W active  1}\n"
"bind Table <Control-minus>	{tkTableChangeWidth %W active -1}\n"
"proc tkTableBeginSelect {w el} {\n"
"    global tkPriv\n"
"    if {[scan $el %d,%d r c] != 2} return\n"
"    switch [$w cget -selectmode] {\n"
"	multiple {\n"
"	    if {[$w tag includes title $el]} {\n"
"		## in the title area\n"
"		if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {\n"
"		    ## We're in a column header\n"
"		    if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {\n"
"			## We're in the topleft title area\n"
"			set inc topleft\n"
"			set el2 end\n"
"		    } else {\n"
"			set inc [$w index topleft row],$c\n"
"			set el2 [$w index end row],$c\n"
"		    }\n"
"		} else {\n"
"		    ## We're in a row header\n"
"		    set inc $r,[$w index topleft col]\n"
"		    set el2 $r,[$w index end col]\n"
"		}\n"
"	    } else {\n"
"		set inc $el\n"
"		set el2 $el\n"
"	    }\n"
"	    if [$w selection includes $inc] {\n"
"		$w selection clear $el $el2\n"
"	    } else {\n"
"		$w selection set $el $el2\n"
"	    }\n"
"	}\n"
"	extended {\n"
"	    $w selection clear all\n"
"	    if {[$w tag includes title $el]} {\n"
"		if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {\n"
"		    ## We're in a column header\n"
"		    if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {\n"
"			$w selection set origin end\n"
"		    } else {\n"
"			$w selection set $el [$w index end row],$c\n"
"		    }\n"
"		} else {\n"
"		    ## We're in a row header\n"
"		    $w selection set $el $r,[$w index end col]\n"
"		}\n"
"	    } else {\n"
"		$w selection set $el\n"
"	    }\n"
"	    $w selection anchor $el\n"
"	    set tkPriv(tablePrev) $el\n"
"	}\n"
"	default {\n"
"	    if {![$w tag includes title $el]} {\n"
"		$w selection clear all\n"
"		$w selection set $el\n"
"		set tkPriv(tablePrev) $el\n"
"	    }\n"
"	    $w selection anchor $el\n"
"	}\n"
"    }\n"
"}\n"
"proc tkTableMotion {w el} {\n"
"    global tkPriv\n"
"    if {![info exists tkPriv(tablePrev)]} {\n"
"	set tkPriv(tablePrev) $el\n"
"	return\n"
"    }\n"
"    if {[string match $tkPriv(tablePrev) $el]} return\n"
"    switch [$w cget -selectmode] {\n"
"	browse {\n"
"	    $w selection clear all\n"
"	    $w selection set $el\n"
"	    set tkPriv(tablePrev) $el\n"
"	}\n"
"	extended {\n"
"	    scan $tkPriv(tablePrev) %d,%d r c\n"
"	    scan $el %d,%d elr elc\n"
"	    if {[$w tag includes title $el]} {\n"
"		if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {\n"
"		    ## We're in a column header\n"
"		    if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {\n"
"			## We're in the topleft title area\n"
"			$w selection clear anchor end\n"
"		    } else {\n"
"			$w selection clear anchor [$w index end row],$c\n"
"		    }\n"
"		    $w selection set anchor [$w index end row],$elc\n"
"		} else {\n"
"		    ## We're in a row header\n"
"		    $w selection clear anchor $r,[$w index end col]\n"
"		    $w selection set anchor $elr,[$w index end col]\n"
"		}\n"
"	    } else {\n"
"		$w selection clear anchor $tkPriv(tablePrev)\n"
"		$w selection set anchor $el\n"
"	    }\n"
"	    set tkPriv(tablePrev) $el\n"
"	}\n"
"    }\n"
"}\n"
"proc tkTableBeginExtend {w el} {\n"
"    if {[string match extended [$w cget -selectmode]] &&\n"
"	[$w selection includes anchor]} {\n"
"	tkTableMotion $w $el\n"
"    }\n"
"}\n"
"proc tkTableBeginToggle {w el} {\n"
"    global tkPriv\n"
"    if {[string match extended [$w cget -selectmode]]} {\n"
"	set tkPriv(tablePrev) $el\n"
"	$w selection anchor $el\n"
"	if [$w selection includes $el] {\n"
"	    $w selection clear $el\n"
"	} else {\n"
"	    $w selection set $el\n"
"	}\n"
"    }\n"
"}\n"
"proc tkTableAutoScan {w} {\n"
"    global tkPriv\n"
"    if {![winfo exists $w]} return\n"
"    set x $tkPriv(x)\n"
"    set y $tkPriv(y)\n"
"    if {$y >= [winfo height $w]} {\n"
"	$w yview scroll 1 units\n"
"    } elseif {$y < 0} {\n"
"	$w yview scroll -1 units\n"
"    } elseif {$x >= [winfo width $w]} {\n"
"	$w xview scroll 1 units\n"
"    } elseif {$x < 0} {\n"
"	$w xview scroll -1 units\n"
"    } else {\n"
"	return\n"
"    }\n"
"    tkTableMotion $w [$w index @$x,$y]\n"
"    set tkPriv(afterId) [after 50 tkTableAutoScan $w]\n"
"}\n"
"proc tkTableMoveCell {w x y} {\n"
"    global tkPriv\n"
"    if {[catch {$w index active row} r]} return\n"
"    set c [$w index active col]\n"
"    $w activate [incr r $x],[incr c $y]\n"
"    $w see active\n"
"    switch [$w cget -selectmode] {\n"
"	browse {\n"
"	    $w selection clear all\n"
"	    $w selection set active\n"
"	}\n"
"	extended {\n"
"	    $w selection clear all\n"
"	    $w selection set active\n"
"	    $w selection anchor active\n"
"	    set tkPriv(tablePrev) [$w index active]\n"
"	}\n"
"    }\n"
"}\n"
"proc tkTableExtendSelect {w x y} {\n"
"    if {[string compare extended [$w cget -selectmode]] ||\n"
"	[catch {$w index active row} r]} return\n"
"    set c [$w index active col]\n"
"    $w activate [incr r $x],[incr c $y]\n"
"    $w see active\n"
"    tkTableMotion $w [$w index active]\n"
"}\n"
"proc tkTableDataExtend {w el} {\n"
"    set mode [$w cget -selectmode]\n"
"    if {[string match extended $mode]} {\n"
"	$w activate $el\n"
"	$w see $el\n"
"	if [$w selection includes anchor] {tkTableMotion $w $el}\n"
"    } elseif {[string match multiple $mode]} {\n"
"	$w activate $el\n"
"	$w see $el\n"
"    }\n"
"}\n"
"proc tkTableSelectAll {w} {\n"
"    if {[regexp {^(single|browse)$} [$w cget -selectmode]]} {\n"
"	$w selection clear all\n"
"	$w selection set active\n"
"	tkTableHandleType $w [$w index active]\n"
"    } else {\n"
"	$w selection set origin end\n"
"    }\n"
"}\n"
"proc tkTableChangeWidth {w i a} {\n"
"    set tmp [$w index $i col]\n"
"    if {[set width [$w width $tmp]] >= 0} {\n"
"	$w width $tmp [incr width $a]\n"
"    } else {\n"
"	$w width $tmp [incr width -$a]\n"
"    }\n"
"}\n"
"proc tk_tableCopy w {\n"
"    if {[selection own -displayof $w] == \"$w\"} {\n"
"	clipboard clear -displayof $w\n"
"	catch {clipboard append -displayof $w [selection get -displayof $w]}\n"
"    }\n"
"}\n"
"proc tk_tableCut w {\n"
"    if {[selection own -displayof $w] == \"$w\"} {\n"
"	clipboard clear -displayof $w\n"
"	catch {\n"
"	    clipboard append -displayof $w [selection get -displayof $w]\n"
"	    $w cursel set {}\n"
"	    $w selection clear all\n"
"	}\n"
"    }\n"
"}\n"
"proc tk_tablePaste {w {cell {}}} {\n"
"    if {[string compare {} $cell]} {\n"
"	if {[catch {selection get -displayof $w} data]} return\n"
"    } else {\n"
"	if {[catch {selection get -displayof $w -selection CLIPBOARD} data]} {\n"
"	    return\n"
"	}\n"
"	set cell active\n"
"    }\n"
"    tk_tablePasteHandler $w [$w index $cell] $data\n"
"    if {[$w cget -state] == \"normal\"} {focus $w}\n"
"}\n"
"proc tk_tablePasteHandler {w cell data} {\n"
"    set rows	[expr {[$w cget -rows]-[$w cget -roworigin]}]\n"
"    set cols	[expr {[$w cget -cols]-[$w cget -colorigin]}]\n"
"    set r	[$w index $cell row]\n"
"    set c	[$w index $cell col]\n"
"    set rsep	[$w cget -rowseparator]\n"
"    set csep	[$w cget -colseparator]\n"
"    ## Assume separate rows are split by row separator if specified\n"
"    ## If you were to want multi-character row separators, you would need:\n"
"    # regsub -all $rsep $data <newline> data\n"
"    # set data [join $data <newline>]\n"
"    if {[string comp {} $rsep]} { set data [split $data $rsep] }\n"
"    set row	$r\n"
"    foreach line $data {\n"
"	if {$row > $rows} break\n"
"	set col	$c\n"
"	## Assume separate cols are split by col separator if specified\n"
"	## Unless a -separator was specified\n"
"	if {[string comp {} $csep]} { set line [split $line $csep] }\n"
"	## If you were to want multi-character col separators, you would need:\n"
"	# regsub -all $csep $line <newline> line\n"
"	# set line [join $line <newline>]\n"
"	foreach item $line {\n"
"	    if {$col > $cols} break\n"
"	    $w set $row,$col $item\n"
"	    incr col\n"
"	}\n"
"	incr row\n"
"    }\n"
"}\n"