lib/CommandEntry.wish

   1 #
   2 # CommandEntry
   3 #
   4 #
   5
   6 #
   7 # CommandEntry
   8 #
   9 proc CommandEntry { name label width command args } {
  10
  11         set f [ frame $name ]
  12         #label $name.label -text $label -anchor w
  13         label $name.label -text $label -width [ expr $width * 7 ] -anchor w
  14         #label $name.label -text $label -width 20 -anchor w
  15         #labelframe $name -text $label -labelanchor w
  16
  17         label $name.space -text " "
  18         set cmd  { entry $name.entry -relief sunken }
  19         eval $cmd $args
  20
  21         pack $name.label -side left -expand yes -fill x
  22         #pack $name.space -side left -expand yes -fill x
  23         #pack $name
  24         pack $name.entry -side left -anchor e
  25         bind $name.entry <Return> $command
  26         return $name.entry
  27 }
  28
  29 #
  30 #
  31 #
  32 proc CommandEntryWithSelection { name label pack var list command args } {
  33         #puts "CommandEntryWithSelection"
  34         #puts $var
  35         set f [ frame $name ]
  36         menubutton $f.label -text $label -menu $f.label.menu
  37         set m [ menu $f.label.menu ]
  38         foreach item $list {
  39                 $m add com -label $item -command "CommandEntryWithSelectionEntrySet $f $item"
  40         }
  41         eval { entry $f.entry -relief sunken -textvar $var } $args
  42         pack $name.label $name.entry -side $pack
  43         bind $f.entry <Return> $command
  44
  45         return $name.entry
  46 }
  47
  48 proc CommandEntryWithSelectionEntrySet { name var } {
  49         $name.entry delete 0 end
  50         $name.entry insert 0 $var
  51 }
  52
  53 #
  54 #
  55 #
  56 proc CommandEntryWithUpDown { name label width command var delta args } {
  57         frame $name
  58         #label $name.label -text $label -width $width -anchor w
  59         label $name.label -text $label -width [ expr $width * 6 ] -anchor w
  60         #label $name.label -text $label -anchor w
  61         label $name.space -text " "
  62         eval { entry $name.entry -relief sunken -textvar $var } $args
  63
  64         button $name.down -text < -command "CommandEntryWithUpDownDown $name $delta; $command "
  65         button $name.up   -text > -command "CommandEntryWithUpDownUp   $name $delta; $command "
  66
  67         eval { entry $name.delta -relief sunken -textvar $delta } $args
  68
  69         pack $name.label -side left -expand yes -fill x -anchor w
  70         pack $name.space -side left -expand yes -fill x
  71         pack $name.down $name.up $name.entry $name.delta -side left -fill x -expand true
  72
  73         bind $name.entry <Return> $command
  74
  75         return $name.entry
  76 }
  77
  78
  79 proc CommandEntryWithUpDownUp { name delta } {
  80                 set current [ $name.entry get ]
  81                 set d       [ $name.delta get ]
  82                 #puts $current
  83                 set var [ expr $current + $d ]
  84                 $name.entry delete 0 end
  85                 $name.entry insert 0 $var
  86 }
  87
  88 proc CommandEntryWithUpDownDown { name delta } {
  89                 set current [ $name.entry get ]
  90                 set d       [ $name.delta get ]
  91                 #puts $current
  92                 set var [ expr $current - $d ]
  93                 $name.entry delete 0 end
  94                 $name.entry insert 0 $var
  95 }
  96