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 / tk8.3 / text.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  27.7 KB  |  1,065 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.12.2.1 2001/04/04 07:57:17 hobbs 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 tkPriv 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. # The code below creates the default class bindings for text widgets.
  40. #-------------------------------------------------------------------------
  41.  
  42. # Standard Motif bindings:
  43.  
  44. bind Text <1> {
  45.     tkTextButton1 %W %x %y
  46.     %W tag remove sel 0.0 end
  47. }
  48. bind Text <B1-Motion> {
  49.     set tkPriv(x) %x
  50.     set tkPriv(y) %y
  51.     tkTextSelectTo %W %x %y
  52. }
  53. bind Text <Double-1> {
  54.     set tkPriv(selectMode) word
  55.     tkTextSelectTo %W %x %y
  56.     catch {%W mark set insert sel.last}
  57.     catch {%W mark set anchor sel.first}
  58. }
  59. bind Text <Triple-1> {
  60.     set tkPriv(selectMode) line
  61.     tkTextSelectTo %W %x %y
  62.     catch {%W mark set insert sel.last}
  63.     catch {%W mark set anchor sel.first}
  64. }
  65. bind Text <Shift-1> {
  66.     tkTextResetAnchor %W @%x,%y
  67.     set tkPriv(selectMode) char
  68.     tkTextSelectTo %W %x %y
  69. }
  70. bind Text <Double-Shift-1>    {
  71.     set tkPriv(selectMode) word
  72.     tkTextSelectTo %W %x %y 1
  73. }
  74. bind Text <Triple-Shift-1>    {
  75.     set tkPriv(selectMode) line
  76.     tkTextSelectTo %W %x %y
  77. }
  78. bind Text <B1-Leave> {
  79.     set tkPriv(x) %x
  80.     set tkPriv(y) %y
  81.     tkTextAutoScan %W
  82. }
  83. bind Text <B1-Enter> {
  84.     tkCancelRepeat
  85. }
  86. bind Text <ButtonRelease-1> {
  87.     tkCancelRepeat
  88. }
  89. bind Text <Control-1> {
  90.     %W mark set insert @%x,%y
  91. }
  92. bind Text <Left> {
  93.     tkTextSetCursor %W insert-1c
  94. }
  95. bind Text <Right> {
  96.     tkTextSetCursor %W insert+1c
  97. }
  98. bind Text <Up> {
  99.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  100. }
  101. bind Text <Down> {
  102.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  103. }
  104. bind Text <Shift-Left> {
  105.     tkTextKeySelect %W [%W index {insert - 1c}]
  106. }
  107. bind Text <Shift-Right> {
  108.     tkTextKeySelect %W [%W index {insert + 1c}]
  109. }
  110. bind Text <Shift-Up> {
  111.     tkTextKeySelect %W [tkTextUpDownLine %W -1]
  112. }
  113. bind Text <Shift-Down> {
  114.     tkTextKeySelect %W [tkTextUpDownLine %W 1]
  115. }
  116. bind Text <Control-Left> {
  117.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  118. }
  119. bind Text <Control-Right> {
  120.     tkTextSetCursor %W [tkTextNextWord %W insert]
  121. }
  122. bind Text <Control-Up> {
  123.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  124. }
  125. bind Text <Control-Down> {
  126.     tkTextSetCursor %W [tkTextNextPara %W insert]
  127. }
  128. bind Text <Shift-Control-Left> {
  129.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  130. }
  131. bind Text <Shift-Control-Right> {
  132.     tkTextKeySelect %W [tkTextNextWord %W insert]
  133. }
  134. bind Text <Shift-Control-Up> {
  135.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  136. }
  137. bind Text <Shift-Control-Down> {
  138.     tkTextKeySelect %W [tkTextNextPara %W insert]
  139. }
  140. bind Text <Prior> {
  141.     tkTextSetCursor %W [tkTextScrollPages %W -1]
  142. }
  143. bind Text <Shift-Prior> {
  144.     tkTextKeySelect %W [tkTextScrollPages %W -1]
  145. }
  146. bind Text <Next> {
  147.     tkTextSetCursor %W [tkTextScrollPages %W 1]
  148. }
  149. bind Text <Shift-Next> {
  150.     tkTextKeySelect %W [tkTextScrollPages %W 1]
  151. }
  152. bind Text <Control-Prior> {
  153.     %W xview scroll -1 page
  154. }
  155. bind Text <Control-Next> {
  156.     %W xview scroll 1 page
  157. }
  158.  
  159. bind Text <Home> {
  160.     tkTextSetCursor %W {insert linestart}
  161. }
  162. bind Text <Shift-Home> {
  163.     tkTextKeySelect %W {insert linestart}
  164. }
  165. bind Text <End> {
  166.     tkTextSetCursor %W {insert lineend}
  167. }
  168. bind Text <Shift-End> {
  169.     tkTextKeySelect %W {insert lineend}
  170. }
  171. bind Text <Control-Home> {
  172.     tkTextSetCursor %W 1.0
  173. }
  174. bind Text <Control-Shift-Home> {
  175.     tkTextKeySelect %W 1.0
  176. }
  177. bind Text <Control-End> {
  178.     tkTextSetCursor %W {end - 1 char}
  179. }
  180. bind Text <Control-Shift-End> {
  181.     tkTextKeySelect %W {end - 1 char}
  182. }
  183.  
  184. bind Text <Tab> {
  185.     if { [string equal [%W cget -state] "normal"] } {
  186.     tkTextInsert %W \t
  187.     focus %W
  188.     break
  189.     }
  190. }
  191. bind Text <Shift-Tab> {
  192.     # Needed only to keep <Tab> binding from triggering;  doesn't
  193.     # have to actually do anything.
  194.     break
  195. }
  196. bind Text <Control-Tab> {
  197.     focus [tk_focusNext %W]
  198. }
  199. bind Text <Control-Shift-Tab> {
  200.     focus [tk_focusPrev %W]
  201. }
  202. bind Text <Control-i> {
  203.     tkTextInsert %W \t
  204. }
  205. bind Text <Return> {
  206.     tkTextInsert %W \n
  207. }
  208. bind Text <Delete> {
  209.     if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
  210.     %W delete sel.first sel.last
  211.     } else {
  212.     %W delete insert
  213.     %W see insert
  214.     }
  215. }
  216. bind Text <BackSpace> {
  217.     if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
  218.     %W delete sel.first sel.last
  219.     } elseif {[%W compare insert != 1.0]} {
  220.     %W delete insert-1c
  221.     %W see insert
  222.     }
  223. }
  224.  
  225. bind Text <Control-space> {
  226.     %W mark set anchor insert
  227. }
  228. bind Text <Select> {
  229.     %W mark set anchor insert
  230. }
  231. bind Text <Control-Shift-space> {
  232.     set tkPriv(selectMode) char
  233.     tkTextKeyExtend %W insert
  234. }
  235. bind Text <Shift-Select> {
  236.     set tkPriv(selectMode) char
  237.     tkTextKeyExtend %W insert
  238. }
  239. bind Text <Control-slash> {
  240.     %W tag add sel 1.0 end
  241. }
  242. bind Text <Control-backslash> {
  243.     %W tag remove sel 1.0 end
  244. }
  245. bind Text <<Cut>> {
  246.     tk_textCut %W
  247. }
  248. bind Text <<Copy>> {
  249.     tk_textCopy %W
  250. }
  251. bind Text <<Paste>> {
  252.     tk_textPaste %W
  253. }
  254. bind Text <<Clear>> {
  255.     catch {%W delete sel.first sel.last}
  256. }
  257. bind Text <<PasteSelection>> {
  258.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  259.     tkTextPaste %W %x %y
  260.     }
  261. }
  262. bind Text <Insert> {
  263.     catch {tkTextInsert %W [selection get -displayof %W]}
  264. }
  265. bind Text <KeyPress> {
  266.     tkTextInsert %W %A
  267. }
  268.  
  269. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  270. # Otherwise, if a widget binding for one of these is defined, the
  271. # <KeyPress> class binding will also fire and insert the character,
  272. # which is wrong.  Ditto for <Escape>.
  273.  
  274. bind Text <Alt-KeyPress> {# nothing }
  275. bind Text <Meta-KeyPress> {# nothing}
  276. bind Text <Control-KeyPress> {# nothing}
  277. bind Text <Escape> {# nothing}
  278. bind Text <KP_Enter> {# nothing}
  279. if {[string equal $tcl_platform(platform) "macintosh"]} {
  280.     bind Text <Command-KeyPress> {# nothing}
  281. }
  282.  
  283. # Additional emacs-like bindings:
  284.  
  285. bind Text <Control-a> {
  286.     if {!$tk_strictMotif} {
  287.     tkTextSetCursor %W {insert linestart}
  288.     }
  289. }
  290. bind Text <Control-b> {
  291.     if {!$tk_strictMotif} {
  292.     tkTextSetCursor %W insert-1c
  293.     }
  294. }
  295. bind Text <Control-d> {
  296.     if {!$tk_strictMotif} {
  297.     %W delete insert
  298.     }
  299. }
  300. bind Text <Control-e> {
  301.     if {!$tk_strictMotif} {
  302.     tkTextSetCursor %W {insert lineend}
  303.     }
  304. }
  305. bind Text <Control-f> {
  306.     if {!$tk_strictMotif} {
  307.     tkTextSetCursor %W insert+1c
  308.     }
  309. }
  310. bind Text <Control-k> {
  311.     if {!$tk_strictMotif} {
  312.     if {[%W compare insert == {insert lineend}]} {
  313.         %W delete insert
  314.     } else {
  315.         %W delete insert {insert lineend}
  316.     }
  317.     }
  318. }
  319. bind Text <Control-n> {
  320.     if {!$tk_strictMotif} {
  321.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  322.     }
  323. }
  324. bind Text <Control-o> {
  325.     if {!$tk_strictMotif} {
  326.     %W insert insert \n
  327.     %W mark set insert insert-1c
  328.     }
  329. }
  330. bind Text <Control-p> {
  331.     if {!$tk_strictMotif} {
  332.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  333.     }
  334. }
  335. bind Text <Control-t> {
  336.     if {!$tk_strictMotif} {
  337.     tkTextTranspose %W
  338.     }
  339. }
  340.  
  341. if {[string compare $tcl_platform(platform) "windows"]} {
  342. bind Text <Control-v> {
  343.     if {!$tk_strictMotif} {
  344.     tkTextScrollPages %W 1
  345.     }
  346. }
  347. }
  348.  
  349. bind Text <Meta-b> {
  350.     if {!$tk_strictMotif} {
  351.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  352.     }
  353. }
  354. bind Text <Meta-d> {
  355.     if {!$tk_strictMotif} {
  356.     %W delete insert [tkTextNextWord %W insert]
  357.     }
  358. }
  359. bind Text <Meta-f> {
  360.     if {!$tk_strictMotif} {
  361.     tkTextSetCursor %W [tkTextNextWord %W insert]
  362.     }
  363. }
  364. bind Text <Meta-less> {
  365.     if {!$tk_strictMotif} {
  366.     tkTextSetCursor %W 1.0
  367.     }
  368. }
  369. bind Text <Meta-greater> {
  370.     if {!$tk_strictMotif} {
  371.     tkTextSetCursor %W end-1c
  372.     }
  373. }
  374. bind Text <Meta-BackSpace> {
  375.     if {!$tk_strictMotif} {
  376.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  377.     }
  378. }
  379. bind Text <Meta-Delete> {
  380.     if {!$tk_strictMotif} {
  381.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  382.     }
  383. }
  384.  
  385. # Macintosh only bindings:
  386.  
  387. # if text black & highlight black -> text white, other text the same
  388. if {[string equal $tcl_platform(platform) "macintosh"]} {
  389. bind Text <FocusIn> {
  390.     %W tag configure sel -borderwidth 0
  391.     %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
  392. }
  393. bind Text <FocusOut> {
  394.     %W tag configure sel -borderwidth 1
  395.     %W configure -selectbackground white -selectforeground black
  396. }
  397. bind Text <Option-Left> {
  398.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  399. }
  400. bind Text <Option-Right> {
  401.     tkTextSetCursor %W [tkTextNextWord %W insert]
  402. }
  403. bind Text <Option-Up> {
  404.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  405. }
  406. bind Text <Option-Down> {
  407.     tkTextSetCursor %W [tkTextNextPara %W insert]
  408. }
  409. bind Text <Shift-Option-Left> {
  410.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  411. }
  412. bind Text <Shift-Option-Right> {
  413.     tkTextKeySelect %W [tkTextNextWord %W insert]
  414. }
  415. bind Text <Shift-Option-Up> {
  416.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  417. }
  418. bind Text <Shift-Option-Down> {
  419.     tkTextKeySelect %W [tkTextNextPara %W insert]
  420. }
  421.  
  422. # End of Mac only bindings
  423. }
  424.  
  425. # A few additional bindings of my own.
  426.  
  427. bind Text <Control-h> {
  428.     if {!$tk_strictMotif} {
  429.     if {[%W compare insert != 1.0]} {
  430.         %W delete insert-1c
  431.         %W see insert
  432.     }
  433.     }
  434. }
  435. bind Text <2> {
  436.     if {!$tk_strictMotif} {
  437.     %W scan mark %x %y
  438.     set tkPriv(x) %x
  439.     set tkPriv(y) %y
  440.     set tkPriv(mouseMoved) 0
  441.     }
  442. }
  443. bind Text <B2-Motion> {
  444.     if {!$tk_strictMotif} {
  445.     if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
  446.         set tkPriv(mouseMoved) 1
  447.     }
  448.     if {$tkPriv(mouseMoved)} {
  449.         %W scan dragto %x %y
  450.     }
  451.     }
  452. }
  453. set tkPriv(prevPos) {}
  454.  
  455. # The MouseWheel will typically only fire on Windows.  However,
  456. # someone could use the "event generate" command to produce one
  457. # on other platforms.
  458.  
  459. bind Text <MouseWheel> {
  460.     %W yview scroll [expr {- (%D / 120) * 4}] units
  461. }
  462.  
  463. if {[string equal "unix" $tcl_platform(platform)]} {
  464.     # Support for mousewheels on Linux/Unix commonly comes through mapping
  465.     # the wheel to the extended buttons.  If you have a mousewheel, find
  466.     # Linux configuration info at:
  467.     #    http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  468.     bind Text <4> {
  469.     if {!$tk_strictMotif} {
  470.         %W yview scroll -5 units
  471.     }
  472.     }
  473.     bind Text <5> {
  474.     if {!$tk_strictMotif} {
  475.         %W yview scroll 5 units
  476.     }
  477.     }
  478. }
  479.  
  480. # tkTextClosestGap --
  481. # Given x and y coordinates, this procedure finds the closest boundary
  482. # between characters to the given coordinates and returns the index
  483. # of the character just after the boundary.
  484. #
  485. # Arguments:
  486. # w -        The text window.
  487. # x -        X-coordinate within the window.
  488. # y -        Y-coordinate within the window.
  489.  
  490. proc tkTextClosestGap {w x y} {
  491.     set pos [$w index @$x,$y]
  492.     set bbox [$w bbox $pos]
  493.     if {[string equal $bbox ""]} {
  494.     return $pos
  495.     }
  496.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  497.     return $pos
  498.     }
  499.     $w index "$pos + 1 char"
  500. }
  501.  
  502. # tkTextButton1 --
  503. # This procedure is invoked to handle button-1 presses in text
  504. # widgets.  It moves the insertion cursor, sets the selection anchor,
  505. # and claims the input focus.
  506. #
  507. # Arguments:
  508. # w -        The text window in which the button was pressed.
  509. # x -        The x-coordinate of the button press.
  510. # y -        The x-coordinate of the button press.
  511.  
  512. proc tkTextButton1 {w x y} {
  513.     global tkPriv
  514.  
  515.     set tkPriv(selectMode) char
  516.     set tkPriv(mouseMoved) 0
  517.     set tkPriv(pressX) $x
  518.     $w mark set insert [tkTextClosestGap $w $x $y]
  519.     $w mark set anchor insert
  520.     if {[string equal [$w cget -state] "normal"]} {focus $w}
  521. }
  522.  
  523. # tkTextSelectTo --
  524. # This procedure is invoked to extend the selection, typically when
  525. # dragging it with the mouse.  Depending on the selection mode (character,
  526. # word, line) it selects in different-sized units.  This procedure
  527. # ignores mouse motions initially until the mouse has moved from
  528. # one character to another or until there have been multiple clicks.
  529. #
  530. # Arguments:
  531. # w -        The text window in which the button was pressed.
  532. # x -        Mouse x position.
  533. # y -         Mouse y position.
  534.  
  535. proc tkTextSelectTo {w x y {extend 0}} {
  536.     global tkPriv tcl_platform
  537.  
  538.     set cur [tkTextClosestGap $w $x $y]
  539.     if {[catch {$w index anchor}]} {
  540.     $w mark set anchor $cur
  541.     }
  542.     set anchor [$w index anchor]
  543.     if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
  544.     set tkPriv(mouseMoved) 1
  545.     }
  546.     switch $tkPriv(selectMode) {
  547.     char {
  548.         if {[$w compare $cur < anchor]} {
  549.         set first $cur
  550.         set last anchor
  551.         } else {
  552.         set first anchor
  553.         set last $cur
  554.         }
  555.     }
  556.     word {
  557.         if {[$w compare $cur < anchor]} {
  558.         set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
  559.         if { !$extend } {
  560.             set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
  561.         } else {
  562.             set last anchor
  563.         }
  564.         } else {
  565.         set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
  566.         if { !$extend } {
  567.             set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
  568.         } else {
  569.             set first anchor
  570.         }
  571.         }
  572.     }
  573.     line {
  574.         if {[$w compare $cur < anchor]} {
  575.         set first [$w index "$cur linestart"]
  576.         set last [$w index "anchor - 1c lineend + 1c"]
  577.         } else {
  578.         set first [$w index "anchor linestart"]
  579.         set last [$w index "$cur lineend + 1c"]
  580.         }
  581.     }
  582.     }
  583.     if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
  584.     $w tag remove sel 0.0 end
  585.     $w mark set insert $cur
  586.     $w tag add sel $first $last
  587.     update idletasks
  588.     }
  589. }
  590.  
  591. # tkTextKeyExtend --
  592. # This procedure handles extending the selection from the keyboard,
  593. # where the point to extend to is really the boundary between two
  594. # characters rather than a particular character.
  595. #
  596. # Arguments:
  597. # w -        The text window.
  598. # index -    The point to which the selection is to be extended.
  599.  
  600. proc tkTextKeyExtend {w index} {
  601.     global tkPriv
  602.  
  603.     set cur [$w index $index]
  604.     if {[catch {$w index anchor}]} {
  605.     $w mark set anchor $cur
  606.     }
  607.     set anchor [$w index anchor]
  608.     if {[$w compare $cur < anchor]} {
  609.     set first $cur
  610.     set last anchor
  611.     } else {
  612.     set first anchor
  613.     set last $cur
  614.     }
  615.     $w tag remove sel 0.0 $first
  616.     $w tag add sel $first $last
  617.     $w tag remove sel $last end
  618. }
  619.  
  620. # tkTextPaste --
  621. # This procedure sets the insertion cursor to the mouse position,
  622. # inserts the selection, and sets the focus to the window.
  623. #
  624. # Arguments:
  625. # w -        The text window.
  626. # x, y -     Position of the mouse.
  627.  
  628. proc tkTextPaste {w x y} {
  629.     $w mark set insert [tkTextClosestGap $w $x $y]
  630.     catch {$w insert insert [selection get -displayof $w]}
  631.     if {[string equal [$w cget -state] "normal"]} {focus $w}
  632. }
  633.  
  634. # tkTextAutoScan --
  635. # This procedure is invoked when the mouse leaves a text window
  636. # with button 1 down.  It scrolls the window up, down, left, or right,
  637. # depending on where the mouse is (this information was saved in
  638. # tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
  639. # command so that the window continues to scroll until the mouse
  640. # moves back into the window or the mouse button is released.
  641. #
  642. # Arguments:
  643. # w -        The text window.
  644.  
  645. proc tkTextAutoScan {w} {
  646.     global tkPriv
  647.     if {![winfo exists $w]} return
  648.     if {$tkPriv(y) >= [winfo height $w]} {
  649.     $w yview scroll 2 units
  650.     } elseif {$tkPriv(y) < 0} {
  651.     $w yview scroll -2 units
  652.     } elseif {$tkPriv(x) >= [winfo width $w]} {
  653.     $w xview scroll 2 units
  654.     } elseif {$tkPriv(x) < 0} {
  655.     $w xview scroll -2 units
  656.     } else {
  657.     return
  658.     }
  659.     tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
  660.     set tkPriv(afterId) [after 50 [list tkTextAutoScan $w]]
  661. }
  662.  
  663. # tkTextSetCursor
  664. # Move the insertion cursor to a given position in a text.  Also
  665. # clears the selection, if there is one in the text, and makes sure
  666. # that the insertion cursor is visible.  Also, don't let the insertion
  667. # cursor appear on the dummy last line of the text.
  668. #
  669. # Arguments:
  670. # w -        The text window.
  671. # pos -        The desired new position for the cursor in the window.
  672.  
  673. proc tkTextSetCursor {w pos} {
  674.     global tkPriv
  675.  
  676.     if {[$w compare $pos == end]} {
  677.     set pos {end - 1 chars}
  678.     }
  679.     $w mark set insert $pos
  680.     $w tag remove sel 1.0 end
  681.     $w see insert
  682. }
  683.  
  684. # tkTextKeySelect
  685. # This procedure is invoked when stroking out selections using the
  686. # keyboard.  It moves the cursor to a new position, then extends
  687. # the selection to that position.
  688. #
  689. # Arguments:
  690. # w -        The text window.
  691. # new -        A new position for the insertion cursor (the cursor hasn't
  692. #        actually been moved to this position yet).
  693.  
  694. proc tkTextKeySelect {w new} {
  695.     global tkPriv
  696.  
  697.     if {[string equal [$w tag nextrange sel 1.0 end] ""]} {
  698.     if {[$w compare $new < insert]} {
  699.         $w tag add sel $new insert
  700.     } else {
  701.         $w tag add sel insert $new
  702.     }
  703.     $w mark set anchor insert
  704.     } else {
  705.     if {[$w compare $new < anchor]} {
  706.         set first $new
  707.         set last anchor
  708.     } else {
  709.         set first anchor
  710.         set last $new
  711.     }
  712.     $w tag remove sel 1.0 $first
  713.     $w tag add sel $first $last
  714.     $w tag remove sel $last end
  715.     }
  716.     $w mark set insert $new
  717.     $w see insert
  718.     update idletasks
  719. }
  720.  
  721. # tkTextResetAnchor --
  722. # Set the selection anchor to whichever end is farthest from the
  723. # index argument.  One special trick: if the selection has two or
  724. # fewer characters, just leave the anchor where it is.  In this
  725. # case it doesn't matter which point gets chosen for the anchor,
  726. # and for the things like Shift-Left and Shift-Right this produces
  727. # better behavior when the cursor moves back and forth across the
  728. # anchor.
  729. #
  730. # Arguments:
  731. # w -        The text widget.
  732. # index -    Position at which mouse button was pressed, which determines
  733. #        which end of selection should be used as anchor point.
  734.  
  735. proc tkTextResetAnchor {w index} {
  736.     global tkPriv
  737.  
  738.     if {[string equal [$w tag ranges sel] ""]} {
  739.     # Don't move the anchor if there is no selection now; this makes
  740.     # the widget behave "correctly" when the user clicks once, then
  741.     # shift-clicks somewhere -- ie, the area between the two clicks will be
  742.     # selected. [Bug: 5929].
  743.     return
  744.     }
  745.     set a [$w index $index]
  746.     set b [$w index sel.first]
  747.     set c [$w index sel.last]
  748.     if {[$w compare $a < $b]} {
  749.     $w mark set anchor sel.last
  750.     return
  751.     }
  752.     if {[$w compare $a > $c]} {
  753.     $w mark set anchor sel.first
  754.     return
  755.     }
  756.     scan $a "%d.%d" lineA chA
  757.     scan $b "%d.%d" lineB chB
  758.     scan $c "%d.%d" lineC chC
  759.     if {$lineB < $lineC+2} {
  760.     set total [string length [$w get $b $c]]
  761.     if {$total <= 2} {
  762.         return
  763.     }
  764.     if {[string length [$w get $b $a]] < ($total/2)} {
  765.         $w mark set anchor sel.last
  766.     } else {
  767.         $w mark set anchor sel.first
  768.     }
  769.     return
  770.     }
  771.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  772.     $w mark set anchor sel.last
  773.     } else {
  774.     $w mark set anchor sel.first
  775.     }
  776. }
  777.  
  778. # tkTextInsert --
  779. # Insert a string into a text at the point of the insertion cursor.
  780. # If there is a selection in the text, and it covers the point of the
  781. # insertion cursor, then delete the selection before inserting.
  782. #
  783. # Arguments:
  784. # w -        The text window in which to insert the string
  785. # s -        The string to insert (usually just a single character)
  786.  
  787. proc tkTextInsert {w s} {
  788.     if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
  789.     return
  790.     }
  791.     catch {
  792.     if {[$w compare sel.first <= insert] \
  793.         && [$w compare sel.last >= insert]} {
  794.         $w delete sel.first sel.last
  795.     }
  796.     }
  797.     $w insert insert $s
  798.     $w see insert
  799. }
  800.  
  801. # tkTextUpDownLine --
  802. # Returns the index of the character one line above or below the
  803. # insertion cursor.  There are two tricky things here.  First,
  804. # we want to maintain the original column across repeated operations,
  805. # even though some lines that will get passed through don't have
  806. # enough characters to cover the original column.  Second, don't
  807. # try to scroll past the beginning or end of the text.
  808. #
  809. # Arguments:
  810. # w -        The text window in which the cursor is to move.
  811. # n -        The number of lines to move: -1 for up one line,
  812. #        +1 for down one line.
  813.  
  814. proc tkTextUpDownLine {w n} {
  815.     global tkPriv
  816.  
  817.     set i [$w index insert]
  818.     scan $i "%d.%d" line char
  819.     if {[string compare $tkPriv(prevPos) $i]} {
  820.     set tkPriv(char) $char
  821.     }
  822.     set new [$w index [expr {$line + $n}].$tkPriv(char)]
  823.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  824.     set new $i
  825.     }
  826.     set tkPriv(prevPos) $new
  827.     return $new
  828. }
  829.  
  830. # tkTextPrevPara --
  831. # Returns the index of the beginning of the paragraph just before a given
  832. # position in the text (the beginning of a paragraph is the first non-blank
  833. # character after a blank line).
  834. #
  835. # Arguments:
  836. # w -        The text window in which the cursor is to move.
  837. # pos -        Position at which to start search.
  838.  
  839. proc tkTextPrevPara {w pos} {
  840.     set pos [$w index "$pos linestart"]
  841.     while {1} {
  842.     if {([string equal [$w get "$pos - 1 line"] "\n"] \
  843.         && [string compare [$w get $pos] "\n"]) \
  844.         || [string equal $pos "1.0"]} {
  845.         if {[regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  846.             dummy index]} {
  847.         set pos [$w index "$pos + [lindex $index 0] chars"]
  848.         }
  849.         if {[$w compare $pos != insert] || [string equal $pos 1.0]} {
  850.         return $pos
  851.         }
  852.     }
  853.     set pos [$w index "$pos - 1 line"]
  854.     }
  855. }
  856.  
  857. # tkTextNextPara --
  858. # Returns the index of the beginning of the paragraph just after a given
  859. # position in the text (the beginning of a paragraph is the first non-blank
  860. # character after a blank line).
  861. #
  862. # Arguments:
  863. # w -        The text window in which the cursor is to move.
  864. # start -    Position at which to start search.
  865.  
  866. proc tkTextNextPara {w start} {
  867.     set pos [$w index "$start linestart + 1 line"]
  868.     while {[string compare [$w get $pos] "\n"]} {
  869.     if {[$w compare $pos == end]} {
  870.         return [$w index "end - 1c"]
  871.     }
  872.     set pos [$w index "$pos + 1 line"]
  873.     }
  874.     while {[string equal [$w get $pos] "\n"]} {
  875.     set pos [$w index "$pos + 1 line"]
  876.     if {[$w compare $pos == end]} {
  877.         return [$w index "end - 1c"]
  878.     }
  879.     }
  880.     if {[regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  881.         dummy index]} {
  882.     return [$w index "$pos + [lindex $index 0] chars"]
  883.     }
  884.     return $pos
  885. }
  886.  
  887. # tkTextScrollPages --
  888. # This is a utility procedure used in bindings for moving up and down
  889. # pages and possibly extending the selection along the way.  It scrolls
  890. # the view in the widget by the number of pages, and it returns the
  891. # index of the character that is at the same position in the new view
  892. # as the insertion cursor used to be in the old view.
  893. #
  894. # Arguments:
  895. # w -        The text window in which the cursor is to move.
  896. # count -    Number of pages forward to scroll;  may be negative
  897. #        to scroll backwards.
  898.  
  899. proc tkTextScrollPages {w count} {
  900.     set bbox [$w bbox insert]
  901.     $w yview scroll $count pages
  902.     if {[string equal $bbox ""]} {
  903.     return [$w index @[expr {[winfo height $w]/2}],0]
  904.     }
  905.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  906. }
  907.  
  908. # tkTextTranspose --
  909. # This procedure implements the "transpose" function for text widgets.
  910. # It tranposes the characters on either side of the insertion cursor,
  911. # unless the cursor is at the end of the line.  In this case it
  912. # transposes the two characters to the left of the cursor.  In either
  913. # case, the cursor ends up to the right of the transposed characters.
  914. #
  915. # Arguments:
  916. # w -        Text window in which to transpose.
  917.  
  918. proc tkTextTranspose w {
  919.     set pos insert
  920.     if {[$w compare $pos != "$pos lineend"]} {
  921.     set pos [$w index "$pos + 1 char"]
  922.     }
  923.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  924.     if {[$w compare "$pos - 1 char" == 1.0]} {
  925.     return
  926.     }
  927.     $w delete "$pos - 2 char" $pos
  928.     $w insert insert $new
  929.     $w see insert
  930. }
  931.  
  932. # tk_textCopy --
  933. # This procedure copies the selection from a text widget into the
  934. # clipboard.
  935. #
  936. # Arguments:
  937. # w -        Name of a text widget.
  938.  
  939. proc tk_textCopy w {
  940.     if {![catch {set data [$w get sel.first sel.last]}]} {
  941.     clipboard clear -displayof $w
  942.     clipboard append -displayof $w $data
  943.     }
  944. }
  945.  
  946. # tk_textCut --
  947. # This procedure copies the selection from a text widget into the
  948. # clipboard, then deletes the selection (if it exists in the given
  949. # widget).
  950. #
  951. # Arguments:
  952. # w -        Name of a text widget.
  953.  
  954. proc tk_textCut w {
  955.     if {![catch {set data [$w get sel.first sel.last]}]} {
  956.     clipboard clear -displayof $w
  957.     clipboard append -displayof $w $data
  958.     $w delete sel.first sel.last
  959.     }
  960. }
  961.  
  962. # tk_textPaste --
  963. # This procedure pastes the contents of the clipboard to the insertion
  964. # point in a text widget.
  965. #
  966. # Arguments:
  967. # w -        Name of a text widget.
  968.  
  969. proc tk_textPaste w {
  970.     global tcl_platform
  971.     catch {
  972.     if {[string compare $tcl_platform(platform) "unix"]} {
  973.         catch {
  974.         $w delete sel.first sel.last
  975.         }
  976.     }
  977.     $w insert insert [selection get -displayof $w -selection CLIPBOARD]
  978.     }
  979. }
  980.  
  981. # tkTextNextWord --
  982. # Returns the index of the next word position after a given position in the
  983. # text.  The next word is platform dependent and may be either the next
  984. # end-of-word position or the next start-of-word position after the next
  985. # end-of-word position.
  986. #
  987. # Arguments:
  988. # w -        The text window in which the cursor is to move.
  989. # start -    Position at which to start search.
  990.  
  991. if {[string equal $tcl_platform(platform) "windows"]}  {
  992.     proc tkTextNextWord {w start} {
  993.     tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
  994.         tcl_startOfNextWord
  995.     }
  996. } else {
  997.     proc tkTextNextWord {w start} {
  998.     tkTextNextPos $w $start tcl_endOfWord
  999.     }
  1000. }
  1001.  
  1002. # tkTextNextPos --
  1003. # Returns the index of the next position after the given starting
  1004. # position in the text as computed by a specified function.
  1005. #
  1006. # Arguments:
  1007. # w -        The text window in which the cursor is to move.
  1008. # start -    Position at which to start search.
  1009. # op -        Function to use to find next position.
  1010.  
  1011. proc tkTextNextPos {w start op} {
  1012.     set text ""
  1013.     set cur $start
  1014.     while {[$w compare $cur < end]} {
  1015.     set text $text[$w get $cur "$cur lineend + 1c"]
  1016.     set pos [$op $text 0]
  1017.     if {$pos >= 0} {
  1018.         ## Adjust for embedded windows and images
  1019.         ## dump gives us 3 items per window/image
  1020.         set dump [$w dump -image -window $start "$start + $pos c"]
  1021.         if {[llength $dump]} {
  1022.         set pos [expr {$pos + ([llength $dump]/3)}]
  1023.         }
  1024.         return [$w index "$start + $pos c"]
  1025.     }
  1026.     set cur [$w index "$cur lineend +1c"]
  1027.     }
  1028.     return end
  1029. }
  1030.  
  1031. # tkTextPrevPos --
  1032. # Returns the index of the previous position before the given starting
  1033. # position in the text as computed by a specified function.
  1034. #
  1035. # Arguments:
  1036. # w -        The text window in which the cursor is to move.
  1037. # start -    Position at which to start search.
  1038. # op -        Function to use to find next position.
  1039.  
  1040. proc tkTextPrevPos {w start op} {
  1041.     set text ""
  1042.     set cur $start
  1043.     while {[$w compare $cur > 0.0]} {
  1044.     set text [$w get "$cur linestart - 1c" $cur]$text
  1045.     set pos [$op $text end]
  1046.     if {$pos >= 0} {
  1047.         ## Adjust for embedded windows and images
  1048.         ## dump gives us 3 items per window/image
  1049.         set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
  1050.         if {[llength $dump]} {
  1051.         ## This is a hokey extra hack for control-arrow movement
  1052.         ## that should be in a while loop to be correct (hobbs)
  1053.         if {[$w compare [lindex $dump 2] > \
  1054.             "$cur linestart - 1c + $pos c"]} {
  1055.             incr pos -1
  1056.         }
  1057.         set pos [expr {$pos + ([llength $dump]/3)}]
  1058.         }
  1059.         return [$w index "$cur linestart - 1c + $pos c"]
  1060.     }
  1061.     set cur [$w index "$cur linestart - 1c"]
  1062.     }
  1063.     return 0.0
  1064. }
  1065.