gdb/gdbtk/library/tdump.tcl

   1 # Trace dump window for Insight
   2 # Copyright (C) 1998, 1999, 2001, 2002, 2004, 2008 Red Hat, Inc.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License (GPL) as published by
   6 # the Free Software Foundation; either version 2 of the License, or (at
   7 # your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14
  15 # ----------------------------------------------------------------------
  16 # Implements Tdump window for gdb
  17 #
  18 #   PUBLIC ATTRIBUTES:
  19 #
  20 #
  21 #   METHODS:
  22 #
  23 #     reconfig ....... called when preferences change
  24 #
  25 #
  26 #   X11 OPTION DATABASE ATTRIBUTES
  27 #
  28 #
  29 # ----------------------------------------------------------------------
  30
  31 itcl::class TdumpWin {
  32   inherit ManagedWin GDBWin
  33
  34   # ------------------------------------------------------------------
  35   #  CONSTRUCTOR - create new tdump window
  36   # ------------------------------------------------------------------
  37   constructor {args} {
  38     window_name "Trace Dump"
  39     build_win
  40     eval itk_initialize $args
  41   }
  42
  43
  44   # ------------------------------------------------------------------
  45   #  METHOD:  build_win - build the main tdump window
  46   # ------------------------------------------------------------------
  47   method build_win {} {
  48     itk_component add stext {
  49       iwidgets::scrolledtext $itk_interior.stext -hscrollmode dynamic \
  50         -vscrollmode dynamic -textfont global/fixed \
  51         -background $::Colors(bg)
  52     } {}
  53     [$itk_component(stext) component text] configure \
  54       -background $::Colors(bg)
  55     pack $itk_component(stext) -side left -expand yes -fill both
  56     update dummy
  57   }
  58
  59
  60   # ------------------------------------------------------------------
  61   #  METHOD:  update - update widget when PC changes
  62   # ------------------------------------------------------------------
  63   method update {event} {
  64     #debug "tdump: update"
  65     gdbtk_busy
  66     set tframe_num [gdb_get_trace_frame_num]
  67
  68     if { $tframe_num!=-1 } {
  69       debug "doing tdump"
  70       $itk_component(stext) delete 1.0 end
  71
  72       if {[catch {gdb_cmd "tdump $tframe_num" 0} tdump_output]} {
  73         tk_messageBox -title "Error" -message $tdump_output -icon error \
  74           -type ok
  75       } else {
  76         #debug "tdum output is $tdump_output"
  77
  78         $itk_component(stext) insert end $tdump_output
  79         $itk_component(stext) see insert
  80       }
  81     }
  82     gdbtk_idle
  83   }
  84
  85   # ------------------------------------------------------------------
  86   #  METHOD:  reconfig - used when preferences change
  87   # ------------------------------------------------------------------
  88   method reconfig {} {
  89     if {[winfo exists $itk_interior.stext]} { destroy $itk_interior.stext }
  90     build_win
  91   }
  92 }
  93