home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / library / tk.tcl < prev    next >
Encoding:
Text File  |  1995-06-21  |  3.2 KB  |  110 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. # @(#) tk.tcl 1.67 95/06/19 10:45:49
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 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. scan [info tclversion] "%d.%d" a b
  17. if {$a != 7} {
  18.     error "wrong version of Tcl loaded ([info tclversion]): need 7.x"
  19. }
  20. scan $tk_version "%d.%d" a b
  21. if {($a != 4) || ($b < 0)} {
  22.     error "wrong version of Tk loaded ($tk_version): need 4.x"
  23. }
  24. unset a b
  25.  
  26. # Add Tk's directory to the end of the auto-load search path:
  27.  
  28. lappend auto_path $tk_library
  29.  
  30. # Turn off strict Motif look and feel as a default.
  31.  
  32. set tk_strictMotif 0
  33.  
  34. # tkScreenChanged --
  35. # This procedure is invoked by the binding mechanism whenever the
  36. # "current" screen is changing.  The procedure does two things.
  37. # First, it uses "upvar" to make global variable "tkPriv" point at an
  38. # array variable that holds state for the current display.  Second,
  39. # it initializes the array if it didn't already exist.
  40. #
  41. # Arguments:
  42. # screen -        The name of the new screen.
  43.  
  44. proc tkScreenChanged screen {
  45.     set disp [file rootname $screen]
  46.     uplevel #0 upvar #0 tkPriv.$disp tkPriv
  47.     global tkPriv
  48.     if [info exists tkPriv] {
  49.     set tkPriv(screen) $screen
  50.     return
  51.     }
  52.     set tkPriv(afterId) {}
  53.     set tkPriv(buttons) 0
  54.     set tkPriv(buttonWindow) {}
  55.     set tkPriv(dragging) {}
  56.     set tkPriv(focus) {}
  57.     set tkPriv(grab) {}
  58.     set tkPriv(initPos) {}
  59.     set tkPriv(inMenubutton) {}
  60.     set tkPriv(listboxPrev) {}
  61.     set tkPriv(mouseMoved) 0
  62.     set tkPriv(popup) {}
  63.     set tkPriv(postedMb) {}
  64.     set tkPriv(pressX) 0
  65.     set tkPriv(pressY) 0
  66.     set tkPriv(screen) $screen
  67.     set tkPriv(selectMode) char
  68.     set tkPriv(window) {}
  69. }
  70.  
  71. # Do initial setup for tkPriv, so that it is always bound to something
  72. # (otherwise, if someone references it, it may get set to a non-upvar-ed
  73. # value, which will cause trouble later).
  74.  
  75. tkScreenChanged [winfo screen .]
  76.  
  77. # ----------------------------------------------------------------------
  78. # Read in files that define all of the class bindings.
  79. # ----------------------------------------------------------------------
  80.  
  81. source $tk_library/button.tcl
  82. source $tk_library/entry.tcl
  83. source $tk_library/listbox.tcl
  84. source $tk_library/menu.tcl
  85. source $tk_library/scale.tcl
  86. source $tk_library/scrollbar.tcl
  87. source $tk_library/text.tcl
  88.  
  89. # ----------------------------------------------------------------------
  90. # Default bindings for keyboard traversal.
  91. # ----------------------------------------------------------------------
  92.  
  93. bind all <Tab> {focus [tk_focusNext %W]}
  94. bind all <Shift-Tab> {focus [tk_focusPrev %W]}
  95.  
  96. # tkCancelRepeat --
  97. # This procedure is invoked to cancel an auto-repeat action described
  98. # by tkPriv(afterId).  It's used by several widgets to auto-scroll
  99. # the widget when the mouse is dragged out of the widget with a
  100. # button pressed.
  101. #
  102. # Arguments:
  103. # None.
  104.  
  105. proc tkCancelRepeat {} {
  106.     global tkPriv
  107.     after cancel $tkPriv(afterId)
  108.     set tkPriv(afterId) {}
  109. }
  110.