gdb/gdbtk/library/gdbtoolbar.itcl

   1 # GDBToolBar
   2 # Copyright (C) 2000 Red Hat, Inc.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License (GPL) as published by
   6 # the Free Software Foundation; either version 2 of the License, or (at
   7 # your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # ----------------------------------------------------------------------
  15 # Implements a toolbar.
  16 #
  17 #   PUBLIC ATTRIBUTES:
  18 #
  19 #
  20 #   METHODS:
  21 #
  22 #     configure ....... used to change public attributes
  23 #
  24 #   PRIVATE METHODS
  25 #
  26 #   X11 OPTION DATABASE ATTRIBUTES
  27 #
  28 #
  29 # ----------------------------------------------------------------------
  30
  31 itcl::class GDBToolBar {
  32   inherit itk::Widget
  33
  34   # ------------------------------------------------------------------
  35   #  CONSTRUCTOR - create widget
  36   # ------------------------------------------------------------------
  37   constructor {args} {
  38
  39     # Make a subframe so that the menu can't accidentally conflict
  40     # with a name created by some subclass.
  41     set ButtonFrame [frame $itk_interior.t]
  42
  43     pack $ButtonFrame $itk_interior -fill both -expand true
  44
  45     eval itk_initialize $args
  46   }
  47
  48   # ------------------------------------------------------------------
  49   #  DESTRUCTOR - destroy window containing widget
  50   # ------------------------------------------------------------------
  51   destructor {
  52
  53     #destroy $this
  54   }
  55
  56   # ------------------------------------------------------------------
  57   #  METHOD:  show - show the toolbar
  58   # ------------------------------------------------------------------
  59   public method show {} {
  60
  61     if {[llength $button_list]} {
  62       eval standard_toolbar $ButtonFrame $button_list
  63     }
  64   }
  65
  66   # ------------------------------------------------------------------
  67   #  METHOD:  set_class_state - standard method to control state by class
  68   # ------------------------------------------------------------------
  69   public method set_class_state {enable_list} {
  70     debug "Enable list is: $enable_list"
  71
  72     foreach {type state} $enable_list {
  73       # debug $type
  74       if {[info exists button_classes($type)]} {
  75         set class_list $button_classes($type)
  76         if {[llength $class_list]} {
  77           # debug "$type $state \{$class_list\}"
  78           foreach button $class_list {
  79             # debug "$type $button $state"
  80             itemconfigure $button -state $state
  81           }
  82         }
  83       }
  84     }
  85   }
  86 \f
  87   ####################################################################
  88   # Methods that deal with buttons.
  89   ####################################################################
  90
  91   # ------------------------------------------------------------------
  92   #  METHOD:  add - Add something.
  93   #                 It can be a button a separator or a label.
  94   #
  95   #  type - what we want to add
  96   #  args - arguments appropriate to what is being added
  97   #
  98   # ------------------------------------------------------------------
  99   method add {type args} {
 100
 101     switch $type {
 102       button {
 103         eval toolbar_add_button $args
 104       }
 105       label {
 106         eval toolbar_add_label $args
 107       }
 108       separator {
 109         toolbar_add_button_separator
 110       }
 111       custom {
 112         eval toolbar_add_custom $args
 113       }
 114       default {
 115         error "Invalid item type: $type"
 116       }
 117     }
 118   }
 119
 120   # ------------------------------------------------------------------
 121   #  PRIVATE METHOD:  toolbar_add_button - Creates a button, and inserts
 122   #                      it at the end of the button list.  Call this when
 123   #                      the toolbar is being set up, but has not yet been
 124   #                      made.
 125   # ------------------------------------------------------------------
 126   private method toolbar_add_button {name class command balloon args} {
 127
 128     lappend button_list \
 129             [eval _register_button 1 \$name \$class \$command \$balloon $args]
 130
 131   }
 132
 133   # ------------------------------------------------------------------
 134   #  PRIVATE METHOD:  toolbar_add_label - Create a label to be inserted
 135   #                        in the toolbar.
 136   # ------------------------------------------------------------------
 137
 138   private method toolbar_add_label {name text balloon args} {
 139     set lname $ButtonFrame.$name
 140     set Buttons($name) $lname
 141     set Buttons($lname,align) $button_align
 142     eval label $lname -text \$text $args
 143     balloon register $lname $balloon
 144     lappend button_list $lname
 145   }
 146
 147   # ------------------------------------------------------------------
 148   #  PRIVATE METHOD:  toolbar_add_custom - Create a user defined widget
 149   #                   to be inserted in the toolbar.
 150   # ------------------------------------------------------------------
 151
 152   private method toolbar_add_custom {name createCmd balloon args} {
 153     set wname $ButtonFrame.$name
 154     set Buttons($name) $wname
 155     set Buttons($wname,align) $button_align
 156
 157     eval $createCmd $wname $args
 158     balloon register $wname $balloon
 159
 160     lappend button_list $wname
 161   }
 162
 163   # ------------------------------------------------------------------
 164   #  PRIVATE METHOD:  toolbar_add_button_separator -
 165   # ------------------------------------------------------------------
 166
 167   private method toolbar_add_button_separator {} {
 168     lappend button_list -
 169   }
 170
 171   # ------------------------------------------------------------------
 172   #  PRIVATE METHOD:  _register_button - Creates all the bookkeeping
 173   #           for a button,  without actually inserting it in the toolbar.
 174   #           If the button will not be immediately inserted (INS == 0),
 175   #           sets its bindings and appearences to the same of a
 176   #           standard_toolbar button.
 177   # ------------------------------------------------------------------
 178   private method _register_button {ins name class command balloon args} {
 179     set bname $ButtonFrame.$name
 180     set Buttons($name) $bname
 181     set Buttons($bname,align) $button_align
 182
 183     eval button $bname -command \$command $args
 184     balloon register $bname $balloon
 185     foreach elem $class {
 186       switch $elem {
 187         None {}
 188         default {
 189           lappend button_classes($elem) $name
 190         }
 191       }
 192     }
 193
 194    # If the button is not going to be inserted now...
 195    if {! $ins} {
 196      # This is a bit of a hack, but I need to bind the standard_toolbar bindings
 197      # and appearances to these externally, since I am not inserting them in
 198      # the original toolbar...
 199      # FIXME:  Have to add a method to the libgui toolbar to do this.
 200
 201      # Make sure the button acts the way we want, not the default Tk way.
 202      $bname configure -takefocus 0 -highlightthickness 0 \
 203                       -relief flat -borderwidth 1
 204      set index [lsearch -exact [bindtags $bname] Button]
 205      bindtags $bname [lreplace [bindtags $bname] $index $index ToolbarButton]
 206     }
 207
 208     return $bname
 209   }
 210
 211   # ------------------------------------------------------------------
 212   #  METHOD:  create - Creates all the bookkeeping for a button,
 213   #           without actually inserting it in the toolbar.
 214   # ------------------------------------------------------------------
 215   method create {name class command balloon args} {
 216
 217     return [eval _register_button 0 \$name \$class \$command \$balloon $args]
 218   }
 219
 220   # ------------------------------------------------------------------
 221   #  METHOD:  itemconfigure -
 222   # ------------------------------------------------------------------
 223
 224   method itemconfigure {button args} {
 225     eval $Buttons($button) configure $args
 226   }
 227
 228   # ------------------------------------------------------------------
 229   #  METHOD:  itembind -
 230   # ------------------------------------------------------------------
 231
 232   method itembind {button key cmd} {
 233     eval [list bind $Buttons($button) $key $cmd]
 234   }
 235
 236   # ------------------------------------------------------------------
 237   #  METHOD:  itemballoon -
 238   # ------------------------------------------------------------------
 239
 240   method itemballoon {button text} {
 241     eval [list balloon register $Buttons($button) $text]
 242   }
 243
 244   # ------------------------------------------------------------------
 245   #  PRIVATE METHOD:  toolbar_insert_button - Inserts button "name" before
 246   #           button "before".
 247   #           The toolbar must be made, and the buttons must have been
 248   #           created before you run this.
 249   # ------------------------------------------------------------------
 250   private method toolbar_insert_button {name before} {
 251
 252     if {[string first "-" $name] == 0} {
 253       set name [string range $name 1 end]
 254       set add_sep 1
 255     } else {
 256       set add_sep 0
 257     }
 258
 259     if {![info exists Buttons($name)] || ![info exists Buttons($before)]} {
 260       error "toolbar_insert_buttons called with non-existant button"
 261     }
 262
 263     set before_col [gridCGet $Buttons($before) -column]
 264     set before_row [gridCGet $Buttons($before) -row]
 265
 266     set slaves [grid slaves $ButtonFrame]
 267
 268     set incr [expr 1 + $add_sep]
 269     foreach slave $slaves {
 270       set slave_col [gridCGet $slave -column]
 271       if {$slave_col >= $before_col} {
 272         grid configure $slave -column [expr $slave_col + $incr]
 273       }
 274     }
 275     if {$add_sep} {
 276       grid $Buttons(-$name) -column $before_col -row $before_row
 277     }
 278
 279     # Now grid our button.  Have to put in the pady since this button
 280     # may not have been originally inserted by the libgui toolbar
 281     # proc.
 282
 283     grid $Buttons($name) -column [expr $before_col + $add_sep] \
 284       -row $before_row -pady 2
 285
 286   }
 287
 288   # ------------------------------------------------------------------
 289   #  PRIVATE METHOD:  toolbar_remove_button -
 290   # ------------------------------------------------------------------
 291
 292   private method toolbar_remove_button {name} {
 293
 294     if {[string first "-" $name] == 0} {
 295       set name [string range $name 1 end]
 296       set remove_sep 1
 297     } else {
 298       set remove_sep 0
 299     }
 300
 301     if {![info exists Buttons($name)] } {
 302       error "toolbar_remove_buttons called with non-existant button $name"
 303     }
 304
 305     set name_col [gridCGet $Buttons($name) -column]
 306     set name_row [gridCGet $Buttons($name) -row]
 307
 308     grid remove $Buttons($name)
 309     if {$remove_sep} {
 310       set Buttons(-$name) [grid slaves $ButtonFrame \
 311                              -column [expr $name_col - 1] \
 312                             -row $name_row]
 313       grid remove $Buttons(-$name)
 314     }
 315
 316     set slaves [grid slaves $ButtonFrame -row $name_row]
 317     foreach slave $slaves {
 318       set slave_col [gridCGet $slave -column]
 319       if {($slave_col > $name_col)
 320           && ! ([info exists Buttons($slave,align)]
 321               && $Buttons($slave,align) == "right")} {
 322         grid configure $slave -column [expr $slave_col - 1 - $remove_sep]
 323       }
 324     }
 325   }
 326
 327   # ------------------------------------------------------------------
 328   #  METHOD:  toolbar_button_right_justify -
 329   # ------------------------------------------------------------------
 330
 331   method toolbar_button_right_justify {} {
 332     lappend button_list --
 333     set button_align "right"
 334   }
 335
 336   # ------------------------------------------------------------------
 337   #  METHOD:  toolbar_swap_button_lists -
 338   # ------------------------------------------------------------------
 339
 340   method toolbar_swap_button_lists {in_list out_list} {
 341     # Now swap out the buttons...
 342     set first_out [lindex $out_list 0]
 343     if {[info exists Buttons($first_out)] && [grid info $Buttons($first_out)] != ""} {
 344       foreach button $in_list {
 345         toolbar_insert_button $button $first_out
 346       }
 347       foreach button $out_list {
 348         toolbar_remove_button $button
 349       }
 350     } elseif {[info exists Buttons($first_out)]} {
 351       debug "Error in swap_button_list - $first_out not gridded..."
 352     } else {
 353       debug "Button $first_out is not in button list"
 354     }
 355   }
 356 \f
 357   ####################################################################
 358   #
 359   #  PRIVATE DATA
 360   #
 361   ####################################################################
 362
 363   # This is the list of buttons that are being built up
 364   #
 365   private variable button_list {}
 366
 367   # This is an array of buttons names -> Tk Window names
 368   # and also of Tk Window names -> column position in grid
 369   private variable Buttons
 370
 371   # This array holds the button classes.  The key is the class name,
 372   # and the value is the list of buttons belonging to this class.
 373   private variable button_classes
 374
 375   # Tell if we are inserting buttons left or right justified
 376   private variable button_align "left"
 377
 378   #The frame to contain the buttons:
 379   private variable ButtonFrame
 380
 381   ####################################################################
 382   #
 383   #  PROTECTED DATA
 384   #
 385   ####################################################################
 386
 387   # None.
 388
 389   ####################################################################
 390   #
 391   #  PUBLIC DATA
 392   #
 393   ####################################################################
 394
 395   # None.
 396 }