libgui/library/toolbar.tcl

   1 # toolbar.tcl - Handle layout for a toolbar.
   2 # Copyright (C) 1997 Cygnus Solutions.
   3 # Written by Tom Tromey <tromey@cygnus.com>.
   4
   5 # This holds global state for this module.
   6 defarray TOOLBAR_state {
   7   initialized 0
   8   button ""
   9   window ""
  10   relief flat
  11   last   ""
  12 }
  13
  14 proc TOOLBAR_button_enter {w} {
  15   global TOOLBAR_state
  16
  17   #save older relief (it covers buttons that
  18   #interacte like checkbuttons)
  19   set TOOLBAR_state(relief) [$w cget -relief]
  20
  21   if {[$w cget -state] != "disabled"} then {
  22
  23     if {$TOOLBAR_state(button) == $w} then {
  24       set relief sunken
  25     } else {
  26       set relief raised
  27     }
  28
  29     $w configure \
  30         -state active \
  31         -relief $relief
  32   }
  33
  34   #store last action to synchronize operations
  35   set TOOLBAR_state(last) enter
  36   set TOOLBAR_state(window) $w
  37 }
  38
  39 proc TOOLBAR_button_leave {w} {
  40     global TOOLBAR_state
  41     if {[$w cget -state] != "disabled"} then {
  42         $w configure -state normal
  43     }
  44
  45     #restore original relief
  46     if {
  47         $TOOLBAR_state(window) == $w
  48         && $TOOLBAR_state(last) == "enter"
  49     } then {
  50         $w configure -relief $TOOLBAR_state(relief)
  51     } else {
  52         $w configure -relief flat
  53     }
  54
  55     set TOOLBAR_state(window) ""
  56     #store last action to synch operations (enter->leave)
  57     set TOOLBAR_state(last) leave
  58 }
  59
  60 proc TOOLBAR_button_down {w} {
  61   global TOOLBAR_state
  62   if {[$w cget -state] != "disabled"} then {
  63     set TOOLBAR_state(button) $w
  64     $w configure -relief sunken
  65   }
  66 }
  67
  68 proc TOOLBAR_button_up {w} {
  69   global TOOLBAR_state
  70   if {$w == $TOOLBAR_state(button)} then {
  71     set TOOLBAR_state(button) ""
  72
  73     #restore original relief
  74       $w configure -relief $TOOLBAR_state(relief)
  75
  76     if {$TOOLBAR_state(window) == $w
  77         && [$w cget -state] != "disabled"} then {
  78
  79       #SN does the toolbar bindings using "+" so that older
  80       #bindings don't disapear. So no need to invoke the command.
  81       #other applications should do the same so that we can delete
  82       #this hack
  83       global sn_options
  84       if {! [array exists sn_options]} {
  85         #invoke the binding
  86         uplevel \#0 [list $w invoke]
  87       }
  88       if {[winfo exists $w]} then {
  89         if {[$w cget -state] != "disabled"} then {
  90           $w configure -state normal
  91         }
  92       }
  93       # HOWEVER, if the pointer is still over the button, and it
  94       # is enabled, then raise it again.
  95
  96       if {[string compare [winfo containing \
  97                              [winfo pointerx $w] \
  98                              [winfo pointery $w]] $w] == 0} {
  99         $w configure -relief raised
 100       }
 101     }
 102   }
 103 }
 104
 105 # Set up toolbar bindings.
 106 proc TOOLBAR_maybe_init {} {
 107   global TOOLBAR_state
 108   if {! $TOOLBAR_state(initialized)} then {
 109     set TOOLBAR_state(initialized) 1
 110
 111     # We can't put our bindings onto the widget (and then use "break"
 112     # to avoid the class bindings) because that interacts poorly with
 113     # balloon help.
 114     bind ToolbarButton <Enter> [list TOOLBAR_button_enter %W]
 115     bind ToolbarButton <Leave> [list TOOLBAR_button_leave %W]
 116     bind ToolbarButton <1> [list TOOLBAR_button_down %W]
 117     bind ToolbarButton <ButtonRelease-1> [list TOOLBAR_button_up %W]
 118   }
 119 }
 120
 121 #Allows changing options of a toolbar button from the application
 122 #especially the relief value
 123 proc TOOLBAR_command {w args} {
 124     global TOOLBAR_state
 125
 126     set len [llength $args]
 127     for {set i 0} {$i < $len} {incr i} {
 128         set cmd [lindex $args $i]
 129         switch -- $cmd {
 130           "relief" -
 131           "-relief" {
 132                 incr i
 133                 set TOOLBAR_state(relief) [lindex $args $i]
 134                 $w configure $cmd [lindex $args $i]
 135             }
 136           "window" -
 137           "-window" {
 138                 incr i
 139                 set TOOLBAR_state(window) [lindex $args $i]
 140           }
 141           default {
 142                 #normal widget options
 143                 incr i
 144                 $w configure $cmd [lindex $args $i]
 145           }
 146         }
 147     }
 148 }
 149
 150 # Pass this proc a frame and some children of the frame.  It will put
 151 # the children into the frame so that they look like a toolbar.
 152 # Children are added in the order they are listed.  If a child's name
 153 # is "-", then the appropriate type of separator is entered instead.
 154 # If a child's name is "--" then all remaining children will be placed
 155 # on the right side of the window.
 156 #
 157 # For non-flat mode, each button must display an image, and this image
 158 # must have a twin.  The primary (raised) image's name must end in
 159 # "u", and the depressed image's name must end in "d".  Eg the edit
 160 # images should be called "editu" and "editd".  There's no doubt that
 161 # this is a hack.
 162 #
 163 # If you want to add a button that doesn't have an image (or whose
 164 # image doesn't have a twin), you must wrap it in a frame.
 165 #
 166 # FIXME: someday, write a `toolbar button' widget that handles the
 167 # image mess invisibly.
 168 proc standard_toolbar {frame args} {
 169   global tcl_platform
 170
 171   # For now, there are two different layouts, depending on which kind
 172   # of icons we're using.  This is just a test feature and will be
 173   # eliminated once we decide on an icon style.
 174
 175   TOOLBAR_maybe_init
 176
 177   # We reserve column 0 for some padding.
 178   set column 1
 179   if {$tcl_platform(platform) == "windows"} then {
 180     # See below to understand this.
 181     set row 1
 182   } else {
 183     set row 0
 184   }
 185   # This is set if we see "--" and thus the filling happens in the
 186   # center.
 187   set center_fill 0
 188   set sticky w
 189   foreach button $args {
 190     grid columnconfigure $frame $column -weight 0
 191
 192     if {$button == "-"} then {
 193       # A separator.
 194       set f [frame $frame.[gensym] -borderwidth 1 -width 2 -relief sunken]
 195       grid $f -row $row -column $column -sticky ns${sticky} -padx 4
 196     } elseif {$button == "--"} then {
 197       # Everything after this is put on the right.  We do this by
 198       # adding a column that sucks up all the space.
 199       set center_fill 1
 200       set sticky e
 201       grid columnconfigure $frame $column -weight 1 -minsize 7
 202     } elseif {[winfo class $button] != "Button"} then {
 203       # Something other than a button.  Just put it into the frame.
 204       grid $button -row $row -column $column -sticky $sticky -pady 2
 205     } else {
 206       # A button.
 207       # FIXME: does Windows allow focus traversal?  For now we're
 208       # just turning it off.
 209       $button configure -takefocus 0 -highlightthickness 0 \
 210         -relief flat -borderwidth 1
 211       grid $button -row $row -column $column -sticky $sticky -pady 2
 212
 213       # Make sure the button acts the way we want, not the default Tk
 214       # way.
 215       set index [lsearch -exact [bindtags $button] Button]
 216       bindtags $button [lreplace [bindtags $button] $index $index \
 217                           ToolbarButton]
 218     }
 219
 220     incr column
 221   }
 222
 223   # On Unix, it looks a little more natural to have a raised toolbar.
 224   # On Windows the toolbar is flat, but there is a horizontal
 225   # separator between the toolbar and the menubar.  On both platforms
 226   # we provide some space to the left of the leftmost widget.
 227   grid columnconfigure $frame 0 -minsize 7 -weight 0
 228
 229   if {$tcl_platform(platform) == "windows"} then {
 230     $frame configure -borderwidth 0 -relief flat
 231     set name $frame.[gensym]
 232     frame $name -height 2 -borderwidth 1 -relief sunken
 233     grid $name -row 0 -column 0 -columnspan $column -pady 1 -sticky ew
 234   } else {
 235     $frame configure -borderwidth 2 -relief raised
 236   }
 237
 238   if {! $center_fill} then {
 239     # The rightmost column sucks up the extra space.
 240     incr column -1
 241     grid columnconfigure $frame $column -weight 1
 242   }
 243 }