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