home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / tk / text.tcl < prev    next >
Encoding:
Text File  |  1995-07-21  |  3.7 KB  |  127 lines
  1. # text.tcl --
  2. #
  3. # This file contains Tcl procedures used to manage Tk entries.
  4. #
  5. # $Header: /user6/ouster/wish/library/RCS/text.tcl,v 1.4 93/10/23 16:21:12 ouster Exp $ SPRITE (Berkeley)
  6. #
  7. # Copyright (c) 1992-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27.  
  28. # The procedure below is invoked when dragging one end of the selection.
  29. # The arguments are the text window name and the index of the character
  30. # that is to be the new end of the selection.
  31.  
  32. proc tk_textSelectTo {w index} {
  33.     global tk_priv
  34.  
  35.     if [catch {$w index anchor}] {
  36.     $w mark set anchor $index
  37.     }
  38.     case $tk_priv(selectMode) {
  39.     char {
  40.         if [$w compare $index < anchor] {
  41.         set first $index
  42.         set last anchor
  43.         } else {
  44.         set first anchor
  45.         set last [$w index $index+1c]
  46.         }
  47.     }
  48.     word {
  49.         if [$w compare $index < anchor] {
  50.         set first [$w index "$index wordstart"]
  51.         set last [$w index "anchor wordend"]
  52.         } else {
  53.         set first [$w index "anchor wordstart"]
  54.         set last [$w index "$index wordend"]
  55.         }
  56.     }
  57.     line {
  58.         if [$w compare $index < anchor] {
  59.         set first [$w index "$index linestart"]
  60.         set last [$w index "anchor lineend + 1c"]
  61.         } else {
  62.         set first [$w index "anchor linestart"]
  63.         set last [$w index "$index lineend + 1c"]
  64.         }
  65.     }
  66.     }
  67.     $w tag remove sel 0.0 $first
  68.     $w tag add sel $first $last
  69.     $w tag remove sel $last end
  70. }
  71.  
  72. # The procedure below is invoked to backspace over one character in
  73. # a text widget.  The name of the widget is passed as argument.
  74.  
  75. proc tk_textBackspace w {
  76.     $w delete insert-1c insert
  77. }
  78.  
  79. # The procedure below compares three indices, a, b, and c.  Index b must
  80. # be less than c.  The procedure returns 1 if a is closer to b than to c,
  81. # and 0 otherwise.  The "w" argument is the name of the text widget in
  82. # which to do the comparison.
  83.  
  84. proc tk_textIndexCloser {w a b c} {
  85.     set a [$w index $a]
  86.     set b [$w index $b]
  87.     set c [$w index $c]
  88.     if [$w compare $a <= $b] {
  89.     return 1
  90.     }
  91.     if [$w compare $a >= $c] {
  92.     return 0
  93.     }
  94.     scan $a "%d.%d" lineA chA
  95.     scan $b "%d.%d" lineB chB
  96.     scan $c "%d.%d" lineC chC
  97.     if {$chC == 0} {
  98.     incr lineC -1
  99.     set chC [string length [$w get $lineC.0 $lineC.end]]
  100.     }
  101.     if {$lineB != $lineC} {
  102.     return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
  103.     }
  104.     return [expr {($chA-$chB) < ($chC-$chA)}]
  105. }
  106.  
  107. # The procedure below is called to reset the selection anchor to
  108. # whichever end is FARTHEST from the index argument.
  109.  
  110. proc tk_textResetAnchor {w index} {
  111.     global tk_priv
  112.     if {[$w tag ranges sel] == ""} {
  113.     set tk_priv(selectMode) char
  114.     $w mark set anchor $index
  115.     return
  116.     }
  117.     if [tk_textIndexCloser $w $index sel.first sel.last] {
  118.     if {$tk_priv(selectMode) == "char"} {
  119.         $w mark set anchor sel.last
  120.     } else {
  121.         $w mark set anchor sel.last-1c
  122.     }
  123.     } else {
  124.     $w mark set anchor sel.first
  125.     }
  126. }
  127.