| # toolbar.tcl - Handle layout for a toolbar. |
| # Copyright (C) 1997 Cygnus Solutions. |
| # Written by Tom Tromey <tromey@cygnus.com>. |
| |
| # This holds global state for this module. |
| defarray TOOLBAR_state { |
| initialized 0 |
| button "" |
| window "" |
| relief flat |
| last "" |
| } |
| |
| proc TOOLBAR_button_enter {w} { |
| global TOOLBAR_state |
| |
| #save older relief (it covers buttons that |
| #interacte like checkbuttons) |
| set TOOLBAR_state(relief) [$w cget -relief] |
| |
| if {[$w cget -state] != "disabled"} then { |
| |
| if {$TOOLBAR_state(button) == $w} then { |
| set relief sunken |
| } else { |
| set relief raised |
| } |
| |
| $w configure \ |
| -state active \ |
| -relief $relief |
| } |
| |
| #store last action to synchronize operations |
| set TOOLBAR_state(last) enter |
| set TOOLBAR_state(window) $w |
| } |
| |
| proc TOOLBAR_button_leave {w} { |
| global TOOLBAR_state |
| if {[$w cget -state] != "disabled"} then { |
| $w configure -state normal |
| } |
| |
| #restore original relief |
| if { |
| $TOOLBAR_state(window) == $w |
| && $TOOLBAR_state(last) == "enter" |
| } then { |
| $w configure -relief $TOOLBAR_state(relief) |
| } else { |
| $w configure -relief flat |
| } |
| |
| set TOOLBAR_state(window) "" |
| #store last action to synch operations (enter->leave) |
| set TOOLBAR_state(last) leave |
| } |
| |
| proc TOOLBAR_button_down {w} { |
| global TOOLBAR_state |
| if {[$w cget -state] != "disabled"} then { |
| set TOOLBAR_state(button) $w |
| $w configure -relief sunken |
| } |
| } |
| |
| proc TOOLBAR_button_up {w} { |
| global TOOLBAR_state |
| if {$w == $TOOLBAR_state(button)} then { |
| set TOOLBAR_state(button) "" |
| |
| #restore original relief |
| $w configure -relief $TOOLBAR_state(relief) |
| |
| if {$TOOLBAR_state(window) == $w |
| && [$w cget -state] != "disabled"} then { |
| |
| #SN does the toolbar bindings using "+" so that older |
| #bindings don't disapear. So no need to invoke the command. |
| #other applications should do the same so that we can delete |
| #this hack |
| global sn_options |
| if {! [array exists sn_options]} { |
| #invoke the binding |
| uplevel \#0 [list $w invoke] |
| } |
| if {[winfo exists $w]} then { |
| if {[$w cget -state] != "disabled"} then { |
| $w configure -state normal |
| } |
| } |
| # HOWEVER, if the pointer is still over the button, and it |
| # is enabled, then raise it again. |
| |
| if {[string compare [winfo containing \ |
| [winfo pointerx $w] \ |
| [winfo pointery $w]] $w] == 0} { |
| $w configure -relief raised |
| } |
| } |
| } |
| } |
| |
| # Set up toolbar bindings. |
| proc TOOLBAR_maybe_init {} { |
| global TOOLBAR_state |
| if {! $TOOLBAR_state(initialized)} then { |
| set TOOLBAR_state(initialized) 1 |
| |
| # We can't put our bindings onto the widget (and then use "break" |
| # to avoid the class bindings) because that interacts poorly with |
| # balloon help. |
| bind ToolbarButton <Enter> [list TOOLBAR_button_enter %W] |
| bind ToolbarButton <Leave> [list TOOLBAR_button_leave %W] |
| bind ToolbarButton <1> [list TOOLBAR_button_down %W] |
| bind ToolbarButton <ButtonRelease-1> [list TOOLBAR_button_up %W] |
| } |
| } |
| |
| #Allows changing options of a toolbar button from the application |
| #especially the relief value |
| proc TOOLBAR_command {w args} { |
| global TOOLBAR_state |
| |
| set len [llength $args] |
| for {set i 0} {$i < $len} {incr i} { |
| set cmd [lindex $args $i] |
| switch -- $cmd { |
| "relief" - |
| "-relief" { |
| incr i |
| set TOOLBAR_state(relief) [lindex $args $i] |
| $w configure $cmd [lindex $args $i] |
| } |
| "window" - |
| "-window" { |
| incr i |
| set TOOLBAR_state(window) [lindex $args $i] |
| } |
| default { |
| #normal widget options |
| incr i |
| $w configure $cmd [lindex $args $i] |
| } |
| } |
| } |
| } |
| |
| # Pass this proc a frame and some children of the frame. It will put |
| # the children into the frame so that they look like a toolbar. |
| # Children are added in the order they are listed. If a child's name |
| # is "-", then the appropriate type of separator is entered instead. |
| # If a child's name is "--" then all remaining children will be placed |
| # on the right side of the window. |
| # |
| # For non-flat mode, each button must display an image, and this image |
| # must have a twin. The primary (raised) image's name must end in |
| # "u", and the depressed image's name must end in "d". Eg the edit |
| # images should be called "editu" and "editd". There's no doubt that |
| # this is a hack. |
| # |
| # If you want to add a button that doesn't have an image (or whose |
| # image doesn't have a twin), you must wrap it in a frame. |
| # |
| # FIXME: someday, write a `toolbar button' widget that handles the |
| # image mess invisibly. |
| proc standard_toolbar {frame args} { |
| global tcl_platform |
| |
| # For now, there are two different layouts, depending on which kind |
| # of icons we're using. This is just a test feature and will be |
| # eliminated once we decide on an icon style. |
| |
| TOOLBAR_maybe_init |
| |
| # We reserve column 0 for some padding. |
| set column 1 |
| if {$tcl_platform(platform) == "windows"} then { |
| # See below to understand this. |
| set row 1 |
| } else { |
| set row 0 |
| } |
| # This is set if we see "--" and thus the filling happens in the |
| # center. |
| set center_fill 0 |
| set sticky w |
| foreach button $args { |
| grid columnconfigure $frame $column -weight 0 |
| |
| if {$button == "-"} then { |
| # A separator. |
| set f [frame $frame.[gensym] -borderwidth 1 -width 2 -relief sunken] |
| grid $f -row $row -column $column -sticky ns${sticky} -padx 4 |
| } elseif {$button == "--"} then { |
| # Everything after this is put on the right. We do this by |
| # adding a column that sucks up all the space. |
| set center_fill 1 |
| set sticky e |
| grid columnconfigure $frame $column -weight 1 -minsize 7 |
| } elseif {[winfo class $button] != "Button"} then { |
| # Something other than a button. Just put it into the frame. |
| grid $button -row $row -column $column -sticky $sticky -pady 2 |
| } else { |
| # A button. |
| # FIXME: does Windows allow focus traversal? For now we're |
| # just turning it off. |
| $button configure -takefocus 0 -highlightthickness 0 \ |
| -relief flat -borderwidth 1 |
| grid $button -row $row -column $column -sticky $sticky -pady 2 |
| |
| # Make sure the button acts the way we want, not the default Tk |
| # way. |
| set index [lsearch -exact [bindtags $button] Button] |
| bindtags $button [lreplace [bindtags $button] $index $index \ |
| ToolbarButton] |
| } |
| |
| incr column |
| } |
| |
| # On Unix, it looks a little more natural to have a raised toolbar. |
| # On Windows the toolbar is flat, but there is a horizontal |
| # separator between the toolbar and the menubar. On both platforms |
| # we provide some space to the left of the leftmost widget. |
| grid columnconfigure $frame 0 -minsize 7 -weight 0 |
| |
| if {$tcl_platform(platform) == "windows"} then { |
| $frame configure -borderwidth 0 -relief flat |
| set name $frame.[gensym] |
| frame $name -height 2 -borderwidth 1 -relief sunken |
| grid $name -row 0 -column 0 -columnspan $column -pady 1 -sticky ew |
| } else { |
| $frame configure -borderwidth 2 -relief raised |
| } |
| |
| if {! $center_fill} then { |
| # The rightmost column sucks up the extra space. |
| incr column -1 |
| grid columnconfigure $frame $column -weight 1 |
| } |
| } |