gdb/gdbtk/library/ipcpref.itb

   1 # IPC preferences dialog for Insight.
   2 # Copyright (C) 2004 Red Hat
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License (GPL) as published by
   6 # the Free Software Foundation; either version 2 of the License, or (at
   7 # your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14
  15 # ------------------------------------------------------------------
  16 #  CONSTRUCTOR - create new IPC preferences window
  17 # ------------------------------------------------------------------
  18 itcl::body IPCPref::constructor {args} {
  19   window_name "Insight IPC Preferences"
  20   _init_var
  21   _build_win
  22 }
  23
  24 # ------------------------------------------------------------------
  25 #  METHOD:  init_var - initialize preference variables
  26 # ------------------------------------------------------------------
  27 itcl::body IPCPref::_init_var {} {
  28   set vlist [list gdb/ipc/enabled gdb/ipc/port gdb/ipc/step_button gdb/ipc/stop_button \
  29                gdb/ipc/cont_button gdb/ipc/exit gdb/ipc/run_button]
  30
  31   foreach var $vlist {
  32     set _saved($var) [pref get $var]
  33     set _new($var) $_saved($var)
  34   }
  35 }
  36
  37
  38 # ------------------------------------------------------------------
  39 #  METHOD:  build_win - build the dialog
  40 # ------------------------------------------------------------------
  41 itcl::body IPCPref::_build_win {} {
  42   frame $itk_interior.f
  43   frame $itk_interior.f.a
  44   frame $itk_interior.f.b
  45   set f $itk_interior.f.a
  46
  47   # Description frame
  48   set d [labelframe $f.desc -text "Description"]
  49   label $d.txt -justify left -wraplength 6i -background $::Colors(textbg) \
  50     -text "Some multiprocessor systems use multiple instances of Insight \
  51 for debugging different CPUs.  In these cases it may be desirable to have \
  52 all the instances stop, start, or continue at the same time.  The IPC \
  53 feature can do that and more.\n\nThe IPC uses local TCP connections to the\
  54 port number specified below."
  55
  56   pack $d.txt -side top
  57
  58   checkbutton $f.enabled -text "Enable IPC" -variable [scope _new(gdb/ipc/enabled)]
  59   frame $f.port
  60   spinbox $f.port.box -from 0 -to 65535 -wrap 0\
  61     -width 6 -textvariable [scope _new(gdb/ipc/port)] -validate key \
  62     -vcmd {string is integer %P}
  63   label $f.port.label -text "TCP Port Number"
  64   pack $f.desc -expand yes -fill both
  65   pack $f.enabled  -anchor w -pady 10
  66   pack $f.port.box $f.port.label -side left -pady 10
  67   pack $f.port -anchor w -pady 10
  68
  69   set w [labelframe $f.buttons -text "Enable IPC on these buttons"]
  70   checkbutton $w.0 -text "Run" -variable [scope _new(gdb/ipc/run_button)]
  71   checkbutton $w.1 -text "Stop" -variable [scope _new(gdb/ipc/stop_button)]
  72   checkbutton $w.2 -text "Continue" -variable [scope _new(gdb/ipc/cont_button)]
  73   checkbutton $w.3 -text "Step" -variable [scope _new(gdb/ipc/step_button)]
  74   checkbutton $w.4 -text "Exit" -variable [scope _new(gdb/ipc/exit)]
  75   grid $w.0 $w.1 -padx 10 -pady 10 -sticky w
  76   grid $w.2 $w.3 -padx 10 -pady 10 -sticky w
  77   grid $w.4  -padx 10 -pady 10 -sticky w
  78   pack $w -fill both -expand yes
  79   pack $f.buttons -fill both -expand yes
  80
  81   button $itk_interior.f.b.ok -text OK -width 7 -underline 0 -command [code $this _save]
  82   button $itk_interior.f.b.quit -text Cancel -width 7 -underline 0 -command [code $this _cancel]
  83   standard_button_box $itk_interior.f.b
  84   pack $itk_interior.f.a $itk_interior.f.b $itk_interior.f -expand yes -fill both -padx 5 -pady 5
  85 }
  86
  87 # ------------------------------------------------------------------
  88 #  METHOD:  apply - apply changes
  89 # ------------------------------------------------------------------
  90 itcl::body IPCPref::_apply {} {
  91   set enable_changed 0
  92   if {[pref get gdb/ipc/enabled] != $_new(gdb/ipc/enabled)} {
  93     set enable_changed 1
  94   }
  95   if {$_new(gdb/ipc/enabled) && [pref get gdb/ipc/port] != $_new(gdb/ipc/port)} {
  96     set enable_changed 1
  97   }
  98
  99   foreach var [array names _new] {
 100     if {$_new($var) != [pref get $var]} {
 101       pref set $var $_new($var)
 102     }
 103   }
 104
 105   if {$enable_changed} {
 106     if {$_new(gdb/ipc/enabled)} {
 107       # must start up ipc
 108       catch {delete object $::insight_ipc}
 109       set ::insight_ipc [Iipc \#auto]
 110     } else {
 111       delete object $::insight_ipc
 112     }
 113   }
 114 }
 115
 116 # ------------------------------------------------------------------
 117 #  METHOD:  _cancel
 118 # ------------------------------------------------------------------
 119 itcl::body IPCPref::_cancel {} {
 120   foreach elem [array names _saved] {
 121     set cur_val [pref get $elem]
 122     if {[string compare $cur_val $_saved($elem)] != 0} {
 123       pref set $elem $_saved($elem)
 124     }
 125   }
 126   unpost
 127 }
 128
 129 # ------------------------------------------------------------------
 130 #  METHOD:  save - apply changes and quit
 131 # ------------------------------------------------------------------
 132 itcl::body IPCPref::_save {} {
 133   _apply
 134   unpost
 135 }