Return to tk.tcl CVS log

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

Annotation of micropolis/src/tk/library/tk.tcl, revision 1.1

1.1     ! root        1: # tk.tcl --
        !             2: #
        !             3: # Initialization script normally executed in the interpreter for each
        !             4: # Tk-based application.  Arranges class bindings for widgets.
        !             5: #
        !             6: # $Header: /user6/ouster/wish/scripts/RCS/tk.tcl,v 1.19 92/08/08 14:50:08 ouster Exp $ SPRITE (Berkeley)
        !             7: #
        !             8: # Copyright 1992 Regents of the University of California
        !             9: # Permission to use, copy, modify, and distribute this
        !            10: # software and its documentation for any purpose and without
        !            11: # fee is hereby granted, provided that this copyright
        !            12: # notice appears in all copies.  The University of California
        !            13: # makes no representations about the suitability of this
        !            14: # software for any purpose.  It is provided "as is" without
        !            15: # express or implied warranty.
        !            16: 
        !            17: # Insist on running with a compatible version of Tcl.
        !            18: 
        !            19: if "[info tclversion] != {6.4}" {
        !            20:     error "wrong version of Tcl loaded ([info tclversion]): need 6.4"
        !            21: }
        !            22: 
        !            23: # Initialize the auto-load path to include Tk's directory as well as
        !            24: # Tcl's directory:
        !            25: 
        !            26: set auto_path "$tk_library [info library]"
        !            27: 
        !            28: # Turn off strict Motif look and feel as a default.
        !            29: 
        !            30: set tk_strictMotif 0
        !            31: 
        !            32: # ----------------------------------------------------------------------
        !            33: # Class bindings for various flavors of button widgets.  $tk_priv(window)
        !            34: # keeps track of the button containing the mouse, and $tk_priv(relief)
        !            35: # saves the original relief of the button so it can be restored when
        !            36: # the mouse button is released.
        !            37: # ----------------------------------------------------------------------
        !            38: 
        !            39: bind Button <Any-Enter> {tk_butEnter %W}
        !            40: bind Button <Any-Leave> {tk_butLeave %W}
        !            41: bind Button <1> {tk_butDown %W}
        !            42: bind Button <ButtonRelease-1> {tk_butUp %W}
        !            43: 
        !            44: bind CheckButton <Any-Enter> {tk_butEnter %W}
        !            45: bind CheckButton <Any-Leave> {tk_butLeave %W}
        !            46: bind CheckButton <1> {tk_butDown %W}
        !            47: bind CheckButton <ButtonRelease-1> {tk_butUp %W}
        !            48: 
        !            49: bind RadioButton <Any-Enter> {tk_butEnter %W}
        !            50: bind RadioButton <Any-Leave> {tk_butLeave %W}
        !            51: bind RadioButton <1> {tk_butDown %W}
        !            52: bind RadioButton <ButtonRelease-1> {tk_butUp %W}
        !            53: 
        !            54: # ----------------------------------------------------------------------
        !            55: # Class bindings for entry widgets.
        !            56: # ----------------------------------------------------------------------
        !            57: 
        !            58: bind Entry <1> {
        !            59:     %W cursor @%x
        !            60:     %W select from @%x
        !            61:     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
        !            62: }
        !            63: bind Entry <B1-Motion> {%W select to @%x}
        !            64: bind Entry <Shift-1> {%W select adjust @%x}
        !            65: bind Entry <Shift-B1-Motion> {%W select to @%x}
        !            66: bind Entry <2> {%W scan mark %x}
        !            67: bind Entry <B2-Motion> {%W scan dragto %x}
        !            68: bind Entry <Any-KeyPress> {
        !            69:     if {"%A" != ""} {
        !            70:        %W insert cursor %A
        !            71:        tk_entrySeeCaret %W
        !            72:     }
        !            73: }
        !            74: bind Entry <Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}
        !            75: bind Entry <BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}
        !            76: bind Entry <Control-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}
        !            77: bind Entry <Control-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}
        !            78: bind Entry <Control-u> {%W delete 0 end}
        !            79: bind Entry <Control-v> {%W insert cursor [selection get]; tk_entrySeeCaret %W}
        !            80: bind Entry <Control-w> {tk_entryBackword %W; tk_entrySeeCaret %W}
        !            81: tk_bindForTraversal Entry
        !            82: 
        !            83: # ----------------------------------------------------------------------
        !            84: # Class bindings for listbox widgets.
        !            85: # ----------------------------------------------------------------------
        !            86: 
        !            87: bind Listbox <1> {%W select from [%W nearest %y]}
        !            88: bind Listbox <B1-Motion> {%W select to [%W nearest %y]}
        !            89: bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}
        !            90: bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}
        !            91: bind Listbox <2> {%W scan mark %x %y}
        !            92: bind Listbox <B2-Motion> {%W scan dragto %x %y}
        !            93: 
        !            94: # ----------------------------------------------------------------------
        !            95: # Class bindings for scrollbar widgets.  When strict Motif is requested,
        !            96: # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
        !            97: # -activeforeground color to -foreground when the mouse is in the window
        !            98: # and restore it when the mouse leaves.
        !            99: # ----------------------------------------------------------------------
        !           100: 
        !           101: bind Scrollbar <Any-Enter> {
        !           102:     if $tk_strictMotif {
        !           103:        set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
        !           104:        %W config -activeforeground [lindex [%W config -foreground] 4]
        !           105:     }
        !           106: }
        !           107: bind Scrollbar <Any-Leave> {
        !           108:     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
        !           109:        %W config -activeforeground $tk_priv(activeFg)
        !           110:     }
        !           111: }
        !           112: bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}
        !           113: bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}
        !           114: 
        !           115: # ----------------------------------------------------------------------
        !           116: # Class bindings for scale widgets.  When strict Motif is requested,
        !           117: # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
        !           118: # -activeforeground color to -foreground when the mouse is in the window
        !           119: # and restore it when the mouse leaves.
        !           120: # ----------------------------------------------------------------------
        !           121: 
        !           122: bind Scale <Any-Enter> {
        !           123:     if $tk_strictMotif {
        !           124:        set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
        !           125:        %W config -activeforeground [lindex [%W config -sliderforeground] 4]
        !           126:     }
        !           127: }
        !           128: bind Scale <Any-Leave> {
        !           129:     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
        !           130:        %W config -activeforeground $tk_priv(activeFg)
        !           131:     }
        !           132: }
        !           133: bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}
        !           134: bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}
        !           135: 
        !           136: # ----------------------------------------------------------------------
        !           137: # Class bindings for menubutton widgets.  Variables used:
        !           138: # $tk_priv(posted) -           keeps track of the menubutton whose menu is
        !           139: #                              currently posted (or empty string, if none).
        !           140: # $tk_priv(inMenuButton)-      if non-null, identifies menu button
        !           141: #                              containing mouse pointer.
        !           142: # $tk_priv(relief) -           keeps track of original relief of posted
        !           143: #                              menu button, so it can be restored later.
        !           144: # $tk_priv(dragging) -         if non-null, identifies menu button whose
        !           145: #                              menu is currently being dragged in a tear-off
        !           146: #                              operation.
        !           147: # $tk_priv(focus) -            records old focus window so focus can be
        !           148: #                              returned there after keyboard traversal
        !           149: #                              to menu.
        !           150: # ----------------------------------------------------------------------
        !           151: 
        !           152: bind Menubutton <Enter> {
        !           153:     set tk_priv(inMenuButton) %W
        !           154:     if {[lindex [%W config -state] 4] != "disabled"} {
        !           155:        if {!$tk_strictMotif} {
        !           156:            %W config -state active
        !           157:        }
        !           158:     }
        !           159: }
        !           160: bind Menubutton <Any-Leave> {
        !           161:     set tk_priv(inMenuButton) {}
        !           162:     if {[lindex [%W config -state] 4] != "disabled"} {
        !           163:        if {!$tk_strictMotif} {
        !           164:            %W config -state normal
        !           165:        }
        !           166:     }
        !           167: }
        !           168: bind Menubutton <1> {tk_mbButtonDown %W}
        !           169: bind Menubutton <Any-ButtonRelease-1> {
        !           170:     if {($tk_priv(inMenuButton) != "") && ($tk_priv(posted) != "")} {
        !           171:        [lindex [$tk_priv(posted) config -menu] 4] activate 0
        !           172:     } else {
        !           173:        tk_mbUnpost
        !           174:     }
        !           175: }
        !           176: 
        !           177: # In the binding below, it's important to ignore grab-related entries
        !           178: # and exits because they lag reality and can cause menus to chase
        !           179: # their own tail, repeatedly posting and unposting.
        !           180: 
        !           181: bind Menubutton <B1-Enter> {
        !           182:     set tk_priv(inMenuButton) %W
        !           183:     if {([lindex [%W config -state] 4] != "disabled")
        !           184:            && ("%m" != "NotifyGrab") && ("%m" != "NotifyUngrab")} {
        !           185:        if {!$tk_strictMotif} {
        !           186:            %W config -state active
        !           187:        }
        !           188:        tk_mbPost %W
        !           189:     }
        !           190: }
        !           191: bind Menubutton <2> {
        !           192:     if {($tk_priv(posted) == "")
        !           193:            && ([lindex [%W config -state] 4] != "disabled")} {
        !           194:        set tk_priv(dragging) %W
        !           195:        [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
        !           196:     }
        !           197: }
        !           198: bind Menubutton <B2-Motion> {
        !           199:     if {$tk_priv(dragging) != ""} {
        !           200:        [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
        !           201:     }
        !           202: }
        !           203: bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) ""}
        !           204: 
        !           205: # ----------------------------------------------------------------------
        !           206: # Class bindings for menu widgets.  $tk_priv(x) and $tk_priv(y) are used
        !           207: # to keep track of the position of the mouse cursor in the menu window
        !           208: # during dragging of tear-off menus.  $tk_priv(window) keeps track of
        !           209: # the menu containing the mouse, if any.
        !           210: # ----------------------------------------------------------------------
        !           211: 
        !           212: bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}
        !           213: bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}
        !           214: bind Menu <Any-Motion> {
        !           215:     if {$tk_priv(window) != ""} {
        !           216:        %W activate @%y
        !           217:     }
        !           218: }
        !           219: bind Menu <ButtonRelease-1> {tk_invokeMenu %W}
        !           220: bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}
        !           221: bind Menu <B2-Motion> {
        !           222:     if {$tk_priv(posted) == ""} {
        !           223:        %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]
        !           224:     }
        !           225: }
        !           226: bind Menu <B2-Leave> { }
        !           227: bind Menu <B2-Enter> { }
        !           228: bind Menu <Escape> {tk_mbUnpost}
        !           229: bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}
        !           230: bind Menu <Left> {tk_nextMenu -1}
        !           231: bind Menu <Right> {tk_nextMenu 1}
        !           232: bind Menu <Up> {tk_nextMenuEntry -1}
        !           233: bind Menu <Down> {tk_nextMenuEntry 1}
        !           234: bind Menu <Return> {tk_invokeMenu %W}
        !           235: 
        !           236: # ----------------------------------------------------------------------
        !           237: # Class bindings for text widgets. $tk_priv(selectMode) holds one of
        !           238: # "char", "word", or "line" to indicate which selection mode is active.
        !           239: # ----------------------------------------------------------------------
        !           240: 
        !           241: bind Text <1> {
        !           242:     set tk_priv(selectMode) char
        !           243:     %W mark set insert @%x,%y
        !           244:     %W mark set anchor insert
        !           245:     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
        !           246: }
        !           247: bind Text <Double-1> {
        !           248:     set tk_priv(selectMode) word
        !           249:     %W mark set insert "@%x,%y wordstart"
        !           250:     tk_textSelectTo %W insert
        !           251: }
        !           252: bind Text <Triple-1> {
        !           253:     set tk_priv(selectMode) line
        !           254:     %W mark set insert "@%x,%y linestart"
        !           255:     tk_textSelectTo %W insert
        !           256: }
        !           257: bind Text <B1-Motion> {tk_textSelectTo %W @%x,%y}
        !           258: bind Text <Shift-1> {
        !           259:     tk_textResetAnchor %W @%x,%y
        !           260:     tk_textSelectTo %W @%x,%y
        !           261: }
        !           262: bind Text <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}
        !           263: bind Text <2> {%W scan mark %y}
        !           264: bind Text <B2-Motion> {%W scan dragto %y}
        !           265: bind Text <Any-KeyPress> {
        !           266:     if {"%A" != ""} {
        !           267:        %W insert insert %A
        !           268:        %W yview -pickplace insert
        !           269:     }
        !           270: }
        !           271: bind Text <Return> {%W insert insert \n; %W yview -pickplace insert}
        !           272: bind Text <BackSpace> {tk_textBackspace %W; %W yview -pickplace insert}
        !           273: bind Text <Delete> {tk_textBackspace %W; %W yview -pickplace insert}
        !           274: bind Text <Control-h> {tk_textBackspace %W; %W yview -pickplace insert}
        !           275: bind Text <Control-d> {%W delete sel.first sel.last}
        !           276: bind Text <Control-v> {
        !           277:     %W insert insert [selection get]
        !           278:     %W yview -pickplace insert
        !           279: }
        !           280: tk_bindForTraversal Text
        !           281: 
        !           282: # Initialize the elements of tk_priv that require initialization.
        !           283: 
        !           284: set tk_priv(buttons) 0
        !           285: set tk_priv(dragging) {}
        !           286: set tk_priv(focus) {}
        !           287: set tk_priv(inMenuButton) {}
        !           288: set tk_priv(posted) {}
        !           289: set tk_priv(selectMode) char
        !           290: set tk_priv(window) {}

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