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

Subversion Repositories or1k

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

Details | Compare with Previous | View Log

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
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.