library/button.tcl

   1 # button.tcl --
   2 #
   3 # This file defines the default bindings for Ck label, button,
   4 # checkbutton, and radiobutton widgets and provides procedures
   5 # that help in implementing those bindings.
   6 #
   7 # Copyright (c) 1992-1994 The Regents of the University of California.
   8 # Copyright (c) 1994 Sun Microsystems, Inc.
   9 #
  10 # See the file "license.terms" for information on usage and redistribution
  11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12 #
  13
  14 set ckPriv(buttonWindow) ""
  15
  16 #-------------------------------------------------------------------------
  17 # The code below creates the default class bindings for buttons.
  18 #-------------------------------------------------------------------------
  19
  20 bind Button <FocusIn> {ckButtonFocus %W 1}
  21 bind Button <FocusOut> {ckButtonFocus %W 0}
  22 bind Button <space> {ckButtonInvoke %W}
  23 bind Button <Return> {ckButtonInvoke %W}
  24 bind Button <Linefeed> {ckButtonInvoke %W}
  25 bind Button <Button-1> {ckButtonInvoke %W}
  26
  27 bind Checkbutton <FocusIn> {ckButtonFocus %W 1}
  28 bind Checkbutton <FocusOut> {ckButtonFocus %W 0}
  29 bind Checkbutton <space> {ckButtonInvoke %W}
  30 bind Checkbutton <Return> {ckButtonInvoke %W}
  31 bind Checkbutton <Linefeed> {ckButtonInvoke %W}
  32 bind Checkbutton <Button-1> {ckButtonInvoke %W}
  33
  34 bind Radiobutton <FocusIn> {ckButtonFocus %W 1}
  35 bind Radiobutton <FocusOut> {ckButtonFocus %W 0}
  36 bind Radiobutton <space> {ckButtonInvoke %W}
  37 bind Radiobutton <Return> {ckButtonInvoke %W}
  38 bind Radiobutton <Linefeed> {ckButtonInvoke %W}
  39 bind Radiobutton <Button-1> {ckButtonInvoke %W}
  40
  41 # ckButtonFocus --
  42 # The procedure below is called when a button is invoked through
  43 # the keyboard.
  44 #
  45 # Arguments:
  46 # w -           The name of the widget.
  47
  48 proc ckButtonFocus {w flag} {
  49     global ckPriv
  50     if {[$w cget -state] == "disabled"} return
  51     if {$flag} {
  52         set ckPriv(buttonWindow) $w
  53         set ckPriv(buttonState) [$w cget -state]
  54         $w configure -state active
  55         return
  56     }
  57     if {$w == $ckPriv(buttonWindow)} {
  58         set ckPriv(buttonWindow) ""
  59         $w configure -state $ckPriv(buttonState)
  60         set ckPriv(buttonState) ""
  61     }
  62 }
  63
  64 # ckButtonInvoke --
  65 # The procedure below is called when a button is invoked through
  66 # the keyboard.
  67 #
  68 # Arguments:
  69 # w -           The name of the widget.
  70
  71 proc ckButtonInvoke w {
  72     if {[$w cget -state] != "disabled"} {
  73         uplevel #0 [list $w invoke]
  74     }
  75 }