/System/Platforms/tcltk/init/optionMenu.tcl

https://bitbucket.org/starware/sather · TCL · 46 lines · 16 code · 3 blank · 27 comment · 1 complexity · c1490c873697644e22490c87418204e9 MD5 · raw file

  1. # optionMenu.tcl --
  2. #
  3. # This file defines the procedure tk_optionMenu, which creates
  4. # an option button and its associated menu.
  5. #
  6. # @(#) optionMenu.tcl 1.6 95/01/06 11:18:53
  7. #
  8. # Copyright (c) 1994 The Regents of the University of California.
  9. # Copyright (c) 1994 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. # tk_optionMenu --
  15. # This procedure creates an option button named $w and an associated
  16. # menu. Together they provide the functionality of Motif option menus:
  17. # they can be used to select one of many values, and the current value
  18. # appears in the global variable varName, as well as in the text of
  19. # the option menubutton. The name of the menu is returned as the
  20. # procedure's result, so that the caller can use it to change configuration
  21. # options on the menu or otherwise manipulate it.
  22. #
  23. # Arguments:
  24. # w - The name to use for the menubutton.
  25. # varName - Global variable to hold the currently selected value.
  26. # firstValue - First of legal values for option (must be >= 1).
  27. # args - Any number of additional values.
  28. proc tk_optionMenu {w varName firstValue args} {
  29. upvar #0 $varName var
  30. if ![info exists var] {
  31. set var $firstValue
  32. }
  33. menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
  34. -relief raised -bd 2 -padx 4p -pady 4p -highlightthickness 2 \
  35. -anchor c
  36. menu $w.menu -tearoff 0
  37. $w.menu add command -label $firstValue \
  38. -command [list set $varName $firstValue]
  39. foreach i $args {
  40. $w.menu add command -label $i -command [list set $varName $i]
  41. }
  42. return $w.menu
  43. }