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     ! 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.