home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / Tktable2.7 / tkTable.tcl < prev   
Encoding:
Text File  |  2001-10-22  |  20.3 KB  |  701 lines
  1. # table.tcl --
  2. #
  3. # Version align with tkTable 2.7, jeff.hobbs@acm.org
  4. # This file defines the default bindings for Tk table widgets
  5. # and provides procedures that help in implementing those bindings.
  6. #
  7.  
  8. #--------------------------------------------------------------------------
  9. # ::tk::table::Priv elements used in this file:
  10. #
  11. # x && y -        Coords in widget
  12. # afterId -        Token returned by "after" for autoscanning.
  13. # tablePrev -        The last element to be selected or deselected
  14. #            during a selection operation.
  15. # mouseMoved -        Boolean to indicate whether mouse moved while
  16. #            the button was pressed.
  17. #--------------------------------------------------------------------------
  18.  
  19. namespace eval ::tk::table {
  20.     # Ensure that a namespace is created for us
  21.     variable Priv
  22.     array set Priv { x 0 y 0 afterId {} mouseMoved 0 }
  23. }
  24.  
  25. # ::tk::table::ClipboardKeysyms --
  26. # This procedure is invoked to identify the keys that correspond to
  27. # the "copy", "cut", and "paste" functions for the clipboard.
  28. #
  29. # Arguments:
  30. # copy -    Name of the key (keysym name plus modifiers, if any,
  31. #        such as "Meta-y") used for the copy operation.
  32. # cut -        Name of the key used for the cut operation.
  33. # paste -    Name of the key used for the paste operation.
  34.  
  35. proc ::tk::table::ClipboardKeysyms {copy cut paste} {
  36.     bind Table <$copy>    {tk_tableCopy %W}
  37.     bind Table <$cut>    {tk_tableCut %W}
  38.     bind Table <$paste>    {tk_tablePaste %W}
  39. }
  40. ::tk::table::ClipboardKeysyms <Copy> <Cut> <Paste>
  41.  
  42. ## Interactive cell resizing, affected by -resizeborders option
  43. ##
  44. bind Table <3>        {
  45.     ## You might want to check for cell returned if you want to
  46.     ## restrict the resizing of certain cells
  47.     %W border mark %x %y
  48. }
  49. bind Table <B3-Motion>    { %W border dragto %x %y }
  50.  
  51. ## Button events
  52.  
  53. bind Table <1> {
  54.     if {[winfo exists %W]} {
  55.     ::tk::table::BeginSelect %W [%W index @%x,%y]
  56.     focus %W
  57.     }
  58.     array set ::tk::table::Priv {x %x y %y}
  59.     set ::tk::table::Priv(mouseMoved) 0
  60. }
  61. bind Table <B1-Motion> {
  62.     # If we already had motion, or we moved more than 1 pixel,
  63.     # then we start the Motion routine
  64.     if {
  65.     $::tk::table::Priv(mouseMoved)
  66.     || abs(%x-$::tk::table::Priv(x)) > 1
  67.     || abs(%y-$::tk::table::Priv(y)) > 1
  68.     } {
  69.     set ::tk::table::Priv(mouseMoved) 1
  70.     }
  71.     if {$::tk::table::Priv(mouseMoved)} {
  72.     ::tk::table::Motion %W [%W index @%x,%y]
  73.     }
  74. }
  75. bind Table <Double-1> {
  76.     # empty
  77. }
  78. bind Table <ButtonRelease-1> {
  79.     if {[winfo exists %W]} {
  80.     ::tk::table::CancelRepeat
  81.     %W activate @%x,%y
  82.     }
  83. }
  84.  
  85. bind Table <Shift-1>    {::tk::table::BeginExtend %W [%W index @%x,%y]}
  86. bind Table <Control-1>    {::tk::table::BeginToggle %W [%W index @%x,%y]}
  87. bind Table <B1-Enter>    {::tk::table::CancelRepeat}
  88. bind Table <B1-Leave>    {
  89.     array set ::tk::table::Priv {x %x y %y}
  90.     ::tk::table::AutoScan %W
  91. }
  92. bind Table <2> {
  93.     %W scan mark %x %y
  94.     array set ::tk::table::Priv {x %x y %y}
  95.     set ::tk::table::Priv(mouseMoved) 0
  96. }
  97. bind Table <B2-Motion> {
  98.     if {(%x != $::tk::table::Priv(x)) || (%y != $::tk::table::Priv(y))} {
  99.     set ::tk::table::Priv(mouseMoved) 1
  100.     }
  101.     if {$::tk::table::Priv(mouseMoved)} { %W scan dragto %x %y }
  102. }
  103. bind Table <ButtonRelease-2> {
  104.     if {!$::tk::table::Priv(mouseMoved)} { tk_tablePaste %W [%W index @%x,%y] }
  105. }
  106.  
  107. ## Key events
  108.  
  109. # This forces a cell commit if an active cell exists
  110. bind Table <<Table_Commit>> {
  111.     catch {%W activate active}
  112. }
  113. # Remove this if you don't want cell commit to occur on every
  114. # Leave of the table.  Another possible choice is <FocusOut>.
  115. event add <<Table_Commit>> <Leave>
  116.  
  117. bind Table <Shift-Up>        {::tk::table::ExtendSelect %W -1  0}
  118. bind Table <Shift-Down>        {::tk::table::ExtendSelect %W  1  0}
  119. bind Table <Shift-Left>        {::tk::table::ExtendSelect %W  0 -1}
  120. bind Table <Shift-Right>    {::tk::table::ExtendSelect %W  0  1}
  121. bind Table <Prior>        {%W yview scroll -1 pages; %W activate @0,0}
  122. bind Table <Next>        {%W yview scroll  1 pages; %W activate @0,0}
  123. bind Table <Control-Prior>    {%W xview scroll -1 pages}
  124. bind Table <Control-Next>    {%W xview scroll  1 pages}
  125. bind Table <Home>        {%W see origin}
  126. bind Table <End>        {%W see end}
  127. bind Table <Control-Home> {
  128.     %W selection clear all
  129.     %W activate origin
  130.     %W selection set active
  131.     %W see active
  132. }
  133. bind Table <Control-End> {
  134.     %W selection clear all
  135.     %W activate end
  136.     %W selection set active
  137.     %W see active
  138. }
  139. bind Table <Shift-Control-Home>    {::tk::table::DataExtend %W origin}
  140. bind Table <Shift-Control-End>    {::tk::table::DataExtend %W end}
  141. bind Table <Select>        {::tk::table::BeginSelect %W [%W index active]}
  142. bind Table <Shift-Select>    {::tk::table::BeginExtend %W [%W index active]}
  143. bind Table <Control-slash>    {::tk::table::SelectAll %W}
  144. bind Table <Control-backslash> {
  145.     if {[string match browse [%W cget -selectmode]]} {%W selection clear all}
  146. }
  147. bind Table <Up>            {::tk::table::MoveCell %W -1  0}
  148. bind Table <Down>        {::tk::table::MoveCell %W  1  0}
  149. bind Table <Left>        {::tk::table::MoveCell %W  0 -1}
  150. bind Table <Right>        {::tk::table::MoveCell %W  0  1}
  151. bind Table <KeyPress>        {::tk::table::Insert %W %A}
  152. bind Table <BackSpace>        {::tk::table::BackSpace %W}
  153. bind Table <Delete>        {%W delete active insert}
  154. bind Table <Escape>        {%W reread}
  155.  
  156. #bind Table <Return>        {::tk::table::MoveCell %W 1 0}
  157. bind Table <Return>        {::tk::table::Insert %W "\n"}
  158.  
  159. bind Table <Control-Left>    {%W icursor [expr {[%W icursor]-1}]}
  160. bind Table <Control-Right>    {%W icursor [expr {[%W icursor]+1}]}
  161. bind Table <Control-e>        {%W icursor end}
  162. bind Table <Control-a>        {%W icursor 0}
  163. bind Table <Control-k>        {%W delete active insert end}
  164. bind Table <Control-equal>    {::tk::table::ChangeWidth %W active  1}
  165. bind Table <Control-minus>    {::tk::table::ChangeWidth %W active -1}
  166.  
  167. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  168. # Otherwise, if a widget binding for one of these is defined, the
  169. # <KeyPress> class binding will also fire and insert the character,
  170. # which is wrong.  Ditto for Tab.
  171.  
  172. bind Table <Alt-KeyPress>    {# nothing}
  173. bind Table <Meta-KeyPress>    {# nothing}
  174. bind Table <Control-KeyPress>    {# nothing}
  175. bind Table <Any-Tab>        {# nothing}
  176. if {[string match "macintosh" $tcl_platform(platform)]} {
  177.     bind Table <Command-KeyPress> {# nothing}
  178. }
  179.  
  180. # ::tk::table::GetSelection --
  181. #   This tries to obtain the default selection.  On Unix, we first try
  182. #   and get a UTF8_STRING, a type supported by modern Unix apps for
  183. #   passing Unicode data safely.  We fall back on the default STRING
  184. #   type otherwise.  On Windows, only the STRING type is necessary.
  185. # Arguments:
  186. #   w    The widget for which the selection will be retrieved.
  187. #    Important for the -displayof property.
  188. #   sel    The source of the selection (PRIMARY or CLIPBOARD)
  189. # Results:
  190. #   Returns the selection, or an error if none could be found
  191. #
  192. if {[string equal $tcl_platform(platform) "unix"]} {
  193.     proc ::tk::table::GetSelection {w {sel PRIMARY}} {
  194.     if {[catch {selection get -displayof $w -selection $sel \
  195.         -type UTF8_STRING} txt] \
  196.         && [catch {selection get -displayof $w -selection $sel} txt]} {
  197.         return -code error "could not find default selection"
  198.     } else {
  199.         return $txt
  200.     }
  201.     }
  202. } else {
  203.     proc ::tk::table::GetSelection {w {sel PRIMARY}} {
  204.     if {[catch {selection get -displayof $w -selection $sel} txt]} {
  205.         return -code error "could not find default selection"
  206.     } else {
  207.         return $txt
  208.     }
  209.     }
  210. }
  211.  
  212. # ::tk::table::CancelRepeat --
  213. # A copy of tkCancelRepeat, just in case it's not available or changes.
  214. # This procedure is invoked to cancel an auto-repeat action described
  215. # by ::tk::table::Priv(afterId).  It's used by several widgets to auto-scroll
  216. # the widget when the mouse is dragged out of the widget with a
  217. # button pressed.
  218. #
  219. # Arguments:
  220. # None.
  221.  
  222. proc ::tk::table::CancelRepeat {} {
  223.     variable Priv
  224.     after cancel $Priv(afterId)
  225.     set Priv(afterId) {}
  226. }
  227.  
  228. # ::tk::table::Insert --
  229. #
  230. #   Insert into the active cell
  231. #
  232. # Arguments:
  233. #   w    - the table widget
  234. #   s    - the string to insert
  235. # Results:
  236. #   Returns nothing
  237. #
  238. proc ::tk::table::Insert {w s} {
  239.     if {[string compare $s {}]} {
  240.     $w insert active insert $s
  241.     }
  242. }
  243.  
  244. # ::tk::table::BackSpace --
  245. #
  246. #   BackSpace in the current cell
  247. #
  248. # Arguments:
  249. #   w    - the table widget
  250. # Results:
  251. #   Returns nothing
  252. #
  253. proc ::tk::table::BackSpace {w} {
  254.     set cur [$w icursor]
  255.     if {[string compare {} $cur] && $cur} {
  256.     $w delete active [expr {$cur-1}]
  257.     }
  258. }
  259.  
  260. # ::tk::table::BeginSelect --
  261. #
  262. # This procedure is typically invoked on button-1 presses. It begins
  263. # the process of making a selection in the table. Its exact behavior
  264. # depends on the selection mode currently in effect for the table;
  265. # see the Motif documentation for details.
  266. #
  267. # Arguments:
  268. # w    - The table widget.
  269. # el    - The element for the selection operation (typically the
  270. #    one under the pointer).  Must be in row,col form.
  271.  
  272. proc ::tk::table::BeginSelect {w el} {
  273.     variable Priv
  274.     if {[scan $el %d,%d r c] != 2} return
  275.     switch [$w cget -selectmode] {
  276.     multiple {
  277.         if {[$w tag includes title $el]} {
  278.         ## in the title area
  279.         if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
  280.             ## We're in a column header
  281.             if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
  282.             ## We're in the topleft title area
  283.             set inc topleft
  284.             set el2 end
  285.             } else {
  286.             set inc [$w index topleft row],$c
  287.             set el2 [$w index end row],$c
  288.             }
  289.         } else {
  290.             ## We're in a row header
  291.             set inc $r,[$w index topleft col]
  292.             set el2 $r,[$w index end col]
  293.         }
  294.         } else {
  295.         set inc $el
  296.         set el2 $el
  297.         }
  298.         if {[$w selection includes $inc]} {
  299.         $w selection clear $el $el2
  300.         } else {
  301.         $w selection set $el $el2
  302.         }
  303.     }
  304.     extended {
  305.         $w selection clear all
  306.         if {[$w tag includes title $el]} {
  307.         if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
  308.             ## We're in a column header
  309.             if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
  310.             ## We're in the topleft title area
  311.             $w selection set $el end
  312.             } else {
  313.             $w selection set $el [$w index end row],$c
  314.             }
  315.         } else {
  316.             ## We're in a row header
  317.             $w selection set $el $r,[$w index end col]
  318.         }
  319.         } else {
  320.         $w selection set $el
  321.         }
  322.         $w selection anchor $el
  323.         set Priv(tablePrev) $el
  324.     }
  325.     default {
  326.         if {![$w tag includes title $el]} {
  327.         $w selection clear all
  328.         $w selection set $el
  329.         set Priv(tablePrev) $el
  330.         }
  331.         $w selection anchor $el
  332.     }
  333.     }
  334. }
  335.  
  336. # ::tk::table::Motion --
  337. #
  338. # This procedure is called to process mouse motion events while
  339. # button 1 is down. It may move or extend the selection, depending
  340. # on the table's selection mode.
  341. #
  342. # Arguments:
  343. # w    - The table widget.
  344. # el    - The element under the pointer (must be in row,col form).
  345.  
  346. proc ::tk::table::Motion {w el} {
  347.     variable Priv
  348.     if {![info exists Priv(tablePrev)]} {
  349.     set Priv(tablePrev) $el
  350.     return
  351.     }
  352.     if {[string match $Priv(tablePrev) $el]} return
  353.     switch [$w cget -selectmode] {
  354.     browse {
  355.         $w selection clear all
  356.         $w selection set $el
  357.         set Priv(tablePrev) $el
  358.     }
  359.     extended {
  360.         scan $Priv(tablePrev) %d,%d r c
  361.         scan $el %d,%d elr elc
  362.         if {[$w tag includes title $el]} {
  363.         if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
  364.             ## We're in a column header
  365.             if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
  366.             ## We're in the topleft title area
  367.             $w selection clear anchor end
  368.             } else {
  369.             $w selection clear anchor [$w index end row],$c
  370.             }
  371.             $w selection set anchor [$w index end row],$elc
  372.         } else {
  373.             ## We're in a row header
  374.             $w selection clear anchor $r,[$w index end col]
  375.             $w selection set anchor $elr,[$w index end col]
  376.         }
  377.         } else {
  378.         $w selection clear anchor $Priv(tablePrev)
  379.         $w selection set anchor $el
  380.         }
  381.         set Priv(tablePrev) $el
  382.     }
  383.     }
  384. }
  385.  
  386. # ::tk::table::BeginExtend --
  387. #
  388. # This procedure is typically invoked on shift-button-1 presses. It
  389. # begins the process of extending a selection in the table. Its
  390. # exact behavior depends on the selection mode currently in effect
  391. # for the table; see the Motif documentation for details.
  392. #
  393. # Arguments:
  394. # w - The table widget.
  395. # el - The element for the selection operation (typically the
  396. # one under the pointer). Must be in numerical form.
  397.  
  398. proc ::tk::table::BeginExtend {w el} {
  399.     if {[string match extended [$w cget -selectmode]] &&
  400.     [$w selection includes anchor]} {
  401.     ::tk::table::Motion $w $el
  402.     }
  403. }
  404.  
  405. # ::tk::table::BeginToggle --
  406. #
  407. # This procedure is typically invoked on control-button-1 presses. It
  408. # begins the process of toggling a selection in the table. Its
  409. # exact behavior depends on the selection mode currently in effect
  410. # for the table; see the Motif documentation for details.
  411. #
  412. # Arguments:
  413. # w - The table widget.
  414. # el - The element for the selection operation (typically the
  415. # one under the pointer). Must be in numerical form.
  416.  
  417. proc ::tk::table::BeginToggle {w el} {
  418.     if {[string match extended [$w cget -selectmode]]} {
  419.     variable Priv
  420.     set Priv(tablePrev) $el
  421.     $w selection anchor $el
  422.     if {[$w tag includes title $el]} {
  423.         scan $el %d,%d r c
  424.         if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
  425.         ## We're in a column header
  426.         if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
  427.             ## We're in the topleft title area
  428.             set end end
  429.         } else {
  430.             set end [$w index end row],$c
  431.         }
  432.         } else {
  433.         ## We're in a row header
  434.         set end $r,[$w index end col]
  435.         }
  436.     } else {
  437.         ## We're in a non-title cell
  438.         set end $el
  439.     }
  440.     if {[$w selection includes  $end]} {
  441.         $w selection clear $el $end
  442.     } else {
  443.         $w selection set   $el $end
  444.         }
  445.     }
  446. }
  447.  
  448. # ::tk::table::AutoScan --
  449. # This procedure is invoked when the mouse leaves an table window
  450. # with button 1 down. It scrolls the window up, down, left, or
  451. # right, depending on where the mouse left the window, and reschedules
  452. # itself as an "after" command so that the window continues to scroll until
  453. # the mouse moves back into the window or the mouse button is released.
  454. #
  455. # Arguments:
  456. # w - The table window.
  457.  
  458. proc ::tk::table::AutoScan {w} {
  459.     if {![winfo exists $w]} return
  460.     variable Priv
  461.     set x $Priv(x)
  462.     set y $Priv(y)
  463.     if {$y >= [winfo height $w]} {
  464.     $w yview scroll 1 units
  465.     } elseif {$y < 0} {
  466.     $w yview scroll -1 units
  467.     } elseif {$x >= [winfo width $w]} {
  468.     $w xview scroll 1 units
  469.     } elseif {$x < 0} {
  470.     $w xview scroll -1 units
  471.     } else {
  472.     return
  473.     }
  474.     ::tk::table::Motion $w [$w index @$x,$y]
  475.     set Priv(afterId) [after 50 ::tk::table::AutoScan $w]
  476. }
  477.  
  478. # ::tk::table::MoveCell --
  479. #
  480. # Moves the location cursor (active element) by the specified number
  481. # of cells and changes the selection if we're in browse or extended
  482. # selection mode.  If the new cell is "hidden", we skip to the next
  483. # visible cell if possible, otherwise just abort.
  484. #
  485. # Arguments:
  486. # w - The table widget.
  487. # x - +1 to move down one cell, -1 to move up one cell.
  488. # y - +1 to move right one cell, -1 to move left one cell.
  489.  
  490. proc ::tk::table::MoveCell {w x y} {
  491.     if {[catch {$w index active row} r]} return
  492.     set c [$w index active col]
  493.     set cell [$w index [incr r $x],[incr c $y]]
  494.     while {[string compare [set true [$w hidden $cell]] {}]} {
  495.     # The cell is in some way hidden
  496.     if {[string compare $true [$w index active]]} {
  497.         # The span cell wasn't the previous cell, so go to that
  498.         set cell $true
  499.         break
  500.     }
  501.     if {$x > 0} {incr r} elseif {$x < 0} {incr r -1}
  502.     if {$y > 0} {incr c} elseif {$y < 0} {incr c -1}
  503.     if {[string compare $cell [$w index $r,$c]]} {
  504.         set cell [$w index $r,$c]
  505.     } else {
  506.         # We couldn't find a non-hidden cell, just don't move
  507.         return
  508.     }
  509.     }
  510.     $w activate $cell
  511.     $w see active
  512.     switch [$w cget -selectmode] {
  513.     browse {
  514.         $w selection clear all
  515.         $w selection set active
  516.     }
  517.     extended {
  518.         variable Priv
  519.         $w selection clear all
  520.         $w selection set active
  521.         $w selection anchor active
  522.         set Priv(tablePrev) [$w index active]
  523.     }
  524.     }
  525. }
  526.  
  527. # ::tk::table::ExtendSelect --
  528. #
  529. # Does nothing unless we're in extended selection mode; in this
  530. # case it moves the location cursor (active element) by the specified
  531. # number of cells, and extends the selection to that point.
  532. #
  533. # Arguments:
  534. # w - The table widget.
  535. # x - +1 to move down one cell, -1 to move up one cell.
  536. # y - +1 to move right one cell, -1 to move left one cell.
  537.  
  538. proc ::tk::table::ExtendSelect {w x y} {
  539.     if {[string compare extended [$w cget -selectmode]] ||
  540.     [catch {$w index active row} r]} return
  541.     set c [$w index active col]
  542.     $w activate [incr r $x],[incr c $y]
  543.     $w see active
  544.     ::tk::table::Motion $w [$w index active]
  545. }
  546.  
  547. # ::tk::table::DataExtend
  548. #
  549. # This procedure is called for key-presses such as Shift-KEndData.
  550. # If the selection mode isnt multiple or extend then it does nothing.
  551. # Otherwise it moves the active element to el and, if we're in
  552. # extended mode, extends the selection to that point.
  553. #
  554. # Arguments:
  555. # w - The table widget.
  556. # el - An integer cell number.
  557.  
  558. proc ::tk::table::DataExtend {w el} {
  559.     set mode [$w cget -selectmode]
  560.     if {[string match extended $mode]} {
  561.     $w activate $el
  562.     $w see $el
  563.     if {[$w selection includes anchor]} {::tk::table::Motion $w $el}
  564.     } elseif {[string match multiple $mode]} {
  565.     $w activate $el
  566.     $w see $el
  567.     }
  568. }
  569.  
  570. # ::tk::table::SelectAll
  571. #
  572. # This procedure is invoked to handle the "select all" operation.
  573. # For single and browse mode, it just selects the active element.
  574. # Otherwise it selects everything in the widget.
  575. #
  576. # Arguments:
  577. # w - The table widget.
  578.  
  579. proc ::tk::table::SelectAll {w} {
  580.     if {[regexp {^(single|browse)$} [$w cget -selectmode]]} {
  581.     $w selection clear all
  582.     $w selection set active
  583.     ::tk::table::HandleType $w [$w index active]
  584.     } elseif {[$w cget -selecttitles]} {
  585.     $w selection set [$w cget -roworigin],[$w cget -colorigin] end
  586.     } else {
  587.     $w selection set origin end
  588.     }
  589. }
  590.  
  591. # ::tk::table::ChangeWidth --
  592. # Adjust the widget of the specified cell by $a.
  593. #
  594. # Arguments:
  595. # w - The table widget.
  596. # i - cell index
  597. # a - amount to adjust by
  598.  
  599. proc ::tk::table::ChangeWidth {w i a} {
  600.     set tmp [$w index $i col]
  601.     if {[set width [$w width $tmp]] >= 0} {
  602.     $w width $tmp [incr width $a]
  603.     } else {
  604.     $w width $tmp [incr width [expr {-$a}]]
  605.     }
  606. }
  607.  
  608. # tk_tableCopy --
  609. # This procedure copies the selection from a table widget into the
  610. # clipboard.
  611. #
  612. # Arguments:
  613. # w -        Name of a table widget.
  614.  
  615. proc tk_tableCopy w {
  616.     if {[selection own -displayof $w] == "$w"} {
  617.     clipboard clear -displayof $w
  618.     catch {clipboard append -displayof $w [::tk::table::GetSelection $w]}
  619.     }
  620. }
  621.  
  622. # tk_tableCut --
  623. # This procedure copies the selection from a table widget into the
  624. # clipboard, then deletes the selection (if it exists in the given
  625. # widget).
  626. #
  627. # Arguments:
  628. # w -        Name of a table widget.
  629.  
  630. proc tk_tableCut w {
  631.     if {[selection own -displayof $w] == "$w"} {
  632.     clipboard clear -displayof $w
  633.     catch {
  634.         clipboard append -displayof $w [::tk::table::GetSelection $w]
  635.         $w cursel {}
  636.         $w selection clear all
  637.     }
  638.     }
  639. }
  640.  
  641. # tk_tablePaste --
  642. # This procedure pastes the contents of the clipboard to the specified
  643. # cell (active by default) in a table widget.
  644. #
  645. # Arguments:
  646. # w -        Name of a table widget.
  647. # cell -    Cell to start pasting in.
  648.  
  649. proc tk_tablePaste {w {cell {}}} {
  650.     if {[string compare {} $cell]} {
  651.     if {[catch {::tk::table::GetSelection $w} data]} return
  652.     } else {
  653.     if {[catch {::tk::table::GetSelection $w CLIPBOARD} data]} {
  654.         return
  655.     }
  656.     set cell active
  657.     }
  658.     tk_tablePasteHandler $w [$w index $cell] $data
  659.     if {[$w cget -state] == "normal"} {focus $w}
  660. }
  661.  
  662. # tk_tablePasteHandler --
  663. # This procedure handles how data is pasted into the table widget.
  664. # This handles data in the default table selection form.
  665. # NOTE: this allows pasting into all cells, even those with -state disabled
  666. #
  667. # Arguments:
  668. # w -        Name of a table widget.
  669. # cell -    Cell to start pasting in.
  670.  
  671. proc tk_tablePasteHandler {w cell data} {
  672.     set rows    [expr {[$w cget -rows]-[$w cget -roworigin]}]
  673.     set cols    [expr {[$w cget -cols]-[$w cget -colorigin]}]
  674.     set r    [$w index $cell row]
  675.     set c    [$w index $cell col]
  676.     set rsep    [$w cget -rowseparator]
  677.     set csep    [$w cget -colseparator]
  678.     ## Assume separate rows are split by row separator if specified
  679.     ## If you were to want multi-character row separators, you would need:
  680.     # regsub -all $rsep $data <newline> data
  681.     # set data [join $data <newline>]
  682.     if {[string comp {} $rsep]} { set data [split $data $rsep] }
  683.     set row    $r
  684.     foreach line $data {
  685.     if {$row > $rows} break
  686.     set col    $c
  687.     ## Assume separate cols are split by col separator if specified
  688.     ## Unless a -separator was specified
  689.     if {[string comp {} $csep]} { set line [split $line $csep] }
  690.     ## If you were to want multi-character col separators, you would need:
  691.     # regsub -all $csep $line <newline> line
  692.     # set line [join $line <newline>]
  693.     foreach item $line {
  694.         if {$col > $cols} break
  695.         $w set $row,$col $item
  696.         incr col
  697.     }
  698.     incr row
  699.     }
  700. }
  701.