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

Subversion Repositories or1k

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# GDBMenuBar
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 GDB menubar.
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 GDBMenuBar {
32
  inherit itk::Widget
33
 
34
  # ------------------------------------------------------------------
35
  #  CONSTRUCTOR - create widget
36
  # ------------------------------------------------------------------
37
  constructor {args} {
38
 
39
    set Menu [menu $itk_interior.m -tearoff 0]
40
 
41
    eval itk_initialize $args
42
  }
43
 
44
  # ------------------------------------------------------------------
45
  #  DESTRUCTOR - destroy window containing widget
46
  # ------------------------------------------------------------------
47
  destructor {
48
 
49
    #destroy $this
50
  }
51
 
52
  # ------------------------------------------------------------------
53
  #  METHOD:  show - attach menu to the toplevel window
54
  # ------------------------------------------------------------------
55
  public method show {} {
56
      [winfo toplevel $itk_interior] configure -menu $Menu
57
  }
58
 
59
  # ------------------------------------------------------------------
60
  #  METHOD:  set_class_state - standard method to control state by class
61
  # ------------------------------------------------------------------
62
  public method set_class_state {enable_list} {
63
    debug "Enable list is: $enable_list"
64
 
65
    foreach {type state} $enable_list {
66
      # debug $type
67
      if {[info exists menu_classes($type)]} {
68
        set class_list $menu_classes($type)
69
        if {[llength $class_list]} {
70
          # debug "$type $state \{$class_list\}"
71
          foreach menu $class_list {
72
            # debug "$type $menu $state"
73
            menubar_change_menu_state $menu $state
74
          }
75
        }
76
      }
77
    }
78
  }
79
 
80
  ####################################################################
81
  # Methods that deal with menus.
82
  #
83
  # The next set of methods control the menubar associated with the
84
  # toolbar.  Currently, only sequential addition of submenu's and menu
85
  # entries is allowed.  Here's what you do.  First, create a submenu
86
  # with the "new_menu" command.  This submenu is the targeted menu.
87
  # Subsequent calls to add_menu_separator, and add_menu_command add
88
  # separators and commands to the end of this submenu.
89
  # If you need to edit a submenu, call clear_menu and then add all the
90
  # items again.
91
  #
92
  # Each menu command also has a class list.  Transitions between states
93
  #  of gdb will enable and disable different classes of menus.
94
  #
95
  # FIXME - support insert_command, and also cascade menus, whenever
96
  # we need it...
97
  ####################################################################
98
 
99
  # ------------------------------------------------------------------
100
  #  METHOD:  add - Add something.
101
  #                 It can be a menubutton for the main menu,
102
  #                 a separator or a command.
103
  #
104
  #  type - what we want to add
105
  #  args - arguments appropriate to what is being added
106
  #
107
  #  RETURNS: the cascade menu widget path.
108
  # ------------------------------------------------------------------
109
  method add {type args} {
110
 
111
    switch $type {
112
      menubutton {
113
        eval menubar_new_menu $args
114
      }
115
      command {
116
        eval menubar_add_menu_command $args
117
      }
118
      separator {
119
        menubar_add_menu_separator
120
      }
121
      default {
122
        error "Invalid item type: $type"
123
      }
124
    }
125
 
126
    return $current_menu
127
  }
128
 
129
  # ------------------------------------------------------------------
130
  #  PRIVATE METHOD:  menubar_new_menu - Add a new cascade menu to the
131
  #                      main menu.
132
  #                      Also target this menu for subsequent
133
  #                      menubar_add_menu_command calls.
134
  #
135
  #  name - the token for the new menu
136
  #  label - The label used for the label
137
  #  underline - the index of the underlined character for this menu item.
138
  #
139
  # ------------------------------------------------------------------
140
  private method menubar_new_menu {name label underline} {
141
    set current_menu $Menu.$name
142
    set menu_list($name) [$Menu add cascade -menu  $current_menu \
143
                             -label $label -underline $underline]
144
    menu $current_menu -tearoff 0
145
    set menu_list($name,label) $label
146
 
147
    set item_number -1
148
  }
149
 
150
  # ------------------------------------------------------------------
151
  #  PRIVATE METHOD:  menubar_add_menu_command - Adds a menu command item
152
  #                   to the currently targeted submenu of the main menu.
153
  #
154
  #  class - The class of the command, used for disabling entries.
155
  #  label - The text for the command.
156
  #  command - The command for the menu entry
157
  #  args  - Passed to the menu entry creation command (eval'ed)
158
  # ------------------------------------------------------------------
159
  private method menubar_add_menu_command {class label command args} {
160
 
161
    eval $current_menu add command -label \$label -command \$command \
162
          $args
163
 
164
    incr item_number
165
 
166
    switch $class {
167
      None {}
168
      default {
169
        foreach elem $class {
170
          lappend menu_classes($elem) [list $current_menu $item_number]
171
        }
172
      }
173
    }
174
  }
175
 
176
  # ------------------------------------------------------------------
177
  #  PRIVATE METHOD:  menubar_add_menu_separator - Adds a menu separator
178
  #                   to the currently targeted submenu of the main menu.
179
  #
180
  # ------------------------------------------------------------------
181
  private method menubar_add_menu_separator {} {
182
    incr item_number
183
    $current_menu add separator
184
  }
185
 
186
  # ------------------------------------------------------------------
187
  #  METHOD:  exists - Report whether a menu keyed by NAME exists.
188
  #
189
  #  name - the token for the menu sought
190
  #
191
  #  RETURNS: 1 if the menu exists, 0 otherwise.
192
  # ------------------------------------------------------------------
193
  method exists {name} {
194
    return [info exists menu_list($name)]
195
 
196
  }
197
 
198
  # ------------------------------------------------------------------
199
  #  METHOD:  clear - Deletes the items from one of the
200
  #                   main menu cascade menus. Also makes this menu
201
  #                   the target menu.
202
  #
203
  #  name - the token for the new menu
204
  #
205
  #  RETURNS: then item number of the menu, or "" if the menu is not found.
206
  #
207
  #  FIXME: Does not remove the deleted menus from their class lists.
208
  # ------------------------------------------------------------------
209
  method clear {name} {
210
    if {[info exists menu_list($name)]} {
211
      set current_menu [$Menu entrycget $menu_list($name) -menu]
212
      $current_menu delete 0 end
213
      set item_number -1
214
      return $current_menu
215
    } else {
216
      return ""
217
    }
218
  }
219
 
220
  # ------------------------------------------------------------------
221
  #  METHOD:  delete - Deletes one of the main menu
222
  #                    cascade menus. Also makes the previous menu the
223
  #                    target menu.
224
  #
225
  #  name - the token for the new menu
226
  #
227
  #  RETURNS: then item number of the menu, or "" if the menu is not found.
228
  #
229
  #  FIXME: Does not remove the deleted menus from their class lists.
230
  # ------------------------------------------------------------------
231
  method delete {name} {
232
    if {[info exists menu_list($name)]} {
233
      $Menu delete $menu_list($name,label)
234
      set current_menu {}
235
      unset menu_list($name,label)
236
      unset menu_list($name)
237
    }
238
  }
239
 
240
  # ------------------------------------------------------------------
241
  # PRIVATE METHOD:  menubar_change_menu_state - Does the actual job of
242
  #                  enabling menus...
243
  #
244
  # INPUT:  Pass normal or disabled for the state.
245
  # ------------------------------------------------------------------
246
  private method menubar_change_menu_state {menu state} {
247
 
248
    [lindex $menu 0] entryconfigure [lindex $menu 1] -state $state
249
  }
250
 
251
  # ------------------------------------------------------------------
252
  # METHOD:  menubar_set_current_menu - Change the current_menu pointer.
253
  #          Returns the current value so it can be restored.
254
  # ------------------------------------------------------------------
255
  method menubar_set_current_menu {menup} {
256
    set saved_menu $current_menu
257
    set current_menu $menup
258
    return $saved_menu
259
  }
260
 
261
  ####################################################################
262
  #
263
  #  PRIVATE DATA
264
  #
265
  ####################################################################
266
 
267
  # This array holds the menu classes.  The key is the class name,
268
  # and the value is the list of menus belonging to this class.
269
  private variable menu_classes
270
 
271
  # This array holds the pathname that corresponds to a menu name
272
  private variable menu_list
273
 
274
  private variable item_number -1
275
  private variable current_menu {}
276
 
277
  ####################################################################
278
  #
279
  #  PROTECTED DATA
280
  #
281
  ####################################################################
282
 
283
  # The menu Tk widget
284
  protected variable Menu
285
 
286
  ####################################################################
287
  #
288
  #  PUBLIC DATA
289
  #
290
  ####################################################################
291
 
292
  # None
293
}

powered by: WebSVN 2.1.0

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