URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtcl/] [gdbtoolbar.itcl] - Blame information for rev 1767

Go to most recent revision | Details | Compare with Previous | View Log


# GDBToolBar
# Copyright 2000 Red Hat, Inc.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License (GPL) as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
 
# ----------------------------------------------------------------------
# Implements a toolbar.
#
#   PUBLIC ATTRIBUTES:
#
#
#   METHODS:
#
#     configure ....... used to change public attributes
#
#   PRIVATE METHODS
#
#   X11 OPTION DATABASE ATTRIBUTES
#
#
# ----------------------------------------------------------------------
 
class GDBToolBar {
  inherit itk::Widget
 
  # ------------------------------------------------------------------
  #  CONSTRUCTOR - create widget
  # ------------------------------------------------------------------
  constructor {args} {
 
    # Make a subframe so that the menu can't accidentally conflict
    # with a name created by some subclass.
    set ButtonFrame [frame $itk_interior.t]
 
    pack $ButtonFrame $itk_interior -fill both -expand true
 
    eval itk_initialize $args
  }
 
  # ------------------------------------------------------------------
  #  DESTRUCTOR - destroy window containing widget
  # ------------------------------------------------------------------
  destructor {
 
    #destroy $this
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  show - show the toolbar
  # ------------------------------------------------------------------
  public method show {} {
 
    if {[llength $button_list]} {
      eval standard_toolbar $ButtonFrame $button_list
    }
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  set_class_state - standard method to control state by class
  # ------------------------------------------------------------------
  public method set_class_state {enable_list} {
    debug "Enable list is: $enable_list"
 
    foreach {type state} $enable_list {
      # debug $type
      if {[info exists button_classes($type)]} {
        set class_list $button_classes($type)
        if {[llength $class_list]} {
          # debug "$type $state \{$class_list\}"
          foreach button $class_list {
            # debug "$type $button $state"
            itemconfigure $button -state $state
          }
        }
      }
    }
  }
 
  ####################################################################
  # Methods that deal with buttons.
  ####################################################################
 
  # ------------------------------------------------------------------
  #  METHOD:  add - Add something.
  #                 It can be a button a separator or a label.
  #
  #  type - what we want to add
  #  args - arguments appropriate to what is being added
  #
  # ------------------------------------------------------------------
  method add {type args} {
 
    switch $type {
      button {
        eval toolbar_add_button $args
      }
      label {
        eval toolbar_add_label $args
      }
      separator {
        toolbar_add_button_separator
      }
      default {
        error "Invalid item type: $type"
      }
    }
  }
 
  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  toolbar_add_button - Creates a button, and inserts
  #                      it at the end of the button list.  Call this when
  #                      the toolbar is being set up, but has not yet been
  #                      made.
  # ------------------------------------------------------------------
  private method toolbar_add_button {name class command balloon args} {
 
    lappend button_list \
            [eval _register_button 1 \$name \$class \$command \$balloon $args]
 
  }
 
  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  toolbar_add_label - Create a label to be inserted
  #                        in the toolbar.
  # ------------------------------------------------------------------
 
  private method toolbar_add_label {name text balloon args} {
    set lname $ButtonFrame.$name
    set Buttons($name) $lname
    set Buttons($lname,align) $button_align
    eval label $lname -text \$text $args
    balloon register $lname $balloon
    lappend button_list $lname
  }
 
  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  toolbar_add_button_separator -
  # ------------------------------------------------------------------
 
  private method toolbar_add_button_separator {} {
    lappend button_list -
  }
 
  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  _register_button - Creates all the bookkeeping
  #           for a button,  without actually inserting it in the toolbar.
  #           If the button will not be immediately inserted (INS == 0),
  #           sets its bindings and appearences to the same of a
  #           standard_toolbar button.
  # ------------------------------------------------------------------
  private method _register_button {ins name class command balloon args} {
    set bname $ButtonFrame.$name
    set Buttons($name) $bname
    set Buttons($bname,align) $button_align
 
    eval button $bname -command \$command $args
    balloon register $bname $balloon
    foreach elem $class {
      switch $elem {
        None {}
        default {
          lappend button_classes($elem) $name
        }
      }
    }
 
   # If the button is not going to be inserted now...
   if {! $ins} {
     # This is a bit of a hack, but I need to bind the standard_toolbar bindings
     # and appearances to these externally, since I am not inserting them in
     # the original toolbar...
     # FIXME:  Have to add a method to the libgui toolbar to do this.
 
     # Make sure the button acts the way we want, not the default Tk way.
     $bname configure -takefocus 0 -highlightthickness 0 \
                      -relief flat -borderwidth 1
     set index [lsearch -exact [bindtags $bname] Button]
     bindtags $bname [lreplace [bindtags $bname] $index $index ToolbarButton]
    }
 
    return $bname
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  create - Creates all the bookkeeping for a button,
  #           without actually inserting it in the toolbar.
  # ------------------------------------------------------------------
  method create {name class command balloon args} {
 
    return [eval _register_button 0 \$name \$class \$command \$balloon $args]
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  itemconfigure -
  # ------------------------------------------------------------------
 
  method itemconfigure {button args} {
    eval $Buttons($button) configure $args
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  itembind -
  # ------------------------------------------------------------------
 
  method itembind {button key cmd} {
    eval [list bind $Buttons($button) $key $cmd]
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  itemballoon -
  # ------------------------------------------------------------------
 
  method itemballoon {button text} {
    eval [list balloon register $Buttons($button) $text]
  }
 
  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  toolbar_insert_button - Inserts button "name" before
  #           button "before".
  #           The toolbar must be made, and the buttons must have been
  #           created before you run this.
  # ------------------------------------------------------------------
  private method toolbar_insert_button {name before} {
 
    if {[string first "-" $name] == 0} {
      set name [string range $name 1 end]
      set add_sep 1
    } else {
      set add_sep 0
    }
 
    if {![info exists Buttons($name)] || ![info exists Buttons($before)]} {
      error "toolbar_insert_buttons called with non-existant button"
    }
 
    set before_col [gridCGet $Buttons($before) -column]
    set before_row [gridCGet $Buttons($before) -row]
 
    set slaves [grid slaves $ButtonFrame]
 
    set incr [expr 1 + $add_sep]
    foreach slave $slaves {
      set slave_col [gridCGet $slave -column]
      if {$slave_col >= $before_col} {
        grid configure $slave -column [expr $slave_col + $incr]
      }
    }
    if {$add_sep} {
      grid $Buttons(-$name) -column $before_col -row $before_row
    }
 
    # Now grid our button.  Have to put in the pady since this button
    # may not have been originally inserted by the libgui toolbar
    # proc.
 
    grid $Buttons($name) -column [expr $before_col + $add_sep] \
      -row $before_row -pady 2
 
  }
 
  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  toolbar_remove_button -
  # ------------------------------------------------------------------
 
  private method toolbar_remove_button {name} {
 
    if {[string first "-" $name] == 0} {
      set name [string range $name 1 end]
      set remove_sep 1
    } else {
      set remove_sep 0
    }
 
    if {![info exists Buttons($name)] } {
      error "toolbar_remove_buttons called with non-existant button $name"
    }
 
    set name_col [gridCGet $Buttons($name) -column]
    set name_row [gridCGet $Buttons($name) -row]
 
    grid remove $Buttons($name)
    if {$remove_sep} {
      set Buttons(-$name) [grid slaves $ButtonFrame \
                             -column [expr $name_col - 1] \
                            -row $name_row]
      grid remove $Buttons(-$name)
    }
 
    set slaves [grid slaves $ButtonFrame -row $name_row]
    foreach slave $slaves {
      set slave_col [gridCGet $slave -column]
      if {($slave_col > $name_col)
          && ! ([info exists Buttons($slave,align)]
              && $Buttons($slave,align) == "right")} {
        grid configure $slave -column [expr $slave_col - 1 - $remove_sep]
      }
    }
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  toolbar_button_right_justify -
  # ------------------------------------------------------------------
 
  method toolbar_button_right_justify {} {
    lappend button_list --
    set button_align "right"
  }
 
  # ------------------------------------------------------------------
  #  METHOD:  toolbar_swap_button_lists -
  # ------------------------------------------------------------------
 
  method toolbar_swap_button_lists {in_list out_list} {
    # Now swap out the buttons...
    set first_out [lindex $out_list 0]
    if {[info exists Buttons($first_out)] && [grid info $Buttons($first_out)] != ""} {
      foreach button $in_list {
        toolbar_insert_button $button $first_out
      }
      foreach button $out_list {
        toolbar_remove_button $button
      }
    } elseif {[info exists Buttons($first_out)]} {
      debug "Error in swap_button_list - $first_out not gridded..."
    } else {
      debug "Button $first_out is not in button list"
    }
  }
 
  ####################################################################
  #
  #  PRIVATE DATA
  #
  ####################################################################
 
  # This is the list of buttons that are being built up
  #
  private variable button_list {}
 
  # This is an array of buttons names -> Tk Window names
  # and also of Tk Window names -> column position in grid
  private variable Buttons
 
  # This array holds the button classes.  The key is the class name,
  # and the value is the list of buttons belonging to this class.
  private variable button_classes
 
  # Tell if we are inserting buttons left or right justified
  private variable button_align "left"
 
  #The frame to contain the buttons:
  private variable ButtonFrame
 
  ####################################################################
  #
  #  PROTECTED DATA
  #
  ####################################################################
 
  # None.
 
  ####################################################################
  #
  #  PUBLIC DATA
  #
  ####################################################################
 
  # None.
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtcl/] [gdbtoolbar.itcl] - Blame information for rev 1767

Line No.	Rev	Author	Line
1	578	markom	`# GDBToolBar`
2			`# Copyright 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			`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
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			`default {`
112			`error "Invalid item type: $type"`
113			`}`
114			`}`
115			`}`
116
117			`# ------------------------------------------------------------------`
118			`# PRIVATE METHOD: toolbar_add_button - Creates a button, and inserts`
119			`# it at the end of the button list. Call this when`
120			`# the toolbar is being set up, but has not yet been`
121			`# made.`
122			`# ------------------------------------------------------------------`
123			`private method toolbar_add_button {name class command balloon args} {`
124
125			`lappend button_list \`
126			`[eval _register_button 1 \$name \$class \$command \$balloon $args]`
127
128			`}`
129
130			`# ------------------------------------------------------------------`
131			`# PRIVATE METHOD: toolbar_add_label - Create a label to be inserted`
132			`# in the toolbar.`
133			`# ------------------------------------------------------------------`
134
135			`private method toolbar_add_label {name text balloon args} {`
136			`set lname $ButtonFrame.$name`
137			`set Buttons($name) $lname`
138			`set Buttons($lname,align) $button_align`
139			`eval label $lname -text \$text $args`
140			`balloon register $lname $balloon`
141			`lappend button_list $lname`
142			`}`
143
144			`# ------------------------------------------------------------------`
145			`# PRIVATE METHOD: toolbar_add_button_separator -`
146			`# ------------------------------------------------------------------`
147
148			`private method toolbar_add_button_separator {} {`
149			`lappend button_list -`
150			`}`
151
152			`# ------------------------------------------------------------------`
153			`# PRIVATE METHOD: _register_button - Creates all the bookkeeping`
154			`# for a button, without actually inserting it in the toolbar.`
155			`# If the button will not be immediately inserted (INS == 0),`
156			`# sets its bindings and appearences to the same of a`
157			`# standard_toolbar button.`
158			`# ------------------------------------------------------------------`
159			`private method _register_button {ins name class command balloon args} {`
160			`set bname $ButtonFrame.$name`
161			`set Buttons($name) $bname`
162			`set Buttons($bname,align) $button_align`
163
164			`eval button $bname -command \$command $args`
165			`balloon register $bname $balloon`
166			`foreach elem $class {`
167			`switch $elem {`
168			`None {}`
169			`default {`
170			`lappend button_classes($elem) $name`
171			`}`
172			`}`
173			`}`
174
175			`# If the button is not going to be inserted now...`
176			`if {! $ins} {`
177			`# This is a bit of a hack, but I need to bind the standard_toolbar bindings`
178			`# and appearances to these externally, since I am not inserting them in`
179			`# the original toolbar...`
180			`# FIXME: Have to add a method to the libgui toolbar to do this.`
181
182			`# Make sure the button acts the way we want, not the default Tk way.`
183			`$bname configure -takefocus 0 -highlightthickness 0 \`
184			`-relief flat -borderwidth 1`
185			`set index [lsearch -exact [bindtags $bname] Button]`
186			`bindtags $bname [lreplace [bindtags $bname] $index $index ToolbarButton]`
187			`}`
188
189			`return $bname`
190			`}`
191
192			`# ------------------------------------------------------------------`
193			`# METHOD: create - Creates all the bookkeeping for a button,`
194			`# without actually inserting it in the toolbar.`
195			`# ------------------------------------------------------------------`
196			`method create {name class command balloon args} {`
197
198			`return [eval _register_button 0 \$name \$class \$command \$balloon $args]`
199			`}`
200
201			`# ------------------------------------------------------------------`
202			`# METHOD: itemconfigure -`
203			`# ------------------------------------------------------------------`
204
205			`method itemconfigure {button args} {`
206			`eval $Buttons($button) configure $args`
207			`}`
208
209			`# ------------------------------------------------------------------`
210			`# METHOD: itembind -`
211			`# ------------------------------------------------------------------`
212
213			`method itembind {button key cmd} {`
214			`eval [list bind $Buttons($button) $key $cmd]`
215			`}`
216
217			`# ------------------------------------------------------------------`
218			`# METHOD: itemballoon -`
219			`# ------------------------------------------------------------------`
220
221			`method itemballoon {button text} {`
222			`eval [list balloon register $Buttons($button) $text]`
223			`}`
224
225			`# ------------------------------------------------------------------`
226			`# PRIVATE METHOD: toolbar_insert_button - Inserts button "name" before`
227			`# button "before".`
228			`# The toolbar must be made, and the buttons must have been`
229			`# created before you run this.`
230			`# ------------------------------------------------------------------`
231			`private method toolbar_insert_button {name before} {`
232
233			`if {[string first "-" $name] == 0} {`
234			`set name [string range $name 1 end]`
235			`set add_sep 1`
236			`} else {`
237			`set add_sep 0`
238			`}`
239
240			`if {![info exists Buttons($name)] \|\| ![info exists Buttons($before)]} {`
241			`error "toolbar_insert_buttons called with non-existant button"`
242			`}`
243
244			`set before_col [gridCGet $Buttons($before) -column]`
245			`set before_row [gridCGet $Buttons($before) -row]`
246
247			`set slaves [grid slaves $ButtonFrame]`
248
249			`set incr [expr 1 + $add_sep]`
250			`foreach slave $slaves {`
251			`set slave_col [gridCGet $slave -column]`
252			`if {$slave_col >= $before_col} {`
253			`grid configure $slave -column [expr $slave_col + $incr]`
254			`}`
255			`}`
256			`if {$add_sep} {`
257			`grid $Buttons(-$name) -column $before_col -row $before_row`
258			`}`
259
260			`# Now grid our button. Have to put in the pady since this button`
261			`# may not have been originally inserted by the libgui toolbar`
262			`# proc.`
263
264			`grid $Buttons($name) -column [expr $before_col + $add_sep] \`
265			`-row $before_row -pady 2`
266
267			`}`
268
269			`# ------------------------------------------------------------------`
270			`# PRIVATE METHOD: toolbar_remove_button -`
271			`# ------------------------------------------------------------------`
272
273			`private method toolbar_remove_button {name} {`
274
275			`if {[string first "-" $name] == 0} {`
276			`set name [string range $name 1 end]`
277			`set remove_sep 1`
278			`} else {`
279			`set remove_sep 0`
280			`}`
281
282			`if {![info exists Buttons($name)] } {`
283			`error "toolbar_remove_buttons called with non-existant button $name"`
284			`}`
285
286			`set name_col [gridCGet $Buttons($name) -column]`
287			`set name_row [gridCGet $Buttons($name) -row]`
288
289			`grid remove $Buttons($name)`
290			`if {$remove_sep} {`
291			`set Buttons(-$name) [grid slaves $ButtonFrame \`
292			`-column [expr $name_col - 1] \`
293			`-row $name_row]`
294			`grid remove $Buttons(-$name)`
295			`}`
296
297			`set slaves [grid slaves $ButtonFrame -row $name_row]`
298			`foreach slave $slaves {`
299			`set slave_col [gridCGet $slave -column]`
300			`if {($slave_col > $name_col)`
301			`&& ! ([info exists Buttons($slave,align)]`
302			`&& $Buttons($slave,align) == "right")} {`
303			`grid configure $slave -column [expr $slave_col - 1 - $remove_sep]`
304			`}`
305			`}`
306			`}`
307
308			`# ------------------------------------------------------------------`
309			`# METHOD: toolbar_button_right_justify -`
310			`# ------------------------------------------------------------------`
311
312			`method toolbar_button_right_justify {} {`
313			`lappend button_list --`
314			`set button_align "right"`
315			`}`
316
317			`# ------------------------------------------------------------------`
318			`# METHOD: toolbar_swap_button_lists -`
319			`# ------------------------------------------------------------------`
320
321			`method toolbar_swap_button_lists {in_list out_list} {`
322			`# Now swap out the buttons...`
323			`set first_out [lindex $out_list 0]`
324			`if {[info exists Buttons($first_out)] && [grid info $Buttons($first_out)] != ""} {`
325			`foreach button $in_list {`
326			`toolbar_insert_button $button $first_out`
327			`}`
328			`foreach button $out_list {`
329			`toolbar_remove_button $button`
330			`}`
331			`} elseif {[info exists Buttons($first_out)]} {`
332			`debug "Error in swap_button_list - $first_out not gridded..."`
333			`} else {`
334			`debug "Button $first_out is not in button list"`
335			`}`
336			`}`
337
338			`####################################################################`
339			`#`
340			`# PRIVATE DATA`
341			`#`
342			`####################################################################`
343
344			`# This is the list of buttons that are being built up`
345			`#`
346			`private variable button_list {}`
347
348			`# This is an array of buttons names -> Tk Window names`
349			`# and also of Tk Window names -> column position in grid`
350			`private variable Buttons`
351
352			`# This array holds the button classes. The key is the class name,`
353			`# and the value is the list of buttons belonging to this class.`
354			`private variable button_classes`
355
356			`# Tell if we are inserting buttons left or right justified`
357			`private variable button_align "left"`
358
359			`#The frame to contain the buttons:`
360			`private variable ButtonFrame`
361
362			`####################################################################`
363			`#`
364			`# PROTECTED DATA`
365			`#`
366			`####################################################################`
367
368			`# None.`
369
370			`####################################################################`
371			`#`
372			`# PUBLIC DATA`
373			`#`
374			`####################################################################`
375
376			`# None.`
377			`}`