Revision: 41797 http://brlcad.svn.sourceforge.net/brlcad/?rev=41797&view=rev Author: bob1961 Date: 2010-12-23 21:30:45 +0000 (Thu, 23 Dec 2010)
Log Message: ----------- Added more windows and emacs style bindings for cell editing and traversal. Modified Paths: -------------- brlcad/trunk/src/tclscripts/lib/TkTable.tcl Modified: brlcad/trunk/src/tclscripts/lib/TkTable.tcl =================================================================== --- brlcad/trunk/src/tclscripts/lib/TkTable.tcl 2010-12-23 19:28:26 UTC (rev 41796) +++ brlcad/trunk/src/tclscripts/lib/TkTable.tcl 2010-12-23 21:30:45 UTC (rev 41797) @@ -35,6 +35,7 @@ itk_option define -vclientdata vclientdata VClientData "" public { + method handlePaste {} method setDataEntry {_index _val} method setTableCol {_col _val} method setTableVal {_index _val} @@ -54,10 +55,12 @@ variable mDoBreak 0 method doBreak {} + method handleCopy {_win} + method handleCut {_win} method handleKey {_win _key} method handleLeftRight {_win _sflag} method handleTablePopup {_win _x _y _X _Y} - method handleUpDown {_win _key} + method handleUpDown {_win _up} method keyVisible {_key} method setInsertMode {_imode} method toggleSelect {_win _x _y} @@ -96,19 +99,24 @@ keep -anchor -autoclear -background -bordercursor -borderwidth \ -browsecommand -cache -colorigin -colseparator \ -colstretchmode -coltagcommand -colwidth -command -cursor -drawmode \ - -ellipsis -exportselection -flashmode -flashtime -font -foreground \ + -ellipsis -flashmode -flashtime -font -foreground \ -height -highlightbackground -highlightcolor -highlightthickness \ -insertbackground -insertborderwidth -insertofftime -insertontime \ -insertwidth -invertselected -ipadx -ipady -justify -maxheight \ -maxwidth -multiline -padx -pady -relief -resizeborders -rowheight \ -roworigin -rows -rowseparator -rowstretchmode -rowtagcommand \ - -selectioncommand -selectmode -selecttitles -selecttype -sparsearray \ + -selectioncommand \ -takefocus -usecommand -validate \ -width -wrap } # Hide these options from users of TkTable #-cols +#-exportselection +#-selecttitles +#-selectmode +#-selecttype +#-sparsearray #-state #-titlecols #-titlerows @@ -161,17 +169,29 @@ bind $itk_component(table) <Key-Right> "[::itcl::code $this handleLeftRight %W 0]; break" bind $itk_component(table) <Control-Key-Left> {%W icursor [expr {[%W icursor]-1}]; break} bind $itk_component(table) <Control-Key-Right> {%W icursor [expr {[%W icursor]+1}]; break} - bind $itk_component(table) <Key-Up> "[::itcl::code $this handleUpDown %W %K]; break" - bind $itk_component(table) <Key-Down> "[::itcl::code $this handleUpDown %W %K]; break" + bind $itk_component(table) <Key-Up> "[::itcl::code $this handleUpDown %W 1]; break" + bind $itk_component(table) <Key-Down> "[::itcl::code $this handleUpDown %W 0]; break" + bind $itk_component(table) <Control-b> {%W icursor [expr {[%W icursor]-1}]; break} + bind $itk_component(table) <Control-c> [::itcl::code $this handleCopy %W] + bind $itk_component(table) <Control-d> {%W delete active insert; break} + bind $itk_component(table) <Control-f> {%W icursor [expr {[%W icursor]+1}]; break} + bind $itk_component(table) <Control-i> [::itcl::code $this setInsertMode 1] + bind $itk_component(table) <Control-k> "[::itcl::code $this handleCut %W]; break" + bind $itk_component(table) <Control-n> "[::itcl::code $this handleUpDown %W 0]; break" + bind $itk_component(table) <Control-p> "[::itcl::code $this handleUpDown %W 1]; break" + bind $itk_component(table) <Control-v> "[::itcl::code $this handlePaste]; break" + bind $itk_component(table) <Control-y> "[::itcl::code $this handlePaste]; break" + bind $itk_component(table) <Control-Key> "\# nothing; break" + bind $itk_component(table) <Key-Insert> [::itcl::code $this setInsertMode 1] + set bg [$itk_component(table) tag cget title -background] -# $itk_component(table) tag col select_col 0 $itk_component(table) tag configure select_col \ -background \#9999ff + $itk_component(table) tag raise select_col $itk_component(table) tag col title 0 $itk_component(table) tag configure title \ -relief raised - $itk_component(table) tag raise select_col eval itk_initialize $args set mNumRows [$itk_component(table) cget -rows] @@ -182,6 +202,57 @@ # PUBLIC METHODS # ------------------------------------------------------------ +::itcl::body cadwidgets::TkTable::handlePaste {} { + # + # Don't allow pasting into the title cells + # + if {[$itk_component(table) tag includes title active]} { + return + } + + set savestate [$itk_component(table) cget -state] + setInsertMode 1 + + if {[catch {::tk::table::GetSelection $itk_component(table) CLIPBOARD} data]} { + return + } + + set newinsert [string length $data] + + if {$savestate == "normal"} { + set curval [$itk_component(table) curvalue] + set insert [$itk_component(table) icursor] + set first [string range $curval 0 $insert-1] + set last [string range $curval $insert end] + + set index [$itk_component(table) index active] + + append first $data $last + set data $first + set newinsert [expr {$insert + $newinsert}] + } + + if {$itk_option(-validatecommand) != ""} { + set index [$itk_component(table) index active] + set ilist [split $index ,] + set row [lindex $ilist 0] + set col [lindex $ilist 1] + + if {[catch {$itk_option(-validatecommand) $row $col $data $itk_option(-vclientdata)} isvalid]} { + set isvalid 0 + } + } else { + set isvalid 1 + } + + if {$isvalid} { + $itk_component(table) set active $data + $itk_component(table) icursor $newinsert + } + +# focus $itk_component(table) +} + ::itcl::body cadwidgets::TkTable::setDataEntry {_index _val} { set $mTableDataVar\($_index\) $_val if {$itk_option(-dataCallback) != ""} { @@ -249,6 +320,34 @@ return $mDoBreak } +::itcl::body cadwidgets::TkTable::handleCopy {_win} { + set index [$_win index active] + set ilist [split $index ,] + set row [lindex $ilist 0] + set col [lindex $ilist 1] + + if {$row == 0} { + return + } + + $_win selection clear all + $_win activate $row,$col + $_win selection set $row,$col + tk_tableCopy $_win +} + +::itcl::body cadwidgets::TkTable::handleCut {_win} { + # First, grab the piece of string about to be cut + # and stuff it into the clipboard. + set curval [$_win curvalue] + set begin [$_win icursor] + clipboard clear -displayof $_win + catch {clipboard append -displayof $_win [string range $curval $begin end]} + + $_win delete active insert end +} + + ::itcl::body cadwidgets::TkTable::handleKey {_win _key} { set index [$_win index active] set ilist [split $index ,] @@ -264,10 +363,11 @@ # (i.e. these get swallowed up by more specific bindings). if {$col != 0 && !$mInsertMode} { set mDoBreak 1 - setInsertMode 1 # Overwrite what's in the cell if {[keyVisible $_key]} { + setInsertMode 1 + if {$itk_option(-validatecommand) != ""} { if {[catch {$itk_option(-validatecommand) $row $col $_key $itk_option(-vclientdata)} isvalid]} { set isvalid 0 @@ -341,9 +441,9 @@ } } - $itk_component(table) selection clear all - $itk_component(table) activate $row,$col - $itk_component(table) selection set $row,$col + $_win selection clear all + $_win activate $row,$col + $_win selection set $row,$col if {$mInsertMode} { setInsertMode 0 @@ -359,7 +459,7 @@ catch {$itk_option(-tablePopupHandler) $index $_X $_Y} } -::itcl::body cadwidgets::TkTable::handleUpDown {_win _key} { +::itcl::body cadwidgets::TkTable::handleUpDown {_win _up} { set index [$_win index active] set ilist [split $index ,] set row [lindex $ilist 0] @@ -369,7 +469,7 @@ return } - if {$_key == "Up"} { + if {$_up} { incr row -1 if {$row < 1} { set row 1 @@ -381,9 +481,9 @@ } } - $itk_component(table) selection clear all - $itk_component(table) activate $row,$col - $itk_component(table) selection set $row,$col + $_win selection clear all + $_win activate $row,$col + $_win selection set $row,$col if {$mInsertMode} { setInsertMode 0 @@ -448,10 +548,10 @@ # Using "set" instead. if {[set [subst $mTableDataVar\($index\)]] == "*"} { setTableVal $index "" - $itk_component(table) tag cell {} $index + $_win tag cell {} $index } else { setTableVal $index "*" - $itk_component(table) tag cell select_col $index + $_win tag cell select_col $index } } else { set mDoBreak 1 @@ -485,6 +585,7 @@ } + # Local Variables: # mode: Tcl # tab-width: 8 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. ------------------------------------------------------------------------------ Learn how Oracle Real Application Clusters (RAC) One Node allows customers to consolidate database storage, standardize their database environment, and, should the need arise, upgrade to a full multi-node Oracle RAC database without downtime or disruption http://p.sf.net/sfu/oracle-sfdevnl _______________________________________________ BRL-CAD Source Commits mailing list brlcad-commits@lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/brlcad-commits