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