home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tk42r2x.zip / TclTk / lib / tk4.2 / text.tcl < prev    next >
Text File  |  1999-07-27  |  23KB  |  889 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. # SCCS: @(#) text.tcl 1.46 96/08/23 14:07:32
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # char -        Character position on the line;  kept in order
  22. #            to allow moving up or down past short lines while
  23. #            still remembering the desired position.
  24. # mouseMoved -        Non-zero means the mouse has moved a significant
  25. #            amount since the button went down (so, for example,
  26. #            start dragging out a selection).
  27. # prevPos -        Used when moving up or down lines via the keyboard.
  28. #            Keeps track of the previous insert position, so
  29. #            we can distinguish a series of ups and downs, all
  30. #            in a row, from a new up or down.
  31. # selectMode -        The style of selection currently underway:
  32. #            char, word, or line.
  33. # x, y -        Last known mouse coordinates for scanning
  34. #            and auto-scanning.
  35. #-------------------------------------------------------------------------
  36.  
  37. #-------------------------------------------------------------------------
  38. # The code below creates the default class bindings for entries.
  39. #-------------------------------------------------------------------------
  40.  
  41. # Standard Motif bindings:
  42.  
  43. bind Text <1> {
  44.     tkTextButton1 %W %x %y
  45.     %W tag remove sel 0.0 end
  46. }
  47. bind Text <B1-Motion> {
  48.     set tkPriv(x) %x
  49.     set tkPriv(y) %y
  50.     tkTextSelectTo %W %x %y
  51. }
  52. bind Text <Double-1> {
  53.     set tkPriv(selectMode) word
  54.     tkTextSelectTo %W %x %y
  55.     catch {%W mark set insert sel.first}
  56. }
  57. bind Text <Triple-1> {
  58.     set tkPriv(selectMode) line
  59.     tkTextSelectTo %W %x %y
  60.     catch {%W mark set insert sel.first}
  61. }
  62. bind Text <Shift-1> {
  63.     tkTextResetAnchor %W @%x,%y
  64.     set tkPriv(selectMode) char
  65.     tkTextSelectTo %W %x %y
  66. }
  67. bind Text <Double-Shift-1>    {
  68.     set tkPriv(selectMode) word
  69.     tkTextSelectTo %W %x %y
  70. }
  71. bind Text <Triple-Shift-1>    {
  72.     set tkPriv(selectMode) line
  73.     tkTextSelectTo %W %x %y
  74. }
  75. bind Text <B1-Leave> {
  76.     set tkPriv(x) %x
  77.     set tkPriv(y) %y
  78.     tkTextAutoScan %W
  79. }
  80. bind Text <B1-Enter> {
  81.     tkCancelRepeat
  82. }
  83. bind Text <ButtonRelease-1> {
  84.     tkCancelRepeat
  85. }
  86. bind Text <Control-1> {
  87.     %W mark set insert @%x,%y
  88. }
  89. bind Text <ButtonRelease-2> {
  90.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  91.     tkTextPaste %W %x %y
  92.     }
  93. }
  94. bind Text <Left> {
  95.     tkTextSetCursor %W insert-1c
  96. }
  97. bind Text <Right> {
  98.     tkTextSetCursor %W insert+1c
  99. }
  100. bind Text <Up> {
  101.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  102. }
  103. bind Text <Down> {
  104.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  105. }
  106. bind Text <Shift-Left> {
  107.     tkTextKeySelect %W [%W index {insert - 1c}]
  108. }
  109. bind Text <Shift-Right> {
  110.     tkTextKeySelect %W [%W index {insert + 1c}]
  111. }
  112. bind Text <Shift-Up> {
  113.     tkTextKeySelect %W [tkTextUpDownLine %W -1]
  114. }
  115. bind Text <Shift-Down> {
  116.     tkTextKeySelect %W [tkTextUpDownLine %W 1]
  117. }
  118. bind Text <Control-Left> {
  119.     tkTextSetCursor %W [%W index {insert - 1c wordstart}]
  120. }
  121. bind Text <Control-Right> {
  122.     tkTextSetCursor %W [%W index {insert wordend}]
  123. }
  124. bind Text <Control-Up> {
  125.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  126. }
  127. bind Text <Control-Down> {
  128.     tkTextSetCursor %W [tkTextNextPara %W insert]
  129. }
  130. bind Text <Shift-Control-Left> {
  131.     tkTextKeySelect %W [%W index {insert - 1c wordstart}]
  132. }
  133. bind Text <Shift-Control-Right> {
  134.     tkTextKeySelect %W [%W index {insert wordend}]
  135. }
  136. bind Text <Shift-Control-Up> {
  137.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  138. }
  139. bind Text <Shift-Control-Down> {
  140.     tkTextKeySelect %W [tkTextNextPara %W insert]
  141. }
  142. bind Text <Prior> {
  143.     tkTextSetCursor %W [tkTextScrollPages %W -1]
  144. }
  145. bind Text <Shift-Prior> {
  146.     tkTextKeySelect %W [tkTextScrollPages %W -1]
  147. }
  148. bind Text <Next> {
  149.     tkTextSetCursor %W [tkTextScrollPages %W 1]
  150. }
  151. bind Text <Shift-Next> {
  152.     tkTextKeySelect %W [tkTextScrollPages %W 1]
  153. }
  154. bind Text <Control-Prior> {
  155.     %W xview scroll -1 page
  156. }
  157. bind Text <Control-Next> {
  158.     %W xview scroll 1 page
  159. }
  160.  
  161. bind Text <Home> {
  162.     tkTextSetCursor %W {insert linestart}
  163. }
  164. bind Text <Shift-Home> {
  165.     tkTextKeySelect %W {insert linestart}
  166. }
  167. bind Text <End> {
  168.     tkTextSetCursor %W {insert lineend}
  169. }
  170. bind Text <Shift-End> {
  171.     tkTextKeySelect %W {insert lineend}
  172. }
  173. bind Text <Control-Home> {
  174.     tkTextSetCursor %W 1.0
  175. }
  176. bind Text <Control-Shift-Home> {
  177.     tkTextKeySelect %W 1.0
  178. }
  179. bind Text <Control-End> {
  180.     tkTextSetCursor %W {end - 1 char}
  181. }
  182. bind Text <Control-Shift-End> {
  183.     tkTextKeySelect %W {end - 1 char}
  184. }
  185.  
  186. bind Text <Tab> {
  187.     tkTextInsert %W \t
  188.     focus %W
  189.     break
  190. }
  191. bind Text <Shift-Tab> {
  192.     # Needed only to keep <Tab> binding from triggering;  doesn't
  193.     # have to actually do anything.
  194. }
  195. bind Text <Control-Tab> {
  196.     focus [tk_focusNext %W]
  197. }
  198. bind Text <Control-Shift-Tab> {
  199.     focus [tk_focusPrev %W]
  200. }
  201. bind Text <Control-i> {
  202.     tkTextInsert %W \t
  203. }
  204. bind Text <Return> {
  205.     tkTextInsert %W \n
  206. }
  207. bind Text <Delete> {
  208.     if {[%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 {[%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 tkPriv(selectMode) char
  232.     tkTextKeyExtend %W insert
  233. }
  234. bind Text <Shift-Select> {
  235.     set tkPriv(selectMode) char
  236.     tkTextKeyExtend %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.     %W delete sel.first sel.last
  255. }
  256. bind Text <Insert> {
  257.     catch {tkTextInsert %W [selection get -displayof %W]}
  258. }
  259. bind Text <KeyPress> {
  260.     tkTextInsert %W %A
  261. }
  262.  
  263. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  264. # Otherwise, if a widget binding for one of these is defined, the
  265. # <KeyPress> class binding will also fire and insert the character,
  266. # which is wrong.  Ditto for <Escape>.
  267.  
  268. bind Text <Alt-KeyPress> {# nothing }
  269. bind Text <Meta-KeyPress> {# nothing}
  270. bind Text <Control-KeyPress> {# nothing}
  271. bind Text <Escape> {# nothing}
  272. bind Text <KP_Enter> {# nothing}
  273.  
  274. # Additional emacs-like bindings:
  275.  
  276. bind Text <Control-a> {
  277.     if !$tk_strictMotif {
  278.     tkTextSetCursor %W {insert linestart}
  279.     }
  280. }
  281. bind Text <Control-b> {
  282.     if !$tk_strictMotif {
  283.     tkTextSetCursor %W insert-1c
  284.     }
  285. }
  286. bind Text <Control-d> {
  287.     if !$tk_strictMotif {
  288.     %W delete insert
  289.     }
  290. }
  291. bind Text <Control-e> {
  292.     if !$tk_strictMotif {
  293.     tkTextSetCursor %W {insert lineend}
  294.     }
  295. }
  296. bind Text <Control-f> {
  297.     if !$tk_strictMotif {
  298.     tkTextSetCursor %W insert+1c
  299.     }
  300. }
  301. bind Text <Control-k> {
  302.     if !$tk_strictMotif {
  303.     if [%W compare insert == {insert lineend}] {
  304.         %W delete insert
  305.     } else {
  306.         %W delete insert {insert lineend}
  307.     }
  308.     }
  309. }
  310. bind Text <Control-n> {
  311.     if !$tk_strictMotif {
  312.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  313.     }
  314. }
  315. bind Text <Control-o> {
  316.     if !$tk_strictMotif {
  317.     %W insert insert \n
  318.     %W mark set insert insert-1c
  319.     }
  320. }
  321. bind Text <Control-p> {
  322.     if !$tk_strictMotif {
  323.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  324.     }
  325. }
  326. bind Text <Control-t> {
  327.     if !$tk_strictMotif {
  328.     tkTextTranspose %W
  329.     }
  330. }
  331. bind Text <Control-v> {
  332.     if !$tk_strictMotif {
  333.     tkTextScrollPages %W 1
  334.     }
  335. }
  336. bind Text <Meta-b> {
  337.     if !$tk_strictMotif {
  338.     tkTextSetCursor %W {insert - 1c wordstart}
  339.     }
  340. }
  341. bind Text <Meta-d> {
  342.     if !$tk_strictMotif {
  343.     %W delete insert {insert wordend}
  344.     }
  345. }
  346. bind Text <Meta-f> {
  347.     if !$tk_strictMotif {
  348.     tkTextSetCursor %W {insert wordend}
  349.     }
  350. }
  351. bind Text <Meta-less> {
  352.     if !$tk_strictMotif {
  353.     tkTextSetCursor %W 1.0
  354.     }
  355. }
  356. bind Text <Meta-greater> {
  357.     if !$tk_strictMotif {
  358.     tkTextSetCursor %W end-1c
  359.     }
  360. }
  361. bind Text <Meta-BackSpace> {
  362.     if !$tk_strictMotif {
  363.     %W delete {insert -1c wordstart} insert
  364.     }
  365. }
  366. bind Text <Meta-Delete> {
  367.     if !$tk_strictMotif {
  368.     %W delete {insert -1c wordstart} insert
  369.     }
  370. }
  371.  
  372. # A few additional bindings of my own.
  373.  
  374. bind Text <Control-h> {
  375.     if !$tk_strictMotif {
  376.     if [%W compare insert != 1.0] {
  377.         %W delete insert-1c
  378.         %W see insert
  379.     }
  380.     }
  381. }
  382. bind Text <2> {
  383.     if !$tk_strictMotif {
  384.     %W scan mark %x %y
  385.     set tkPriv(x) %x
  386.     set tkPriv(y) %y
  387.     set tkPriv(mouseMoved) 0
  388.     }
  389. }
  390. bind Text <B2-Motion> {
  391.     if !$tk_strictMotif {
  392.     if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
  393.         set tkPriv(mouseMoved) 1
  394.     }
  395.     if $tkPriv(mouseMoved) {
  396.         %W scan dragto %x %y
  397.     }
  398.     }
  399. }
  400. set tkPriv(prevPos) {}
  401.  
  402. # tkTextClosestGap --
  403. # Given x and y coordinates, this procedure finds the closest boundary
  404. # between characters to the given coordinates and returns the index
  405. # of the character just after the boundary.
  406. #
  407. # Arguments:
  408. # w -        The text window.
  409. # x -        X-coordinate within the window.
  410. # y -        Y-coordinate within the window.
  411.  
  412. proc tkTextClosestGap {w x y} {
  413.     set pos [$w index @$x,$y]
  414.     set bbox [$w bbox $pos]
  415.     if ![string compare $bbox ""] {
  416.     return $pos
  417.     }
  418.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  419.     return $pos
  420.     }
  421.     $w index "$pos + 1 char"
  422. }
  423.  
  424. # tkTextButton1 --
  425. # This procedure is invoked to handle button-1 presses in text
  426. # widgets.  It moves the insertion cursor, sets the selection anchor,
  427. # and claims the input focus.
  428. #
  429. # Arguments:
  430. # w -        The text window in which the button was pressed.
  431. # x -        The x-coordinate of the button press.
  432. # y -        The x-coordinate of the button press.
  433.  
  434. proc tkTextButton1 {w x y} {
  435.     global tkPriv
  436.  
  437.     set tkPriv(selectMode) char
  438.     set tkPriv(mouseMoved) 0
  439.     set tkPriv(pressX) $x
  440.     $w mark set insert [tkTextClosestGap $w $x $y]
  441.     $w mark set anchor insert
  442.     if {[$w cget -state] == "normal"} {focus $w}
  443. }
  444.  
  445. # tkTextSelectTo --
  446. # This procedure is invoked to extend the selection, typically when
  447. # dragging it with the mouse.  Depending on the selection mode (character,
  448. # word, line) it selects in different-sized units.  This procedure
  449. # ignores mouse motions initially until the mouse has moved from
  450. # one character to another or until there have been multiple clicks.
  451. #
  452. # Arguments:
  453. # w -        The text window in which the button was pressed.
  454. # x -        Mouse x position.
  455. # y -         Mouse y position.
  456.  
  457. proc tkTextSelectTo {w x y} {
  458.     global tkPriv
  459.  
  460.     set cur [tkTextClosestGap $w $x $y]
  461.     if [catch {$w index anchor}] {
  462.     $w mark set anchor $cur
  463.     }
  464.     set anchor [$w index anchor]
  465.     if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
  466.     set tkPriv(mouseMoved) 1
  467.     }
  468.     switch $tkPriv(selectMode) {
  469.     char {
  470.         if [$w compare $cur < anchor] {
  471.         set first $cur
  472.         set last anchor
  473.         } else {
  474.         set first anchor
  475.         set last $cur
  476.         }
  477.     }
  478.     word {
  479.         if [$w compare $cur < anchor] {
  480.         set first [$w index "$cur wordstart"]
  481.         set last [$w index "anchor - 1c wordend"]
  482.         } else {
  483.         set first [$w index "anchor wordstart"]
  484.         set last [$w index "$cur -1c wordend"]
  485.         }
  486.     }
  487.     line {
  488.         if [$w compare $cur < anchor] {
  489.         set first [$w index "$cur linestart"]
  490.         set last [$w index "anchor - 1c lineend + 1c"]
  491.         } else {
  492.         set first [$w index "anchor linestart"]
  493.         set last [$w index "$cur lineend + 1c"]
  494.         }
  495.     }
  496.     }
  497.     if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {
  498.     $w tag remove sel 0.0 $first
  499.     $w tag add sel $first $last
  500.     $w tag remove sel $last end
  501.     update idletasks
  502.     }
  503. }
  504.  
  505. # tkTextKeyExtend --
  506. # This procedure handles extending the selection from the keyboard,
  507. # where the point to extend to is really the boundary between two
  508. # characters rather than a particular character.
  509. #
  510. # Arguments:
  511. # w -        The text window.
  512. # index -    The point to which the selection is to be extended.
  513.  
  514. proc tkTextKeyExtend {w index} {
  515.     global tkPriv
  516.  
  517.     set cur [$w index $index]
  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] {
  523.     set first $cur
  524.     set last anchor
  525.     } else {
  526.     set first anchor
  527.     set last $cur
  528.     }
  529.     $w tag remove sel 0.0 $first
  530.     $w tag add sel $first $last
  531.     $w tag remove sel $last end
  532. }
  533.  
  534. # tkTextPaste --
  535. # This procedure sets the insertion cursor to the mouse position,
  536. # inserts the selection, and sets the focus to the window.
  537. #
  538. # Arguments:
  539. # w -        The text window.
  540. # x, y -     Position of the mouse.
  541.  
  542. proc tkTextPaste {w x y} {
  543.     $w mark set insert [tkTextClosestGap $w $x $y]
  544.     catch {$w insert insert [selection get -displayof $w]}
  545.     if {[$w cget -state] == "normal"} {focus $w}
  546. }
  547.  
  548. # tkTextAutoScan --
  549. # This procedure is invoked when the mouse leaves a text window
  550. # with button 1 down.  It scrolls the window up, down, left, or right,
  551. # depending on where the mouse is (this information was saved in
  552. # tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
  553. # command so that the window continues to scroll until the mouse
  554. # moves back into the window or the mouse button is released.
  555. #
  556. # Arguments:
  557. # w -        The text window.
  558.  
  559. proc tkTextAutoScan {w} {
  560.     global tkPriv
  561.     if {![winfo exists $w]} return
  562.     if {$tkPriv(y) >= [winfo height $w]} {
  563.     $w yview scroll 2 units
  564.     } elseif {$tkPriv(y) < 0} {
  565.     $w yview scroll -2 units
  566.     } elseif {$tkPriv(x) >= [winfo width $w]} {
  567.     $w xview scroll 2 units
  568.     } elseif {$tkPriv(x) < 0} {
  569.     $w xview scroll -2 units
  570.     } else {
  571.     return
  572.     }
  573.     tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
  574.     set tkPriv(afterId) [after 50 tkTextAutoScan $w]
  575. }
  576.  
  577. # tkTextSetCursor
  578. # Move the insertion cursor to a given position in a text.  Also
  579. # clears the selection, if there is one in the text, and makes sure
  580. # that the insertion cursor is visible.  Also, don't let the insertion
  581. # cursor appear on the dummy last line of the text.
  582. #
  583. # Arguments:
  584. # w -        The text window.
  585. # pos -        The desired new position for the cursor in the window.
  586.  
  587. proc tkTextSetCursor {w pos} {
  588.     global tkPriv
  589.  
  590.     if [$w compare $pos == end] {
  591.     set pos {end - 1 chars}
  592.     }
  593.     $w mark set insert $pos
  594.     $w tag remove sel 1.0 end
  595.     $w see insert
  596. }
  597.  
  598. # tkTextKeySelect
  599. # This procedure is invoked when stroking out selections using the
  600. # keyboard.  It moves the cursor to a new position, then extends
  601. # the selection to that position.
  602. #
  603. # Arguments:
  604. # w -        The text window.
  605. # new -        A new position for the insertion cursor (the cursor hasn't
  606. #        actually been moved to this position yet).
  607.  
  608. proc tkTextKeySelect {w new} {
  609.     global tkPriv
  610.  
  611.     if {[$w tag nextrange sel 1.0 end] == ""} {
  612.     if [$w compare $new < insert] {
  613.         $w tag add sel $new insert
  614.     } else {
  615.         $w tag add sel insert $new
  616.     }
  617.     $w mark set anchor insert
  618.     } else {
  619.     if [$w compare $new < anchor] {
  620.         set first $new
  621.         set last anchor
  622.     } else {
  623.         set first anchor
  624.         set last $new
  625.     }
  626.     $w tag remove sel 1.0 $first
  627.     $w tag add sel $first $last
  628.     $w tag remove sel $last end
  629.     }
  630.     $w mark set insert $new
  631.     $w see insert
  632.     update idletasks
  633. }
  634.  
  635. # tkTextResetAnchor --
  636. # Set the selection anchor to whichever end is farthest from the
  637. # index argument.  One special trick: if the selection has two or
  638. # fewer characters, just leave the anchor where it is.  In this
  639. # case it doesn't matter which point gets chosen for the anchor,
  640. # and for the things like Shift-Left and Shift-Right this produces
  641. # better behavior when the cursor moves back and forth across the
  642. # anchor.
  643. #
  644. # Arguments:
  645. # w -        The text widget.
  646. # index -    Position at which mouse button was pressed, which determines
  647. #        which end of selection should be used as anchor point.
  648.  
  649. proc tkTextResetAnchor {w index} {
  650.     global tkPriv
  651.  
  652.     if {[$w tag ranges sel] == ""} {
  653.     $w mark set anchor $index
  654.     return
  655.     }
  656.     set a [$w index $index]
  657.     set b [$w index sel.first]
  658.     set c [$w index sel.last]
  659.     if [$w compare $a < $b] {
  660.     $w mark set anchor sel.last
  661.     return
  662.     }
  663.     if [$w compare $a > $c] {
  664.     $w mark set anchor sel.first
  665.     return
  666.     }
  667.     scan $a "%d.%d" lineA chA
  668.     scan $b "%d.%d" lineB chB
  669.     scan $c "%d.%d" lineC chC
  670.     if {$lineB < $lineC+2} {
  671.     set total [string length [$w get $b $c]]
  672.     if {$total <= 2} {
  673.         return
  674.     }
  675.     if {[string length [$w get $b $a]] < ($total/2)} {
  676.         $w mark set anchor sel.last
  677.     } else {
  678.         $w mark set anchor sel.first
  679.     }
  680.     return
  681.     }
  682.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  683.     $w mark set anchor sel.last
  684.     } else {
  685.     $w mark set anchor sel.first
  686.     }
  687. }
  688.  
  689. # tkTextInsert --
  690. # Insert a string into a text at the point of the insertion cursor.
  691. # If there is a selection in the text, and it covers the point of the
  692. # insertion cursor, then delete the selection before inserting.
  693. #
  694. # Arguments:
  695. # w -        The text window in which to insert the string
  696. # s -        The string to insert (usually just a single character)
  697.  
  698. proc tkTextInsert {w s} {
  699.     if {($s == "") || ([$w cget -state] == "disabled")} {
  700.     return
  701.     }
  702.     catch {
  703.     if {[$w compare sel.first <= insert]
  704.         && [$w compare sel.last >= insert]} {
  705.         $w delete sel.first sel.last
  706.     }
  707.     }
  708.     $w insert insert $s
  709.     $w see insert
  710. }
  711.  
  712. # tkTextUpDownLine --
  713. # Returns the index of the character one line above or below the
  714. # insertion cursor.  There are two tricky things here.  First,
  715. # we want to maintain the original column across repeated operations,
  716. # even though some lines that will get passed through don't have
  717. # enough characters to cover the original column.  Second, don't
  718. # try to scroll past the beginning or end of the text.
  719. #
  720. # Arguments:
  721. # w -        The text window in which the cursor is to move.
  722. # n -        The number of lines to move: -1 for up one line,
  723. #        +1 for down one line.
  724.  
  725. proc tkTextUpDownLine {w n} {
  726.     global tkPriv
  727.  
  728.     set i [$w index insert]
  729.     scan $i "%d.%d" line char
  730.     if {[string compare $tkPriv(prevPos) $i] != 0} {
  731.     set tkPriv(char) $char
  732.     }
  733.     set new [$w index [expr $line + $n].$tkPriv(char)]
  734.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  735.     set new $i
  736.     }
  737.     set tkPriv(prevPos) $new
  738.     return $new
  739. }
  740.  
  741. # tkTextPrevPara --
  742. # Returns the index of the beginning of the paragraph just before a given
  743. # position in the text (the beginning of a paragraph is the first non-blank
  744. # character after a blank line).
  745. #
  746. # Arguments:
  747. # w -        The text window in which the cursor is to move.
  748. # pos -        Position at which to start search.
  749.  
  750. proc tkTextPrevPara {w pos} {
  751.     set pos [$w index "$pos linestart"]
  752.     while 1 {
  753.     if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))
  754.         || ($pos == "1.0")} {
  755.         if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  756.             dummy index] {
  757.         set pos [$w index "$pos + [lindex $index 0] chars"]
  758.         }
  759.         if {[$w compare $pos != insert] || ($pos == "1.0")} {
  760.         return $pos
  761.         }
  762.     }
  763.     set pos [$w index "$pos - 1 line"]
  764.     }
  765. }
  766.  
  767. # tkTextNextPara --
  768. # Returns the index of the beginning of the paragraph just after a given
  769. # position in the text (the beginning of a paragraph is the first non-blank
  770. # character after a blank line).
  771. #
  772. # Arguments:
  773. # w -        The text window in which the cursor is to move.
  774. # start -    Position at which to start search.
  775.  
  776. proc tkTextNextPara {w start} {
  777.     set pos [$w index "$start linestart + 1 line"]
  778.     while {[$w get $pos] != "\n"} {
  779.     if [$w compare $pos == end] {
  780.         return [$w index "end - 1c"]
  781.     }
  782.     set pos [$w index "$pos + 1 line"]
  783.     }
  784.     while {[$w get $pos] == "\n"} {
  785.     set pos [$w index "$pos + 1 line"]
  786.     if [$w compare $pos == end] {
  787.         return [$w index "end - 1c"]
  788.     }
  789.     }
  790.     if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  791.         dummy index] {
  792.     return [$w index "$pos + [lindex $index 0] chars"]
  793.     }
  794.     return $pos
  795. }
  796.  
  797. # tkTextScrollPages --
  798. # This is a utility procedure used in bindings for moving up and down
  799. # pages and possibly extending the selection along the way.  It scrolls
  800. # the view in the widget by the number of pages, and it returns the
  801. # index of the character that is at the same position in the new view
  802. # as the insertion cursor used to be in the old view.
  803. #
  804. # Arguments:
  805. # w -        The text window in which the cursor is to move.
  806. # count -    Number of pages forward to scroll;  may be negative
  807. #        to scroll backwards.
  808.  
  809. proc tkTextScrollPages {w count} {
  810.     set bbox [$w bbox insert]
  811.     $w yview scroll $count pages
  812.     if {$bbox == ""} {
  813.     return [$w index @[expr [winfo height $w]/2],0]
  814.     }
  815.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  816. }
  817.  
  818. # tkTextTranspose --
  819. # This procedure implements the "transpose" function for text widgets.
  820. # It tranposes the characters on either side of the insertion cursor,
  821. # unless the cursor is at the end of the line.  In this case it
  822. # transposes the two characters to the left of the cursor.  In either
  823. # case, the cursor ends up to the right of the transposed characters.
  824. #
  825. # Arguments:
  826. # w -        Text window in which to transpose.
  827.  
  828. proc tkTextTranspose w {
  829.     set pos insert
  830.     if [$w compare $pos != "$pos lineend"] {
  831.     set pos [$w index "$pos + 1 char"]
  832.     }
  833.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  834.     if [$w compare "$pos - 1 char" == 1.0] {
  835.     return
  836.     }
  837.     $w delete "$pos - 2 char" $pos
  838.     $w insert insert $new
  839.     $w see insert
  840. }
  841.  
  842. # tk_textCopy --
  843. # This procedure copies the selection from a text widget into the
  844. # clipboard.
  845. #
  846. # Arguments:
  847. # w -        Name of a text widget.
  848.  
  849. proc tk_textCopy w {
  850.     if {[selection own -displayof $w] == "$w"} {
  851.     clipboard clear -displayof $w
  852.     catch {
  853.         clipboard append -displayof $w [selection get -displayof $w]
  854.     }
  855.     }
  856. }
  857.  
  858. # tk_textCut --
  859. # This procedure copies the selection from a text widget into the
  860. # clipboard, then deletes the selection (if it exists in the given
  861. # widget).
  862. #
  863. # Arguments:
  864. # w -        Name of a text widget.
  865.  
  866. proc tk_textCut w {
  867.     if {[selection own -displayof $w] == "$w"} {
  868.     clipboard clear -displayof $w
  869.     catch {
  870.         clipboard append -displayof $w [selection get -displayof $w]
  871.         $w delete sel.first sel.last
  872.     }
  873.     }
  874. }
  875.  
  876. # tk_textPaste --
  877. # This procedure pastes the contents of the clipboard to the insertion
  878. # point in a text widget.
  879. #
  880. # Arguments:
  881. # w -        Name of a text widget.
  882.  
  883. proc tk_textPaste w {
  884.     catch {
  885.     $w insert insert [selection get -displayof $w \
  886.         -selection CLIPBOARD]
  887.     }
  888. }
  889.