home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / library / tk.tcl < prev    next >
Encoding:
Text File  |  1993-07-01  |  11.4 KB  |  317 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. # $Header: /user6/ouster/wish/library/RCS/tk.tcl,v 1.34 93/07/01 13:41:59 ouster Exp $ SPRITE (Berkeley)
  7. #
  8. # Copyright (c) 1992-1993 The Regents of the University of California.
  9. # All rights reserved.
  10. #
  11. # Permission is hereby granted, without written agreement and without
  12. # license or royalty fees, to use, copy, modify, and distribute this
  13. # software and its documentation for any purpose, provided that the
  14. # above copyright notice and the following two paragraphs appear in
  15. # all copies of this software.
  16. #
  17. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  18. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  19. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  20. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  21. #
  22. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  23. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  24. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  25. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  26. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  27.  
  28. # Insist on running with compatible versions of Tcl and Tk.
  29.  
  30. scan [info tclversion] "%d.%d" a b
  31. if {$a != 7} {
  32.     error "wrong version of Tcl loaded ([info tclversion]): need 7.x"
  33. }
  34. scan $tk_version "%d.%d" a b
  35. if {($a != 3) || ($b < 3)} {
  36.     error "wrong version of Tk loaded ($tk_version): need 3.3 or later"
  37. }
  38. unset a b
  39.  
  40. # Initialize the auto-load path to include Tk's directory as well as
  41. # Tcl's directory:
  42.  
  43. set auto_path "$tk_library [info library]"
  44.  
  45. # Turn off strict Motif look and feel as a default.
  46.  
  47. set tk_strictMotif 0
  48.  
  49. # ----------------------------------------------------------------------
  50. # Class bindings for various flavors of button widgets.  $tk_priv(window)
  51. # keeps track of the button containing the mouse $tk_priv(relief) saves
  52. # the original relief of the button so it can be restored when the mouse
  53. # button is released, and $tk_priv(buttonWindow) keeps track of the
  54. # window in which the mouse button was pressed.
  55. # ----------------------------------------------------------------------
  56.  
  57. bind Button <Any-Enter> {tk_butEnter %W}
  58. bind Button <Any-Leave> {tk_butLeave %W}
  59. bind Button <1> {tk_butDown %W}
  60. bind Button <ButtonRelease-1> {tk_butUp %W}
  61.  
  62. bind Checkbutton <Any-Enter> {tk_butEnter %W}
  63. bind Checkbutton <Any-Leave> {tk_butLeave %W}
  64. bind Checkbutton <1> {tk_butDown %W}
  65. bind Checkbutton <ButtonRelease-1> {tk_butUp %W}
  66.  
  67. bind Radiobutton <Any-Enter> {tk_butEnter %W}
  68. bind Radiobutton <Any-Leave> {tk_butLeave %W}
  69. bind Radiobutton <1> {tk_butDown %W}
  70. bind Radiobutton <ButtonRelease-1> {tk_butUp %W}
  71.  
  72. # ----------------------------------------------------------------------
  73. # Class bindings for entry widgets.
  74. # ----------------------------------------------------------------------
  75.  
  76. bind Entry <1> {
  77.     %W icursor @%x
  78.     %W select from @%x
  79.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  80. }
  81. bind Entry <B1-Motion> {%W select to @%x}
  82. bind Entry <Shift-1> {%W select adjust @%x}
  83. bind Entry <Shift-B1-Motion> {%W select to @%x}
  84. bind Entry <2> {%W scan mark %x}
  85. bind Entry <B2-Motion> {%W scan dragto %x}
  86. bind Entry <Any-KeyPress> {
  87.     if {"%A" != ""} {
  88.     %W insert insert %A
  89.     tk_entrySeeCaret %W
  90.     }
  91. }
  92. bind Entry <Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  93. bind Entry <BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  94. bind Entry <Control-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  95. bind Entry <Control-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}
  96. bind Entry <Control-u> {%W delete 0 end}
  97. bind Entry <Control-v> {%W insert insert [selection get]; tk_entrySeeCaret %W}
  98. bind Entry <Control-w> {tk_entryBackword %W; tk_entrySeeCaret %W}
  99. tk_bindForTraversal Entry
  100.  
  101. # ----------------------------------------------------------------------
  102. # Class bindings for listbox widgets.
  103. # ----------------------------------------------------------------------
  104.  
  105. bind Listbox <1> {%W select from [%W nearest %y]}
  106. bind Listbox <B1-Motion> {%W select to [%W nearest %y]}
  107. bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}
  108. bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}
  109. bind Listbox <2> {%W scan mark %x %y}
  110. bind Listbox <B2-Motion> {%W scan dragto %x %y}
  111.  
  112. # ----------------------------------------------------------------------
  113. # Class bindings for scrollbar widgets.  When strict Motif is requested,
  114. # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
  115. # -activeforeground color to -foreground when the mouse is in the window
  116. # and restore it when the mouse leaves.
  117. # ----------------------------------------------------------------------
  118.  
  119. bind Scrollbar <Any-Enter> {
  120.     if $tk_strictMotif {
  121.     set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
  122.     %W config -activeforeground [lindex [%W config -foreground] 4]
  123.     }
  124. }
  125. bind Scrollbar <Any-Leave> {
  126.     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
  127.     %W config -activeforeground $tk_priv(activeFg)
  128.     }
  129. }
  130. bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}
  131. bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}
  132.  
  133. # ----------------------------------------------------------------------
  134. # Class bindings for scale widgets.  When strict Motif is requested,
  135. # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
  136. # -activeforeground color to -foreground when the mouse is in the window
  137. # and restore it when the mouse leaves.
  138. # ----------------------------------------------------------------------
  139.  
  140. bind Scale <Any-Enter> {
  141.     if $tk_strictMotif {
  142.     set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
  143.     %W config -activeforeground [lindex [%W config -sliderforeground] 4]
  144.     }
  145. }
  146. bind Scale <Any-Leave> {
  147.     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
  148.     %W config -activeforeground $tk_priv(activeFg)
  149.     }
  150. }
  151. bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}
  152. bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}
  153.  
  154. # ----------------------------------------------------------------------
  155. # Class bindings for menubutton widgets.  Variables used:
  156. # $tk_priv(posted) -        keeps track of the menubutton whose menu is
  157. #                currently posted (or empty string, if none).
  158. # $tk_priv(inMenuButton)-    if non-null, identifies menu button
  159. #                containing mouse pointer.
  160. # $tk_priv(relief) -        keeps track of original relief of posted
  161. #                menu button, so it can be restored later.
  162. # $tk_priv(dragging) -        if non-null, identifies menu button whose
  163. #                menu is currently being dragged in a tear-off
  164. #                operation.
  165. # $tk_priv(focus) -        records old focus window so focus can be
  166. #                returned there after keyboard traversal
  167. #                to menu.
  168. # ----------------------------------------------------------------------
  169.  
  170. bind Menubutton <Any-Enter> {
  171.     set tk_priv(inMenuButton) %W
  172.     if {[lindex [%W config -state] 4] != "disabled"} {
  173.     if {!$tk_strictMotif} {
  174.         %W config -state active
  175.     }
  176.     }
  177. }
  178. bind Menubutton <Any-Leave> {
  179.     set tk_priv(inMenuButton) {}
  180.     if {[lindex [%W config -state] 4] == "active"} {
  181.     %W config -state normal
  182.     }
  183. }
  184. bind Menubutton <1> {tk_mbButtonDown %W}
  185. bind Menubutton <Any-ButtonRelease-1> {
  186.     if {($tk_priv(posted) == "%W") && ($tk_priv(inMenuButton) == "%W")} {
  187.     [lindex [$tk_priv(posted) config -menu] 4] activate 0
  188.     } else {
  189.     tk_mbUnpost
  190.     }
  191. }
  192.  
  193. # The binding below is trickier than it looks.  It's important to check
  194. # to see that another menu is posted in the "if" statement below.
  195. # The check is needed because some window managers (e.g. mwm in
  196. # click-to-focus mode) cause a button-press event to be preceded by
  197. # a B1-Enter event;  we don't want to process that B1-Enter event (if
  198. # we do, the grab may get mis-set so that the menu is non-responsive).
  199.  
  200. bind Menubutton <B1-Enter> {
  201.     set tk_priv(inMenuButton) %W
  202.     if {([lindex [%W config -state] 4] != "disabled")
  203.         && ($tk_priv(posted) != "")} {
  204.     if {!$tk_strictMotif} {
  205.         %W config -state active
  206.     }
  207.     tk_mbPost %W
  208.     }
  209. }
  210. bind Menubutton <2> {
  211.     if {($tk_priv(posted) == "")
  212.         && ([lindex [%W config -state] 4] != "disabled")} {
  213.     set tk_priv(dragging) %W
  214.     [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
  215.     }
  216. }
  217. bind Menubutton <B2-Motion> {
  218.     if {$tk_priv(dragging) != ""} {
  219.     [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
  220.     }
  221. }
  222. bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) ""}
  223.  
  224. # ----------------------------------------------------------------------
  225. # Class bindings for menu widgets.  $tk_priv(x) and $tk_priv(y) are used
  226. # to keep track of the position of the mouse cursor in the menu window
  227. # during dragging of tear-off menus.  $tk_priv(window) keeps track of
  228. # the menu containing the mouse, if any.
  229. # ----------------------------------------------------------------------
  230.  
  231. bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}
  232. bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}
  233. bind Menu <Any-Motion> {
  234.     if {$tk_priv(window) == "%W"} {
  235.     %W activate @%y
  236.     }
  237. }
  238. bind Menu <1> {
  239.     if {$tk_priv(grab) != ""} {
  240.     grab $tk_priv(grab)
  241.     }
  242. }
  243. bind Menu <ButtonRelease-1> {tk_invokeMenu %W}
  244. bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}
  245. bind Menu <B2-Motion> {
  246.     if {$tk_priv(posted) == ""} {
  247.     %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]
  248.     }
  249. }
  250. bind Menu <B2-Leave> { }
  251. bind Menu <B2-Enter> { }
  252. bind Menu <Escape> {tk_mbUnpost}
  253. bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}
  254. bind Menu <Left> {tk_nextMenu -1}
  255. bind Menu <Right> {tk_nextMenu 1}
  256. bind Menu <Up> {tk_nextMenuEntry -1}
  257. bind Menu <Down> {tk_nextMenuEntry 1}
  258. bind Menu <Return> {tk_invokeMenu %W}
  259.  
  260. # ----------------------------------------------------------------------
  261. # Class bindings for text widgets. $tk_priv(selectMode) holds one of
  262. # "char", "word", or "line" to indicate which selection mode is active.
  263. # ----------------------------------------------------------------------
  264.  
  265. bind Text <1> {
  266.     set tk_priv(selectMode) char
  267.     %W mark set insert @%x,%y
  268.     %W mark set anchor insert
  269.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  270. }
  271. bind Text <Double-1> {
  272.     set tk_priv(selectMode) word
  273.     %W mark set insert "@%x,%y wordstart"
  274.     tk_textSelectTo %W insert
  275. }
  276. bind Text <Triple-1> {
  277.     set tk_priv(selectMode) line
  278.     %W mark set insert "@%x,%y linestart"
  279.     tk_textSelectTo %W insert
  280. }
  281. bind Text <B1-Motion> {tk_textSelectTo %W @%x,%y}
  282. bind Text <Shift-1> {
  283.     tk_textResetAnchor %W @%x,%y
  284.     tk_textSelectTo %W @%x,%y
  285. }
  286. bind Text <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}
  287. bind Text <2> {%W scan mark %y}
  288. bind Text <B2-Motion> {%W scan dragto %y}
  289. bind Text <Any-KeyPress> {
  290.     if {"%A" != ""} {
  291.     %W insert insert %A
  292.     %W yview -pickplace insert
  293.     }
  294. }
  295. bind Text <Return> {%W insert insert \n; %W yview -pickplace insert}
  296. bind Text <BackSpace> {tk_textBackspace %W; %W yview -pickplace insert}
  297. bind Text <Delete> {tk_textBackspace %W; %W yview -pickplace insert}
  298. bind Text <Control-h> {tk_textBackspace %W; %W yview -pickplace insert}
  299. bind Text <Control-d> {%W delete sel.first sel.last}
  300. bind Text <Control-v> {
  301.     %W insert insert [selection get]
  302.     %W yview -pickplace insert
  303. }
  304. tk_bindForTraversal Text
  305.  
  306. # Initialize the elements of tk_priv that require initialization.
  307.  
  308. set tk_priv(buttons) 0
  309. set tk_priv(buttonWindow) {}
  310. set tk_priv(dragging) {}
  311. set tk_priv(focus) {}
  312. set tk_priv(grab) {}
  313. set tk_priv(inMenuButton) {}
  314. set tk_priv(posted) {}
  315. set tk_priv(selectMode) char
  316. set tk_priv(window) {}
  317.