git.zerfleddert.de Git - micropolis/blob - src/tk/library/tk.tcl

   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) {}