library/optMenu.tcl

   1 # optMenu.tcl --
   2 #
   3 # This file defines the procedure ck_optionMenu, which creates
   4 # an option button and its associated menu.
   5 #
   6 # Copyright (c) 1994 The Regents of the University of California.
   7 # Copyright (c) 1994 Sun Microsystems, Inc.
   8 # Copyright (c) 1999 Christian Werner
   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 # ck_optionMenu --
  14 # This procedure creates an option button named $w and an associated
  15 # menu.  Together they provide the functionality of Motif option menus:
  16 # they can be used to select one of many values, and the current value
  17 # appears in the global variable varName, as well as in the text of
  18 # the option menubutton.  The name of the menu is returned as the
  19 # procedure's result, so that the caller can use it to change configuration
  20 # options on the menu or otherwise manipulate it.
  21 #
  22 # Arguments:
  23 # w -                   The name to use for the menubutton.
  24 # varName -             Global variable to hold the currently selected value.
  25 # firstValue -          First of legal values for option (must be >= 1).
  26 # args -                Any number of additional values.
  27
  28 proc ck_optionMenu {w varName firstValue args} {
  29     upvar #0 $varName var
  30     if {![info exists var]} {
  31         set var $firstValue
  32     }
  33     set width [string length $firstValue]
  34     foreach i $args {
  35         set l [string length $i]
  36         if {$l > $width} {
  37             set width $l
  38         }
  39     }
  40     incr width 2
  41     menubutton $w -textvariable $varName -menu $w.menu \
  42         -anchor c -takefocus 1 -width $width
  43     bind $w <FocusIn> {
  44         if {[%W cget -state] != "disabled"} {
  45             %W configure -state active
  46             update idletasks
  47         }
  48     }
  49     bind $w <FocusOut> {
  50         if {[%W cget -state] != "disabled"} {
  51             %W configure -state normal
  52             update idletasks
  53         }
  54     }
  55     menu $w.menu \
  56         -border { ulcorner hline urcorner vline lrcorner hline llcorner vline }
  57     $w.menu add radiobutton -label $firstValue -variable $varName
  58     foreach i $args {
  59         $w.menu add radiobutton -label $i -variable $varName
  60     }
  61     return $w.menu
  62 }