File: ts_optmenu.tcl

package info (click to toggle)
ts 9802-1
  • links: PTS
  • area: non-free
  • in suites: hamm
  • size: 2,348 kB
  • ctags: 1,468
  • sloc: tcl: 4,567; ansic: 3,389; makefile: 88; sh: 1
file content (23 lines) | stat: -rw-r--r-- 629 bytes parent folder | download | duplicates (2) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
# ts_optMenu.tcl
#
# like tk_optionMenu, but with another layout and callback
# callback is: function value

proc ts_optionMenu {w varName callback firstValue args} {
  upvar #0 $varName var
  upvar #0 $callback funct

  if ![info exists var] {
    set var $firstValue
  }
  menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
    -relief raised -bd 1
  menu $w.menu -tearoff 0
  $w.menu add radiobutton -label $firstValue -variable $varName -command \
    "$callback $firstValue"
  foreach i $args {
    $w.menu add radiobutton -label $i -variable $varName \
      -command "$callback $i"
  }
  return $w.menu
}