home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / tk8.3 / button.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  11.2 KB  |  456 lines
  1. # button.tcl --
  2. #
  3. # This file defines the default bindings for Tk label, button,
  4. # checkbutton, and radiobutton widgets and provides procedures
  5. # that help in implementing those bindings.
  6. #
  7. # RCS: @(#) $Id: button.tcl,v 1.6 1999/09/02 17:02:52 hobbs Exp $
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  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.  
  16. #-------------------------------------------------------------------------
  17. # The code below creates the default class bindings for buttons.
  18. #-------------------------------------------------------------------------
  19.  
  20. if {[string match "macintosh" $tcl_platform(platform)]} {
  21.     bind Radiobutton <Enter> {
  22.     tkButtonEnter %W
  23.     }
  24.     bind Radiobutton <1> {
  25.     tkButtonDown %W
  26.     }
  27.     bind Radiobutton <ButtonRelease-1> {
  28.     tkButtonUp %W
  29.     }
  30.     bind Checkbutton <Enter> {
  31.     tkButtonEnter %W
  32.     }
  33.     bind Checkbutton <1> {
  34.     tkButtonDown %W
  35.     }
  36.     bind Checkbutton <ButtonRelease-1> {
  37.     tkButtonUp %W
  38.     }
  39. }
  40. if {[string match "windows" $tcl_platform(platform)]} {
  41.     bind Checkbutton <equal> {
  42.     tkCheckRadioInvoke %W select
  43.     }
  44.     bind Checkbutton <plus> {
  45.     tkCheckRadioInvoke %W select
  46.     }
  47.     bind Checkbutton <minus> {
  48.     tkCheckRadioInvoke %W deselect
  49.     }
  50.     bind Checkbutton <1> {
  51.     tkCheckRadioDown %W
  52.     }
  53.     bind Checkbutton <ButtonRelease-1> {
  54.     tkButtonUp %W
  55.     }
  56.     bind Checkbutton <Enter> {
  57.     tkCheckRadioEnter %W
  58.     }
  59.  
  60.     bind Radiobutton <1> {
  61.     tkCheckRadioDown %W
  62.     }
  63.     bind Radiobutton <ButtonRelease-1> {
  64.     tkButtonUp %W
  65.     }
  66.     bind Radiobutton <Enter> {
  67.     tkCheckRadioEnter %W
  68.     }
  69. }
  70. if {[string match "unix" $tcl_platform(platform)]} {
  71.     bind Checkbutton <Return> {
  72.     if {!$tk_strictMotif} {
  73.         tkCheckRadioInvoke %W
  74.     }
  75.     }
  76.     bind Radiobutton <Return> {
  77.     if {!$tk_strictMotif} {
  78.         tkCheckRadioInvoke %W
  79.     }
  80.     }
  81.     bind Checkbutton <1> {
  82.     tkCheckRadioInvoke %W
  83.     }
  84.     bind Radiobutton <1> {
  85.     tkCheckRadioInvoke %W
  86.     }
  87.     bind Checkbutton <Enter> {
  88.     tkButtonEnter %W
  89.     }
  90.     bind Radiobutton <Enter> {
  91.     tkButtonEnter %W
  92.     }
  93. }
  94.  
  95. bind Button <space> {
  96.     tkButtonInvoke %W
  97. }
  98. bind Checkbutton <space> {
  99.     tkCheckRadioInvoke %W
  100. }
  101. bind Radiobutton <space> {
  102.     tkCheckRadioInvoke %W
  103. }
  104.  
  105. bind Button <FocusIn> {}
  106. bind Button <Enter> {
  107.     tkButtonEnter %W
  108. }
  109. bind Button <Leave> {
  110.     tkButtonLeave %W
  111. }
  112. bind Button <1> {
  113.     tkButtonDown %W
  114. }
  115. bind Button <ButtonRelease-1> {
  116.     tkButtonUp %W
  117. }
  118.  
  119. bind Checkbutton <FocusIn> {}
  120. bind Checkbutton <Leave> {
  121.     tkButtonLeave %W
  122. }
  123.  
  124. bind Radiobutton <FocusIn> {}
  125. bind Radiobutton <Leave> {
  126.     tkButtonLeave %W
  127. }
  128.  
  129. if {[string match "windows" $tcl_platform(platform)]} {
  130.  
  131. #########################
  132. # Windows implementation 
  133. #########################
  134.  
  135. # tkButtonEnter --
  136. # The procedure below is invoked when the mouse pointer enters a
  137. # button widget.  It records the button we're in and changes the
  138. # state of the button to active unless the button is disabled.
  139. #
  140. # Arguments:
  141. # w -        The name of the widget.
  142.  
  143. proc tkButtonEnter w {
  144.     global tkPriv
  145.     if {[string compare [$w cget -state] "disabled"] \
  146.         && [string equal $tkPriv(buttonWindow) $w]} {
  147.     $w configure -state active -relief sunken
  148.     }
  149.     set tkPriv(window) $w
  150. }
  151.  
  152. # tkButtonLeave --
  153. # The procedure below is invoked when the mouse pointer leaves a
  154. # button widget.  It changes the state of the button back to
  155. # inactive.  If we're leaving the button window with a mouse button
  156. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  157. # button too.
  158. #
  159. # Arguments:
  160. # w -        The name of the widget.
  161.  
  162. proc tkButtonLeave w {
  163.     global tkPriv
  164.     if {[string compare [$w cget -state] "disabled"]} {
  165.     $w configure -state normal
  166.     }
  167.     if {[string equal $tkPriv(buttonWindow) $w]} {
  168.     $w configure -relief $tkPriv(relief)
  169.     }
  170.     set tkPriv(window) ""
  171. }
  172.  
  173. # tkCheckRadioEnter --
  174. # The procedure below is invoked when the mouse pointer enters a
  175. # checkbutton or radiobutton widget.  It records the button we're in
  176. # and changes the state of the button to active unless the button is
  177. # disabled.
  178. #
  179. # Arguments:
  180. # w -        The name of the widget.
  181.  
  182. proc tkCheckRadioEnter w {
  183.     global tkPriv
  184.     if {[string compare [$w cget -state] "disabled"] \
  185.         && [string equal $tkPriv(buttonWindow) $w]} {
  186.     $w configure -state active
  187.     }
  188.     set tkPriv(window) $w
  189. }
  190.  
  191. # tkButtonDown --
  192. # The procedure below is invoked when the mouse button is pressed in
  193. # a button widget.  It records the fact that the mouse is in the button,
  194. # saves the button's relief so it can be restored later, and changes
  195. # the relief to sunken.
  196. #
  197. # Arguments:
  198. # w -        The name of the widget.
  199.  
  200. proc tkButtonDown w {
  201.     global tkPriv
  202.     set tkPriv(relief) [$w cget -relief]
  203.     if {[string compare [$w cget -state] "disabled"]} {
  204.     set tkPriv(buttonWindow) $w
  205.     $w configure -relief sunken -state active
  206.     }
  207. }
  208.  
  209. # tkCheckRadioDown --
  210. # The procedure below is invoked when the mouse button is pressed in
  211. # a button widget.  It records the fact that the mouse is in the button,
  212. # saves the button's relief so it can be restored later, and changes
  213. # the relief to sunken.
  214. #
  215. # Arguments:
  216. # w -        The name of the widget.
  217.  
  218. proc tkCheckRadioDown w {
  219.     global tkPriv
  220.     set tkPriv(relief) [$w cget -relief]
  221.     if {[string compare [$w cget -state] "disabled"]} {
  222.     set tkPriv(buttonWindow) $w
  223.     $w configure -state active
  224.     }
  225. }
  226.  
  227. # tkButtonUp --
  228. # The procedure below is invoked when the mouse button is released
  229. # in a button widget.  It restores the button's relief and invokes
  230. # the command as long as the mouse hasn't left the button.
  231. #
  232. # Arguments:
  233. # w -        The name of the widget.
  234.  
  235. proc tkButtonUp w {
  236.     global tkPriv
  237.     if {[string equal $tkPriv(buttonWindow) $w]} {
  238.     set tkPriv(buttonWindow) ""
  239.     $w configure -relief $tkPriv(relief)
  240.     if {[string equal $tkPriv(window) $w]
  241.               && [string compare [$w cget -state] "disabled"]} {
  242.         $w configure -state normal
  243.         uplevel #0 [list $w invoke]
  244.     }
  245.     }
  246. }
  247.  
  248. }
  249.  
  250. if {[string match "unix" $tcl_platform(platform)]} {
  251.  
  252. #####################
  253. # Unix implementation
  254. #####################
  255.  
  256. # tkButtonEnter --
  257. # The procedure below is invoked when the mouse pointer enters a
  258. # button widget.  It records the button we're in and changes the
  259. # state of the button to active unless the button is disabled.
  260. #
  261. # Arguments:
  262. # w -        The name of the widget.
  263.  
  264. proc tkButtonEnter {w} {
  265.     global tkPriv
  266.     if {[string compare [$w cget -state] "disabled"]} {
  267.     $w configure -state active
  268.     if {[string equal $tkPriv(buttonWindow) $w]} {
  269.         $w configure -state active -relief sunken
  270.     }
  271.     }
  272.     set tkPriv(window) $w
  273. }
  274.  
  275. # tkButtonLeave --
  276. # The procedure below is invoked when the mouse pointer leaves a
  277. # button widget.  It changes the state of the button back to
  278. # inactive.  If we're leaving the button window with a mouse button
  279. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  280. # button too.
  281. #
  282. # Arguments:
  283. # w -        The name of the widget.
  284.  
  285. proc tkButtonLeave w {
  286.     global tkPriv
  287.     if {[string compare [$w cget -state] "disabled"]} {
  288.     $w configure -state normal
  289.     }
  290.     if {[string equal $tkPriv(buttonWindow) $w]} {
  291.     $w configure -relief $tkPriv(relief)
  292.     }
  293.     set tkPriv(window) ""
  294. }
  295.  
  296. # tkButtonDown --
  297. # The procedure below is invoked when the mouse button is pressed in
  298. # a button widget.  It records the fact that the mouse is in the button,
  299. # saves the button's relief so it can be restored later, and changes
  300. # the relief to sunken.
  301. #
  302. # Arguments:
  303. # w -        The name of the widget.
  304.  
  305. proc tkButtonDown w {
  306.     global tkPriv
  307.     set tkPriv(relief) [$w cget -relief]
  308.     if {[string compare [$w cget -state] "disabled"]} {
  309.     set tkPriv(buttonWindow) $w
  310.     $w configure -relief sunken
  311.     }
  312. }
  313.  
  314. # tkButtonUp --
  315. # The procedure below is invoked when the mouse button is released
  316. # in a button widget.  It restores the button's relief and invokes
  317. # the command as long as the mouse hasn't left the button.
  318. #
  319. # Arguments:
  320. # w -        The name of the widget.
  321.  
  322. proc tkButtonUp w {
  323.     global tkPriv
  324.     if {[string equal $w $tkPriv(buttonWindow)]} {
  325.     set tkPriv(buttonWindow) ""
  326.     $w configure -relief $tkPriv(relief)
  327.     if {[string equal $w $tkPriv(window)] \
  328.         && [string compare [$w cget -state] "disabled"]} {
  329.         uplevel #0 [list $w invoke]
  330.     }
  331.     }
  332. }
  333.  
  334. }
  335.  
  336. if {[string match "macintosh" $tcl_platform(platform)]} {
  337.  
  338. ####################
  339. # Mac implementation
  340. ####################
  341.  
  342. # tkButtonEnter --
  343. # The procedure below is invoked when the mouse pointer enters a
  344. # button widget.  It records the button we're in and changes the
  345. # state of the button to active unless the button is disabled.
  346. #
  347. # Arguments:
  348. # w -        The name of the widget.
  349.  
  350. proc tkButtonEnter {w} {
  351.     global tkPriv
  352.     if {[string compare [$w cget -state] "disabled"]} {
  353.       if {[string equal $w $tkPriv(buttonWindow)]} {
  354.         $w configure -state active
  355.     }
  356.     }
  357.     set tkPriv(window) $w
  358. }
  359.  
  360. # tkButtonLeave --
  361. # The procedure below is invoked when the mouse pointer leaves a
  362. # button widget.  It changes the state of the button back to
  363. # inactive.  If we're leaving the button window with a mouse button
  364. # pressed (tkPriv(buttonWindow) == $w), restore the relief of the
  365. # button too.
  366. #
  367. # Arguments:
  368. # w -        The name of the widget.
  369.  
  370. proc tkButtonLeave w {
  371.     global tkPriv
  372.     if {[string equal $w $tkPriv(buttonWindow)]} {
  373.     $w configure -state normal
  374.     }
  375.     set tkPriv(window) ""
  376. }
  377.  
  378. # tkButtonDown --
  379. # The procedure below is invoked when the mouse button is pressed in
  380. # a button widget.  It records the fact that the mouse is in the button,
  381. # saves the button's relief so it can be restored later, and changes
  382. # the relief to sunken.
  383. #
  384. # Arguments:
  385. # w -        The name of the widget.
  386.  
  387. proc tkButtonDown w {
  388.     global tkPriv
  389.     if {[string compare [$w cget -state] "disabled"]} {
  390.     set tkPriv(buttonWindow) $w
  391.     $w configure -state active
  392.     }
  393. }
  394.  
  395. # tkButtonUp --
  396. # The procedure below is invoked when the mouse button is released
  397. # in a button widget.  It restores the button's relief and invokes
  398. # the command as long as the mouse hasn't left the button.
  399. #
  400. # Arguments:
  401. # w -        The name of the widget.
  402.  
  403. proc tkButtonUp w {
  404.     global tkPriv
  405.     if {[string equal $w $tkPriv(buttonWindow)]} {
  406.     $w configure -state normal
  407.     set tkPriv(buttonWindow) ""
  408.     if {[string equal $w $tkPriv(window)]
  409.               && [string compare [$w cget -state] "disabled"]} {
  410.         uplevel #0 [list $w invoke]
  411.     }
  412.     }
  413. }
  414.  
  415. }
  416.  
  417. ##################
  418. # Shared routines
  419. ##################
  420.  
  421. # tkButtonInvoke --
  422. # The procedure below is called when a button is invoked through
  423. # the keyboard.  It simulate a press of the button via the mouse.
  424. #
  425. # Arguments:
  426. # w -        The name of the widget.
  427.  
  428. proc tkButtonInvoke w {
  429.     if {[string compare [$w cget -state] "disabled"]} {
  430.     set oldRelief [$w cget -relief]
  431.     set oldState [$w cget -state]
  432.     $w configure -state active -relief sunken
  433.     update idletasks
  434.     after 100
  435.     $w configure -state $oldState -relief $oldRelief
  436.     uplevel #0 [list $w invoke]
  437.     }
  438. }
  439.  
  440. # tkCheckRadioInvoke --
  441. # The procedure below is invoked when the mouse button is pressed in
  442. # a checkbutton or radiobutton widget, or when the widget is invoked
  443. # through the keyboard.  It invokes the widget if it
  444. # isn't disabled.
  445. #
  446. # Arguments:
  447. # w -        The name of the widget.
  448. # cmd -        The subcommand to invoke (one of invoke, select, or deselect).
  449.  
  450. proc tkCheckRadioInvoke {w {cmd invoke}} {
  451.     if {[string compare [$w cget -state] "disabled"]} {
  452.     uplevel #0 [list $w $cmd]
  453.     }
  454. }
  455.  
  456.