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