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