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