SGI/util/SGI/lib/tk8.0/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 # SCCS: @(#) tk.tcl 1.98 97/10/28 15:21:04
   7 #
   8 # Copyright (c) 1992-1994 The Regents of the University of California.
   9 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10 #
  11 # See the file "license.terms" for information on usage and redistribution
  12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13
  14 # Insist on running with compatible versions of Tcl and Tk.
  15
  16 package require -exact Tk 8.0
  17 package require -exact Tcl 8.0
  18
  19 # Add Tk's directory to the end of the auto-load search path, if it
  20 # isn't already on the path:
  21
  22 if {[info exists auto_path]} {
  23     if {[lsearch -exact $auto_path $tk_library] < 0} {
  24         lappend auto_path $tk_library
  25     }
  26 }
  27
  28 # Turn off strict Motif look and feel as a default.
  29
  30 set tk_strictMotif 0
  31
  32 # tkScreenChanged --
  33 # This procedure is invoked by the binding mechanism whenever the
  34 # "current" screen is changing.  The procedure does two things.
  35 # First, it uses "upvar" to make global variable "tkPriv" point at an
  36 # array variable that holds state for the current display.  Second,
  37 # it initializes the array if it didn't already exist.
  38 #
  39 # Arguments:
  40 # screen -              The name of the new screen.
  41
  42 proc tkScreenChanged screen {
  43     set x [string last . $screen]
  44     if {$x > 0} {
  45         set disp [string range $screen 0 [expr $x - 1]]
  46     } else {
  47         set disp $screen
  48     }
  49
  50     uplevel #0 upvar #0 tkPriv.$disp tkPriv
  51     global tkPriv
  52     global tcl_platform
  53
  54     if [info exists tkPriv] {
  55         set tkPriv(screen) $screen
  56         return
  57     }
  58     set tkPriv(activeMenu) {}
  59     set tkPriv(activeItem) {}
  60     set tkPriv(afterId) {}
  61     set tkPriv(buttons) 0
  62     set tkPriv(buttonWindow) {}
  63     set tkPriv(dragging) 0
  64     set tkPriv(focus) {}
  65     set tkPriv(grab) {}
  66     set tkPriv(initPos) {}
  67     set tkPriv(inMenubutton) {}
  68     set tkPriv(listboxPrev) {}
  69     set tkPriv(menuBar) {}
  70     set tkPriv(mouseMoved) 0
  71     set tkPriv(oldGrab) {}
  72     set tkPriv(popup) {}
  73     set tkPriv(postedMb) {}
  74     set tkPriv(pressX) 0
  75     set tkPriv(pressY) 0
  76     set tkPriv(prevPos) 0
  77     set tkPriv(screen) $screen
  78     set tkPriv(selectMode) char
  79     if {[string compare $tcl_platform(platform) "unix"] == 0} {
  80         set tkPriv(tearoff) 1
  81     } else {
  82         set tkPriv(tearoff) 0
  83     }
  84     set tkPriv(window) {}
  85 }
  86
  87 # Do initial setup for tkPriv, so that it is always bound to something
  88 # (otherwise, if someone references it, it may get set to a non-upvar-ed
  89 # value, which will cause trouble later).
  90
  91 tkScreenChanged [winfo screen .]
  92
  93 # tkEventMotifBindings --
  94 # This procedure is invoked as a trace whenever tk_strictMotif is
  95 # changed.  It is used to turn on or turn off the motif virtual
  96 # bindings.
  97 #
  98 # Arguments:
  99 # n1 - the name of the variable being changed ("tk_strictMotif").
 100
 101 proc tkEventMotifBindings {n1 dummy dummy} {
 102     upvar $n1 name
 103
 104     if $name {
 105         set op delete
 106     } else {
 107         set op add
 108     }
 109
 110     event $op <<Cut>> <Control-Key-w>
 111     event $op <<Copy>> <Meta-Key-w>
 112     event $op <<Paste>> <Control-Key-y>
 113 }
 114
 115 #----------------------------------------------------------------------
 116 # Define the set of common virtual events.
 117 #----------------------------------------------------------------------
 118
 119 switch $tcl_platform(platform) {
 120     "unix" {
 121         event add <<Cut>> <Control-Key-x> <Key-F20>
 122         event add <<Copy>> <Control-Key-c> <Key-F16>
 123         event add <<Paste>> <Control-Key-v> <Key-F18>
 124         trace variable tk_strictMotif w tkEventMotifBindings
 125         set tk_strictMotif $tk_strictMotif
 126     }
 127     "windows" {
 128         event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
 129         event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
 130         event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
 131     }
 132     "macintosh" {
 133         event add <<Cut>> <Control-Key-x> <Key-F2>
 134         event add <<Copy>> <Control-Key-c> <Key-F3>
 135         event add <<Paste>> <Control-Key-v> <Key-F4>
 136         event add <<Clear>> <Clear>
 137     }
 138 }
 139
 140 # ----------------------------------------------------------------------
 141 # Read in files that define all of the class bindings.
 142 # ----------------------------------------------------------------------
 143
 144 if {$tcl_platform(platform) != "macintosh"} {
 145     source $tk_library/button.tcl
 146     source $tk_library/entry.tcl
 147     source $tk_library/listbox.tcl
 148     source $tk_library/menu.tcl
 149     source $tk_library/scale.tcl
 150     source $tk_library/scrlbar.tcl
 151     source $tk_library/text.tcl
 152 }
 153
 154 # ----------------------------------------------------------------------
 155 # Default bindings for keyboard traversal.
 156 # ----------------------------------------------------------------------
 157
 158 bind all <Tab> {tkTabToWindow [tk_focusNext %W]}
 159 bind all <Shift-Tab> {tkTabToWindow [tk_focusPrev %W]}
 160
 161 # tkCancelRepeat --
 162 # This procedure is invoked to cancel an auto-repeat action described
 163 # by tkPriv(afterId).  It's used by several widgets to auto-scroll
 164 # the widget when the mouse is dragged out of the widget with a
 165 # button pressed.
 166 #
 167 # Arguments:
 168 # None.
 169
 170 proc tkCancelRepeat {} {
 171     global tkPriv
 172     after cancel $tkPriv(afterId)
 173     set tkPriv(afterId) {}
 174 }
 175
 176 # tkTabToWindow --
 177 # This procedure moves the focus to the given widget.  If the widget
 178 # is an entry, it selects the entire contents of the widget.
 179 #
 180 # Arguments:
 181 # w - Window to which focus should be set.
 182
 183 proc tkTabToWindow {w} {
 184     if {"[winfo class $w]" == "Entry"} {
 185         $w select range 0 end
 186         $w icur end
 187     }
 188     focus $w
 189 }