home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / text.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  31.6 KB  |  1,194 lines
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # RCS: @(#) $Id: text.tcl,v 1.41.4.2 2009/10/25 13:50:48 dkf Exp $
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. # Copyright (c) 1998 by Scriptics Corporation.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. #-------------------------------------------------------------------------
  17. # Elements of ::tk::Priv that are used in this file:
  18. #
  19. # afterId -        If non-null, it means that auto-scanning is underway
  20. #            and it gives the "after" id for the next auto-scan
  21. #            command to be executed.
  22. # char -        Character position on the line;  kept in order
  23. #            to allow moving up or down past short lines while
  24. #            still remembering the desired position.
  25. # mouseMoved -        Non-zero means the mouse has moved a significant
  26. #            amount since the button went down (so, for example,
  27. #            start dragging out a selection).
  28. # prevPos -        Used when moving up or down lines via the keyboard.
  29. #            Keeps track of the previous insert position, so
  30. #            we can distinguish a series of ups and downs, all
  31. #            in a row, from a new up or down.
  32. # selectMode -        The style of selection currently underway:
  33. #            char, word, or line.
  34. # x, y -        Last known mouse coordinates for scanning
  35. #            and auto-scanning.
  36. #
  37. #-------------------------------------------------------------------------
  38.  
  39. #-------------------------------------------------------------------------
  40. # The code below creates the default class bindings for text widgets.
  41. #-------------------------------------------------------------------------
  42.  
  43. # Standard Motif bindings:
  44.  
  45. bind Text <1> {
  46.     tk::TextButton1 %W %x %y
  47.     %W tag remove sel 0.0 end
  48. }
  49. bind Text <B1-Motion> {
  50.     set tk::Priv(x) %x
  51.     set tk::Priv(y) %y
  52.     tk::TextSelectTo %W %x %y
  53. }
  54. bind Text <Double-1> {
  55.     set tk::Priv(selectMode) word
  56.     tk::TextSelectTo %W %x %y
  57.     catch {%W mark set insert sel.first}
  58. }
  59. bind Text <Triple-1> {
  60.     set tk::Priv(selectMode) line
  61.     tk::TextSelectTo %W %x %y
  62.     catch {%W mark set insert sel.first}
  63. }
  64. bind Text <Shift-1> {
  65.     tk::TextResetAnchor %W @%x,%y
  66.     set tk::Priv(selectMode) char
  67.     tk::TextSelectTo %W %x %y
  68. }
  69. bind Text <Double-Shift-1>    {
  70.     set tk::Priv(selectMode) word
  71.     tk::TextSelectTo %W %x %y 1
  72. }
  73. bind Text <Triple-Shift-1>    {
  74.     set tk::Priv(selectMode) line
  75.     tk::TextSelectTo %W %x %y
  76. }
  77. bind Text <B1-Leave> {
  78.     set tk::Priv(x) %x
  79.     set tk::Priv(y) %y
  80.     tk::TextAutoScan %W
  81. }
  82. bind Text <B1-Enter> {
  83.     tk::CancelRepeat
  84. }
  85. bind Text <ButtonRelease-1> {
  86.     tk::CancelRepeat
  87. }
  88. bind Text <Control-1> {
  89.     %W mark set insert @%x,%y
  90. }
  91. bind Text <Left> {
  92.     tk::TextSetCursor %W insert-1displayindices
  93. }
  94. bind Text <Right> {
  95.     tk::TextSetCursor %W insert+1displayindices
  96. }
  97. bind Text <Up> {
  98.     tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  99. }
  100. bind Text <Down> {
  101.     tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
  102. }
  103. bind Text <Shift-Left> {
  104.     tk::TextKeySelect %W [%W index {insert - 1displayindices}]
  105. }
  106. bind Text <Shift-Right> {
  107.     tk::TextKeySelect %W [%W index {insert + 1displayindices}]
  108. }
  109. bind Text <Shift-Up> {
  110.     tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
  111. }
  112. bind Text <Shift-Down> {
  113.     tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
  114. }
  115. bind Text <Control-Left> {
  116.     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  117. }
  118. bind Text <Control-Right> {
  119.     tk::TextSetCursor %W [tk::TextNextWord %W insert]
  120. }
  121. bind Text <Control-Up> {
  122.     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
  123. }
  124. bind Text <Control-Down> {
  125.     tk::TextSetCursor %W [tk::TextNextPara %W insert]
  126. }
  127. bind Text <Shift-Control-Left> {
  128.     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  129. }
  130. bind Text <Shift-Control-Right> {
  131.     tk::TextKeySelect %W [tk::TextNextWord %W insert]
  132. }
  133. bind Text <Shift-Control-Up> {
  134.     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
  135. }
  136. bind Text <Shift-Control-Down> {
  137.     tk::TextKeySelect %W [tk::TextNextPara %W insert]
  138. }
  139. bind Text <Prior> {
  140.     tk::TextSetCursor %W [tk::TextScrollPages %W -1]
  141. }
  142. bind Text <Shift-Prior> {
  143.     tk::TextKeySelect %W [tk::TextScrollPages %W -1]
  144. }
  145. bind Text <Next> {
  146.     tk::TextSetCursor %W [tk::TextScrollPages %W 1]
  147. }
  148. bind Text <Shift-Next> {
  149.     tk::TextKeySelect %W [tk::TextScrollPages %W 1]
  150. }
  151. bind Text <Control-Prior> {
  152.     %W xview scroll -1 page
  153. }
  154. bind Text <Control-Next> {
  155.     %W xview scroll 1 page
  156. }
  157.  
  158. bind Text <Home> {
  159.     tk::TextSetCursor %W {insert display linestart}
  160. }
  161. bind Text <Shift-Home> {
  162.     tk::TextKeySelect %W {insert display linestart}
  163. }
  164. bind Text <End> {
  165.     tk::TextSetCursor %W {insert display lineend}
  166. }
  167. bind Text <Shift-End> {
  168.     tk::TextKeySelect %W {insert display lineend}
  169. }
  170. bind Text <Control-Home> {
  171.     tk::TextSetCursor %W 1.0
  172. }
  173. bind Text <Control-Shift-Home> {
  174.     tk::TextKeySelect %W 1.0
  175. }
  176. bind Text <Control-End> {
  177.     tk::TextSetCursor %W {end - 1 indices}
  178. }
  179. bind Text <Control-Shift-End> {
  180.     tk::TextKeySelect %W {end - 1 indices}
  181. }
  182.  
  183. bind Text <Tab> {
  184.     if {[%W cget -state] eq "normal"} {
  185.     tk::TextInsert %W \t
  186.     focus %W
  187.     break
  188.     }
  189. }
  190. bind Text <Shift-Tab> {
  191.     # Needed only to keep <Tab> binding from triggering;  doesn't
  192.     # have to actually do anything.
  193.     break
  194. }
  195. bind Text <Control-Tab> {
  196.     focus [tk_focusNext %W]
  197. }
  198. bind Text <Control-Shift-Tab> {
  199.     focus [tk_focusPrev %W]
  200. }
  201. bind Text <Control-i> {
  202.     tk::TextInsert %W \t
  203. }
  204. bind Text <Return> {
  205.     tk::TextInsert %W \n
  206.     if {[%W cget -autoseparators]} {
  207.     %W edit separator
  208.     }
  209. }
  210. bind Text <Delete> {
  211.     if {[%W tag nextrange sel 1.0 end] ne ""} {
  212.     %W delete sel.first sel.last
  213.     } else {
  214.     if {[%W compare end != insert+1c]} {
  215.         %W delete insert
  216.     }
  217.     %W see insert
  218.     }
  219. }
  220. bind Text <BackSpace> {
  221.     if {[%W tag nextrange sel 1.0 end] ne ""} {
  222.     %W delete sel.first sel.last
  223.     } else {
  224.     if {[%W compare insert != 1.0]} {
  225.         %W delete insert-1c
  226.     }
  227.     %W see insert
  228.     }
  229. }
  230.  
  231. bind Text <Control-space> {
  232.     %W mark set [tk::TextAnchor %W] insert
  233. }
  234. bind Text <Select> {
  235.     %W mark set [tk::TextAnchor %W] insert
  236. }
  237. bind Text <Control-Shift-space> {
  238.     set tk::Priv(selectMode) char
  239.     tk::TextKeyExtend %W insert
  240. }
  241. bind Text <Shift-Select> {
  242.     set tk::Priv(selectMode) char
  243.     tk::TextKeyExtend %W insert
  244. }
  245. bind Text <Control-slash> {
  246.     %W tag add sel 1.0 end
  247. }
  248. bind Text <Control-backslash> {
  249.     %W tag remove sel 1.0 end
  250. }
  251. bind Text <<Cut>> {
  252.     tk_textCut %W
  253. }
  254. bind Text <<Copy>> {
  255.     tk_textCopy %W
  256. }
  257. bind Text <<Paste>> {
  258.     tk_textPaste %W
  259. }
  260. bind Text <<Clear>> {
  261.     catch {%W delete sel.first sel.last}
  262. }
  263. bind Text <<PasteSelection>> {
  264.     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  265.         || !$tk::Priv(mouseMoved)} {
  266.     tk::TextPasteSelection %W %x %y
  267.     }
  268. }
  269. bind Text <Insert> {
  270.     catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
  271. }
  272. bind Text <KeyPress> {
  273.     tk::TextInsert %W %A
  274. }
  275.  
  276. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  277. # Otherwise, if a widget binding for one of these is defined, the
  278. # <KeyPress> class binding will also fire and insert the character,
  279. # which is wrong.  Ditto for <Escape>.
  280.  
  281. bind Text <Alt-KeyPress> {# nothing }
  282. bind Text <Meta-KeyPress> {# nothing}
  283. bind Text <Control-KeyPress> {# nothing}
  284. bind Text <Escape> {# nothing}
  285. bind Text <KP_Enter> {# nothing}
  286. if {[tk windowingsystem] eq "aqua"} {
  287.     bind Text <Command-KeyPress> {# nothing}
  288. }
  289.  
  290. # Additional emacs-like bindings:
  291.  
  292. bind Text <Control-a> {
  293.     if {!$tk_strictMotif} {
  294.     tk::TextSetCursor %W {insert display linestart}
  295.     }
  296. }
  297. bind Text <Control-b> {
  298.     if {!$tk_strictMotif} {
  299.     tk::TextSetCursor %W insert-1displayindices
  300.     }
  301. }
  302. bind Text <Control-d> {
  303.     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
  304.     %W delete insert
  305.     }
  306. }
  307. bind Text <Control-e> {
  308.     if {!$tk_strictMotif} {
  309.     tk::TextSetCursor %W {insert display lineend}
  310.     }
  311. }
  312. bind Text <Control-f> {
  313.     if {!$tk_strictMotif} {
  314.     tk::TextSetCursor %W insert+1displayindices
  315.     }
  316. }
  317. bind Text <Control-k> {
  318.     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
  319.     if {[%W compare insert == {insert lineend}]} {
  320.         %W delete insert
  321.     } else {
  322.         %W delete insert {insert lineend}
  323.     }
  324.     }
  325. }
  326. bind Text <Control-n> {
  327.     if {!$tk_strictMotif} {
  328.     tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
  329.     }
  330. }
  331. bind Text <Control-o> {
  332.     if {!$tk_strictMotif} {
  333.     %W insert insert \n
  334.     %W mark set insert insert-1c
  335.     }
  336. }
  337. bind Text <Control-p> {
  338.     if {!$tk_strictMotif} {
  339.     tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  340.     }
  341. }
  342. bind Text <Control-t> {
  343.     if {!$tk_strictMotif} {
  344.     tk::TextTranspose %W
  345.     }
  346. }
  347.  
  348. bind Text <<Undo>> {
  349.     catch { %W edit undo }
  350. }
  351.  
  352. bind Text <<Redo>> {
  353.     catch { %W edit redo }
  354. }
  355.  
  356. bind Text <Meta-b> {
  357.     if {!$tk_strictMotif} {
  358.     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  359.     }
  360. }
  361. bind Text <Meta-d> {
  362.     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
  363.     %W delete insert [tk::TextNextWord %W insert]
  364.     }
  365. }
  366. bind Text <Meta-f> {
  367.     if {!$tk_strictMotif} {
  368.     tk::TextSetCursor %W [tk::TextNextWord %W insert]
  369.     }
  370. }
  371. bind Text <Meta-less> {
  372.     if {!$tk_strictMotif} {
  373.     tk::TextSetCursor %W 1.0
  374.     }
  375. }
  376. bind Text <Meta-greater> {
  377.     if {!$tk_strictMotif} {
  378.     tk::TextSetCursor %W end-1c
  379.     }
  380. }
  381. bind Text <Meta-BackSpace> {
  382.     if {!$tk_strictMotif} {
  383.     %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
  384.     }
  385. }
  386. bind Text <Meta-Delete> {
  387.     if {!$tk_strictMotif} {
  388.     %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
  389.     }
  390. }
  391.  
  392. # Macintosh only bindings:
  393.  
  394. if {[tk windowingsystem] eq "aqua"} {
  395. bind Text <Option-Left> {
  396.     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  397. }
  398. bind Text <Option-Right> {
  399.     tk::TextSetCursor %W [tk::TextNextWord %W insert]
  400. }
  401. bind Text <Option-Up> {
  402.     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
  403. }
  404. bind Text <Option-Down> {
  405.     tk::TextSetCursor %W [tk::TextNextPara %W insert]
  406. }
  407. bind Text <Shift-Option-Left> {
  408.     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  409. }
  410. bind Text <Shift-Option-Right> {
  411.     tk::TextKeySelect %W [tk::TextNextWord %W insert]
  412. }
  413. bind Text <Shift-Option-Up> {
  414.     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
  415. }
  416. bind Text <Shift-Option-Down> {
  417.     tk::TextKeySelect %W [tk::TextNextPara %W insert]
  418. }
  419. bind Text <Control-v> {
  420.     tk::TextScrollPages %W 1
  421. }
  422.  
  423. # End of Mac only bindings
  424. }
  425.  
  426. # A few additional bindings of my own.
  427.  
  428. bind Text <Control-h> {
  429.     if {!$tk_strictMotif && [%W compare insert != 1.0]} {
  430.     %W delete insert-1c
  431.     %W see insert
  432.     }
  433. }
  434. bind Text <2> {
  435.     if {!$tk_strictMotif} {
  436.     tk::TextScanMark %W %x %y
  437.     }
  438. }
  439. bind Text <B2-Motion> {
  440.     if {!$tk_strictMotif} {
  441.     tk::TextScanDrag %W %x %y
  442.     }
  443. }
  444. set ::tk::Priv(prevPos) {}
  445.  
  446. # The MouseWheel will typically only fire on Windows and MacOS X.
  447. # However, someone could use the "event generate" command to produce one
  448. # on other platforms.  We must be careful not to round -ve values of %D
  449. # down to zero.
  450.  
  451. if {[tk windowingsystem] eq "aqua"} {
  452.     bind Text <MouseWheel> {
  453.         %W yview scroll [expr {-15 * (%D)}] pixels
  454.     }
  455.     bind Text <Option-MouseWheel> {
  456.         %W yview scroll [expr {-150 * (%D)}] pixels
  457.     }
  458.     bind Text <Shift-MouseWheel> {
  459.         %W xview scroll [expr {-15 * (%D)}] pixels
  460.     }
  461.     bind Text <Shift-Option-MouseWheel> {
  462.         %W xview scroll [expr {-150 * (%D)}] pixels
  463.     }
  464. } else {
  465.     # We must make sure that positive and negative movements are rounded
  466.     # equally to integers, avoiding the problem that
  467.     #     (int)1/3 = 0,
  468.     # but
  469.     #     (int)-1/3 = -1
  470.     # The following code ensure equal +/- behaviour.
  471.     bind Text <MouseWheel> {
  472.     if {%D >= 0} {
  473.         %W yview scroll [expr {-%D/3}] pixels
  474.     } else {
  475.         %W yview scroll [expr {(2-%D)/3}] pixels
  476.     }
  477.     }
  478. }
  479.  
  480. if {"x11" eq [tk windowingsystem]} {
  481.     # Support for mousewheels on Linux/Unix commonly comes through mapping
  482.     # the wheel to the extended buttons.  If you have a mousewheel, find
  483.     # Linux configuration info at:
  484.     #    http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  485.     bind Text <4> {
  486.     if {!$tk_strictMotif} {
  487.         %W yview scroll -50 pixels
  488.     }
  489.     }
  490.     bind Text <5> {
  491.     if {!$tk_strictMotif} {
  492.         %W yview scroll 50 pixels
  493.     }
  494.     }
  495. }
  496.  
  497. # ::tk::TextClosestGap --
  498. # Given x and y coordinates, this procedure finds the closest boundary
  499. # between characters to the given coordinates and returns the index
  500. # of the character just after the boundary.
  501. #
  502. # Arguments:
  503. # w -        The text window.
  504. # x -        X-coordinate within the window.
  505. # y -        Y-coordinate within the window.
  506.  
  507. proc ::tk::TextClosestGap {w x y} {
  508.     set pos [$w index @$x,$y]
  509.     set bbox [$w bbox $pos]
  510.     if {$bbox eq ""} {
  511.     return $pos
  512.     }
  513.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  514.     return $pos
  515.     }
  516.     $w index "$pos + 1 char"
  517. }
  518.  
  519. # ::tk::TextButton1 --
  520. # This procedure is invoked to handle button-1 presses in text
  521. # widgets.  It moves the insertion cursor, sets the selection anchor,
  522. # and claims the input focus.
  523. #
  524. # Arguments:
  525. # w -        The text window in which the button was pressed.
  526. # x -        The x-coordinate of the button press.
  527. # y -        The x-coordinate of the button press.
  528.  
  529. proc ::tk::TextButton1 {w x y} {
  530.     variable ::tk::Priv
  531.  
  532.     set Priv(selectMode) char
  533.     set Priv(mouseMoved) 0
  534.     set Priv(pressX) $x
  535.     set anchorname [tk::TextAnchor $w]
  536.     $w mark set insert [TextClosestGap $w $x $y]
  537.     $w mark set $anchorname insert
  538.     # Set the anchor mark's gravity depending on the click position
  539.     # relative to the gap
  540.     set bbox [$w bbox [$w index $anchorname]]
  541.     if {$x > [lindex $bbox 0]} {
  542.     $w mark gravity $anchorname right
  543.     } else {
  544.     $w mark gravity $anchorname left
  545.     }
  546.     # Allow focus in any case on Windows, because that will let the
  547.     # selection be displayed even for state disabled text widgets.
  548.     if {$::tcl_platform(platform) eq "windows" \
  549.         || [$w cget -state] eq "normal"} {
  550.     focus $w
  551.     }
  552.     if {[$w cget -autoseparators]} {
  553.     $w edit separator
  554.     }
  555. }
  556.  
  557. # ::tk::TextSelectTo --
  558. # This procedure is invoked to extend the selection, typically when
  559. # dragging it with the mouse.  Depending on the selection mode (character,
  560. # word, line) it selects in different-sized units.  This procedure
  561. # ignores mouse motions initially until the mouse has moved from
  562. # one character to another or until there have been multiple clicks.
  563. #
  564. # Note that the 'anchor' is implemented programmatically using
  565. # a text widget mark, and uses a name that will be unique for each
  566. # text widget (even when there are multiple peers).  Currently the
  567. # anchor is considered private to Tk, hence the name 'tk::anchor$w'.
  568. #
  569. # Arguments:
  570. # w -        The text window in which the button was pressed.
  571. # x -        Mouse x position.
  572. # y -         Mouse y position.
  573.  
  574. set ::tk::Priv(textanchoruid) 0
  575.  
  576. proc ::tk::TextAnchor {w} {
  577.     variable Priv
  578.     if {![info exists Priv(textanchor,$w)]} {
  579.         set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)]
  580.     }
  581.     return $Priv(textanchor,$w)
  582. }
  583.  
  584. proc ::tk::TextSelectTo {w x y {extend 0}} {
  585.     global tcl_platform
  586.     variable ::tk::Priv
  587.  
  588.     set anchorname [tk::TextAnchor $w]
  589.     set cur [TextClosestGap $w $x $y]
  590.     if {[catch {$w index $anchorname}]} {
  591.     $w mark set $anchorname $cur
  592.     }
  593.     set anchor [$w index $anchorname]
  594.     if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
  595.     set Priv(mouseMoved) 1
  596.     }
  597.     switch -- $Priv(selectMode) {
  598.     char {
  599.         if {[$w compare $cur < $anchorname]} {
  600.         set first $cur
  601.         set last $anchorname
  602.         } else {
  603.         set first $anchorname
  604.         set last $cur
  605.         }
  606.     }
  607.     word {
  608.         # Set initial range based only on the anchor (1 char min width)
  609.         if {[$w mark gravity $anchorname] eq "right"} {
  610.         set first $anchorname
  611.         set last "$anchorname + 1c"
  612.         } else {
  613.         set first "$anchorname - 1c"
  614.         set last $anchorname
  615.         }
  616.         # Extend range (if necessary) based on the current point
  617.         if {[$w compare $cur < $first]} {
  618.         set first $cur
  619.         } elseif {[$w compare $cur > $last]} {
  620.         set last $cur
  621.         }
  622.  
  623.         # Now find word boundaries
  624.         set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore]
  625.         set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter]
  626.     }
  627.     line {
  628.         # Set initial range based only on the anchor
  629.         set first "$anchorname linestart"
  630.         set last "$anchorname lineend"
  631.  
  632.         # Extend range (if necessary) based on the current point
  633.         if {[$w compare $cur < $first]} {
  634.         set first "$cur linestart"
  635.         } elseif {[$w compare $cur > $last]} {
  636.         set last "$cur lineend"
  637.         }
  638.         set first [$w index $first]
  639.         set last [$w index "$last + 1c"]
  640.     }
  641.     }
  642.     if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} {
  643.     $w tag remove sel 0.0 end
  644.     $w mark set insert $cur
  645.     $w tag add sel $first $last
  646.     $w tag remove sel $last end
  647.     update idletasks
  648.     }
  649. }
  650.  
  651. # ::tk::TextKeyExtend --
  652. # This procedure handles extending the selection from the keyboard,
  653. # where the point to extend to is really the boundary between two
  654. # characters rather than a particular character.
  655. #
  656. # Arguments:
  657. # w -        The text window.
  658. # index -    The point to which the selection is to be extended.
  659.  
  660. proc ::tk::TextKeyExtend {w index} {
  661.  
  662.     set anchorname [tk::TextAnchor $w]
  663.     set cur [$w index $index]
  664.     if {[catch {$w index $anchorname}]} {
  665.     $w mark set $anchorname $cur
  666.     }
  667.     set anchor [$w index $anchorname]
  668.     if {[$w compare $cur < $anchorname]} {
  669.     set first $cur
  670.     set last $anchorname
  671.     } else {
  672.     set first $anchorname
  673.     set last $cur
  674.     }
  675.     $w tag remove sel 0.0 $first
  676.     $w tag add sel $first $last
  677.     $w tag remove sel $last end
  678. }
  679.  
  680. # ::tk::TextPasteSelection --
  681. # This procedure sets the insertion cursor to the mouse position,
  682. # inserts the selection, and sets the focus to the window.
  683. #
  684. # Arguments:
  685. # w -        The text window.
  686. # x, y -     Position of the mouse.
  687.  
  688. proc ::tk::TextPasteSelection {w x y} {
  689.     $w mark set insert [TextClosestGap $w $x $y]
  690.     if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
  691.     set oldSeparator [$w cget -autoseparators]
  692.     if {$oldSeparator} {
  693.         $w configure -autoseparators 0
  694.         $w edit separator
  695.     }
  696.     $w insert insert $sel
  697.     if {$oldSeparator} {
  698.         $w edit separator
  699.         $w configure -autoseparators 1
  700.     }
  701.     }
  702.     if {[$w cget -state] eq "normal"} {
  703.     focus $w
  704.     }
  705. }
  706.  
  707. # ::tk::TextAutoScan --
  708. # This procedure is invoked when the mouse leaves a text window
  709. # with button 1 down.  It scrolls the window up, down, left, or right,
  710. # depending on where the mouse is (this information was saved in
  711. # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
  712. # command so that the window continues to scroll until the mouse
  713. # moves back into the window or the mouse button is released.
  714. #
  715. # Arguments:
  716. # w -        The text window.
  717.  
  718. proc ::tk::TextAutoScan {w} {
  719.     variable ::tk::Priv
  720.     if {![winfo exists $w]} {
  721.     return
  722.     }
  723.     if {$Priv(y) >= [winfo height $w]} {
  724.     $w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels
  725.     } elseif {$Priv(y) < 0} {
  726.     $w yview scroll [expr {-1 + $Priv(y)}] pixels
  727.     } elseif {$Priv(x) >= [winfo width $w]} {
  728.     $w xview scroll 2 units
  729.     } elseif {$Priv(x) < 0} {
  730.     $w xview scroll -2 units
  731.     } else {
  732.     return
  733.     }
  734.     TextSelectTo $w $Priv(x) $Priv(y)
  735.     set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
  736. }
  737.  
  738. # ::tk::TextSetCursor
  739. # Move the insertion cursor to a given position in a text.  Also
  740. # clears the selection, if there is one in the text, and makes sure
  741. # that the insertion cursor is visible.  Also, don't let the insertion
  742. # cursor appear on the dummy last line of the text.
  743. #
  744. # Arguments:
  745. # w -        The text window.
  746. # pos -        The desired new position for the cursor in the window.
  747.  
  748. proc ::tk::TextSetCursor {w pos} {
  749.     if {[$w compare $pos == end]} {
  750.     set pos {end - 1 chars}
  751.     }
  752.     $w mark set insert $pos
  753.     $w tag remove sel 1.0 end
  754.     $w see insert
  755.     if {[$w cget -autoseparators]} {
  756.     $w edit separator
  757.     }
  758. }
  759.  
  760. # ::tk::TextKeySelect
  761. # This procedure is invoked when stroking out selections using the
  762. # keyboard.  It moves the cursor to a new position, then extends
  763. # the selection to that position.
  764. #
  765. # Arguments:
  766. # w -        The text window.
  767. # new -        A new position for the insertion cursor (the cursor hasn't
  768. #        actually been moved to this position yet).
  769.  
  770. proc ::tk::TextKeySelect {w new} {
  771.     set anchorname [tk::TextAnchor $w]
  772.     if {[$w tag nextrange sel 1.0 end] eq ""} {
  773.     if {[$w compare $new < insert]} {
  774.         $w tag add sel $new insert
  775.     } else {
  776.         $w tag add sel insert $new
  777.     }
  778.     $w mark set $anchorname insert
  779.     } else {
  780.     if {[$w compare $new < $anchorname]} {
  781.         set first $new
  782.         set last $anchorname
  783.     } else {
  784.         set first $anchorname
  785.         set last $new
  786.     }
  787.     $w tag remove sel 1.0 $first
  788.     $w tag add sel $first $last
  789.     $w tag remove sel $last end
  790.     }
  791.     $w mark set insert $new
  792.     $w see insert
  793.     update idletasks
  794. }
  795.  
  796. # ::tk::TextResetAnchor --
  797. # Set the selection anchor to whichever end is farthest from the
  798. # index argument.  One special trick: if the selection has two or
  799. # fewer characters, just leave the anchor where it is.  In this
  800. # case it doesn't matter which point gets chosen for the anchor,
  801. # and for the things like Shift-Left and Shift-Right this produces
  802. # better behavior when the cursor moves back and forth across the
  803. # anchor.
  804. #
  805. # Arguments:
  806. # w -        The text widget.
  807. # index -    Position at which mouse button was pressed, which determines
  808. #        which end of selection should be used as anchor point.
  809.  
  810. proc ::tk::TextResetAnchor {w index} {
  811.     if {[$w tag ranges sel] eq ""} {
  812.     # Don't move the anchor if there is no selection now; this
  813.     # makes the widget behave "correctly" when the user clicks
  814.     # once, then shift-clicks somewhere -- ie, the area between
  815.     # the two clicks will be selected. [Bug: 5929].
  816.     return
  817.     }
  818.     set anchorname [tk::TextAnchor $w]
  819.     set a [$w index $index]
  820.     set b [$w index sel.first]
  821.     set c [$w index sel.last]
  822.     if {[$w compare $a < $b]} {
  823.     $w mark set $anchorname sel.last
  824.     return
  825.     }
  826.     if {[$w compare $a > $c]} {
  827.     $w mark set $anchorname sel.first
  828.     return
  829.     }
  830.     scan $a "%d.%d" lineA chA
  831.     scan $b "%d.%d" lineB chB
  832.     scan $c "%d.%d" lineC chC
  833.     if {$lineB < $lineC+2} {
  834.     set total [string length [$w get $b $c]]
  835.     if {$total <= 2} {
  836.         return
  837.     }
  838.     if {[string length [$w get $b $a]] < ($total/2)} {
  839.         $w mark set $anchorname sel.last
  840.     } else {
  841.         $w mark set $anchorname sel.first
  842.     }
  843.     return
  844.     }
  845.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  846.     $w mark set $anchorname sel.last
  847.     } else {
  848.     $w mark set $anchorname sel.first
  849.     }
  850. }
  851.  
  852. # ::tk::TextInsert --
  853. # Insert a string into a text at the point of the insertion cursor.
  854. # If there is a selection in the text, and it covers the point of the
  855. # insertion cursor, then delete the selection before inserting.
  856. #
  857. # Arguments:
  858. # w -        The text window in which to insert the string
  859. # s -        The string to insert (usually just a single character)
  860.  
  861. proc ::tk::TextInsert {w s} {
  862.     if {$s eq "" || [$w cget -state] eq "disabled"} {
  863.     return
  864.     }
  865.     set compound 0
  866.     if {[llength [set range [$w tag ranges sel]]]} {
  867.     if {[$w compare [lindex $range 0] <= insert] \
  868.         && [$w compare [lindex $range end] >= insert]} {
  869.         set oldSeparator [$w cget -autoseparators]
  870.         if {$oldSeparator} {
  871.         $w configure -autoseparators 0
  872.         $w edit separator
  873.         set compound 1
  874.         }
  875.         $w delete [lindex $range 0] [lindex $range end]
  876.     }
  877.     }
  878.     $w insert insert $s
  879.     $w see insert
  880.     if {$compound && $oldSeparator} {
  881.     $w edit separator
  882.     $w configure -autoseparators 1
  883.     }
  884. }
  885.  
  886. # ::tk::TextUpDownLine --
  887. # Returns the index of the character one display line above or below the
  888. # insertion cursor.  There are two tricky things here.  First, we want to
  889. # maintain the original x position across repeated operations, even though
  890. # some lines that will get passed through don't have enough characters to
  891. # cover the original column.  Second, don't try to scroll past the
  892. # beginning or end of the text.
  893. #
  894. # Arguments:
  895. # w -        The text window in which the cursor is to move.
  896. # n -        The number of display lines to move: -1 for up one line,
  897. #        +1 for down one line.
  898.  
  899. proc ::tk::TextUpDownLine {w n} {
  900.     variable ::tk::Priv
  901.  
  902.     set i [$w index insert]
  903.     if {$Priv(prevPos) ne $i} {
  904.     set Priv(textPosOrig) $i
  905.     }
  906.     set lines [$w count -displaylines $Priv(textPosOrig) $i]
  907.     set new [$w index \
  908.         "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"]
  909.     if {[$w compare $new == end] \
  910.         || [$w compare $new == "insert display linestart"]} {
  911.     set new $i
  912.     }
  913.     set Priv(prevPos) $new
  914.     return $new
  915. }
  916.  
  917. # ::tk::TextPrevPara --
  918. # Returns the index of the beginning of the paragraph just before a given
  919. # position in the text (the beginning of a paragraph is the first non-blank
  920. # character after a blank line).
  921. #
  922. # Arguments:
  923. # w -        The text window in which the cursor is to move.
  924. # pos -        Position at which to start search.
  925.  
  926. proc ::tk::TextPrevPara {w pos} {
  927.     set pos [$w index "$pos linestart"]
  928.     while {1} {
  929.     if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \
  930.         || $pos eq "1.0"} {
  931.         if {[regexp -indices -- {^[ \t]+(.)} \
  932.             [$w get $pos "$pos lineend"] -> index]} {
  933.         set pos [$w index "$pos + [lindex $index 0] chars"]
  934.         }
  935.         if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} {
  936.         return $pos
  937.         }
  938.     }
  939.     set pos [$w index "$pos - 1 line"]
  940.     }
  941. }
  942.  
  943. # ::tk::TextNextPara --
  944. # Returns the index of the beginning of the paragraph just after a given
  945. # position in the text (the beginning of a paragraph is the first non-blank
  946. # character after a blank line).
  947. #
  948. # Arguments:
  949. # w -        The text window in which the cursor is to move.
  950. # start -    Position at which to start search.
  951.  
  952. proc ::tk::TextNextPara {w start} {
  953.     set pos [$w index "$start linestart + 1 line"]
  954.     while {[$w get $pos] ne "\n"} {
  955.     if {[$w compare $pos == end]} {
  956.         return [$w index "end - 1c"]
  957.     }
  958.     set pos [$w index "$pos + 1 line"]
  959.     }
  960.     while {[$w get $pos] eq "\n"} {
  961.     set pos [$w index "$pos + 1 line"]
  962.     if {[$w compare $pos == end]} {
  963.         return [$w index "end - 1c"]
  964.     }
  965.     }
  966.     if {[regexp -indices -- {^[ \t]+(.)} \
  967.         [$w get $pos "$pos lineend"] -> index]} {
  968.     return [$w index "$pos + [lindex $index 0] chars"]
  969.     }
  970.     return $pos
  971. }
  972.  
  973. # ::tk::TextScrollPages --
  974. # This is a utility procedure used in bindings for moving up and down
  975. # pages and possibly extending the selection along the way.  It scrolls
  976. # the view in the widget by the number of pages, and it returns the
  977. # index of the character that is at the same position in the new view
  978. # as the insertion cursor used to be in the old view.
  979. #
  980. # Arguments:
  981. # w -        The text window in which the cursor is to move.
  982. # count -    Number of pages forward to scroll;  may be negative
  983. #        to scroll backwards.
  984.  
  985. proc ::tk::TextScrollPages {w count} {
  986.     set bbox [$w bbox insert]
  987.     $w yview scroll $count pages
  988.     if {$bbox eq ""} {
  989.     return [$w index @[expr {[winfo height $w]/2}],0]
  990.     }
  991.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  992. }
  993.  
  994. # ::tk::TextTranspose --
  995. # This procedure implements the "transpose" function for text widgets.
  996. # It tranposes the characters on either side of the insertion cursor,
  997. # unless the cursor is at the end of the line.  In this case it
  998. # transposes the two characters to the left of the cursor.  In either
  999. # case, the cursor ends up to the right of the transposed characters.
  1000. #
  1001. # Arguments:
  1002. # w -        Text window in which to transpose.
  1003.  
  1004. proc ::tk::TextTranspose w {
  1005.     set pos insert
  1006.     if {[$w compare $pos != "$pos lineend"]} {
  1007.     set pos [$w index "$pos + 1 char"]
  1008.     }
  1009.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  1010.     if {[$w compare "$pos - 1 char" == 1.0]} {
  1011.     return
  1012.     }
  1013.     # ensure this is seen as an atomic op to undo
  1014.     set autosep [$w cget -autoseparators]
  1015.     if {$autosep} {
  1016.     $w configure -autoseparators 0
  1017.     $w edit separator
  1018.     }
  1019.     $w delete "$pos - 2 char" $pos
  1020.     $w insert insert $new
  1021.     $w see insert
  1022.     if {$autosep} {
  1023.     $w edit separator
  1024.     $w configure -autoseparators $autosep
  1025.     }
  1026. }
  1027.  
  1028. # ::tk_textCopy --
  1029. # This procedure copies the selection from a text widget into the
  1030. # clipboard.
  1031. #
  1032. # Arguments:
  1033. # w -        Name of a text widget.
  1034.  
  1035. proc ::tk_textCopy w {
  1036.     if {![catch {set data [$w get sel.first sel.last]}]} {
  1037.     clipboard clear -displayof $w
  1038.     clipboard append -displayof $w $data
  1039.     }
  1040. }
  1041.  
  1042. # ::tk_textCut --
  1043. # This procedure copies the selection from a text widget into the
  1044. # clipboard, then deletes the selection (if it exists in the given
  1045. # widget).
  1046. #
  1047. # Arguments:
  1048. # w -        Name of a text widget.
  1049.  
  1050. proc ::tk_textCut w {
  1051.     if {![catch {set data [$w get sel.first sel.last]}]} {
  1052.     clipboard clear -displayof $w
  1053.     clipboard append -displayof $w $data
  1054.     $w delete sel.first sel.last
  1055.     }
  1056. }
  1057.  
  1058. # ::tk_textPaste --
  1059. # This procedure pastes the contents of the clipboard to the insertion
  1060. # point in a text widget.
  1061. #
  1062. # Arguments:
  1063. # w -        Name of a text widget.
  1064.  
  1065. proc ::tk_textPaste w {
  1066.     global tcl_platform
  1067.     if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
  1068.     set oldSeparator [$w cget -autoseparators]
  1069.     if {$oldSeparator} {
  1070.         $w configure -autoseparators 0
  1071.         $w edit separator
  1072.     }
  1073.     if {[tk windowingsystem] ne "x11"} {
  1074.         catch { $w delete sel.first sel.last }
  1075.     }
  1076.     $w insert insert $sel
  1077.     if {$oldSeparator} {
  1078.         $w edit separator
  1079.         $w configure -autoseparators 1
  1080.     }
  1081.     }
  1082. }
  1083.  
  1084. # ::tk::TextNextWord --
  1085. # Returns the index of the next word position after a given position in the
  1086. # text.  The next word is platform dependent and may be either the next
  1087. # end-of-word position or the next start-of-word position after the next
  1088. # end-of-word position.
  1089. #
  1090. # Arguments:
  1091. # w -        The text window in which the cursor is to move.
  1092. # start -    Position at which to start search.
  1093.  
  1094. if {$tcl_platform(platform) eq "windows"}  {
  1095.     proc ::tk::TextNextWord {w start} {
  1096.     TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
  1097.         tcl_startOfNextWord
  1098.     }
  1099. } else {
  1100.     proc ::tk::TextNextWord {w start} {
  1101.     TextNextPos $w $start tcl_endOfWord
  1102.     }
  1103. }
  1104.  
  1105. # ::tk::TextNextPos --
  1106. # Returns the index of the next position after the given starting
  1107. # position in the text as computed by a specified function.
  1108. #
  1109. # Arguments:
  1110. # w -        The text window in which the cursor is to move.
  1111. # start -    Position at which to start search.
  1112. # op -        Function to use to find next position.
  1113.  
  1114. proc ::tk::TextNextPos {w start op} {
  1115.     set text ""
  1116.     set cur $start
  1117.     while {[$w compare $cur < end]} {
  1118.     set text $text[$w get -displaychars $cur "$cur lineend + 1c"]
  1119.     set pos [$op $text 0]
  1120.     if {$pos >= 0} {
  1121.         return [$w index "$start + $pos display chars"]
  1122.     }
  1123.     set cur [$w index "$cur lineend +1c"]
  1124.     }
  1125.     return end
  1126. }
  1127.  
  1128. # ::tk::TextPrevPos --
  1129. # Returns the index of the previous position before the given starting
  1130. # position in the text as computed by a specified function.
  1131. #
  1132. # Arguments:
  1133. # w -        The text window in which the cursor is to move.
  1134. # start -    Position at which to start search.
  1135. # op -        Function to use to find next position.
  1136.  
  1137. proc ::tk::TextPrevPos {w start op} {
  1138.     set text ""
  1139.     set cur $start
  1140.     while {[$w compare $cur > 0.0]} {
  1141.     set text [$w get -displaychars "$cur linestart - 1c" $cur]$text
  1142.     set pos [$op $text end]
  1143.     if {$pos >= 0} {
  1144.         return [$w index "$cur linestart - 1c + $pos display chars"]
  1145.     }
  1146.     set cur [$w index "$cur linestart - 1c"]
  1147.     }
  1148.     return 0.0
  1149. }
  1150.  
  1151. # ::tk::TextScanMark --
  1152. #
  1153. # Marks the start of a possible scan drag operation
  1154. #
  1155. # Arguments:
  1156. # w -    The text window from which the text to get
  1157. # x -    x location on screen
  1158. # y -    y location on screen
  1159.  
  1160. proc ::tk::TextScanMark {w x y} {
  1161.     variable ::tk::Priv
  1162.     $w scan mark $x $y
  1163.     set Priv(x) $x
  1164.     set Priv(y) $y
  1165.     set Priv(mouseMoved) 0
  1166. }
  1167.  
  1168. # ::tk::TextScanDrag --
  1169. #
  1170. # Marks the start of a possible scan drag operation
  1171. #
  1172. # Arguments:
  1173. # w -    The text window from which the text to get
  1174. # x -    x location on screen
  1175. # y -    y location on screen
  1176.  
  1177. proc ::tk::TextScanDrag {w x y} {
  1178.     variable ::tk::Priv
  1179.     # Make sure these exist, as some weird situations can trigger the
  1180.     # motion binding without the initial press.  [Bug #220269]
  1181.     if {![info exists Priv(x)]} {
  1182.     set Priv(x) $x
  1183.     }
  1184.     if {![info exists Priv(y)]} {
  1185.     set Priv(y) $y
  1186.     }
  1187.     if {($x != $Priv(x)) || ($y != $Priv(y))} {
  1188.     set Priv(mouseMoved) 1
  1189.     }
  1190.     if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} {
  1191.     $w scan dragto $x $y
  1192.     }
  1193. }
  1194.