Annotation of micropolis/res/tk.tlb, revision 1.1

1.1     ! root        1: #@package: button.tcl tk_butEnter tk_butLeave tk_butDown tk_butUp
        !             2: 
        !             3: # button.tcl --
        !             4: #
        !             5: # This file contains Tcl procedures used to manage Tk buttons.
        !             6: #
        !             7: # $Header: /user6/ouster/wish/scripts/RCS/button.tcl,v 1.7 92/07/28 15:41:13 ouster Exp $ SPRITE (Berkeley)
        !             8: #
        !             9: # Copyright 1992 Regents of the University of California
        !            10: # Permission to use, copy, modify, and distribute this
        !            11: # software and its documentation for any purpose and without
        !            12: # fee is hereby granted, provided that this copyright
        !            13: # notice appears in all copies.  The University of California
        !            14: # makes no representations about the suitability of this
        !            15: # software for any purpose.  It is provided "as is" without
        !            16: # express or implied warranty.
        !            17: #
        !            18: 
        !            19: # The procedure below is invoked when the mouse pointer enters a
        !            20: # button widget.  It records the button we're in and changes the
        !            21: # state of the button to active unless the button is disabled.
        !            22: 
        !            23: proc tk_butEnter w {
        !            24:     global tk_priv tk_strictMotif
        !            25:     if {[lindex [$w config -state] 4] != "disabled"} {
        !            26:        if {!$tk_strictMotif} {
        !            27:            $w config -state active
        !            28:        }
        !            29:        set tk_priv(window) $w
        !            30:     }
        !            31: }
        !            32: 
        !            33: # The procedure below is invoked when the mouse pointer leaves a
        !            34: # button widget.  It changes the state of the button back to
        !            35: # inactive.
        !            36: 
        !            37: proc tk_butLeave w {
        !            38:     global tk_priv tk_strictMotif
        !            39:     if {[lindex [$w config -state] 4] != "disabled"} {
        !            40:        if {!$tk_strictMotif} {
        !            41:            $w config -state normal
        !            42:        }
        !            43:     }
        !            44:     set tk_priv(window) ""
        !            45: }
        !            46: 
        !            47: # The procedure below is invoked when the mouse button is pressed in
        !            48: # a button/radiobutton/checkbutton widget.  It records information
        !            49: # (a) to indicate that the mouse is in the button, and
        !            50: # (b) to save the button's relief so it can be restored later.
        !            51: 
        !            52: proc tk_butDown w {
        !            53:     global tk_priv
        !            54:     set tk_priv(relief) [lindex [$w config -relief] 4]
        !            55:     if {[lindex [$w config -state] 4] != "disabled"} {
        !            56:        $w config -relief sunken
        !            57:     }
        !            58: }
        !            59: 
        !            60: # The procedure below is invoked when the mouse button is released
        !            61: # for a button/radiobutton/checkbutton widget.  It restores the
        !            62: # button's relief and invokes the command as long as the mouse
        !            63: # hasn't left the button.
        !            64: 
        !            65: proc tk_butUp w {
        !            66:     global tk_priv
        !            67:     $w config -relief $tk_priv(relief)
        !            68:     if {($w == $tk_priv(window))
        !            69:            && ([lindex [$w config -state] 4] != "disabled")} {
        !            70:        uplevel #0 [list $w invoke]
        !            71:     }
        !            72: }
        !            73: #@package: listbox.tcl tk_listboxSingleSelect
        !            74: 
        !            75: # listbox.tcl --
        !            76: #
        !            77: # This file contains Tcl procedures used to manage Tk listboxes.
        !            78: #
        !            79: # $Header: /user6/ouster/wish/scripts/RCS/listbox.tcl,v 1.2 92/06/03 15:21:28 ouster Exp $ SPRITE (Berkeley)
        !            80: #
        !            81: # Copyright 1992 Regents of the University of California
        !            82: # Permission to use, copy, modify, and distribute this
        !            83: # software and its documentation for any purpose and without
        !            84: # fee is hereby granted, provided that this copyright
        !            85: # notice appears in all copies.  The University of California
        !            86: # makes no representations about the suitability of this
        !            87: # software for any purpose.  It is provided "as is" without
        !            88: # express or implied warranty.
        !            89: #
        !            90: 
        !            91: # The procedure below may be invoked to change the behavior of
        !            92: # listboxes so that only a single item may be selected at once.
        !            93: # The arguments give one or more windows whose behavior should
        !            94: # be changed;  if one of the arguments is "Listbox" then the default
        !            95: # behavior is changed for all listboxes.
        !            96: 
        !            97: proc tk_listboxSingleSelect args {
        !            98:     foreach w $args {
        !            99:        bind $w <B1-Motion> {%W select from [%W nearest %y]} 
        !           100:        bind $w <Shift-1> {%W select from [%W nearest %y]}
        !           101:        bind $w <Shift-B1-Motion> {%W select from [%W nearest %y]}
        !           102:     }
        !           103: }
        !           104: #@package: tkerror.tcl tkerror
        !           105: 
        !           106: # This file contains a default version of the tkError procedure.  It
        !           107: # just prints out a stack trace.
        !           108: 
        !           109: proc tkerror err {
        !           110:     global errorInfo
        !           111:     puts stdout "$errorInfo"
        !           112: }
        !           113: #@package: text.tcl tk_textSelectTo tk_textBackspace tk_textIndexCloser tk_textResetAnchor
        !           114: 
        !           115: # text.tcl --
        !           116: #
        !           117: # This file contains Tcl procedures used to manage Tk entries.
        !           118: #
        !           119: # $Header: /user6/ouster/wish/scripts/RCS/text.tcl,v 1.2 92/07/16 16:26:33 ouster Exp $ SPRITE (Berkeley)
        !           120: #
        !           121: # Copyright 1992 Regents of the University of California
        !           122: # Permission to use, copy, modify, and distribute this
        !           123: # software and its documentation for any purpose and without
        !           124: # fee is hereby granted, provided that this copyright
        !           125: # notice appears in all copies.  The University of California
        !           126: # makes no representations about the suitability of this
        !           127: # software for any purpose.  It is provided "as is" without
        !           128: # express or implied warranty.
        !           129: #
        !           130: 
        !           131: # The procedure below is invoked when dragging one end of the selection.
        !           132: # The arguments are the text window name and the index of the character
        !           133: # that is to be the new end of the selection.
        !           134: 
        !           135: proc tk_textSelectTo {w index} {
        !           136:     global tk_priv
        !           137: 
        !           138:     case $tk_priv(selectMode) {
        !           139:        char {
        !           140:            if [$w compare $index < anchor] {
        !           141:                set first $index
        !           142:                set last anchor
        !           143:            } else {
        !           144:                set first anchor
        !           145:                set last [$w index $index+1c]
        !           146:            }
        !           147:        }
        !           148:        word {
        !           149:            if [$w compare $index < anchor] {
        !           150:                set first [$w index "$index wordstart"]
        !           151:                set last [$w index "anchor wordend"]
        !           152:            } else {
        !           153:                set first [$w index "anchor wordstart"]
        !           154:                set last [$w index "$index wordend"]
        !           155:            }
        !           156:        }
        !           157:        line {
        !           158:            if [$w compare $index < anchor] {
        !           159:                set first [$w index "$index linestart"]
        !           160:                set last [$w index "anchor lineend + 1c"]
        !           161:            } else {
        !           162:                set first [$w index "anchor linestart"]
        !           163:                set last [$w index "$index lineend + 1c"]
        !           164:            }
        !           165:        }
        !           166:     }
        !           167:     $w tag remove sel 0.0 $first
        !           168:     $w tag add sel $first $last
        !           169:     $w tag remove sel $last end
        !           170: }
        !           171: 
        !           172: # The procedure below is invoked to backspace over one character in
        !           173: # a text widget.  The name of the widget is passed as argument.
        !           174: 
        !           175: proc tk_textBackspace w {
        !           176:     $w delete insert-1c insert
        !           177: }
        !           178: 
        !           179: # The procedure below compares three indices, a, b, and c.  Index b must
        !           180: # be less than c.  The procedure returns 1 if a is closer to b than to c,
        !           181: # and 0 otherwise.  The "w" argument is the name of the text widget in
        !           182: # which to do the comparison.
        !           183: 
        !           184: proc tk_textIndexCloser {w a b c} {
        !           185:     set a [$w index $a]
        !           186:     set b [$w index $b]
        !           187:     set c [$w index $c]
        !           188:     if [$w compare $a <= $b] {
        !           189:        return 1
        !           190:     }
        !           191:     if [$w compare $a >= $c] {
        !           192:        return 0
        !           193:     }
        !           194:     scan $a "%d.%d" lineA chA
        !           195:     scan $b "%d.%d" lineB chB
        !           196:     scan $c "%d.%d" lineC chC
        !           197:     if {$chC == 0} {
        !           198:        incr lineC -1
        !           199:        set chC [string length [$w get $lineC.0 $lineC.end]]
        !           200:     }
        !           201:     if {$lineB != $lineC} {
        !           202:        return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
        !           203:     }
        !           204:     return [expr {($chA-$chB) < ($chC-$chA)}]
        !           205: }
        !           206: 
        !           207: # The procedure below is called to reset the selection anchor to
        !           208: # whichever end is FARTHEST from the index argument.
        !           209: 
        !           210: proc tk_textResetAnchor {w index} {
        !           211:     global tk_priv
        !           212:     if {[$w tag ranges sel] == ""} {
        !           213:        set tk_priv(selectMode) char
        !           214:        $w mark set anchor $index
        !           215:        return
        !           216:     }
        !           217:     if [tk_textIndexCloser $w $index sel.first sel.last] {
        !           218:        if {$tk_priv(selectMode) == "char"} {
        !           219:            $w mark set anchor sel.last
        !           220:        } else {
        !           221:            $w mark set anchor sel.last-1c
        !           222:        }
        !           223:     } else {
        !           224:        $w mark set anchor sel.first
        !           225:     }
        !           226: }
        !           227: #@package: menu.tcl tk_menus tk_bindForTraversal tk_mbPost tk_mbUnpost tk_traverseToMenu tk_traverseWithinMenu tk_getMenuButtons tk_nextMenu tk_nextMenuEntry tk_invokeMenu tk_firstMenu
        !           228: 
        !           229: # menu.tcl --
        !           230: #
        !           231: # This file contains Tcl procedures used to manage Tk menus and
        !           232: # menubuttons.  Most of the code here is dedicated to support for
        !           233: # menu traversal via the keyboard.
        !           234: #
        !           235: # $Header: /user6/ouster/wish/scripts/RCS/menu.tcl,v 1.11 92/08/08 14:49:55 ouster Exp $ SPRITE (Berkeley)
        !           236: #
        !           237: # Copyright 1992 Regents of the University of California
        !           238: # Permission to use, copy, modify, and distribute this
        !           239: # software and its documentation for any purpose and without
        !           240: # fee is hereby granted, provided that this copyright
        !           241: # notice appears in all copies.  The University of California
        !           242: # makes no representations about the suitability of this
        !           243: # software for any purpose.  It is provided "as is" without
        !           244: # express or implied warranty.
        !           245: #
        !           246: 
        !           247: # The procedure below is publically available.  It is used to indicate
        !           248: # the menus associated with a particular top-level window, for purposes
        !           249: # of keyboard menu traversal.  Its first argument is the path name of
        !           250: # a top-level window, and any additional arguments are the path names of
        !           251: # the menu buttons associated with that top-level window, in the order
        !           252: # they should be traversed.  If no menu buttons are named, the procedure
        !           253: # returns the current list of menus for w.  If a single empty string is
        !           254: # supplied, then the menu list for w is cancelled.  Otherwise, tk_menus
        !           255: # sets the menu list for w to the menu buttons.
        !           256: 
        !           257: proc tk_menus {w args} {
        !           258:     global tk_priv
        !           259: 
        !           260:     if {$args == ""} {
        !           261:        if [catch {set result [set tk_priv(menusFor$w)]}] {
        !           262:            return ""
        !           263:        }
        !           264:        return $result
        !           265:     }
        !           266: 
        !           267:     if {$args == "{}"} {
        !           268:        catch {unset tk_priv(menusFor$w)}
        !           269:        return ""
        !           270:     }
        !           271: 
        !           272:     set tk_priv(menusFor$w) $args
        !           273: }
        !           274: 
        !           275: # The procedure below is publically available.  It takes any number of
        !           276: # arguments taht are names of widgets or classes.  It sets up bindings
        !           277: # for the widgets or classes so that keyboard menu traversal is possible
        !           278: # when the input focus is in those widgets or classes.
        !           279: 
        !           280: proc tk_bindForTraversal args {
        !           281:     foreach w $args {
        !           282:        bind $w <Alt-KeyPress> {tk_traverseToMenu %W %A}
        !           283:        bind $w <F10> {tk_firstMenu %W}
        !           284:     }
        !           285: }
        !           286: 
        !           287: # The procedure below does all of the work of posting a menu (including
        !           288: # unposting any other menu that might currently be posted).  The "w"
        !           289: # argument is the name of the menubutton for the menu to be posted.
        !           290: # Note:  if $w is disabled then the procedure does nothing.
        !           291: 
        !           292: proc tk_mbPost {w} {
        !           293:     global tk_priv tk_strictMotif
        !           294:     if {[lindex [$w config -state] 4] == "disabled"} {
        !           295:        return
        !           296:     }
        !           297:     set cur $tk_priv(posted)
        !           298:     if {$cur == $w} {
        !           299:        return
        !           300:     }
        !           301:     if {$cur != ""} tk_mbUnpost
        !           302:     set tk_priv(relief) [lindex [$w config -relief] 4]
        !           303:     $w config -relief raised
        !           304:     set tk_priv(cursor) [lindex [$w config -cursor] 4]
        !           305:     $w config -cursor arrow
        !           306:     $w post
        !           307:     grab -global $w
        !           308:     set tk_priv(posted) $w
        !           309:     if {$tk_priv(focus) == ""} {
        !           310:        set tk_priv(focus) [focus]
        !           311:     }
        !           312:     set menu [lindex [$w config -menu] 4]
        !           313:     set tk_priv(activeBg) [lindex [$menu config -activebackground] 4]
        !           314:     set tk_priv(activeFg) [lindex [$menu config -activeforeground] 4]
        !           315:     if $tk_strictMotif {
        !           316:        $menu config -activebackground [lindex [$menu config -background] 4]
        !           317:        $menu config -activeforeground [lindex [$menu config -foreground] 4]
        !           318:     }
        !           319:     focus $menu
        !           320: }
        !           321: 
        !           322: # The procedure below does all the work of unposting the menubutton that's
        !           323: # currently posted.  It takes no arguments.
        !           324: 
        !           325: proc tk_mbUnpost {} {
        !           326:     global tk_priv
        !           327:     if {$tk_priv(posted) != ""} {
        !           328:        $tk_priv(posted) config -relief $tk_priv(relief)
        !           329:        $tk_priv(posted) config -cursor $tk_priv(cursor)
        !           330:        $tk_priv(posted) config -activebackground $tk_priv(activeBg)
        !           331:        $tk_priv(posted) config -activeforeground $tk_priv(activeFg)
        !           332:        $tk_priv(posted) unpost
        !           333:        grab none
        !           334:        focus $tk_priv(focus)
        !           335:        set tk_priv(focus) ""
        !           336:        set menu [lindex [$tk_priv(posted) config -menu] 4]
        !           337:        $menu config -activebackground $tk_priv(activeBg)
        !           338:        $menu config -activeforeground $tk_priv(activeFg)
        !           339:        set tk_priv(posted) {}
        !           340:     }
        !           341: }
        !           342: 
        !           343: # The procedure below is invoked to implement keyboard traversal to
        !           344: # a menu button.  It takes two arguments:  the name of a window where
        !           345: # a keystroke originated, and the ascii character that was typed.
        !           346: # This procedure finds a menu bar by looking upward for a top-level
        !           347: # window, then looking for a window underneath that named "menu".
        !           348: # Then it searches through all the subwindows of "menu" for a menubutton
        !           349: # with an underlined character matching char.  If one is found, it
        !           350: # posts that menu.
        !           351: 
        !           352: proc tk_traverseToMenu {w char} {
        !           353:     global tk_priv
        !           354:     if {$char == ""} {
        !           355:        return
        !           356:     }
        !           357:     set char [string tolower $char]
        !           358: 
        !           359:     foreach mb [tk_getMenuButtons $w] {
        !           360:        if {[winfo class $mb] == "Menubutton"} {
        !           361:            set char2 [string index [lindex [$mb config -text] 4] \
        !           362:                    [lindex [$mb config -underline] 4]]
        !           363:            if {[string compare $char [string tolower $char2]] == 0} {
        !           364:                tk_mbPost $mb
        !           365:                [lindex [$mb config -menu] 4] activate 0
        !           366:                return
        !           367:            }
        !           368:        }
        !           369:     }
        !           370: }
        !           371: 
        !           372: # The procedure below is used to implement keyboard traversal within
        !           373: # the posted menu.  It takes two arguments:  the name of the menu to
        !           374: # be traversed within, and an ASCII character.  It searches for an
        !           375: # entry in the menu that has that character underlined.  If such an
        !           376: # entry is found, it is invoked and the menu is unposted.
        !           377: 
        !           378: proc tk_traverseWithinMenu {w char} {
        !           379:     if {$char == ""} {
        !           380:        return
        !           381:     }
        !           382:     set char [string tolower $char]
        !           383:     set last [$w index last]
        !           384:     for {set i 0} {$i <= $last} {incr i} {
        !           385:        if [catch {set char2 [string index \
        !           386:                [lindex [$w entryconfig $i -label] 4] \
        !           387:                [lindex [$w entryconfig $i -underline] 4]]}] {
        !           388:            continue
        !           389:        }
        !           390:        if {[string compare $char [string tolower $char2]] == 0} {
        !           391:            tk_mbUnpost
        !           392:            $w invoke $i
        !           393:            return
        !           394:        }
        !           395:     }
        !           396: }
        !           397: 
        !           398: # The procedure below takes a single argument, which is the name of
        !           399: # a window.  It returns a list containing path names for all of the
        !           400: # menu buttons associated with that window's top-level window, or an
        !           401: # empty list if there are none.
        !           402: 
        !           403: proc tk_getMenuButtons w {
        !           404:     global tk_priv
        !           405:     set top [winfo toplevel $w]
        !           406:     if [catch {set buttons [set tk_priv(menusFor$top)]}] {
        !           407:        return ""
        !           408:     }
        !           409:     return $buttons
        !           410: }
        !           411: 
        !           412: # The procedure below is used to traverse to the next or previous
        !           413: # menu in a menu bar.  It takes one argument, which is a count of
        !           414: # how many menu buttons forward or backward (if negative) to move.
        !           415: # If there is no posted menu then this procedure has no effect.
        !           416: 
        !           417: proc tk_nextMenu count {
        !           418:     global tk_priv
        !           419:     if {$tk_priv(posted) == ""} {
        !           420:        return
        !           421:     }
        !           422:     set buttons [tk_getMenuButtons $tk_priv(posted)]
        !           423:     set length [llength $buttons]
        !           424:     for {set i 0} 1 {incr i} {
        !           425:        if {$i >= $length} {
        !           426:            return
        !           427:        }
        !           428:        if {[lindex $buttons $i] == $tk_priv(posted)} {
        !           429:            break
        !           430:        }
        !           431:     }
        !           432:     incr i $count
        !           433:     while 1 {
        !           434:        while {$i < 0} {
        !           435:            incr i $length
        !           436:        }
        !           437:        while {$i >= $length} {
        !           438:            incr i -$length
        !           439:        }
        !           440:        set mb [lindex $buttons $i]
        !           441:        if {[lindex [$mb configure -state] 4] != "disabled"} {
        !           442:            break
        !           443:        }
        !           444:        incr i $count
        !           445:     }
        !           446:     tk_mbUnpost
        !           447:     tk_mbPost $mb
        !           448:     [lindex [$mb config -menu] 4] activate 0
        !           449: }
        !           450: 
        !           451: # The procedure below is used to traverse to the next or previous entry
        !           452: # in the posted menu.  It takes one argument, which is 1 to go to the
        !           453: # next entry or -1 to go to the previous entry.  Disabled entries are
        !           454: # skipped in this process.
        !           455: 
        !           456: proc tk_nextMenuEntry count {
        !           457:     global tk_priv
        !           458:     if {$tk_priv(posted) == ""} {
        !           459:        return
        !           460:     }
        !           461:     set menu [lindex [$tk_priv(posted) config -menu] 4]
        !           462:     set length [expr [$menu index last]+1]
        !           463:     set i [$menu index active]
        !           464:     if {$i == "none"} {
        !           465:        set i 0
        !           466:     } else {
        !           467:        incr i $count
        !           468:     }
        !           469:     while 1 {
        !           470:        while {$i < 0} {
        !           471:            incr i $length
        !           472:        }
        !           473:        while {$i >= $length} {
        !           474:            incr i -$length
        !           475:        }
        !           476:        if {[catch {$menu entryconfigure $i -state} state] == 0} {
        !           477:            if {[lindex $state 4] != "disabled"} {
        !           478:                break
        !           479:            }
        !           480:        }
        !           481:        incr i $count
        !           482:     }
        !           483:     $menu activate $i
        !           484: }
        !           485: 
        !           486: # The procedure below invokes the active entry in the posted menu,
        !           487: # if there is one.  Otherwise it does nothing.
        !           488: 
        !           489: proc tk_invokeMenu {menu} {
        !           490:     set i [$menu index active]
        !           491:     if {$i != "none"} {
        !           492:        tk_mbUnpost
        !           493:        update idletasks
        !           494:        $menu invoke $i
        !           495:     }
        !           496: }
        !           497: 
        !           498: # The procedure below is invoked to keyboard-traverse to the first
        !           499: # menu for a given source window.  The source window is passed as
        !           500: # parameter.
        !           501: 
        !           502: proc tk_firstMenu w {
        !           503:     set mb [lindex [tk_getMenuButtons $w] 0]
        !           504:     if {$mb != ""} {
        !           505:        tk_mbPost $mb
        !           506:        [lindex [$mb config -menu] 4] activate 0
        !           507:     }
        !           508: }
        !           509: 
        !           510: # The procedure below is invoked when a button-1-down event is
        !           511: # received by a menu button.  If the mouse is in the menu button
        !           512: # then it posts the button's menu.  If the mouse isn't in the
        !           513: # button's menu, then it deactivates any active entry in the menu.
        !           514: # Remember, event-sharing can cause this procedure to be invoked
        !           515: # for two different menu buttons on the same event.
        !           516: 
        !           517: proc tk_mbButtonDown w {
        !           518:     global tk_priv
        !           519:     if {[lindex [$w config -state] 4] == "disabled"} {
        !           520:        return
        !           521:     } 
        !           522:     if {$tk_priv(inMenuButton) == $w} {
        !           523:        tk_mbPost $w
        !           524:     }
        !           525:     set menu [lindex [$tk_priv(posted) config -menu] 4]
        !           526:     if {$tk_priv(window) != $menu} {
        !           527:        $menu activate none
        !           528:     }
        !           529: }
        !           530: #@package: entry.tcl tk_entryBackspace tk_entryBackword tk_entrySeeCaret
        !           531: 
        !           532: # entry.tcl --
        !           533: #
        !           534: # This file contains Tcl procedures used to manage Tk entries.
        !           535: #
        !           536: # $Header: /user6/ouster/wish/scripts/RCS/entry.tcl,v 1.2 92/05/23 16:40:57 ouster Exp $ SPRITE (Berkeley)
        !           537: #
        !           538: # Copyright 1992 Regents of the University of California
        !           539: # Permission to use, copy, modify, and distribute this
        !           540: # software and its documentation for any purpose and without
        !           541: # fee is hereby granted, provided that this copyright
        !           542: # notice appears in all copies.  The University of California
        !           543: # makes no representations about the suitability of this
        !           544: # software for any purpose.  It is provided "as is" without
        !           545: # express or implied warranty.
        !           546: #
        !           547: 
        !           548: # The procedure below is invoked to backspace over one character
        !           549: # in an entry widget.  The name of the widget is passed as argument.
        !           550: 
        !           551: proc tk_entryBackspace w {
        !           552:     set x [expr {[$w index cursor] - 1}]
        !           553:     if {$x != -1} {$w delete $x}
        !           554: }
        !           555: 
        !           556: # The procedure below is invoked to backspace over one word in an
        !           557: # entry widget.  The name of the widget is passed as argument.
        !           558: 
        !           559: proc tk_entryBackword w {
        !           560:     set string [$w get]
        !           561:     set curs [expr [$w index cursor]-1]
        !           562:     if {$curs < 0} return
        !           563:     for {set x $curs} {$x > 0} {incr x -1} {
        !           564:        if {([string first [string index $string $x] " \t"] < 0)
        !           565:                && ([string first [string index $string [expr $x-1]] " \t"]
        !           566:                >= 0)} {
        !           567:            break
        !           568:        }
        !           569:     }
        !           570:     $w delete $x $curs
        !           571: }
        !           572: 
        !           573: # The procedure below is invoked after insertions.  If the caret is not
        !           574: # visible in the window then the procedure adjusts the entry's view to
        !           575: # bring the caret back into the window again.
        !           576: 
        !           577: proc tk_entrySeeCaret w {
        !           578:     set c [$w index cursor]
        !           579:     set left [$w index @0]
        !           580:     if {$left > $c} {
        !           581:        $w view $c
        !           582:        return
        !           583:     }
        !           584:     while {[$w index @[expr [winfo width $w]-5]] < $c} {
        !           585:        set left [expr $left+1]
        !           586:        $w view $left
        !           587:     }
        !           588: }

unix.superglobalmegacorp.com

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