diff options
Diffstat (limited to 'tix/generic/tk4.2/tk.tcl')
| -rw-r--r-- | tix/generic/tk4.2/tk.tcl | 157 |
1 files changed, 157 insertions, 0 deletions
diff --git a/tix/generic/tk4.2/tk.tcl b/tix/generic/tk4.2/tk.tcl new file mode 100644 index 00000000000..c305faa743b --- /dev/null +++ b/tix/generic/tk4.2/tk.tcl @@ -0,0 +1,157 @@ +# tk.tcl -- +# +# Initialization script normally executed in the interpreter for each +# Tk-based application. Arranges class bindings for widgets. +# +# SCCS: @(#) tk.tcl 1.87 96/09/30 09:28:02 +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# Insist on running with compatible versions of Tcl and Tk. + +package require -exact Tk 4.2 +package require -exact Tcl 7.6 + +# Add Tk's directory to the end of the auto-load search path, if it +# isn't already on the path: + +if {[lsearch -exact $auto_path $tk_library] < 0} { + lappend auto_path $tk_library +} + +# Turn off strict Motif look and feel as a default. + +set tk_strictMotif 0 + +# tkScreenChanged -- +# This procedure is invoked by the binding mechanism whenever the +# "current" screen is changing. The procedure does two things. +# First, it uses "upvar" to make global variable "tkPriv" point at an +# array variable that holds state for the current display. Second, +# it initializes the array if it didn't already exist. +# +# Arguments: +# screen - The name of the new screen. + +proc tkScreenChanged screen { + set disp [file rootname $screen] + uplevel #0 upvar #0 tkPriv.$disp tkPriv + global tkPriv + if [info exists tkPriv] { + set tkPriv(screen) $screen + return + } + set tkPriv(afterId) {} + set tkPriv(buttons) 0 + set tkPriv(buttonWindow) {} + set tkPriv(dragging) 0 + set tkPriv(focus) {} + set tkPriv(grab) {} + set tkPriv(initPos) {} + set tkPriv(inMenubutton) {} + set tkPriv(listboxPrev) {} + set tkPriv(mouseMoved) 0 + set tkPriv(oldGrab) {} + set tkPriv(popup) {} + set tkPriv(postedMb) {} + set tkPriv(pressX) 0 + set tkPriv(pressY) 0 + set tkPriv(screen) $screen + set tkPriv(selectMode) char + set tkPriv(window) {} +} + +# Do initial setup for tkPriv, so that it is always bound to something +# (otherwise, if someone references it, it may get set to a non-upvar-ed +# value, which will cause trouble later). + +tkScreenChanged [winfo screen .] + +# tkEventMotifBindings -- +# This procedure is invoked as a trace whenever tk_strictMotif is +# changed. It is used to turn on or turn off the motif virtual +# bindings. +# +# Arguments: +# n1 - the name of the variable being changed ("tk_strictMotif"). + +proc tkEventMotifBindings {n1 dummy dummy} { + upvar $n1 name + + if $name { + set op delete + } else { + set op add + } + + event $op <<Cut>> <Control-Key-w> + event $op <<Copy>> <Meta-Key-w> + event $op <<Paste>> <Control-Key-y> +} + +#---------------------------------------------------------------------- +# Define the set of common virtual events. +#---------------------------------------------------------------------- + +switch $tcl_platform(platform) { + "unix" { + event add <<Cut>> <Control-Key-x> <Key-F20> + event add <<Copy>> <Control-Key-c> <Key-F16> + event add <<Paste>> <Control-Key-v> <Key-F18> + trace variable tk_strictMotif w tkEventMotifBindings + set tk_strictMotif $tk_strictMotif + } + "windows" { + event add <<Cut>> <Control-Key-x> <Shift-Key-Delete> + event add <<Copy>> <Control-Key-c> <Control-Key-Insert> + event add <<Paste>> <Control-Key-v> <Shift-Key-Insert> + } + "macintosh" { + event add <<Cut>> <Control-Key-x> <Key-F2> + event add <<Copy>> <Control-Key-c> <Key-F3> + event add <<Paste>> <Control-Key-v> <Key-F4> + event add <<Clear>> <Clear> + } +} + +# ---------------------------------------------------------------------- +# Read in files that define all of the class bindings. +# ---------------------------------------------------------------------- + +# No need in SamTk +# +#if {$tcl_platform(platform) != "macintosh"} { +# source $tk_library/button.tcl +# source $tk_library/entry.tcl +# source $tk_library/listbox.tcl +# source $tk_library/menu.tcl +# source $tk_library/scale.tcl +# source $tk_library/scrlbar.tcl +# source $tk_library/text.tcl +#} + +# ---------------------------------------------------------------------- +# Default bindings for keyboard traversal. +# ---------------------------------------------------------------------- + +bind all <Tab> {focus [tk_focusNext %W]} +bind all <Shift-Tab> {focus [tk_focusPrev %W]} + +# tkCancelRepeat -- +# This procedure is invoked to cancel an auto-repeat action described +# by tkPriv(afterId). It's used by several widgets to auto-scroll +# the widget when the mouse is dragged out of the widget with a +# button pressed. +# +# Arguments: +# None. + +proc tkCancelRepeat {} { + global tkPriv + after cancel $tkPriv(afterId) + set tkPriv(afterId) {} +} |