home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / bind.tk < prev    next >
Encoding:
Text File  |  1995-11-06  |  5.1 KB  |  203 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # system wide bindings
  8.  
  9. # palette bindings for "look" - the're almost buttons
  10. bind palette <Enter> "%W configure -bg #ececec"
  11. bind palette <Leave> "%W configure -bg #d9d9d9"
  12. bind palette <ButtonRelease-1> "%W configure -relief raised"
  13.  
  14. # set binding to propagate geometry changes
  15. # There are far too many configure events, so this is too slow
  16. # Instead, I should go back to the *old way*, and kick off the updates
  17. # when I know they are needed
  18.  
  19. set Down 0
  20. bind widget <Configure>  {
  21.     if {$Arrow_move} continue
  22.     if {$Down} continue
  23.     dputs "widget %W configure"
  24.     check_update %W
  25. }
  26.  
  27. # new palette behaviour - open option sheet only on double click
  28.  
  29. bind palette <Double-$P(button)> {
  30.     activate_generic [%W cget -text]
  31. }
  32. proc activate_generic {widget} {
  33.     global _Message Geometry Current
  34.     set _Message "fetching generic $widget options ..."
  35.     update idletasks
  36.     wm title .generic "Generic $widget"
  37.     .generic.msg configure -text "- $widget configuration -" \
  38.             -textvariable sample_${widget}(error) -fg red
  39.     widget_extract .sample_$widget sample_$widget
  40.     form_build .generic.form sample_$widget
  41.     if {![winfo ismapped .generic]} {
  42.         parray Geometry
  43.         wm deiconify .generic
  44.         catch {wm geometry .generic $Geometry(generic)}
  45.     }
  46.     raise .generic
  47.     set Current(sample) .palette.$widget 
  48.     set _Message ""
  49. }
  50.  
  51. # new option sheet behaviour - double click on a widget to bring up
  52.  
  53. bind widget <Double-$P(button)> {
  54.     activate_option %W
  55. }
  56. proc activate_option {win} {
  57.     global Current _Message Geometry
  58.     set class [winfo class $win]
  59.     set name [winfo name $win]
  60.     upvar #0 $name data
  61.     set _Message "fetching $class $data(item_name) options ..."
  62.     update idletasks
  63.     wm title .widget "$class options"
  64.     .widget.msg configure -text "- $class configuration -" \
  65.             -textvariable ${name}(error) -fg red
  66.     form_build .widget.form $name
  67.     if {![winfo ismapped .widget]} {
  68.         catch {wm geometry .widget $Geometry(widget)}
  69.         wm deiconify .widget
  70.     }
  71.     set Current(form) $win
  72.     set _Message ""
  73.     raise .widget
  74. }
  75.  
  76. # "deselect" when button press outside active region
  77.  
  78. bind .can <$P(button)> {
  79.     unselect_widget
  80.     current_frame .can.f
  81.     arrow_unhighlight row
  82.     arrow_unhighlight column
  83. }
  84.  
  85. # select row&col when clicking in an empty grid
  86.  
  87. bind .can.f <$P(button)>  {current_frame %W;select_rowcol %x %y}
  88.  
  89. # given an x,y position on the current grid, select the row/column
  90.  
  91. proc select_rowcol {x y} {
  92.     global Current
  93.  
  94.     unselect_widget
  95.     arrow_unhighlight row
  96.     arrow_unhighlight column
  97.     set row [blt_table row $Current(frame) location $y]
  98.     set col [blt_table column $Current(frame) location $x]
  99.     arrow_highlight row $Current(frame) $row red
  100.     arrow_highlight column $Current(frame) $col red
  101. }
  102.  
  103. # Insert a new row/column for button press on a grid line
  104.  
  105. bind grid <$P(button)> {grid_insert %W}
  106.  
  107. # highlight a grid line, for easier identification
  108.  
  109. bind grid <Enter> {
  110.     set Save_grid_color [%W cget -bg]
  111.     %W configure -bg $P(grid_highlight)
  112. }
  113. bind grid <Leave> {
  114.     %W configure -bg $Save_grid_color
  115. }
  116.  
  117. # when a frame background changes color, make sure its grid
  118. # changes too (This still needs work)
  119.  
  120. bind frame <Configure> {
  121.     # if {$Arrow_move} continue
  122.     if {$Down} continue
  123.     dputs "frame %W configure"
  124.     set color [%W cget -bg]
  125.     if {"%W" == $Current(frame)} {
  126.         set color [Contrast_color $color]
  127.     } 
  128.     if {[grid_color %W $color]} {
  129.         # puts "need to change outline colors for %W"
  130.         outline_color %W
  131.     }
  132. }
  133.  
  134. # The "delete" key deletes the current what-ever
  135.  
  136. bind . <Delete> {delete_selected}
  137.  
  138. # short cut for repeating toolbar action for current widget
  139. # (moved to menu bar)
  140. set Current(repeat) ""
  141.  
  142. # Short cut for selecting containing frame
  143.  
  144. bind . <KeyPress-Up> Key_up
  145. proc Key_up {} {
  146.     global Current
  147.  
  148.     if {[set widget $Current(widget)] != ""} {
  149.         upvar #0 [winfo name $widget] data
  150.         set master .can.f$data(master)
  151.         if {$master !=  ".can.f"} {
  152.             unselect_widget
  153.             select_widget $master
  154.         }
  155.     }
  156. }
  157.  
  158. # short cut for going "inside of a frame" (gulp)
  159.  
  160. bind . <KeyPress-Down> Key_down
  161. proc Key_down {} {
  162.     global Current _Message Frames
  163.  
  164.     if {[info exists Frames($Current(widget))]} {
  165.         current_frame $Current(widget)
  166.         set _Message "Entering sub frame"
  167.         set widgets [blt_table slaves $Current(widget) -exclude "*@*"]
  168.         if {[llength $widgets] > 0} {
  169.             unselect_widget
  170.             select_widget [lindex [lsort -command sort_widgets $widgets] 0]
  171.         }
  172.     }
  173. }
  174.  
  175. # temporary short cut for inserting row or column onto the current frame
  176.  
  177. proc grid_add {master what {index 2}} {
  178.     table_insert $master $what $index
  179.     grid_process $master $what 1
  180.     update_table $master "insert $what $index"
  181. }
  182.  
  183. # short cut for option forms
  184. bind all <Alt-KeyPress> {
  185.     if {![access_field %A]} {
  186.     tkTraverseToMenu %W %A
  187.     }
  188. }
  189.  
  190. # Try to clean up on window manager destroy
  191. # The app will automatically exit at the next idle time
  192. # rename "update" to make sure everything is clean up before then
  193.  
  194. wm protocol . WM_DELETE_WINDOW {
  195.     proc update {args} {}
  196.     quit 0
  197.     exit
  198. }
  199.  
  200. bind . <Control-R> {grid_add $Current(frame) row}
  201. bind . <Control-C> {grid_add $Current(frame) column}
  202.  
  203.