git.zerfleddert.de Git - micropolis/blob - src/tk/library/text.tcl

   1 # text.tcl --
   2 #
   3 # This file contains Tcl procedures used to manage Tk entries.
   4 #
   5 # $Header: /user6/ouster/wish/scripts/RCS/text.tcl,v 1.2 92/07/16 16:26:33 ouster Exp $ SPRITE (Berkeley)
   6 #
   7 # Copyright 1992 Regents of the University of California
   8 # Permission to use, copy, modify, and distribute this
   9 # software and its documentation for any purpose and without
  10 # fee is hereby granted, provided that this copyright
  11 # notice appears in all copies.  The University of California
  12 # makes no representations about the suitability of this
  13 # software for any purpose.  It is provided "as is" without
  14 # express or implied warranty.
  15 #
  16
  17 # The procedure below is invoked when dragging one end of the selection.
  18 # The arguments are the text window name and the index of the character
  19 # that is to be the new end of the selection.
  20
  21 proc tk_textSelectTo {w index} {
  22     global tk_priv
  23
  24     case $tk_priv(selectMode) {
  25         char {
  26             if [$w compare $index < anchor] {
  27                 set first $index
  28                 set last anchor
  29             } else {
  30                 set first anchor
  31                 set last [$w index $index+1c]
  32             }
  33         }
  34         word {
  35             if [$w compare $index < anchor] {
  36                 set first [$w index "$index wordstart"]
  37                 set last [$w index "anchor wordend"]
  38             } else {
  39                 set first [$w index "anchor wordstart"]
  40                 set last [$w index "$index wordend"]
  41             }
  42         }
  43         line {
  44             if [$w compare $index < anchor] {
  45                 set first [$w index "$index linestart"]
  46                 set last [$w index "anchor lineend + 1c"]
  47             } else {
  48                 set first [$w index "anchor linestart"]
  49                 set last [$w index "$index lineend + 1c"]
  50             }
  51         }
  52     }
  53     $w tag remove sel 0.0 $first
  54     $w tag add sel $first $last
  55     $w tag remove sel $last end
  56 }
  57
  58 # The procedure below is invoked to backspace over one character in
  59 # a text widget.  The name of the widget is passed as argument.
  60
  61 proc tk_textBackspace w {
  62     $w delete insert-1c insert
  63 }
  64
  65 # The procedure below compares three indices, a, b, and c.  Index b must
  66 # be less than c.  The procedure returns 1 if a is closer to b than to c,
  67 # and 0 otherwise.  The "w" argument is the name of the text widget in
  68 # which to do the comparison.
  69
  70 proc tk_textIndexCloser {w a b c} {
  71     set a [$w index $a]
  72     set b [$w index $b]
  73     set c [$w index $c]
  74     if [$w compare $a <= $b] {
  75         return 1
  76     }
  77     if [$w compare $a >= $c] {
  78         return 0
  79     }
  80     scan $a "%d.%d" lineA chA
  81     scan $b "%d.%d" lineB chB
  82     scan $c "%d.%d" lineC chC
  83     if {$chC == 0} {
  84         incr lineC -1
  85         set chC [string length [$w get $lineC.0 $lineC.end]]
  86     }
  87     if {$lineB != $lineC} {
  88         return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
  89     }
  90     return [expr {($chA-$chB) < ($chC-$chA)}]
  91 }
  92
  93 # The procedure below is called to reset the selection anchor to
  94 # whichever end is FARTHEST from the index argument.
  95
  96 proc tk_textResetAnchor {w index} {
  97     global tk_priv
  98     if {[$w tag ranges sel] == ""} {
  99         set tk_priv(selectMode) char
 100         $w mark set anchor $index
 101         return
 102     }
 103     if [tk_textIndexCloser $w $index sel.first sel.last] {
 104         if {$tk_priv(selectMode) == "char"} {
 105             $w mark set anchor sel.last
 106         } else {
 107             $w mark set anchor sel.last-1c
 108         }
 109     } else {
 110         $w mark set anchor sel.first
 111     }
 112 }