home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 44_1.tcl < prev    next >
Text File  |  2003-04-15  |  2KB  |  72 lines
  1. #
  2. # Example 44-1
  3. # A user interface to widget bindings.
  4. #
  5.  
  6. proc Bind_Interface { w } {
  7.     # Our state
  8.     global bind
  9.     set bind(class) $w
  10.  
  11.     # Set a class used for resource specifications
  12.     set frame [toplevel .bindui -class Bindui]
  13.     # Default relief
  14.     option add *Bindui*Entry.relief sunken startup
  15.     option add *Bindui*Listbox.relief raised startup
  16.     # Default Listbox sizes
  17.     option add *Bindui*key.width 18 startup
  18.     option add *Bindui*cmd.width 25 startup
  19.     option add *Bindui*Listbox.height 5 startup
  20.  
  21.     # A labeled entry at the top to hold the current
  22.     # widget name or class.
  23.     set t [frame $frame.top -bd 2]
  24.     label $t.l -text "Bindings for" -width 11
  25.     entry $t.e -textvariable bind(class)
  26.     pack $t.l -side left
  27.     pack $t.e -side left -fill x -expand true
  28.     pack $t -side top -fill x
  29.     bind $t.e <Return> [list Bind_Display $frame]
  30.  
  31.     # Command buttons
  32.     button $t.quit -text Dismiss \
  33.         -command [list destroy $frame]
  34.     button $t.save -text Save \
  35.         -command [list Bind_Save $frame]
  36.     button $t.edit -text Edit \
  37.         -command [list Bind_Edit $frame]
  38.     button $t.new -text New \
  39.         -command [list Bind_New $frame]
  40.     pack $t.quit $t.save $t.edit $t.new -side right
  41.  
  42.     # A pair of listboxes and a scrollbar
  43.     scrollbar $frame.s -orient vertical \
  44.         -command [list BindYview \
  45.             [list $frame.key $frame.cmd]]
  46.     listbox $frame.key \
  47.         -yscrollcommand [list $frame.s set] \
  48.         -exportselection false
  49.     listbox $frame.cmd \
  50.         -yscrollcommand [list $frame.s set]
  51.     pack $frame.s -side left -fill y
  52.     pack $frame.key $frame.cmd -side left \
  53.         -fill both -expand true
  54.  
  55.     foreach l [list $frame.key $frame.cmd] {
  56.         bind $l <B2-Motion>    \
  57.             [list BindDragto %x %y $frame.key $frame.cmd]
  58.         bind $l <Button-2> \
  59.             [list BindMark %x %y $frame.key $frame.cmd]
  60.         bind $l <Button-1> \
  61.             [list BindSelect %y $frame.key $frame.cmd]
  62.         bind $l <B1-Motion> \
  63.             [list BindSelect %y $frame.key $frame.cmd]
  64.         bind $l <Shift-B1-Motion> {}
  65.         bind $l <Shift-Button-1> {}
  66.     }
  67.     # Initialize the display
  68.     Bind_Display $frame
  69. }
  70.  
  71.  
  72.