* library/ipc.tcl: New file.
* library/ipcpref.ith: New file.
* library/ipcpref.itb: New file.
* library/srcwin.itb (SrcWin::inferior): Call ipc
send if enabled.
* library/prefs.tcl (pref_set_defaults): Enable color
schemes by default. Add IPC defaults.
* library/srcbar.itcl (create_pref_menu): Create
"Advanced" cascade menu and put "Edit Color Schemes"
and "IPC Support" under it.
* library/managedwin.itb (ManagedWin::destructor):
If IPC enabled then send "quit" on exit.
* library/main.tcl: Start IPC if enabled.
* library/prefs.tcl (pref_set_defaults): Add IPC defaults.
* library/gdbmenubar.itcl (menubar_get_current_menu):
New method.
+2004-08-27 Martin Hunt <hunt@redhat.com>
+
+ * library/ipc.tcl: New file.
+ * library/ipcpref.ith: New file.
+ * library/ipcpref.itb: New file.
+
+ * library/srcwin.itb (SrcWin::inferior): Call ipc
+ send if enabled.
+
+ * library/prefs.tcl (pref_set_defaults): Enable color
+ schemes by default. Add IPC defaults.
+
+ * library/srcbar.itcl (create_pref_menu): Create
+ "Advanced" cascade menu and put "Edit Color Schemes"
+ and "IPC Support" under it.
+
+ * library/managedwin.itb (ManagedWin::destructor):
+ If IPC enabled then send "quit" on exit.
+
+ * library/main.tcl: Start IPC if enabled.
+
+ * library/prefs.tcl (pref_set_defaults): Add IPC defaults.
+
+ * library/gdbmenubar.itcl (menubar_get_current_menu):
+ New method.
+
2004-08-09 Ben Elliston <bje@au.ibm.com>
* generic/gdbtk-register.c (get_register_size): Use
set current_menu $menup
return $saved_menu
}
+
+ # ------------------------------------------------------------------
+ # METHOD: menubar_get_current_menu - Get the current_menu pointer.
+ # Returns the current value so it can be restored.
+ # ------------------------------------------------------------------
+ method menubar_get_current_menu {} {
+ return $current_menu
+ }
\f
####################################################################
#
} else {
SrcWin::point_to_main
}
-
+
gdbtk_update
gdbtk_idle
} elseif {[pref get gdb/mode]} {
--- /dev/null
+# ipc.tcl
+# Copyright 2004 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 IPC for multiple Insight instances, allowing any Insight
+# to send commands to all other Insights on the same host.
+#
+# PUBLIC METHODS:
+#
+# send $cmd - sends $cmd to all Insights
+#
+# ----------------------------------------------------------------------
+
+itcl::class Iipc {
+
+ private variable socklist
+ private variable portnum 9909
+ private variable serversock
+
+ constructor {} {
+ init
+ }
+
+ destructor {
+ debug
+ foreach sock $socklist {
+ catch {::close $sock}
+ }
+
+ if {$serversock != "0"} {
+ catch {::close $serversock}
+ }
+ set ::iipc 0
+ }
+
+ private method init {} {
+ debug "iipc init"
+ set socklist {}
+ set serversock 0
+ set portnum [pref get gdb/ipc/port]
+ if {[catch {socket -server [code $this accept] $portnum} serversock]} {
+ debug "server already exists. Connecting to it."
+ set socklist [socket localhost $portnum]
+ fconfigure $socklist -buffering line -blocking 0
+ fileevent $socklist readable [code $this read $socklist]
+ }
+ set ::iipc 1
+ }
+
+ # accept new connection to server
+ private method accept {sock addr port} {
+ debug "accepting connecting from $sock -> $addr:$port"
+ fconfigure $sock -buffering line -blocking 0
+ lappend socklist $sock
+ fileevent $sock readable [code $this sread $sock]
+ }
+
+ private method read {s} {
+ if [eof $s] {
+ debug "The server died on $s!!"
+ catch {::close $s}
+ init
+ return
+ }
+ gets $s res
+ debug "Server: $res"
+ switch $res {
+ quit { gdb_force_quit }
+ stop { gdbtk_stop }
+ run { gdbtk_run }
+ default {
+ catch {gdb_immediate "$res"}
+ }
+ }
+ }
+
+ # server read method. Reads data then forwards
+ # it to all listening sockets.
+ private method sread {s} {
+ if [eof $s] {
+ close $s
+ return
+ }
+ gets $s res
+ if {$res != ""} {
+ debug "Got: $res"
+ foreach sock $socklist {
+ if {$s != $sock} {
+ if {[catch {puts $sock $res}]} {
+ close $sock
+ }
+ }
+ }
+ switch $res {
+ quit { gdb_force_quit }
+ stop { gdbtk_stop }
+ run { gdbtk_run }
+ default {
+ catch {gdb_immediate "$res"}
+ }
+ }
+ }
+ }
+
+ # send data to all sockets.
+ public method send {cmd} {
+ debug "send $cmd"
+ foreach sock $socklist {
+ if {[catch {puts $sock $cmd}]} {
+ close $sock
+ }
+ }
+ }
+
+ private method close {s} {
+ debug "closing socket $s"
+ set socklist [lremove $socklist $s]
+ catch {::close $s}
+ }
+}
+
+
+
+
+
--- /dev/null
+# IPC preferences dialog for Insight.
+# Copyright 2004 Red Hat
+#
+# 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.
+
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR - create new IPC preferences window
+# ------------------------------------------------------------------
+itcl::body IPCPref::constructor {args} {
+ window_name "Insight IPC Preferences"
+ _init_var
+ _build_win
+}
+
+# ------------------------------------------------------------------
+# METHOD: init_var - initialize preference variables
+# ------------------------------------------------------------------
+itcl::body IPCPref::_init_var {} {
+ set vlist [list gdb/ipc/enabled gdb/ipc/port gdb/ipc/step_button gdb/ipc/stop_button \
+ gdb/ipc/cont_button gdb/ipc/exit gdb/ipc/run_button]
+
+ foreach var $vlist {
+ set _saved($var) [pref get $var]
+ set _new($var) $_saved($var)
+ }
+}
+
+
+# ------------------------------------------------------------------
+# METHOD: build_win - build the dialog
+# ------------------------------------------------------------------
+itcl::body IPCPref::_build_win {} {
+ frame $itk_interior.f
+ frame $itk_interior.f.a
+ frame $itk_interior.f.b
+ set f $itk_interior.f.a
+
+ # Description frame
+ set d [labelframe $f.desc -text "Description"]
+ label $d.txt -justify left -wraplength 6i -background $::Colors(textbg) \
+ -text "Some multiprocessor systems use multiple instances of Insight \
+for debugging different CPUs. In these cases it may be desirable to have \
+all the instances stop, start, or continue at the same time. The IPC \
+feature can do that and more.\n\nThe IPC uses local TCP connections to the\
+port number specified below."
+
+ pack $d.txt -side top
+
+ checkbutton $f.enabled -text "Enable IPC" -variable [scope _new(gdb/ipc/enabled)]
+ frame $f.port
+ spinbox $f.port.box -from 0 -to 65535 -wrap 0\
+ -width 6 -textvariable [scope _new(gdb/ipc/port)] -validate key \
+ -vcmd {string is integer %P}
+ label $f.port.label -text "TCP Port Number"
+ pack $f.desc -expand yes -fill both
+ pack $f.enabled -anchor w -pady 10
+ pack $f.port.box $f.port.label -side left -pady 10
+ pack $f.port -anchor w -pady 10
+
+ set w [labelframe $f.buttons -text "Enable IPC on these buttons"]
+ checkbutton $w.0 -text "Run" -variable [scope _new(gdb/ipc/run_button)]
+ checkbutton $w.1 -text "Stop" -variable [scope _new(gdb/ipc/stop_button)]
+ checkbutton $w.2 -text "Continue" -variable [scope _new(gdb/ipc/cont_button)]
+ checkbutton $w.3 -text "Step" -variable [scope _new(gdb/ipc/step_button)]
+ checkbutton $w.4 -text "Exit" -variable [scope _new(gdb/ipc/exit)]
+ grid $w.0 $w.1 -padx 10 -pady 10 -sticky w
+ grid $w.2 $w.3 -padx 10 -pady 10 -sticky w
+ grid $w.4 -padx 10 -pady 10 -sticky w
+ pack $w -fill both -expand yes
+ pack $f.buttons -fill both -expand yes
+
+ button $itk_interior.f.b.ok -text OK -width 7 -underline 0 -command [code $this _save]
+ button $itk_interior.f.b.quit -text Cancel -width 7 -underline 0 -command [code $this _cancel]
+ standard_button_box $itk_interior.f.b
+ pack $itk_interior.f.a $itk_interior.f.b $itk_interior.f -expand yes -fill both -padx 5 -pady 5
+}
+
+# ------------------------------------------------------------------
+# METHOD: apply - apply changes
+# ------------------------------------------------------------------
+itcl::body IPCPref::_apply {} {
+ set enable_changed 0
+ if {[pref get gdb/ipc/enabled] != $_new(gdb/ipc/enabled)} {
+ set enable_changed 1
+ }
+ if {$_new(gdb/ipc/enabled) && [pref get gdb/ipc/port] != $_new(gdb/ipc/port)} {
+ set enable_changed 1
+ }
+
+ foreach var [array names _new] {
+ if {$_new($var) != [pref get $var]} {
+ pref set $var $_new($var)
+ }
+ }
+
+ if {$enable_changed} {
+ if {$_new(gdb/ipc/enabled)} {
+ # must start up ipc
+ catch {delete object $::insight_ipc}
+ set ::insight_ipc [Iipc \#auto]
+ } else {
+ delete object $::insight_ipc
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: _cancel
+# ------------------------------------------------------------------
+itcl::body IPCPref::_cancel {} {
+ foreach elem [array names _saved] {
+ set cur_val [pref get $elem]
+ if {[string compare $cur_val $_saved($elem)] != 0} {
+ pref set $elem $_saved($elem)
+ }
+ }
+ unpost
+}
+
+# ------------------------------------------------------------------
+# METHOD: save - apply changes and quit
+# ------------------------------------------------------------------
+itcl::body IPCPref::_save {} {
+ _apply
+ unpost
+}
--- /dev/null
+# IPC preferences dialog class definition for Insight.
+# Copyright 2004, 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.
+
+
+itcl::class IPCPref {
+ inherit ManagedWin ModalDialog
+
+ private {
+ variable _saved ;# These are the saved values...
+ variable _new ;# These are the changed values
+ variable w
+ method _apply {}
+ method _build_win {}
+ method _cancel {}
+ method _init_var {}
+ method _save {}
+ }
+
+ public {
+ method constructor {args}
+ method reconfig {}
+ }
+}
# GDBtk (Insight) entry point
-# Copyright 1997, 1998, 1999, 2002, 2003 Red Hat, Inc.
+# Copyright 1997, 1998, 1999, 2002, 2003, 2004 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
# Uncomment the next line if you want a splash screen at startup...
# ManagedWin::open About -transient -expire 5000
+# initialize IPC to enable multiple Insight's to communicate
+# with each other.
+set iipc 0
+if {[pref get gdb/ipc/enabled]} {
+ set ::insight_ipc [Iipc \#auto]
+}
+
gdbtk_idle
# splash screen at startup...
if {!$numTopWins && [quit_if_last]} {
+ if {$::iipc && [pref get gdb/ipc/exit]} {
+ $::insight_ipc send quit
+ }
gdb_force_quit
} else {
destroy_toplevel
# FIXME: this is broken. We should discover the list
# dynamically.
lappend secs load console src reg stack locals watch bp search \
- process geometry help browser kod window session mem bg
+ process geometry help browser kod window session mem bg ipc
foreach section $secs {
puts $fd "\[$section\]"
# background colors
set ::gdb_bg_num 0
- pref define gdb/use_color_schemes 0
+ pref define gdb/use_color_schemes 1
pref define gdb/bg/0 \#ffffff
pref define gdb/bg/1 \#ffffd0
pref define gdb/bg/2 \#ffd0ff
pref define gdb/bg/13 \#b0b0ff
pref define gdb/bg/14 \#b0b0b0
pref define gdb/bg/15 \#d0b0d0
+
+ # IPC prefs
+ # set prefs based on GDB version?
+ #set vers [lindex [split [lindex [split [gdb_cmd "show version"]] end-1 ] \"] 1]
+ pref define gdb/ipc/enabled 1
+ pref define gdb/ipc/port 9909
+ pref define gdb/ipc/stop_button 1
+ pref define gdb/ipc/step_button 1
+ pref define gdb/ipc/cont_button 1
+ pref define gdb/ipc/run_button 1
+ pref define gdb/ipc/exit 1
}
$Menu add command Other "Source..." \
"ManagedWin::open SrcPref -transient" -underline 0
- $Menu add command Color "Edit Color Schemes..." \
- "ManagedWin::open CSPref -transient" -underline 0
-
+ set save_menu [$Menu menubar_get_current_menu]
+
+ set advanced_menu [$Menu add cascade adv Advanced "Advanced" 0]
+
+ $advanced_menu add command -label "Edit Color Schemes..." -underline 0 \
+ -command "ManagedWin::open CSPref -transient" -underline 0
+
+ $advanced_menu add command -label "IPC Support..." -underline 0 \
+ -command "ManagedWin::open IPCPref -transient" -underline 0
+
+ $Menu menubar_set_current_menu $save_menu
+
$Menu add separator
set color_menu [$Menu add cascade use_cs Color "Use Color Scheme" 0]
# Source window for Insight.
-# Copyright 1997, 1998, 1999, 2000, 2001, 2002, 2003 Red Hat, Inc.
+# Copyright 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 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
# Unfortunately, this doesn't exist, so it's here for now.
itcl::body SrcWin::inferior {action} {
+ # Check to see if this action is forwarded to other Insight instances
+ if {$::iipc} {
+ switch $action {
+ step -
+ next -
+ stepi -
+ nexti -
+ finish {
+ if {[pref get gdb/ipc/step_button]} {
+ $::insight_ipc send $action
+ }
+ }
+ continue {
+ if {[pref get gdb/ipc/cont_button]} {
+ $::insight_ipc send $action
+ }
+ }
+ run {
+ if {[pref get gdb/ipc/run_button]} {
+ $::insight_ipc send $action
+ }
+ }
+ stop {
+ if {[pref get gdb/ipc/stop_button]} {
+ $::insight_ipc send $action
+ }
+ }
+ }
+ }
+
switch $action {
step { gdbtk_step }
-
next { gdbtk_next }
-
finish { gdbtk_finish }
-
continue { gdbtk_continue }
-
stepi { gdbtk_stepi }
-
nexti { gdbtk_nexti }
-
run { gdbtk_run }
-
stop { gdbtk_stop }
}
}
set auto_index(initialize_gdbtk) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_tcl_architecture_changed) [list source [file join $dir interface.tcl]]
set auto_index(gdbtk_console_read) [list source [file join $dir interface.tcl]]
+set auto_index(Iipc) [list source [file join $dir ipc.tcl]]
set auto_index(LocalsWin) [list source [file join $dir locals.tcl]]
set auto_index(ModalDialog) [list source [file join $dir modal.tcl]]
set auto_index(pref_read) [list source [file join $dir prefs.tcl]]
set auto_index(::Session::delete) [list source [file join $dir session.tcl]]
set auto_index(::Session::list_names) [list source [file join $dir session.tcl]]
set auto_index(TdumpWin) [list source [file join $dir tdump.tcl]]
-set auto_index(TfindArgs) [list source [file join $dir tfind_args.tcl]]
set auto_index(TraceDlg) [list source [file join $dir tracedlg.tcl]]
set auto_index(gdb_add_tracepoint) [list source [file join $dir tracedlg.tcl]]
set auto_index(gdb_edit_tracepoint) [list source [file join $dir tracedlg.tcl]]
set auto_index(ArchChangedEvent) [list source [file join $dir gdbevent.ith]]
set auto_index(GDBWin) [list source [file join $dir gdbwin.ith]]
set auto_index(GlobalPref) [list source [file join $dir globalpref.ith]]
+set auto_index(IPCPref) [list source [file join $dir ipcpref.ith]]
set auto_index(KodWin) [list source [file join $dir kod.ith]]
set auto_index(ManagedWin) [list source [file join $dir managedwin.ith]]
set auto_index(MemPref) [list source [file join $dir mempref.ith]]
set auto_index(::GlobalPref::_apply) [list source [file join $dir globalpref.itb]]
set auto_index(::GlobalPref::_cancel) [list source [file join $dir globalpref.itb]]
set auto_index(::GlobalPref::cancel) [list source [file join $dir globalpref.itb]]
+set auto_index(::IPCPref::constructor) [list source [file join $dir ipcpref.itb]]
+set auto_index(::IPCPref::_init_var) [list source [file join $dir ipcpref.itb]]
+set auto_index(::IPCPref::_build_win) [list source [file join $dir ipcpref.itb]]
+set auto_index(::IPCPref::_apply) [list source [file join $dir ipcpref.itb]]
+set auto_index(::IPCPref::_cancel) [list source [file join $dir ipcpref.itb]]
+set auto_index(::IPCPref::_save) [list source [file join $dir ipcpref.itb]]
set auto_index(::KodWin::constructor) [list source [file join $dir kod.itb]]
set auto_index(::KodWin::build_win) [list source [file join $dir kod.itb]]
set auto_index(::KodWin::update) [list source [file join $dir kod.itb]]
OSDN Git Service
