Return to text.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library

Annotation of micropolis/src/tk/library/text.tcl, revision 1.1.1.1

1.1       root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.