Return to entry.tcl CVS log

Up to [Micropolis - Activity] / micropolis / res

Annotation of micropolis/res/entry.tcl, revision 1.1.1.1

1.1       root        1: # entry.tcl --
                      2: #
                      3: # This file contains Tcl procedures used to manage Tk entries.
                      4: #
                      5: # $Header: /user6/ouster/wish/scripts/RCS/entry.tcl,v 1.2 92/05/23 16:40:57 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 to backspace over one character
                     18: # in an entry widget.  The name of the widget is passed as argument.
                     19: 
                     20: proc tk_entryBackspace w {
                     21:     set x [expr {[$w index cursor] - 1}]
                     22:     if {$x != -1} {$w delete $x}
                     23: }
                     24: 
                     25: # The procedure below is invoked to backspace over one word in an
                     26: # entry widget.  The name of the widget is passed as argument.
                     27: 
                     28: proc tk_entryBackword w {
                     29:     set string [$w get]
                     30:     set curs [expr [$w index cursor]-1]
                     31:     if {$curs < 0} return
                     32:     for {set x $curs} {$x > 0} {incr x -1} {
                     33:        if {([string first [string index $string $x] " \t"] < 0)
                     34:                && ([string first [string index $string [expr $x-1]] " \t"]
                     35:                >= 0)} {
                     36:            break
                     37:        }
                     38:     }
                     39:     $w delete $x $curs
                     40: }
                     41: 
                     42: # The procedure below is invoked after insertions.  If the caret is not
                     43: # visible in the window then the procedure adjusts the entry's view to
                     44: # bring the caret back into the window again.
                     45: 
                     46: proc tk_entrySeeCaret w {
                     47:     set c [$w index cursor]
                     48:     set left [$w index @0]
                     49:     if {$left > $c} {
                     50:        $w view $c
                     51:        return
                     52:     }
                     53:     while {[$w index @[expr [winfo width $w]-5]] < $c} {
                     54:        set left [expr $left+1]
                     55:        $w view $left
                     56:     }
                     57: }
                     58: 
                     59: proc tk_entryCopyPress {w} {
                     60:   set sel ""
                     61:   catch {set sel [selection -window $w get]}
                     62:   $w insert cursor $sel
                     63:   tk_entrySeeCaret $w
                     64: }
                     65: 
                     66: proc tk_entryCutPress {w} {
                     67:   catch {$w delete sel.first sel.last}
                     68:   tk_entrySeeCaret $w
                     69: }
                     70: 
                     71: proc tk_entryDelLine {w} {
                     72:   $w delete 0 end
                     73: }
                     74: 
                     75: proc tk_entryDelPress {w} {
                     76:   tk_entryBackspace $w
                     77:   tk_entrySeeCaret $w
                     78: }

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