+2001-01-25 Fernando Nasser <fnasser@redhat.com>
+
+ * library/srcbar.itcl: New file. Implement SrcBar, a menu and toolbar
+ for the Source Window (code previously in srcmenubar.itcl and
+ srctoolbar.itcl).
+ * library/srcmenubar.itcl: Remove obsolete file.
+ * library/srctoolbar.itcl: Remove obsolete file.
+ * library/srcbar.tcl: Remove obsolete file.
+ * library/srcwin.itb (_build_win): Use SrcBar.
+ * library/tclIndex: Regenerate.
+
2001-01-24 Fernando Nasser <fnasser@redhat.com>
From Martin Hunt <hunt@cygnus.com>
--- /dev/null
+# SrcBar
+# Copyright 2001 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 menu and a toolbar that are attached to a source window.
+#
+# PUBLIC ATTRIBUTES:
+#
+#
+# METHODS:
+#
+# configure ....... used to change public attributes
+#
+# PRIVATE METHODS
+#
+# X11 OPTION DATABASE ATTRIBUTES
+#
+#
+# ----------------------------------------------------------------------
+
+class SrcBar {
+ inherit itk::Widget
+
+ # ------------------------------------------------------------------
+ # CONSTRUCTOR - create widget
+ # ------------------------------------------------------------------
+ constructor {src args} {
+ set source $src
+
+ # Load the images to be used in toolbar buttons
+ _load_images
+ _load_src_images
+
+ # Create a menu widget for the Source Window
+ set Menu [GDBMenuBar $itk_interior.menubar]
+
+ # Fill it with the initial set of entries
+ if {! [create_menu_items]} {
+ destroy $this
+ } else {
+ # We do not pack the menu, but make it the menu of the toplevel window
+ $Menu menubar_show
+ }
+
+ # Create a toolbar widget for the Source Window
+ set Tool [GDBToolBar $itk_interior.toolbar]
+
+ # Now create the Source Window initial set of toolbar buttons
+ # First give the necessary info about each button and their position
+ create_buttons
+ # Then effectively create the tollbar widget
+ $Tool toolbar_show
+
+ # Pack the toolbar
+ pack $Tool -expand 1 -fill both
+
+ eval itk_initialize $args
+ add_hook gdb_idle_hook "$this enable_ui 1"
+ add_hook gdb_busy_hook "$this enable_ui 0"
+ add_hook gdb_no_inferior_hook "$this enable_ui 2"
+ add_hook gdb_set_hook "$this set_hook"
+ add_hook gdb_trace_find_hook "$this handle_trace_find_hook"
+ }
+
+ # ------------------------------------------------------------------
+ # DESTRUCTOR - destroy window containing widget
+ # ------------------------------------------------------------------
+ destructor {
+ global GDBSrcBar_state
+
+ unset GDBSrcBar_state($this)
+ remove_hook gdb_idle_hook "$this enable_ui 1"
+ remove_hook gdb_busy_hook "$this enable_ui 0"
+ remove_hook gdb_no_inferior_hook "$this enable_ui 2"
+ remove_hook gdb_set_hook "$this set_hook"
+ remove_hook gdb_trace_find_hook "$this handle_trace_find_hook"
+
+ #destroy $this
+ }
+\f
+ ####################################################################
+ # The next set of functions create the common menu groupings that
+ # are used in gdb menus.
+ # Private. Used at contruction time.
+ # These were previously at the GDBToolBar...
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: create_menu_items - Add some menu items to the menubar.
+ # Returns 1 if any items added.
+ # ------------------------------------------------------------------
+ private method create_menu_items {} {
+
+ create_file_menu
+
+ create_run_menu
+
+ create_view_menu
+
+ if {[pref get gdb/control_target]} {
+ create_control_menu
+ }
+
+ if {[pref get gdb/mode]} {
+ create_trace_menu
+ }
+
+ create_pref_menu
+
+ create_help_menu
+
+ return 1
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_file_menu - Creates the standard file menu.
+ # ------------------------------------------------------------------
+
+ private method create_file_menu {} {
+ global enable_external_editor tcl_platform
+
+ $Menu menubar_new_menu file "File" 0
+
+ if {[info exists enable_external_editor] && $enable_external_editor} {
+ $Menu menubar_add_menu_command None "Edit Source" \
+ [code $source edit]
+ }
+
+ $Menu menubar_add_menu_command Other "Open..." \
+ "_open_file" -underline 0 -accelerator "Ctrl+O"
+
+ $Menu menubar_add_menu_command Other "Source..." \
+ "source_file" -underline 0
+
+ set sessions [session_list]
+ if {[llength $sessions]} {
+ $Menu menubar_add_menu_separator
+ set i 1
+ foreach item $sessions {
+ $Menu menubar_add_menu_command Other "$i $item" \
+ [list session_load $item] \
+ -underline 0
+ incr i
+ }
+ }
+
+ $Menu menubar_add_menu_separator
+
+ if {$tcl_platform(platform) == "windows"} {
+ $Menu menubar_add_menu_command None "Page Setup..." \
+ [format {
+ set top %s
+ ide_winprint page_setup -parent $top
+ } [winfo toplevel [namespace tail $this]]] \
+ -underline 8
+ }
+
+ $Menu menubar_add_menu_command None "Print Source..." \
+ [code $source print] \
+ -underline 0 -accelerator "Ctrl+P"
+
+ $Menu menubar_add_menu_separator
+
+ $Menu menubar_add_menu_command Other "Target Settings..." \
+ "set_target_name" -underline 0
+
+ $Menu menubar_add_menu_separator
+
+ $Menu menubar_add_menu_command None "Exit" gdbtk_quit -underline 1
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_run_menu - Creates the standard run menu,
+ # or reconfigures it if it already exists.
+ # ------------------------------------------------------------------
+
+ private method create_run_menu {} {
+
+ if {![$Menu menubar_menu_exists Run]} {
+ set run_menu [$Menu menubar_new_menu run "Run" 0]
+ } else {
+ set run_menu [$Menu menubar_clear_menu Run]
+ }
+
+ set is_native [TargetSelection::native_debugging]
+
+ # If we are on a Unix target, put in the attach options. "ps" doesn't
+ # give me the Windows PID yet, and the attach also seems flakey, so
+ # I will hold off on the Windows implementation for now.
+
+ if {$is_native} {
+ if {[string compare $::tcl_platform(platform) windows] != 0} {
+ $Menu menubar_add_menu_command Attach "Attach to process" \
+ [code $this do_attach $run_menu] \
+ -underline 0 -accelerator "Ctrl+A"
+ }
+ } else {
+ $Menu menubar_add_menu_command Other "Connect to target" \
+ "$this do_connect $run_menu" -underline 0
+ }
+
+ if {[pref get gdb/control_target]} {
+ if {!$is_native} {
+ $Menu menubar_add_menu_command Other "Download" Download::download_it \
+ -underline 0 -accelerator "Ctrl+D"
+ }
+ $Menu menubar_add_menu_command Other "Run" [code $source inferior run] \
+ -underline 0 -accelerator R
+ }
+
+ if {$is_native} {
+ if {[string compare $::tcl_platform(platform) windows] != 0} {
+ $Menu menubar_add_menu_command Detach "Detach" \
+ [code $this do_detach $run_menu] \
+ -underline 0 -state disabled
+ }
+ } else {
+ $Menu menubar_add_menu_command Other "Disconnect" \
+ [code $this do_disconnect $run_menu] -underline 0 -state disabled
+ }
+
+ if {$is_native} {
+ $Menu menubar_add_menu_separator
+ $Menu menubar_add_menu_command Control "Kill" \
+ [code $this do_kill $run_menu] \
+ -underline 0 -state disabled
+ }
+
+ if { [pref get gdb/mode] } {
+ $Menu menubar_add_menu_separator
+
+ $Menu menubar_add_menu_command Other "Start collection" "$this do_tstop" \
+ -underline 0 -accelerator "Ctrl+B"
+
+ $Menu menubar_add_menu_command Other "Stop collection" "$this do_tstop" \
+ -underline 0 -accelerator "Ctrl+E" -state disabled
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_view_menu - Creates the standard view menu
+ # ------------------------------------------------------------------
+
+ private method create_view_menu {} {
+
+ $Menu menubar_new_menu view "View" 0
+
+ $Menu menubar_add_menu_command Other "Stack" {ManagedWin::open StackWin} \
+ -underline 0 -accelerator "Ctrl+S"
+
+ $Menu menubar_add_menu_command Other "Registers" {ManagedWin::open RegWin} \
+ -underline 0 -accelerator "Ctrl+R"
+
+ $Menu menubar_add_menu_command Other "Memory" {ManagedWin::open MemWin} \
+ -underline 0 -accelerator "Ctrl+M"
+
+ $Menu menubar_add_menu_command Other "Watch Expressions" \
+ {ManagedWin::open WatchWin} \
+ -underline 0 -accelerator "Ctrl+W"
+ $Menu menubar_add_menu_command Other "Local Variables" \
+ {ManagedWin::open LocalsWin} \
+ -underline 0 -accelerator "Ctrl+L"
+
+ if {[pref get gdb/control_target]} {
+ $Menu menubar_add_menu_command Other "Breakpoints" \
+ {ManagedWin::open BpWin -tracepoints 0} \
+ -underline 0 -accelerator "Ctrl+B"
+ }
+
+ if {[pref get gdb/mode]} {
+ $Menu menubar_add_menu_command Other "Tracepoints" \
+ {ManagedWin::open BpWin -tracepoints 1} \
+ -underline 0 -accelerator "Ctrl+T"
+ $Menu menubar_add_menu_command Other "Tdump" {ManagedWin::open TdumpWin} \
+ -underline 2 -accelerator "Ctrl+U"
+ }
+
+ $Menu menubar_add_menu_command Other "Console" {ManagedWin::open Console} \
+ -underline 2 -accelerator "Ctrl+N"
+
+ $Menu menubar_add_menu_command Other "Function Browser" \
+ {ManagedWin::open BrowserWin} \
+ -underline 1 -accelerator "Ctrl+F"
+ $Menu menubar_add_menu_command Other "Thread List" \
+ {ManagedWin::open ProcessWin} \
+ -underline 0 -accelerator "Ctrl+H"
+ if {[info exists ::env(GDBTK_DEBUG)] && $::env(GDBTK_DEBUG)} {
+ $Menu menubar_add_menu_separator
+ $Menu menubar_add_menu_command Other "Debug Window" \
+ {ManagedWin::open DebugWin} \
+ -underline 3 -accelerator "Ctrl+U"
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_control_menu - Creates the standard control menu
+ # ------------------------------------------------------------------
+
+ private method create_control_menu {} {
+
+ $Menu menubar_new_menu cntrl "Control" 0
+
+ $Menu menubar_add_menu_command Control "Step" [code $source inferior step] \
+ -underline 0 -accelerator S
+
+ $Menu menubar_add_menu_command Control "Next" [code $source inferior next] \
+ -underline 0 -accelerator N
+
+ $Menu menubar_add_menu_command Control "Finish" \
+ [code $source inferior finish] \
+ -underline 0 -accelerator F
+
+ $Menu menubar_add_menu_command Control "Continue" \
+ [code $source inferior continue] \
+ -underline 0 -accelerator C
+
+ $Menu menubar_add_menu_separator
+ $Menu menubar_add_menu_command Control "Step Asm Inst" \
+ [code $source inferior stepi] \
+ -underline 1 -accelerator S
+
+ $Menu menubar_add_menu_command Control "Next Asm Inst" \
+ [code $source inferior nexti] \
+ -underline 1 -accelerator N
+
+ # $Menu menubar_add_menu_separator
+ # $Menu menubar_add_menu_command Other "Automatic Step" auto_step
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_trace_menu - Creates the standard trace menu
+ # ------------------------------------------------------------------
+
+ private method create_trace_menu {} {
+
+ $Menu menubar_new_menu trace "Trace" 0
+
+ $Menu menubar_add_menu_command Other "Save Trace Commands..." \
+ "save_trace_commands" \
+ -underline 0
+
+ $Menu menubar_add_menu_separator
+
+ $Menu menubar_add_menu_command Trace "Next Hit" {tfind_cmd tfind} \
+ -underline 0 -accelerator N
+
+ $Menu menubar_add_menu_command Trace "Previous Hit" {tfind_cmd "tfind -"} \
+ -underline 0 -accelerator P
+
+ $Menu menubar_add_menu_command Trace "First Hit" {tfind_cmd "tfind start"} \
+ -underline 0 -accelerator F
+
+ $Menu menubar_add_menu_command Trace "Next Line Hit" \
+ {tfind_cmd "tfind line"} \
+ -underline 5 -accelerator L
+
+ $Menu menubar_add_menu_command Trace "Next Hit Here" \
+ {tfind_cmd "tfind tracepoint"} \
+ -underline 9 -accelerator H
+
+ $Menu menubar_add_menu_separator
+ $Menu menubar_add_menu_command Trace "Tfind Line..." \
+ "ManagedWin::open TfindArgs -Type LN" \
+ -underline 9 -accelerator E
+
+ $Menu menubar_add_menu_command Trace "Tfind PC..." \
+ "ManagedWin::open TfindArgs -Type PC" \
+ -underline 7 -accelerator C
+
+ $Menu menubar_add_menu_command Trace "Tfind Tracepoint..." \
+ "ManagedWin::open TfindArgs -Type TP" \
+ -underline 6 -accelerator T
+
+ $Menu menubar_add_menu_command Trace "Tfind Frame..." \
+ "ManagedWin::open TfindArgs -Type FR" \
+ -underline 6 -accelerator F
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_pref_menu - Creates the standard preferences menu
+ # ------------------------------------------------------------------
+ private method create_pref_menu {} {
+
+ $Menu menubar_new_menu pref "Preferences" 0
+
+ $Menu menubar_add_menu_command Other "Global..." \
+ "ManagedWin::open GlobalPref -transient" -underline 0
+
+ $Menu menubar_add_menu_command Other "Source..." \
+ "ManagedWin::open SrcPref -transient" -underline 0
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_help_menu - Creates the standard help menu
+ # ------------------------------------------------------------------
+ private method create_help_menu {} {
+
+ $Menu menubar_new_menu help "Help" 0
+ $Menu menubar_add_menu_command Other "Help Topics" \
+ {HtmlViewer::open_help index.html} \
+ -underline 0
+ $Menu menubar_add_menu_separator
+ $Menu menubar_add_menu_command Other "About GDB..." \
+ {ManagedWin::open About -transient} \
+ -underline 0
+ }
+\f
+ ####################################################################
+ # The next set of functions are the generic button groups that gdb uses.
+ # Private. Used at contruction time.
+ # These were previously at the GDBToolBar...
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: create_buttons - Add some buttons to the toolbar.
+ # Returns list of buttons in form acceptable
+ # to standard_toolbar.
+ # ------------------------------------------------------------------
+ private method create_buttons {} {
+ global enable_external_editor
+
+ $Tool toolbar_add_button stop None {} {}
+ _set_runstop
+
+ if {[pref get gdb/mode]} {
+ $Tool toolbar_add_button tstop Control \
+ [list $this do_tstop] "Start Collection" \
+ -image Movie_on_img
+
+ $Tool toolbar_add_button view Other [list $this set_control_mode 1] \
+ "Switch to Browse Mode" -image watch_movie_img
+
+ $Tool toolbar_add_button_separator
+
+ }
+
+ if {[pref get gdb/control_target]} {
+ create_control_buttons
+ if {[pref get gdb/mode]} {
+ create_trace_buttons 0
+ }
+ } elseif {[get pref gdb/mode]} {
+
+ #
+ # If we don't control the target, then we might as well
+ # put a copy of the trace controls on the source window.
+ #
+ create_trace_buttons 1
+ }
+
+ $Tool toolbar_add_button_separator
+
+ create_window_buttons
+
+ # Random bits of obscurity...
+ $Tool toolbar_bind_button reg <Button-3> "ManagedWin::open RegWin -force"
+ $Tool toolbar_bind_button mem <Button-3> "ManagedWin::open MemWin -force"
+ $Tool toolbar_bind_button watch <Button-3> \
+ "ManagedWin::open WatchWin -force"
+ $Tool toolbar_bind_button vars <Button-3> \
+ "ManagedWin::open LocalsWin -force"
+
+ $Tool toolbar_add_button_separator
+
+ if {[info exists enable_external_editor] && $enable_external_editor} {
+ $Tool toolbar_add_button edit Other [code $source edit] "Edit Source" \
+ -image edit_img
+
+ $Tool toolbar_add_button_separator
+ }
+
+ $Tool toolbar_add_label addr $address "Address" -width 10 -relief sunken \
+ -bd 1 -anchor e -font src-font
+
+ $Tool toolbar_add_label line $line "Line Number" -width 6 -relief sunken \
+ -bd 1 -anchor e -font src-font
+
+ $Tool toolbar_button_right_justify
+
+ create_stack_buttons
+
+ # This feature has been disabled for now.
+ # checkbutton $ButtonFrame.upd -command "$this _toggle_updates" \
+ # -variable GDBSrcBar_state($this)
+ # lappend button_list $ButtonFrame.upd
+ # global GDBSrcBar_state
+ # ::set GDBSrcBar_state($this) $updatevalue
+ # balloon register $ButtonFrame.upd "Toggle Window Updates"
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_control_buttons - Creates the step, continue, etc buttons.
+ # ------------------------------------------------------------------
+
+ private method create_control_buttons {} {
+ $Tool toolbar_add_button step Control [code $source inferior step] \
+ "Step (S)" -image step_img
+
+ $Tool toolbar_add_button next Control [code $source inferior next] \
+ "Next (N)" -image next_img
+
+ $Tool toolbar_add_button finish Control [code $source inferior finish] \
+ "Finish (F)" -image finish_img
+
+ $Tool toolbar_add_button continue Control [code $source inferior continue] \
+ "Continue (C)" -image continue_img
+
+ # A spacer before the assembly-level items looks good. It helps
+ # to indicate that these are somehow different.
+ $Tool toolbar_add_button_separator
+
+ $Tool toolbar_add_button stepi Control [code $source inferior stepi] \
+ "Step Asm Inst (S)" -image stepi_img
+
+ $Tool toolbar_add_button nexti Control [code $source inferior nexti] \
+ "Next Asm Inst (N)" -image nexti_img
+
+ _set_stepi
+
+ set Run_control_buttons {step next finish continue -stepi nexti}
+
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_trace_buttons - Creates the next hit, etc.
+ # ------------------------------------------------------------------
+
+ private method create_trace_buttons {{show 0}} {
+
+ if {$show} {
+ set command $Tool toolbar_add_button
+ } else {
+ set command $Tool toolbar_create_button
+ }
+
+ $command tfindstart Trace {tfind_cmd "tfind start"} "First Hit <F>" \
+ -image rewind_img
+
+ $command tfind Trace {tfind_cmd tfind} "Next Hit <N>" -image next_hit_img
+
+ $command tfindprev Trace {tfind_cmd "tfind -"} "Previous Hit <P>" \
+ -image prev_hit_img
+
+ $command tfindline Trace {tfind_cmd "tfind line"} "Next Line Hit <L>" \
+ -image next_line_img
+
+ $command tfindtp Trace { tfind_cmd "tfind tracepoint"} \
+ "Next Hit Here <H>" -image next_check_img
+
+ set Trace_control_buttons {tfindstart tfind tfindprev tfindline tfindtp}
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_window_buttons - Creates the registers, etc, buttons
+ # ------------------------------------------------------------------
+
+ private method create_window_buttons {} {
+ $Tool toolbar_add_button reg Other {ManagedWin::open RegWin} \
+ "Registers (Ctrl+R)" -image reg_img
+
+ $Tool toolbar_add_button mem Other {ManagedWin::open MemWin} \
+ "Memory (Ctrl+M)" -image memory_img
+
+ $Tool toolbar_add_button stack Other {ManagedWin::open StackWin} \
+ "Stack (Ctrl+S)" -image stack_img
+
+ $Tool toolbar_add_button watch Other {ManagedWin::open WatchWin} \
+ "Watch Expressions (Ctrl+W)" -image watch_img
+
+ $Tool toolbar_add_button vars Other {ManagedWin::open LocalsWin} \
+ "Local Variables (Ctrl+L)" -image vars_img
+
+ if {[pref get gdb/control_target]} {
+ $Tool toolbar_add_button bp Other {ManagedWin::open BpWin} \
+ "Breakpoints (Ctrl+B)" -image bp_img
+ }
+
+ if {[pref get gdb/mode]} {
+ $Tool toolbar_add_button tp Other \
+ {ManagedWin::open BpWin -tracepoints 1} \
+ "Tracepoints (Ctrl+T)" -image tp_img
+
+ $Tool toolbar_add_button tdump Trace {ManagedWin::open TdumpWin} \
+ "Tdump (Ctrl+D)" -image tdump_img
+ }
+
+ $Tool toolbar_add_button con Other {ManagedWin::open Console} \
+ "Console (Ctrl+N)" -image console_img
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: create_stack_buttons - Creates the up down bottom stack buttons
+ # ------------------------------------------------------------------
+
+ private method create_stack_buttons {} {
+
+ $Tool toolbar_add_button down {Trace Control} \
+ [code $source stack down] \
+ "Down Stack Frame" -image down_img
+
+ $Tool toolbar_add_button up {Trace Control} \
+ [code $source stack up] \
+ "Up Stack Frame" -image up_img
+
+ $Tool toolbar_add_button bottom {Trace Control} \
+ [code $source stack bottom] \
+ "Go to Bottom of Stack" -image bottom_img
+
+ }
+\f
+ ####################################################################
+ #
+ # Auxiliary methods used by the toolbar
+ #
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: _load_images - Load standard images. Private method.
+ # ------------------------------------------------------------------
+ public method _load_images { {reconfig 0} } {
+ global gdb_ImageDir
+ if {!$reconfig && $_loaded_images} {
+ return
+ }
+ set _loaded_images 1
+
+ lappend imgs console reg stack vmake vars watch memory bp
+ foreach name $imgs {
+ image create photo ${name}_img -file [file join $gdb_ImageDir ${name}.gif]
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: _load_src_images - Load standard images. Private method.
+ # ------------------------------------------------------------------
+ method _load_src_images { {reconf 0} } {
+ global gdb_ImageDir
+
+ if {!$reconf && $_loaded_src_images} {
+ return
+ }
+ set _loaded_src_images 1
+
+ foreach name {run stop step next finish continue edit \
+ stepi nexti up down bottom Movie_on Movie_off \
+ next_line next_check next_hit rewind prev_hit \
+ watch_movie run_expt tdump tp} {
+ image create photo ${name}_img -file [file join $gdb_ImageDir ${name}.gif]
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: _set_runstop - Set state of run/stop button.
+ #
+ # busy - Run button becomes disabled
+ # running - Stop button appears, allowing user to stop executing target
+ # downloading - Stop button appears, allowing user to interrupt downloading
+ # normal - Run button appears, allowing user to run/re-run exe
+ # ------------------------------------------------------------------
+ public method _set_runstop {} {
+ dbug W $runstop
+
+ switch $runstop {
+ busy {
+ $Tool toolbar_configure_button stop -state disabled
+ }
+ downloading {
+ $Tool toolbar_configure_button stop -state normal -image stop_img \
+ -command [code $this cancel_download]
+ $Tool toolbar_set_button_balloon stop "Stop"
+ }
+ running {
+ $Tool toolbar_configure_button stop -state normal -image stop_img \
+ -command [code $source inferior stop]
+ $Tool toolbar_set_button_balloon stop "Stop"
+ }
+ normal {
+ $Tool toolbar_configure_button stop -state normal -image run_img \
+ -command [code $source inferior run]
+ $Tool toolbar_set_button_balloon stop "Run (R)"
+ }
+ default {
+ dbug W "unknown state $runstop"
+ }
+ }
+ }
+
+
+ # ------------------------------------------------------------------
+ # METHOD: _set_stepi - Set state of stepi/nexti buttons.
+ # ------------------------------------------------------------------
+ public method _set_stepi {} {
+
+ # Only do this in synchronous mode
+ if {!$Tracing} {
+ # In source-only mode, disable these buttons. Otherwise, enable
+ # them.
+ if {$displaymode == "SOURCE"} {
+ set state disabled
+ } else {
+ set state normal
+ }
+ $Tool toolbar_configure_button stepi -state $state
+ $Tool toolbar_configure_button nexti -state $state
+ }
+ }
+
+\f
+ ####################################################################
+ #
+ # State control methods used by both the menu and the toolbar
+ #
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: handle_trace_find_hook - response to the tfind command.
+ # If the command puts us in a new mode, then switch modes...
+ # ------------------------------------------------------------------
+ method handle_trace_find_hook {mode from_tty} {
+ debug "mode: $mode, from_tty: $from_tty, Browsing: $Browsing"
+ if {[string compare $mode -1] == 0} {
+ if {$Browsing} {
+ set_control_mode 0
+ }
+ } else {
+ if {!$Browsing} {
+ set_control_mode 1
+ }
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: set_control_mode - sets up the srcbar for browsing
+ # a trace experiment.
+ # mode: 1 => browse mode
+ # 0 => control mode
+ # ------------------------------------------------------------------
+ method set_control_mode {mode} {
+ debug "set_control_mode called with mode $mode"
+ if {$mode} {
+ set Browsing 1
+ $Tool toolbar_configure_button view -image run_expt_img \
+ -command "$this set_control_mode 0"
+ $Tool toolbar_set_button_balloon view "Switch to Control mode"
+ # Now swap out the buttons...
+ $Tool toolbar_swap_button_lists $Trace_control_buttons \
+ $Run_control_buttons
+ enable_ui 1
+ } else {
+ if {$Browsing} {
+ tfind_cmd {tfind none}
+ }
+ set Browsing 0
+ $Tool toolbar_configure_button view -image watch_movie_img \
+ -command "$this set_control_mode 1"
+ $Tool toolbar_set_button_balloon view "Switch to Browse mode"
+ # Now swap out the buttons...
+ $Tool toolbar_swap_button_lists $Run_control_buttons \
+ $Trace_control_buttons
+ enable_ui 1
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: reconfig - reconfigure the srcbar
+ # used when preferences change
+ # ------------------------------------------------------------------
+ public method reconfig {} {
+ debug
+ _load_src_images 1
+ _load_images 1
+ # FIXME: Must Check if we are Tracing and set the buttons accordingly.
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: set_hook - run when user enters a `set' command.
+ #
+ # FIXME: Should not be accessing the base class internal data
+ # As the spec says, one must clear the menu and recreate it.
+ # ------------------------------------------------------------------
+ method set_hook {varname value} {
+ debug "Got $varname = $value"
+
+ if {$varname == "os"} {
+ # Make current_menu pointer point to the View Menu.
+ # FIXME: Should not be accessing the base class internal data directly
+ set view_menu [menu_find View]
+ # Restore the current_menu pointer.
+ set save_menu [$Menu menubar_set_current_menu $view_menu]
+ set title "Kernel Objects"
+
+ # Look for the KOD menu entry...
+ if {[catch {$view_menu index $title} index]} {
+ set index none
+ }
+
+ # FIXME: This assumes that the KOD menu is the last one as it does not
+ # adjust the index information kept by the GDBMenuBar class.
+ if {$value == ""} {
+ # No OS, so remove KOD from View menu.
+ if {$index != "none"} {
+ # FIXME: Should not be accessing the base class internal data
+ $view_menu delete $index
+ }
+ } else {
+ # Add KOD to View menu, but only if it isn't already there.
+ if {$index == "none"} {
+ $Menu menubar_add_menu_command Other $title \
+ {ManagedWin::open KodWin} \
+ -underline 0 -accelerator "Ctrl+K"
+ }
+ }
+
+ # Restore the current_menu pointer.
+ $Menu menubar_set_current_menu $save_menu
+
+ global gdb_kod_cmd
+ set gdb_kod_cmd $value
+ }
+ }
+
+ ####################################################################
+ # The following method enables/disables both menus and buttons.
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: enable_ui - enable/disable the appropriate buttons and menus
+ # Called from the busy, idle, and no_inferior hooks.
+ #
+ # on must be:
+ # value Control Other Trace State
+ # 0 off off off gdb is busy
+ # 1 on on off gdb has inferior, and is idle
+ # 2 off on off gdb has no inferior, and is idle
+ # ------------------------------------------------------------------
+ public method enable_ui {on} {
+ global tcl_platform
+ debug "$on - Browsing=$Browsing"
+
+ # Do the enabling so that all the disabling happens first, this way if a
+ # button belongs to two groups, enabling takes precedence, which is
+ # probably right.
+
+ switch $on {
+ 0 {
+ # Busy
+ set enable_list {Control disabled \
+ Other disabled \
+ Trace disabled \
+ Attach disabled \
+ Detach disabled}
+ }
+ 1 {
+ # Idle, with inferior
+ if {!$Browsing} {
+ set enable_list {Trace disabled \
+ Control normal \
+ Other normal \
+ Attach disabled \
+ Detach normal }
+ # set the states of stepi and nexti correctly
+ _set_stepi
+ } else {
+ set enable_list {Control disabled Other normal Trace normal}
+ }
+
+ }
+ 2 {
+ # Idle, no inferior
+ set enable_list {Control disabled \
+ Trace disabled \
+ Other normal \
+ Attach normal \
+ Detach disabled }
+ }
+ default {
+ debug "Unknown type: $on in enable_ui"
+ return
+ }
+ }
+
+ $Menu set_class_state $enable_list
+ $Tool set_class_state $enable_list
+ }
+\f
+ ####################################################################
+ #
+ # Execute actions corresponding to menu events
+ #
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: do_attach: attach to a running target
+ # ------------------------------------------------------------------
+ method do_attach {menu} {
+ gdbtk_attach_native
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: do_detach: detach from a running target
+ # ------------------------------------------------------------------
+ method do_detach {menu} {
+ gdbtk_disconnect
+ gdbtk_idle
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: do_kill: kill the current target
+ # ------------------------------------------------------------------
+ method do_kill {menu} {
+ gdb_cmd "kill"
+ run_hooks gdb_no_inferior_hook
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: do_connect: connect to a remote target
+ # in asynch mode if async is 1
+ # ------------------------------------------------------------------
+ method do_connect {menu {async 0}} {
+
+ set successful [gdbtk_connect $async]
+
+ if {$successful} {
+ $menu entryconfigure "Connect to target" -state disabled
+ $menu entryconfigure "Disconnect" -state normal
+ } else {
+ $menu entryconfigure "Connect to target" -state normal
+ $menu entryconfigure "Disconnect" -state disabled
+ }
+
+ # Make the menu reflect this change
+ ::update idletasks
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: do_disconnect: disconnect from a remote target
+ # in asynch mode if async is 1.
+ #
+ # ------------------------------------------------------------------
+ method do_disconnect {menu {async 0}} {
+ debug "$menu $async"
+ #
+ # For now, these are the same, but they might be different...
+ #
+
+ gdbtk_disconnect $async
+
+ $menu entryconfigure "Connect to target" -state normal
+ $menu entryconfigure "Disconnect" -state disabled
+ }
+\f
+ ####################################################################
+ #
+ # Execute actions corresponding to toolbar events
+ #
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: _toggle_updates - Run when the update checkbutton is
+ # toggled. Private method.
+ # ------------------------------------------------------------------
+ public method _toggle_updates {} {
+ global GDBSrcBar_state
+ if {$updatecommand != ""} {
+ uplevel \#0 $updatecommand $GDBSrcBar_state($this)
+ }
+ }
+
+ # ------------------------------------------------------------------
+ # METHOD: cancel_download
+ # ------------------------------------------------------------------
+ public method cancel_download {} {
+ global download_dialog download_cancel_ok
+
+ if {"$download_dialog" != ""} {
+ $download_dialog cancel
+ } else {
+ set download_cancel_ok 1
+ }
+ }
+\f
+ ####################################################################
+ #
+ # Execute actions that can be activated by both menu entries and
+ # toolbar buttons
+ #
+ ####################################################################
+
+ # ------------------------------------------------------------------
+ # METHOD: do_tstop: Change the GUI state, then do the tstop or
+ # tstart command, whichever is appropriate.
+ #
+ # ------------------------------------------------------------------
+ method do_tstop {} {
+ debug "do_tstop called... Collecting is $Collecting"
+
+ if {!$Collecting} {
+ #
+ # Start the trace experiment
+ #
+
+ if {$Browsing} {
+ set ret [tk_messageBox -title "Warning" -message \
+"You are currently browsing a trace experiment.
+This command will clear the results of that experiment.
+Do you want to continue?" \
+ -icon warning -type okcancel -default ok]
+ if {[string compare $ret cancel] == 0} {
+ return
+ }
+ set_control_mode 1
+ }
+ if {[tstart]} {
+ # FIXME: Must enable the Stop Collection menu item and
+ # disable the Start Collection item
+ $Tool toolbar_configure_button tstop -image Movie_off_img
+ $Tool toolbar_set_button_balloon tstop "End Collection"
+ set Collecting 1
+ } else {
+ tk_messageBox -title Error \
+ -message "Error downloading tracepoint info" \
+ -icon error -type ok
+ }
+ } else {
+ #
+ # Stop the trace experiment
+ #
+
+ if {[tstop]} {
+ # FIXME: Must enable the Stop Collection menu item and
+ # disable the Start Collection item
+ $Tool toolbar_configure_button tstop -image Movie_on_img
+ $Tool toolbar_set_button_balloon tstop "Start Collection"
+ set Collecting 0
+ }
+ }
+ }
+\f
+ ####################################################################
+ #
+ # PRIVATE DATA
+ #
+ ####################################################################
+
+ # This is a handle on our parent source window.
+ private variable source {}
+
+ # The GdbMenuBar component
+ private variable Menu
+
+ # The GdbToolBar component
+ private variable Tool
+
+ # FIXME - Need to break the images into the sets needed for
+ # each button group, and load them when the button group is
+ # created.
+
+ # This is set if we've already loaded the standard images.
+ private common _loaded_images 0
+
+ # This is set if we've already loaded the standard images. Private
+ # variable.
+ private common _loaded_src_images 0
+
+ # These buttons go in the control area when we are browsing
+ protected variable Trace_control_buttons
+
+ # And these go in the control area when we are running
+ protected variable Run_control_buttons
+
+ ####################################################################
+ #
+ # PUBLIC DATA
+ #
+ ####################################################################
+
+ # This is the command that should be run when the `update'
+ # checkbutton is toggled. The current value of the checkbutton is
+ # appended to the command.
+ public variable updatecommand {}
+
+ # This controls whether the `update' checkbutton is turned on or
+ # off.
+ public variable updatevalue 0 {
+ global GDBSrcBar_state
+ ::set GDBSrcBar_state($this) $updatevalue
+ }
+
+ # This holds the text that is shown in the address label.
+ public variable address {} {
+ $Tool toolbar_configure_button addr -text $address -font src-font
+ }
+
+ # This holds the text that is shown in the line label.
+ public variable line {} {
+ $Tool toolbar_configure_button line -text $line
+ }
+
+ # This holds the source window's display mode. Valid values are
+ # SOURCE, ASSEMBLY, SRC+ASM, and MIXED.
+ public variable displaymode SOURCE {
+ _set_stepi
+ }
+
+ # This indicates what is the inferior state.
+ # Possible values are: {busy running downloading normal}
+ public variable runstop normal {
+ dbug W "configuring runstop $runstop"
+
+ # Set the Run/Stop button accordingly
+ _set_runstop
+ }
+
+ # The next three determine the state of the application when Tracing is enabled.
+
+ public variable Tracing 0 ;# Is tracing enabled for this gdb?
+ public variable Browsing 0 ;# Are we currently browsing a trace experiment?
+ public variable Collecting 0 ;# Are we currently collecting a trace experiment?
+}
+++ /dev/null
-# OBSOLETE: Please see gdbmenubar, gdbtoolbar, srcmenubar and srctoolbar
-#
-# GDBSrcBar
-# Copyright 1997, 1998, 1999 Cygnus Solutions
-#
-# 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 that is attached to a source window.
-#
-# PUBLIC ATTRIBUTES:
-#
-#
-# METHODS:
-#
-# config ....... used to change public attributes
-#
-# PRIVATE METHODS
-#
-# X11 OPTION DATABASE ATTRIBUTES
-#
-#
-# ----------------------------------------------------------------------
-
-class GDBSrcBar {
- inherit GDBToolBar
-
- # ------------------------------------------------------------------
- # CONSTRUCTOR - create widget
- # ------------------------------------------------------------------
- constructor {src args} {
- GDBToolBar::constructor $src
- } {
- eval itk_initialize $args
- add_hook gdb_trace_find_hook "$this trace_find_hook"
- }
-
- # ------------------------------------------------------------------
- # DESTRUCTOR - destroy window containing widget
- # ------------------------------------------------------------------
- destructor {
- global GDBSrcBar_state
- unset GDBSrcBar_state($this)
- remove_hook gdb_trace_find_hook "$this trace_find_hook"
- }
-
- #
- # PUBLIC DATA
- #
-
- # This is the command that should be run when the `update'
- # checkbutton is toggled. The current value of the checkbutton is
- # appended to the command.
- public variable updatecommand {}
-
- # This controls whether the `update' checkbutton is turned on or
- # off.
- public variable updatevalue 0 {
- global GDBSrcBar_state
- ::set GDBSrcBar_state($this) $updatevalue
- }
-
- # This holds the text that is shown in the address label.
- public variable address {} {
- if {$ButtonFrame != "" && [winfo exists $ButtonFrame.addr]} {
- $ButtonFrame.addr configure -text $address -font src-font
- }
- }
-
- # This holds the text that is shown in the line label.
- public variable line {} {
- if {$ButtonFrame != "" && [winfo exists $ButtonFrame.line]} {
- $ButtonFrame.line configure -text $line
- }
- }
-
- # This holds the source window's display mode. Valid values are
- # SOURCE, ASSEMBLY, SRC+ASM, and MIXED.
- public variable displaymode SOURCE {
- if {$ButtonFrame != ""} {
- _set_stepi
- }
- }
-
- # This is true if the inferior is running, or false if it is
- # stopped.
- public variable runstop normal {
- if {$ButtonFrame != ""} {
- _set_runstop
- }
- }
-
- # The next three determine the state of the application when Tracing is enabled.
-
- public variable Tracing 0 ;# Is tracing enabled for this gdb?
- public variable Browsing 0 ;# Are we currently browsing a trace experiment?
- public variable Collecting 0 ;# Are we currently collecting a trace experiment?
-
- # ------------------------------------------------------------------
- # METHOD: create_menu_items - Add some menu items to the menubar.
- # Returns 1 if any items added.
- # This overrides the method in GDBToolBar.
- # ------------------------------------------------------------------
- public method create_menu_items {} {
- global enable_external_editor tcl_platform
-
- set m [new_menu file "File" 0]
-
- if {[info exists enable_external_editor] && $enable_external_editor} {
- add_menu_command None "Edit Source" \
- [list $this _apply_source edit]
- }
- add_menu_command Other "Open..." \
- "_open_file" -underline 0 -accelerator "Ctrl+O"
-
- add_menu_command Other "Source..." \
- "source_file" -underline 0
-
- set sessions [session_list]
- if {[llength $sessions]} {
- add_menu_separator
- set i 1
- foreach item $sessions {
- add_menu_command Other "$i $item" \
- [list session_load $item] \
- -underline 0
- }
- }
-
- add_menu_separator
-
- if {$tcl_platform(platform) == "windows"} {
- add_menu_command None "Page Setup..." \
- [format {
- set top %s
- ide_winprint page_setup -parent $top
- } [winfo toplevel [namespace tail $this]]] \
- -underline 8
- add_menu_command None "Print Source..." \
- "$this _apply_source print" \
- -underline 0 -accelerator "Ctrl+P"
- add_menu_separator
- }
-
- add_menu_command Other "Target Settings..." "set_target_name" \
- -underline 0
- add_menu_separator
- add_menu_command None "Exit" gdbtk_quit -underline 1
-
- create_run_menu
-
- create_view_menu
-
- if {[pref get gdb/control_target]} {
- create_control_menu
- }
-
- if {[pref get gdb/mode]} {
- create_trace_menu
- }
-
- new_menu pref "Preferences" 0
-
- add_menu_command Other "Global..." \
- "ManagedWin::open GlobalPref -transient" -underline 0
-
- add_menu_command Other "Source..." \
- "ManagedWin::open SrcPref -transient" -underline 0
-
- create_help_menu
- return 1
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_buttons - Add some buttons to the toolbar. Returns
- # list of buttons in form acceptable to
- # standard_toolbar.
- # This overrides the method in GDBToolBar.
- # ------------------------------------------------------------------
- public method create_buttons {} {
- global enable_external_editor
-
- add_button stop None {} {}
- _set_runstop
-
- if {[pref get gdb/mode]} {
- add_button tstop Control [list $this do_tstop] "Start Collection" \
- -image Movie_on_img
-
- add_button view Other [list $this set_control_mode 1] \
- "Switch to Browse Mode" -image watch_movie_img
-
- add_button_separator
-
- }
-
- if {[pref get gdb/control_target]} {
- create_control_buttons
- if {[pref get gdb/mode]} {
- create_trace_buttons 0
- }
- } elseif {[get pref gdb/mode]} {
-
- #
- # If we don't control the target, then we might as well
- # put a copy of the trace controls on the source window.
- #
- create_trace_buttons 1
- }
-
- add_button_separator
-
- create_window_buttons
-
- # Random bits of obscurity...
- bind $Buttons(reg) <Button-3> "ManagedWin::open RegWin -force"
- bind $Buttons(mem) <Button-3> "ManagedWin::open MemWin -force"
- bind $Buttons(watch) <Button-3> "ManagedWin::open WatchWin -force"
- bind $Buttons(vars) <Button-3> "ManagedWin::open LocalsWin -force"
-
- add_button_separator
-
- if {[info exists enable_external_editor] && $enable_external_editor} {
- add_button edit Other [list $this _apply_source edit] "Edit Source" \
- -image edit_img
-
- add_button_separator
- }
-
- add_label addr $address "Address" -width 10 -relief sunken -bd 1 -anchor e \
- -font src-font
-
- add_label line $line "Line Number" -width 6 -relief sunken -bd 1 -anchor e \
- -font src-font
-
- button_right_justify
-
- create_stack_buttons
-
- # This feature has been disabled for now.
- # checkbutton $ButtonFrame.upd -command "$this _toggle_updates" \
- # -variable GDBSrcBar_state($this)
- # lappend button_list $ButtonFrame.upd
- # global GDBSrcBar_state
- # ::set GDBSrcBar_state($this) $updatevalue
- # balloon register $ButtonFrame.upd "Toggle Window Updates"
-
- }
-
- # ------------------------------------------------------------------
- # METHOD: _toggle_updates - Run when the update checkbutton is
- # toggled. Private method.
- # ------------------------------------------------------------------
- public method _toggle_updates {} {
- global GDBSrcBar_state
- if {$updatecommand != ""} {
- uplevel \#0 $updatecommand $GDBSrcBar_state($this)
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: cancel_download
- # ------------------------------------------------------------------
- public method cancel_download {} {
- global download_dialog download_cancel_ok
-
- if {"$download_dialog" != ""} {
- $download_dialog cancel
- } else {
- set download_cancel_ok 1
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_run_menu - Creates the standard run menu,
- # or reconfigures it if it already exists.
- # ------------------------------------------------------------------
-
- method create_run_menu {} {
-
- if {![menu_exists Run]} {
- set run_menu [new_menu run "Run" 0]
- } else {
- set run_menu [clear_menu Run]
- }
-
- set is_native [TargetSelection::native_debugging]
-
- # If we are on a Unix target, put in the attach options. "ps" doesn't
- # give me the Windows PID yet, and the attach also seems flakey, so
- # I will hold off on the Windows implementation for now.
-
- if {$is_native} {
- if {[string compare $::tcl_platform(platform) windows] != 0} {
- add_menu_command Attach "Attach to process" \
- [code $this do_attach $run_menu] \
- -underline 0 -accelerator "Ctrl+A"
- }
- } else {
- add_menu_command Other "Connect to target" \
- "$this do_connect $run_menu" -underline 0
- }
-
- if {[pref get gdb/control_target]} {
- if {!$is_native} {
- add_menu_command Other "Download" Download::download_it \
- -underline 0 -accelerator "Ctrl+D"
- }
- add_menu_command Other "Run" [code $source inferior run] -underline 0 \
- -accelerator R
- }
-
- if {$is_native} {
- if {[string compare $::tcl_platform(platform) windows] != 0} {
- add_menu_command Detach "Detach" [code $this do_detach $run_menu] \
- -underline 0 -state disabled
- }
- } else {
- add_menu_command Other "Disconnect" \
- [code $this do_disconnect $run_menu] -underline 0 -state disabled
- }
-
- if {$is_native} {
- add_menu_separator
- add_menu_command Control "Kill" [code $this do_kill $run_menu] \
- -underline 0 -state disabled
- }
-
- if { [pref get gdb/mode] } {
- add_menu_separator
- add_menu_command Other "Start collection" "$this do_tstop" \
- -underline 0 -accelerator "Ctrl+B"
-
- add_menu_command Other "Stop collection" "$this do_tstop" \
- -underline 0 -accelerator "Ctrl+E" -state disabled
- }
-
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_stack_buttons - Creates the up down bottom stack buttons
- # ------------------------------------------------------------------
-
- method create_stack_buttons {} {
-
- add_button down {Trace Control} [list $this _apply_source stack down] \
- "Down Stack Frame" -image down_img
-
- add_button up {Trace Control} [list $this _apply_source stack up] \
- "Up Stack Frame" -image up_img
-
- add_button bottom {Trace Control} [list $this _apply_source stack bottom] \
- "Go to Bottom of Stack" -image bottom_img
-
- }
-
- # ------------------------------------------------------------------
- # METHOD: _set_runstop - Set state of run/stop button.
- # ------------------------------------------------------------------
- public method _set_runstop {} {
- switch $runstop {
- busy {
- $ButtonFrame.stop configure -state disabled
- }
- downloading {
- $ButtonFrame.stop configure -state normal -image stop_img \
- -command [code $this cancel_download]
- balloon register $ButtonFrame.stop "Stop"
- }
- running {
- $ButtonFrame.stop configure -state normal -image stop_img \
- -command [code $source inferior stop]
- balloon register $ButtonFrame.stop "Stop"
-
- }
- normal {
- $ButtonFrame.stop configure -state normal -image run_img \
- -command [code $source inferior run]
- balloon register $ButtonFrame.stop "Run (R)"
- }
- default {
- debug "SrcBar::_set_runstop - unknown state $runstop ($running)"
- }
- }
- }
-
-
- # ------------------------------------------------------------------
- # METHOD: _set_stepi - Set state of stepi/nexti buttons.
- # ------------------------------------------------------------------
- public method _set_stepi {} {
-
- # Only do this in synchronous mode
- if {!$Tracing} {
- # In source-only mode, disable these buttons. Otherwise, enable
- # them.
- if {$displaymode == "SOURCE"} {
- set state disabled
- } else {
- set state normal
- }
- $ButtonFrame.stepi configure -state $state
- $ButtonFrame.nexti configure -state $state
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: _apply_source - Forward some method call to the source window.
- # ------------------------------------------------------------------
- public method _apply_source {args} {
- if {$source != ""} {
- eval $source $args
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: trace_find_hook - response to the tfind command. If the
- # command puts us in a new mode, then switch modes...
- # ------------------------------------------------------------------
- method trace_find_hook {mode from_tty} {
- debug "in trace_find_hook, mode: $mode, from_tty: $from_tty, Browsing: $Browsing"
- if {[string compare $mode -1] == 0} {
- if {$Browsing} {
- set_control_mode 0
- }
- } else {
- if {!$Browsing} {
- set_control_mode 1
- }
- }
- }
- # ------------------------------------------------------------------
- # METHOD: set_control_mode - sets up the srcbar for browsing
- # a trace experiment.
- # mode: 1 => browse mode
- # 0 => control mode
- # ------------------------------------------------------------------
- method set_control_mode {mode} {
- debug "set_control_mode called with mode $mode"
- if {$mode} {
- set Browsing 1
- $Buttons(view) configure -image run_expt_img -command "$this set_control_mode 0"
- balloon register $Buttons(view) "Switch to Control mode"
- # Now swap out the buttons...
- swap_button_lists $Trace_control_buttons $Run_control_buttons
- enable_ui 1
- } else {
- if {$Browsing} {
- tfind_cmd {tfind none}
- }
- set Browsing 0
- $Buttons(view) configure -image watch_movie_img -command "$this set_control_mode 1"
- balloon register $Buttons(view) "Switch to Browse mode"
- # Now swap out the buttons...
- swap_button_lists $Run_control_buttons $Trace_control_buttons
- enable_ui 1
- }
- run_hooks control_mode_hook $Browsing
- }
-
-
- # ------------------------------------------------------------------
- # METHOD: reconfig - reconfigure the srcbar
- # ------------------------------------------------------------------
- public method reconfig {} {
- _load_src_images 1
- GDBToolBar::reconfig
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_attach: attach to a running target
- # ------------------------------------------------------------------
- method do_attach {menu} {
- gdbtk_attach_native
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_detach: detach from a running target
- # ------------------------------------------------------------------
- method do_detach {menu} {
- ::disconnect
- gdbtk_idle
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_kill: kill the current target
- # ------------------------------------------------------------------
- method do_kill {menu} {
- gdb_cmd "kill"
- run_hooks gdb_no_inferior_hook
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_connect: connect to a remote target
- # in asynch mode if async is 1
- # ------------------------------------------------------------------
- method do_connect {menu {async 0}} {
- global file_done
-
- debug "do_connect: menu=$menu async=$async"
-
- gdbtk_busy
-
- set result [gdbtk_attach_remote]
- switch $result {
- ATTACH_ERROR {
- set successful 0
- }
-
- ATTACH_TARGET_CHANGED {
- if {[pref get gdb/load/check] && $file_done} {
- set err [catch {gdb_cmd "compare-sections"} errTxt]
- if {$err} {
- set successful 0
- tk_messageBox -title "Error" -message $errTxt \
- -icon error -type ok
- break
- }
- }
-
- tk_messageBox -title "GDB" -message "Successfully connected" \
- -icon info -type ok
- set successful 1
- }
-
- ATTACH_CANCELED {
- tk_messageBox -title "GDB" -message "Connection Canceled" -icon info \
- -type ok
- set successful 0
- }
-
- ATTACH_TARGET_UNCHANGED {
- tk_messageBox -title "GDB" -message "Successfully connected" \
- -icon info -type ok
- set successful 1
- }
-
- default {
- dbug E "Unhandled response from gdbtk_attach_remote: \"$result\""
- set successful 0
- }
- }
-
- gdbtk_idle
-
- if {$successful} {
- $menu entryconfigure "Connect to target" -state disabled
- $menu entryconfigure "Disconnect" -state normal
- } else {
- $menu entryconfigure "Connect to target" -state normal
- $menu entryconfigure "Disconnect" -state disabled
- }
-
- # Whenever we attach, we need to do an update
- gdbtk_update
- }
-
-
- # ------------------------------------------------------------------
- # METHOD: do_disconnect: disconnect from a remote target
- # in asynch mode if async is 1.
- #
- # ------------------------------------------------------------------
- method do_disconnect {menu {async 0}} {
- debug "$menu $async"
- #
- # For now, these are the same, but they might be different...
- #
-
- disconnect $async
-
- $menu entryconfigure "Connect to target" -state normal
- $menu entryconfigure "Disconnect" -state disabled
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_tstop: Change the GUI state, then do the tstop or
- # tstart command, whichever is appropriate.
- #
- # ------------------------------------------------------------------
- method do_tstop {} {
- debug "do_tstop called... Collecting is $Collecting"
-
- if {!$Collecting} {
- #
- # Start the trace experiment
- #
-
- if {$Browsing} {
- set ret [tk_MessageBox -title "Warning" -message \
-"You are currently browsing a trace experiment.
-This command will clear the results of that experiment.
-Do you want to continue?" \
- -icon warning -type okcancel -default ok]
- if {[string compare $ret cancel] == 0} {
- return
- }
- set_control_mode 1
- }
- if {[tstart]} {
- $Buttons(tstop) configure -image Movie_off_img
- balloon register $Buttons(tstop) "End Collection"
- set Collecting 1
- } else {
- tk_messageBox -title Error -message "Error downloading tracepoint info" \
- -icon error -type ok
- }
- } else {
- #
- # Stop the trace experiment
- #
-
- if {[tstop]} {
- $Buttons(tstop) configure -image Movie_on_img
- balloon register $Buttons(tstop) "Start Collection"
- set Collecting 0
- }
- }
- }
-
- #
- # PROTECTED DATA
- #
- common menu_titles
-}
+++ /dev/null
-# SrcMenuBar
-# 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 menubar that is attached to a source window.
-#
-# PUBLIC ATTRIBUTES:
-#
-#
-# METHODS:
-#
-# configure ....... used to change public attributes
-#
-# PRIVATE METHODS
-#
-# X11 OPTION DATABASE ATTRIBUTES
-#
-#
-# ----------------------------------------------------------------------
-
-class SrcMenuBar {
- inherit GDBMenuBar
-
- # ------------------------------------------------------------------
- # CONSTRUCTOR - create widget
- # ------------------------------------------------------------------
- constructor {src args} {
- set source $src
-
- if {! [create_menu_items]} {
- destroy $this
- } else {
- [winfo toplevel $itk_interior] configure -menu $Menu
- }
-
- eval itk_initialize $args
- add_hook gdb_idle_hook "$this enable_ui 1"
- add_hook gdb_busy_hook "$this enable_ui 0"
- add_hook gdb_no_inferior_hook "$this enable_ui 2"
- add_hook gdb_set_hook "$this set_hook"
- add_hook control_mode_hook "$this set_control_mode"
- }
-
- # ------------------------------------------------------------------
- # DESTRUCTOR - destroy window containing widget
- # ------------------------------------------------------------------
- destructor {
- remove_hook gdb_idle_hook "$this enable_ui 1"
- remove_hook gdb_busy_hook "$this enable_ui 0"
- remove_hook gdb_no_inferior_hook "$this enable_ui 2"
- remove_hook gdb_set_hook "$this set_hook"
- remove_hook control_mode_hook "$this set_control_mode"
-
- #destroy $this
- }
-\f
- ####################################################################
- # The next set of functions create the common menu groupings that
- # are used in gdb menus.
- # Private. Used at contruction time.
- # These were previously at the GDBToolBar...
- ####################################################################
-
- # ------------------------------------------------------------------
- # METHOD: create_menu_items - Add some menu items to the menubar.
- # Returns 1 if any items added.
- # ------------------------------------------------------------------
- private method create_menu_items {} {
-
- create_file_menu
-
- create_run_menu
-
- create_view_menu
-
- if {[pref get gdb/control_target]} {
- create_control_menu
- }
-
- if {[pref get gdb/mode]} {
- create_trace_menu
- }
-
- create_pref_menu
-
- create_help_menu
-
- return 1
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_file_menu - Creates the standard file menu.
- # ------------------------------------------------------------------
-
- private method create_file_menu {} {
- global enable_external_editor tcl_platform
-
- menubar_new_menu file "File" 0
-
- if {[info exists enable_external_editor] && $enable_external_editor} {
- menubar_add_menu_command None "Edit Source" \
- [code $source edit]
- }
-
- menubar_add_menu_command Other "Open..." \
- "_open_file" -underline 0 -accelerator "Ctrl+O"
-
- menubar_add_menu_command Other "Source..." \
- "source_file" -underline 0
-
- set sessions [session_list]
- if {[llength $sessions]} {
- menubar_add_menu_separator
- set i 1
- foreach item $sessions {
- menubar_add_menu_command Other "$i $item" \
- [list session_load $item] \
- -underline 0
- incr i
- }
- }
-
- menubar_add_menu_separator
-
- if {$tcl_platform(platform) == "windows"} {
- menubar_add_menu_command None "Page Setup..." \
- [format {
- set top %s
- ide_winprint page_setup -parent $top
- } [winfo toplevel [namespace tail $this]]] \
- -underline 8
- }
-
- menubar_add_menu_command None "Print Source..." \
- [code $source print] \
- -underline 0 -accelerator "Ctrl+P"
-
- menubar_add_menu_separator
-
- menubar_add_menu_command Other "Target Settings..." "set_target_name" \
- -underline 0
-
- menubar_add_menu_separator
-
- menubar_add_menu_command None "Exit" gdbtk_quit -underline 1
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_run_menu - Creates the standard run menu,
- # or reconfigures it if it already exists.
- # ------------------------------------------------------------------
-
- private method create_run_menu {} {
-
- if {![menubar_menu_exists Run]} {
- set run_menu [menubar_new_menu run "Run" 0]
- } else {
- set run_menu [menubar_clear_menu Run]
- }
-
- set is_native [TargetSelection::native_debugging]
-
- # If we are on a Unix target, put in the attach options. "ps" doesn't
- # give me the Windows PID yet, and the attach also seems flakey, so
- # I will hold off on the Windows implementation for now.
-
- if {$is_native} {
- if {[string compare $::tcl_platform(platform) windows] != 0} {
- menubar_add_menu_command Attach "Attach to process" \
- [code $this do_attach $run_menu] \
- -underline 0 -accelerator "Ctrl+A"
- }
- } else {
- menubar_add_menu_command Other "Connect to target" \
- "$this do_connect $run_menu" -underline 0
- }
-
- if {[pref get gdb/control_target]} {
- if {!$is_native} {
- menubar_add_menu_command Other "Download" Download::download_it \
- -underline 0 -accelerator "Ctrl+D"
- }
- menubar_add_menu_command Other "Run" [code $source inferior run] \
- -underline 0 -accelerator R
- }
-
- if {$is_native} {
- if {[string compare $::tcl_platform(platform) windows] != 0} {
- menubar_add_menu_command Detach "Detach" \
- [code $this do_detach $run_menu] \
- -underline 0 -state disabled
- }
- } else {
- menubar_add_menu_command Other "Disconnect" \
- [code $this do_disconnect $run_menu] -underline 0 -state disabled
- }
-
- if {$is_native} {
- menubar_add_menu_separator
- menubar_add_menu_command Control "Kill" [code $this do_kill $run_menu] \
- -underline 0 -state disabled
- }
-
- if { [pref get gdb/mode] } {
- menubar_add_menu_separator
-
- menubar_add_menu_command Other "Start collection" "$this do_tstop" \
- -underline 0 -accelerator "Ctrl+B"
-
- menubar_add_menu_command Other "Stop collection" "$this do_tstop" \
- -underline 0 -accelerator "Ctrl+E" -state disabled
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_view_menu - Creates the standard view menu
- # ------------------------------------------------------------------
-
- private method create_view_menu {} {
-
- menubar_new_menu view "View" 0
-
- menubar_add_menu_command Other "Stack" {ManagedWin::open StackWin} \
- -underline 0 -accelerator "Ctrl+S"
-
- menubar_add_menu_command Other "Registers" {ManagedWin::open RegWin} \
- -underline 0 -accelerator "Ctrl+R"
-
- menubar_add_menu_command Other "Memory" {ManagedWin::open MemWin} \
- -underline 0 -accelerator "Ctrl+M"
-
- menubar_add_menu_command Other "Watch Expressions" \
- {ManagedWin::open WatchWin} \
- -underline 0 -accelerator "Ctrl+W"
- menubar_add_menu_command Other "Local Variables" \
- {ManagedWin::open LocalsWin} \
- -underline 0 -accelerator "Ctrl+L"
-
- if {[pref get gdb/control_target]} {
- menubar_add_menu_command Other "Breakpoints" \
- {ManagedWin::open BpWin -tracepoints 0} \
- -underline 0 -accelerator "Ctrl+B"
- }
-
- if {[pref get gdb/mode]} {
- menubar_add_menu_command Other "Tracepoints" \
- {ManagedWin::open BpWin -tracepoints 1} \
- -underline 0 -accelerator "Ctrl+T"
- menubar_add_menu_command Other "Tdump" {ManagedWin::open TdumpWin} \
- -underline 2 -accelerator "Ctrl+U"
- }
-
- menubar_add_menu_command Other "Console" {ManagedWin::open Console} \
- -underline 2 -accelerator "Ctrl+N"
-
- menubar_add_menu_command Other "Function Browser" \
- {ManagedWin::open BrowserWin} \
- -underline 1 -accelerator "Ctrl+F"
- menubar_add_menu_command Other "Thread List" \
- {ManagedWin::open ProcessWin} \
- -underline 0 -accelerator "Ctrl+H"
- if {[info exists ::env(GDBTK_DEBUG)] && $::env(GDBTK_DEBUG)} {
- menubar_add_menu_separator
- menubar_add_menu_command Other "Debug Window" \
- {ManagedWin::open DebugWin} \
- -underline 3 -accelerator "Ctrl+U"
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_control_menu - Creates the standard control menu
- # ------------------------------------------------------------------
-
- private method create_control_menu {} {
-
- menubar_new_menu cntrl "Control" 0
-
- menubar_add_menu_command Control "Step" [code $source inferior step] \
- -underline 0 -accelerator S
-
- menubar_add_menu_command Control "Next" [code $source inferior next] \
- -underline 0 -accelerator N
-
- menubar_add_menu_command Control "Finish" [code $source inferior finish] \
- -underline 0 -accelerator F
-
- menubar_add_menu_command Control "Continue" \
- [code $source inferior continue] \
- -underline 0 -accelerator C
-
- menubar_add_menu_separator
- menubar_add_menu_command Control "Step Asm Inst" \
- [code $source inferior stepi] \
- -underline 1 -accelerator S
-
- menubar_add_menu_command Control "Next Asm Inst" \
- [code $source inferior nexti] \
- -underline 1 -accelerator N
-
- # menubar_add_menu_separator
- # menubar_add_menu_command Other "Automatic Step" auto_step
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_trace_menu - Creates the standard trace menu
- # ------------------------------------------------------------------
-
- private method create_trace_menu {} {
-
- menubar_new_menu trace "Trace" 0
-
- menubar_add_menu_command Other "Save Trace Commands..." \
- "save_trace_commands" \
- -underline 0
-
- menubar_add_menu_separator
-
- menubar_add_menu_command Trace "Next Hit" {tfind_cmd tfind} \
- -underline 0 -accelerator N
-
- menubar_add_menu_command Trace "Previous Hit" {tfind_cmd "tfind -"} \
- -underline 0 -accelerator P
-
- menubar_add_menu_command Trace "First Hit" {tfind_cmd "tfind start"} \
- -underline 0 -accelerator F
-
- menubar_add_menu_command Trace "Next Line Hit" {tfind_cmd "tfind line"} \
- -underline 5 -accelerator L
-
- menubar_add_menu_command Trace "Next Hit Here" \
- {tfind_cmd "tfind tracepoint"} \
- -underline 9 -accelerator H
-
- menubar_add_menu_separator
- menubar_add_menu_command Trace "Tfind Line..." \
- "ManagedWin::open TfindArgs -Type LN" \
- -underline 9 -accelerator E
-
- menubar_add_menu_command Trace "Tfind PC..." \
- "ManagedWin::open TfindArgs -Type PC" \
- -underline 7 -accelerator C
-
- menubar_add_menu_command Trace "Tfind Tracepoint..." \
- "ManagedWin::open TfindArgs -Type TP" \
- -underline 6 -accelerator T
-
- menubar_add_menu_command Trace "Tfind Frame..." \
- "ManagedWin::open TfindArgs -Type FR" \
- -underline 6 -accelerator F
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_pref_menu - Creates the standard preferences menu
- # ------------------------------------------------------------------
- private method create_pref_menu {} {
-
- menubar_new_menu pref "Preferences" 0
-
- menubar_add_menu_command Other "Global..." \
- "ManagedWin::open GlobalPref -transient" -underline 0
-
- menubar_add_menu_command Other "Source..." \
- "ManagedWin::open SrcPref -transient" -underline 0
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_help_menu - Creates the standard help menu
- # ------------------------------------------------------------------
- private method create_help_menu {} {
-
- menubar_new_menu help "Help" 0
- menubar_add_menu_command Other "Help Topics" \
- {HtmlViewer::open_help index.html} \
- -underline 0
- menubar_add_menu_separator
- menubar_add_menu_command Other "About GDB..." \
- {ManagedWin::open About -transient} \
- -underline 0
- }
-\f
- ####################################################################
- #
- ####################################################################
-
- # ------------------------------------------------------------------
- # METHOD: set_control_mode - sets up the srcbar for browsing
- # a trace experiment.
- # mode: 1 => browse mode
- # 0 => control mode
- # ------------------------------------------------------------------
- method set_control_mode {mode} {
- debug "set_control_mode called with mode $mode"
- if {$mode} {
- set Browsing 1
- enable_ui 1
- } else {
- set Browsing 0
- enable_ui 1
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_attach: attach to a running target
- # ------------------------------------------------------------------
- method do_attach {menu} {
- gdbtk_attach_native
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_detach: detach from a running target
- # ------------------------------------------------------------------
- method do_detach {menu} {
- gdbtk_disconnect
- gdbtk_idle
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_kill: kill the current target
- # ------------------------------------------------------------------
- method do_kill {menu} {
- gdb_cmd "kill"
- run_hooks gdb_no_inferior_hook
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_connect: connect to a remote target
- # in asynch mode if async is 1
- # ------------------------------------------------------------------
- method do_connect {menu {async 0}} {
-
- set successful [gdbtk_connect $async]
-
- if {$successful} {
- $menu entryconfigure "Connect to target" -state disabled
- $menu entryconfigure "Disconnect" -state normal
- } else {
- $menu entryconfigure "Connect to target" -state normal
- $menu entryconfigure "Disconnect" -state disabled
- }
-
- # Make the menu reflect this change
- ::update idletasks
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_disconnect: disconnect from a remote target
- # in asynch mode if async is 1.
- #
- # ------------------------------------------------------------------
- method do_disconnect {menu {async 0}} {
- debug "$menu $async"
- #
- # For now, these are the same, but they might be different...
- #
-
- gdbtk_disconnect $async
-
- $menu entryconfigure "Connect to target" -state normal
- $menu entryconfigure "Disconnect" -state disabled
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_tstop: Change the GUI state, then do the tstop or
- # tstart command, whichever is appropriate.
- #
- # ------------------------------------------------------------------
- method do_tstop {} {
- debug "do_tstop called... Collecting is $Collecting"
-
- # FIXME: This must be done in conjuntion with the buttons
- # or the states won't match
-
- if {!$Collecting} {
- #
- # Start the trace experiment
- #
-
- if {$Browsing} {
- set ret [tk_messageBox -title "Warning" -message \
-"You are currently browsing a trace experiment.
-This command will clear the results of that experiment.
-Do you want to continue?" \
- -icon warning -type okcancel -default ok]
- if {[string compare $ret cancel] == 0} {
- return
- }
- set_control_mode 1
- }
- if {[tstart]} {
- # FIXME: Must enable the Stop Collection menu item and
- # disable the Start Collection item
- set Collecting 1
- } else {
- tk_messageBox -title Error -message "Error downloading tracepoint info" \
- -icon error -type ok
- }
- } else {
- #
- # Stop the trace experiment
- #
-
- if {[tstop]} {
- # FIXME: Must enable the Stop Collection menu item and
- # disable the Start Collection item
- set Collecting 0
- }
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: set_hook - run when user enters a `set' command.
- #
- # FIXME: Should not be accessing the base class internal data
- # As the spec says, one must clear the menu and recreate it.
- # ------------------------------------------------------------------
- method set_hook {varname value} {
- debug "Got $varname = $value"
-
- if {$varname == "os"} {
- # Make current_menu pointer point to the View Menu.
- # FIXME: Should not be accessing the base class internal data directly
- set view_menu [menu_find View]
- # Restore the current_menu pointer.
- set save_menu [menubar_set_current_menu $view_menu]
- set title "Kernel Objects"
-
- # Look for the KOD menu entry...
- if {[catch {$view_menu index $title} index]} {
- set index none
- }
-
- # FIXME: This assumes that the KOD menu is the last one as it does not
- # adjust the index information kept by the GDBMenuBar class.
- if {$value == ""} {
- # No OS, so remove KOD from View menu.
- if {$index != "none"} {
- # FIXME: Should not be accessing the base class internal data
- $view_menu delete $index
- }
- } else {
- # Add KOD to View menu, but only if it isn't already there.
- if {$index == "none"} {
- menubar_add_menu_command Other $title {ManagedWin::open KodWin} \
- -underline 0 -accelerator "Ctrl+K"
- }
- }
-
- # Restore the current_menu pointer.
- menubar_set_current_menu $save_menu
-
- global gdb_kod_cmd
- set gdb_kod_cmd $value
- }
- }
-\f
- ####################################################################
- # The following method enables/disables both menus and buttons.
- ####################################################################
-
- # ------------------------------------------------------------------
- # METHOD: enable_ui - enable/disable the appropriate buttons and menus
- # Called from the busy, idle, and no_inferior hooks.
- #
- # on must be:
- # value Control Other Trace State
- # 0 off off off gdb is busy
- # 1 on on off gdb has inferior, and is idle
- # 2 off on off gdb has no inferior, and is idle
- # ------------------------------------------------------------------
- public method enable_ui {on} {
- global tcl_platform
- debug "$on - Browsing=$Browsing"
-
- # Do the enabling so that all the disabling happens first, this way if a
- # button belongs to two groups, enabling takes precedence, which is
- # probably right.
-
- switch $on {
- 0 {
- set enable_list {Control disabled \
- Other disabled \
- Trace disabled \
- Attach disabled \
- Detach disabled}
- }
- 1 {
- if {!$Browsing} {
- set enable_list {Trace disabled \
- Control normal \
- Other normal \
- Attach disabled \
- Detach normal }
-# # set the states of stepi and nexti correctly
-# _set_stepi
- } else {
- set enable_list {Control disabled Other normal Trace normal}
- }
-
- }
- 2 {
- set enable_list {Control disabled \
- Trace disabled \
- Other normal \
- Attach normal \
- Detach disabled }
- }
- default {
- debug "Unknown type: $on in enable_ui"
- return
- }
- }
-
- set_class_state $enable_list
- }
-\f
- ####################################################################
- #
- # PRIVATE DATA
- #
- ####################################################################
-
- # This is a handle on our parent source window.
- private variable source {}
-
- ####################################################################
- #
- # PUBLIC DATA
- #
- ####################################################################
-
- # The next two determine the state of the application when Tracing is enabled.
-
- public variable Browsing 0 ;# Are we currently browsing a trace experiment?
- public variable Collecting 0 ;# Are we currently collecting a trace exp.?
-}
+++ /dev/null
-# SrcToolBar
-# 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 that is attached to a source window.
-#
-# PUBLIC ATTRIBUTES:
-#
-#
-# METHODS:
-#
-# configure ....... used to change public attributes
-#
-# PRIVATE METHODS
-#
-# X11 OPTION DATABASE ATTRIBUTES
-#
-#
-# ----------------------------------------------------------------------
-
-class SrcToolBar {
- inherit GDBToolBar
-
- # ------------------------------------------------------------------
- # CONSTRUCTOR - create widget
- # ------------------------------------------------------------------
- constructor {src args} {
- set source $src
- _load_images
- _load_src_images
-
- create_buttons
- toolbar_show
-
- eval itk_initialize $args
- add_hook gdb_idle_hook "$this enable_ui 1"
- add_hook gdb_busy_hook "$this enable_ui 0"
- add_hook gdb_no_inferior_hook "$this enable_ui 2"
- add_hook gdb_trace_find_hook "$this handle_trace_find_hook"
- }
-
- # ------------------------------------------------------------------
- # DESTRUCTOR - destroy window containing widget
- # ------------------------------------------------------------------
- destructor {
- global GDBSrcBar_state
-
- unset GDBSrcBar_state($this)
- remove_hook gdb_idle_hook "$this enable_ui 1"
- remove_hook gdb_busy_hook "$this enable_ui 0"
- remove_hook gdb_no_inferior_hook "$this enable_ui 2"
- remove_hook gdb_trace_find_hook "$this handle_trace_find_hook"
-
- #destroy $this
- }
-\f
- ####################################################################
- # The next set of functions are the generic button groups that gdb uses.
- # Private. Used at contruction time.
- # These were previously at the GDBToolBar...
- ####################################################################
-
- # ------------------------------------------------------------------
- # METHOD: create_buttons - Add some buttons to the toolbar.
- # Returns list of buttons in form acceptable
- # to standard_toolbar.
- # ------------------------------------------------------------------
- private method create_buttons {} {
- global enable_external_editor
-
- toolbar_add_button stop None {} {}
- _set_runstop
-
- if {[pref get gdb/mode]} {
- toolbar_add_button tstop Control \
- [list $this do_tstop] "Start Collection" \
- -image Movie_on_img
-
- toolbar_add_button view Other [list $this set_control_mode 1] \
- "Switch to Browse Mode" -image watch_movie_img
-
- toolbar_add_button_separator
-
- }
-
- if {[pref get gdb/control_target]} {
- create_control_buttons
- if {[pref get gdb/mode]} {
- create_trace_buttons 0
- }
- } elseif {[get pref gdb/mode]} {
-
- #
- # If we don't control the target, then we might as well
- # put a copy of the trace controls on the source window.
- #
- create_trace_buttons 1
- }
-
- toolbar_add_button_separator
-
- create_window_buttons
-
- # Random bits of obscurity...
- toolbar_bind_button reg <Button-3> "ManagedWin::open RegWin -force"
- toolbar_bind_button mem <Button-3> "ManagedWin::open MemWin -force"
- toolbar_bind_button watch <Button-3> "ManagedWin::open WatchWin -force"
- toolbar_bind_button vars <Button-3> "ManagedWin::open LocalsWin -force"
-
- toolbar_add_button_separator
-
- if {[info exists enable_external_editor] && $enable_external_editor} {
- toolbar_add_button edit Other [code $source edit] "Edit Source" \
- -image edit_img
-
- toolbar_add_button_separator
- }
-
- toolbar_add_label addr $address "Address" -width 10 -relief sunken \
- -bd 1 -anchor e -font src-font
-
- toolbar_add_label line $line "Line Number" -width 6 -relief sunken \
- -bd 1 -anchor e -font src-font
-
- toolbar_button_right_justify
-
- create_stack_buttons
-
- # This feature has been disabled for now.
- # checkbutton $ButtonFrame.upd -command "$this _toggle_updates" \
- # -variable GDBSrcBar_state($this)
- # lappend button_list $ButtonFrame.upd
- # global GDBSrcBar_state
- # ::set GDBSrcBar_state($this) $updatevalue
- # balloon register $ButtonFrame.upd "Toggle Window Updates"
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_control_buttons - Creates the step, continue, etc buttons.
- # ------------------------------------------------------------------
-
- private method create_control_buttons {} {
- toolbar_add_button step Control [code $source inferior step] \
- "Step (S)" -image step_img
-
- toolbar_add_button next Control [code $source inferior next] \
- "Next (N)" -image next_img
-
- toolbar_add_button finish Control [code $source inferior finish] \
- "Finish (F)" -image finish_img
-
- toolbar_add_button continue Control [code $source inferior continue] \
- "Continue (C)" -image continue_img
-
- # A spacer before the assembly-level items looks good. It helps
- # to indicate that these are somehow different.
- toolbar_add_button_separator
-
- toolbar_add_button stepi Control [code $source inferior stepi] \
- "Step Asm Inst (S)" -image stepi_img
-
- toolbar_add_button nexti Control [code $source inferior nexti] \
- "Next Asm Inst (N)" -image nexti_img
-
- _set_stepi
-
- set Run_control_buttons {step next finish continue -stepi nexti}
-
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_trace_buttons - Creates the next hit, etc.
- # ------------------------------------------------------------------
-
- private method create_trace_buttons {{show 0}} {
-
- if {$show} {
- set command toolbar_add_button
- } else {
- set command toolbar_create_button
- }
-
- $command tfindstart Trace {tfind_cmd "tfind start"} "First Hit <F>" \
- -image rewind_img
-
- $command tfind Trace {tfind_cmd tfind} "Next Hit <N>" -image next_hit_img
-
- $command tfindprev Trace {tfind_cmd "tfind -"} "Previous Hit <P>" \
- -image prev_hit_img
-
- $command tfindline Trace {tfind_cmd "tfind line"} "Next Line Hit <L>" \
- -image next_line_img
-
- $command tfindtp Trace { tfind_cmd "tfind tracepoint"} \
- "Next Hit Here <H>" -image next_check_img
-
- set Trace_control_buttons {tfindstart tfind tfindprev tfindline tfindtp}
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_window_buttons - Creates the registers, etc, buttons
- # ------------------------------------------------------------------
-
- private method create_window_buttons {} {
- toolbar_add_button reg Other {ManagedWin::open RegWin} \
- "Registers (Ctrl+R)" -image reg_img
-
- toolbar_add_button mem Other {ManagedWin::open MemWin} \
- "Memory (Ctrl+M)" -image memory_img
-
- toolbar_add_button stack Other {ManagedWin::open StackWin} \
- "Stack (Ctrl+S)" -image stack_img
-
- toolbar_add_button watch Other {ManagedWin::open WatchWin} \
- "Watch Expressions (Ctrl+W)" -image watch_img
-
- toolbar_add_button vars Other {ManagedWin::open LocalsWin} \
- "Local Variables (Ctrl+L)" -image vars_img
-
- if {[pref get gdb/control_target]} {
- toolbar_add_button bp Other {ManagedWin::open BpWin} \
- "Breakpoints (Ctrl+B)" -image bp_img
- }
-
- if {[pref get gdb/mode]} {
- toolbar_add_button tp Other {ManagedWin::open BpWin -tracepoints 1} \
- "Tracepoints (Ctrl+T)" -image tp_img
-
- toolbar_add_button tdump Trace {ManagedWin::open TdumpWin} \
- "Tdump (Ctrl+D)" -image tdump_img
- }
-
- toolbar_add_button con Other {ManagedWin::open Console} \
- "Console (Ctrl+N)" -image console_img
- }
-
- # ------------------------------------------------------------------
- # METHOD: create_stack_buttons - Creates the up down bottom stack buttons
- # ------------------------------------------------------------------
-
- private method create_stack_buttons {} {
-
- toolbar_add_button down {Trace Control} \
- [code $source stack down] \
- "Down Stack Frame" -image down_img
-
- toolbar_add_button up {Trace Control} \
- [code $source stack up] \
- "Up Stack Frame" -image up_img
-
- toolbar_add_button bottom {Trace Control} \
- [code $source stack bottom] \
- "Go to Bottom of Stack" -image bottom_img
-
- }
-\f
- ####################################################################
- #
- ####################################################################
-
- # ------------------------------------------------------------------
- # METHOD: _load_images - Load standard images. Private method.
- # ------------------------------------------------------------------
- public method _load_images { {reconfig 0} } {
- global gdb_ImageDir
- if {!$reconfig && $_loaded_images} {
- return
- }
- set _loaded_images 1
-
- lappend imgs console reg stack vmake vars watch memory bp
- foreach name $imgs {
- image create photo ${name}_img -file [file join $gdb_ImageDir ${name}.gif]
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: _load_src_images - Load standard images. Private method.
- # ------------------------------------------------------------------
- method _load_src_images { {reconf 0} } {
- global gdb_ImageDir
-
- if {!$reconf && $_loaded_src_images} {
- return
- }
- set _loaded_src_images 1
-
- foreach name {run stop step next finish continue edit \
- stepi nexti up down bottom Movie_on Movie_off \
- next_line next_check next_hit rewind prev_hit \
- watch_movie run_expt tdump tp} {
- image create photo ${name}_img -file [file join $gdb_ImageDir ${name}.gif]
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: _set_runstop - Set state of run/stop button.
- #
- # busy - Run button becomes disabled
- # running - Stop button appears, allowing user to stop executing target
- # downloading - Stop button appears, allowing user to interrupt downloading
- # normal - Run button appears, allowing user to run/re-run exe
- # ------------------------------------------------------------------
- public method _set_runstop {} {
- dbug W $runstop
-
- switch $runstop {
- busy {
- toolbar_configure_button stop -state disabled
- }
- downloading {
- toolbar_configure_button stop -state normal -image stop_img \
- -command [code $this cancel_download]
- toolbar_set_button_balloon stop "Stop"
- }
- running {
- toolbar_configure_button stop -state normal -image stop_img \
- -command [code $source inferior stop]
- toolbar_set_button_balloon stop "Stop"
- }
- normal {
- toolbar_configure_button stop -state normal -image run_img \
- -command [code $source inferior run]
- toolbar_set_button_balloon stop "Run (R)"
- }
- default {
- dbug W "unknown state $runstop"
- }
- }
- }
-
-
- # ------------------------------------------------------------------
- # METHOD: _set_stepi - Set state of stepi/nexti buttons.
- # ------------------------------------------------------------------
- public method _set_stepi {} {
-
- # Only do this in synchronous mode
- if {!$Tracing} {
- # In source-only mode, disable these buttons. Otherwise, enable
- # them.
- if {$displaymode == "SOURCE"} {
- set state disabled
- } else {
- set state normal
- }
- toolbar_configure_button stepi -state $state
- toolbar_configure_button nexti -state $state
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: handle_trace_find_hook - response to the tfind command.
- # If the command puts us in a new mode, then switch modes...
- # ------------------------------------------------------------------
- method handle_trace_find_hook {mode from_tty} {
- debug "mode: $mode, from_tty: $from_tty, Browsing: $Browsing"
- if {[string compare $mode -1] == 0} {
- if {$Browsing} {
- set_control_mode 0
- }
- } else {
- if {!$Browsing} {
- set_control_mode 1
- }
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: set_control_mode - sets up the srcbar for browsing
- # a trace experiment.
- # mode: 1 => browse mode
- # 0 => control mode
- # ------------------------------------------------------------------
- method set_control_mode {mode} {
- debug "set_control_mode called with mode $mode"
- if {$mode} {
- set Browsing 1
- toolbar_configure_button view -image run_expt_img \
- -command "$this set_control_mode 0"
- toolbar_set_button_balloon view "Switch to Control mode"
- # Now swap out the buttons...
- toolbar_swap_button_lists $Trace_control_buttons $Run_control_buttons
- enable_ui 1
- } else {
- if {$Browsing} {
- tfind_cmd {tfind none}
- }
- set Browsing 0
- toolbar_configure_button view -image watch_movie_img \
- -command "$this set_control_mode 1"
- toolbar_set_button_balloon view "Switch to Browse mode"
- # Now swap out the buttons...
- toolbar_swap_button_lists $Run_control_buttons $Trace_control_buttons
- enable_ui 1
- }
- run_hooks control_mode_hook $Browsing
- }
-
- # ------------------------------------------------------------------
- # METHOD: _toggle_updates - Run when the update checkbutton is
- # toggled. Private method.
- # ------------------------------------------------------------------
- public method _toggle_updates {} {
- global GDBSrcBar_state
- if {$updatecommand != ""} {
- uplevel \#0 $updatecommand $GDBSrcBar_state($this)
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: cancel_download
- # ------------------------------------------------------------------
- public method cancel_download {} {
- global download_dialog download_cancel_ok
-
- if {"$download_dialog" != ""} {
- $download_dialog cancel
- } else {
- set download_cancel_ok 1
- }
- }
-
- # ------------------------------------------------------------------
- # METHOD: reconfig - reconfigure the srcbar
- # used when preferences change
- # ------------------------------------------------------------------
- public method reconfig {} {
- debug
- _load_src_images 1
- _load_images 1
- # FIXME: Must Check if we are Tracing and set the buttons accordingly.
- }
-
- # ------------------------------------------------------------------
- # METHOD: do_tstop: Change the GUI state, then do the tstop or
- # tstart command, whichever is appropriate.
- #
- # ------------------------------------------------------------------
- method do_tstop {} {
- debug "do_tstop called... Collecting is $Collecting"
-
- # FIXME: This must be done in conjunction with the menu or the
- # states will mismatch.
-
- if {!$Collecting} {
- #
- # Start the trace experiment
- #
-
- if {$Browsing} {
- set ret [tk_messageBox -title "Warning" -message \
-"You are currently browsing a trace experiment.
-This command will clear the results of that experiment.
-Do you want to continue?" \
- -icon warning -type okcancel -default ok]
- if {[string compare $ret cancel] == 0} {
- return
- }
- set_control_mode 1
- }
- if {[tstart]} {
- toolbar_configure_button tstop -image Movie_off_img
- toolbar_set_button_balloon tstop "End Collection"
- set Collecting 1
- } else {
- tk_messageBox -title Error -message "Error downloading tracepoint info" \
- -icon error -type ok
- }
- } else {
- #
- # Stop the trace experiment
- #
-
- if {[tstop]} {
- toolbar_configure_button tstop -image Movie_on_img
- toolbar_set_button_balloon tstop "Start Collection"
- set Collecting 0
- }
- }
- }
-\f
- ####################################################################
- # The following method enables/disables both menus and buttons.
- ####################################################################
-
- # ------------------------------------------------------------------
- # METHOD: enable_ui - enable/disable the appropriate buttons and menus
- # Called from the busy, idle, and no_inferior hooks.
- #
- # on must be:
- # value Control Other Trace State
- # 0 off off off gdb is busy
- # 1 on on off gdb has inferior, and is idle
- # 2 off on off gdb has no inferior, and is idle
- # ------------------------------------------------------------------
- public method enable_ui {on} {
- global tcl_platform
- debug "$on - Browsing=$Browsing"
-
- # Do the enabling so that all the disabling happens first, this way if a
- # button belongs to two groups, enabling takes precedence, which is probably right.
-
- switch $on {
- 0 {
- # Busy
- set enable_list {Control disabled \
- Other disabled \
- Trace disabled \
- Attach disabled \
- Detach disabled}
- }
- 1 {
- # Idle, with inferior
- if {!$Browsing} {
- set enable_list {Trace disabled \
- Control normal \
- Other normal \
- Attach disabled \
- Detach normal }
- # set the states of stepi and nexti correctly
- _set_stepi
- } else {
- set enable_list {Control disabled Other normal Trace normal}
- }
-
- }
- 2 {
- # Idle, no inferior
- set enable_list {Control disabled \
- Trace disabled \
- Other normal \
- Attach normal \
- Detach disabled }
- }
- default {
- debug "Unknown type: $on in enable_ui"
- return
- }
- }
-
- set_class_state $enable_list
- }
-\f
- ####################################################################
- #
- # PRIVATE DATA
- #
- ####################################################################
-
- # This is a handle on our parent source window.
- private variable source {}
-
- #
- # FIXME - Need to break the images into the sets needed for
- # each button group, and load them when the button group is
- # created.
-
- # This is set if we've already loaded the standard images.
- private common _loaded_images 0
-
- # This is set if we've already loaded the standard images. Private
- # variable.
- private common _loaded_src_images 0
-
- # These buttons go in the control area when we are browsing
- protected variable Trace_control_buttons
-
- # And these go in the control area when we are running
- protected variable Run_control_buttons
-
- ####################################################################
- #
- # PUBLIC DATA
- #
- ####################################################################
-
- # This is the command that should be run when the `update'
- # checkbutton is toggled. The current value of the checkbutton is
- # appended to the command.
- public variable updatecommand {}
-
- # This controls whether the `update' checkbutton is turned on or
- # off.
- public variable updatevalue 0 {
- global GDBSrcBar_state
- ::set GDBSrcBar_state($this) $updatevalue
- }
-
- # This holds the text that is shown in the address label.
- public variable address {} {
- toolbar_configure_button addr -text $address -font src-font
- }
-
- # This holds the text that is shown in the line label.
- public variable line {} {
- toolbar_configure_button line -text $line
- }
-
- # This holds the source window's display mode. Valid values are
- # SOURCE, ASSEMBLY, SRC+ASM, and MIXED.
- public variable displaymode SOURCE {
- _set_stepi
- }
-
- # This indicates what is the inferior state.
- # Possible values are: {busy running downloading normal}
- public variable runstop normal {
- dbug W "configuring runstop $runstop"
-
- # Set the Run/Stop button accordingly
- _set_runstop
- }
-
- # The next three determine the state of the application when Tracing is enabled.
-
- public variable Tracing 0 ;# Is tracing enabled for this gdb?
- public variable Browsing 0 ;# Are we currently browsing a trace experiment?
- public variable Collecting 0 ;# Are we currently collecting a trace experiment?
-}
body SrcWin::_build_win {} {
global gdb_downloading gdb_running gdb_loaded
- # add a menu to the source window
- SrcMenuBar $this._menubar $this
-
# build source toolbar
set _toolbar [conAdd toolbar -resizable 0]
- SrcToolBar $_toolbar $this \
+ SrcBar $_toolbar $this \
-updatecommand [list $this toggle_updates] \
-updatevalue $do_updates
+ pack $_toolbar -expand 1 -fill both
# if user likes control on bottom...
if {! [pref get gdb/src/top_control]} {
set auto_index(set_target) [list source [file join $dir interface.tcl]]
set auto_index(run_executable) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_attach_remote) [list source [file join $dir interface.tcl]]
+set auto_index(gdbtk_connect) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_step) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_next) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_finish) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_attach_native) [list source [file join $dir interface.tcl]]
set auto_index(set_baud) [list source [file join $dir interface.tcl]]
set auto_index(do_state_hook) [list source [file join $dir interface.tcl]]
-set auto_index(disconnect) [list source [file join $dir interface.tcl]]
+set auto_index(gdbtk_disconnect) [list source [file join $dir interface.tcl]]
set auto_index(tstart) [list source [file join $dir interface.tcl]]
set auto_index(tstop) [list source [file join $dir interface.tcl]]
set auto_index(source_file) [list source [file join $dir interface.tcl]]
set auto_index(WatchWin) [list source [file join $dir watch.tcl]]
set auto_index(GDBMenuBar) [list source [file join $dir gdbmenubar.itcl]]
set auto_index(GDBToolBar) [list source [file join $dir gdbtoolbar.itcl]]
-set auto_index(SrcMenuBar) [list source [file join $dir srcmenubar.itcl]]
-set auto_index(SrcToolBar) [list source [file join $dir srctoolbar.itcl]]
+set auto_index(SrcBar) [list source [file join $dir srcbar.itcl]]
set auto_index(AttachDlg) [list source [file join $dir attachdlg.ith]]
set auto_index(Block) [list source [file join $dir blockframe.ith]]
set auto_index(Frame) [list source [file join $dir blockframe.ith]]
OSDN Git Service
