summaryrefslogtreecommitdiff
path: root/gdb/gdbtk/library/regwin.itb
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/gdbtk/library/regwin.itb')
-rw-r--r--gdb/gdbtk/library/regwin.itb697
1 files changed, 0 insertions, 697 deletions
diff --git a/gdb/gdbtk/library/regwin.itb b/gdb/gdbtk/library/regwin.itb
deleted file mode 100644
index 6ff1275c49f..00000000000
--- a/gdb/gdbtk/library/regwin.itb
+++ /dev/null
@@ -1,697 +0,0 @@
-# Register display window for Insight.
-# Copyright 1998, 1999, 2001 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 register window
-# ------------------------------------------------------------------
-body RegWin::constructor {args} {
- global tixOption
- debug
- wm withdraw [winfo toplevel $itk_interior]
- gdbtk_busy
-
- set NormalForeground $tixOption(fg)
- set HighlightForeground [pref get gdb/reg/highlight_fg]
-
- if {[pref getd gdb/reg/menu] != ""} {
- set mbar 0
- }
-
- init_reg_display_vars 1
- build_win
- eval itk_initialize $args
-
- gdbtk_idle
- add_hook gdb_update_hook "$this update"
- add_hook gdb_busy_hook [list $this busy]
- add_hook gdb_idle_hook [list $this idle]
- if {[get_disassembly_flavor] != ""} {
- add_hook gdb_set_hook [code $this handle_set_hook]
- }
-}
-
-# ------------------------------------------------------------------
-# DESTRUCTOR - destroy window containing widget
-# ------------------------------------------------------------------
-body RegWin::destructor {} {
- debug
- save_reg_display_vars
- remove_hook gdb_update_hook "$this update"
- remove_hook gdb_busy_hook [list $this busy]
- remove_hook gdb_idle_hook [list $this idle]
- if {[get_disassembly_flavor] != ""} {
- remove_hook gdb_set_hook [code $this handle_set_hook]
- }
-}
-
-
-# ------------------------------------------------------------------
-# METHOD: build_win - build the main register window
-# ------------------------------------------------------------------
-body RegWin::build_win {} {
- global reg_display tixOption tcl_platform
-
- set dim [dimensions]
- set nRows [lindex $dim 0]
- set nCols [lindex $dim 1]
- if {$tcl_platform(platform) == "windows"} {
- tixScrolledWindow $itk_interior.scrolled -scrollbar both -sizebox 1
- } else {
- tixScrolledWindow $itk_interior.scrolled -scrollbar auto
- }
- set ScrolledWin [$itk_interior.scrolled subwidget window]
-
- # Calculate the maximum length of a register name
- set regMaxLen 0
- foreach r [gdb_regnames] {
- set l [string length $r]
- if {$l > $regMaxLen} {
- set regMaxLen $l
- }
- }
-
- # Calculate the minimum size for each column so that the register values fit.
- set row 0
- set col 0
- foreach r $reg_display_list {
- if {$row == 0} {
- # A minimum of 10 so the appearence is nice
- set vmax($col) 10
- }
-
- # Typed registers natural values start with a brace (escaped by a slash)
- if {[catch {gdb_fetch_registers {} $r} valtest]} {
- set values($r) ""
- } else {
- if {[string index $valtest 1] == "\{"} {
- # If it is a typed register, we print it raw
- set format r
- set reg_display($r,format) r
- set reg_display($r,typed) 1
- set reg_display($r,editable) 0
- } else {
- set format $reg_display($r,format)
- set reg_display($r,editable) 1
- }
- if {[catch {gdb_fetch_registers $format $r} values($r)]} {
- set values($r) ""
- } else {
- set values($r) [string trim $values($r) \ ]
- }
- }
-
- set l [string length $values($r)]
- if {$l > $vmax($col)} {
- set vmax($col) $l
- }
- incr row
- if {$row == $nRows} {
- set row 0
- incr col
- }
- }
-
- # Create labels
- set row 0
- set col 0
- foreach r $reg_display_list {
- if {$row == $nRows} {
- grid columnconfigure $ScrolledWin $col -weight 1
- set row 0
- incr col
- }
-
- frame $ScrolledWin.$r -takefocus 1
- bind $ScrolledWin.$r <Up> "$this reg_select_up"
- bind $ScrolledWin.$r <Down> "$this reg_select_down"
- bind $ScrolledWin.$r <Tab> "$this reg_select_down"
- bind $ScrolledWin.$r <Left> "$this reg_select_left"
- bind $ScrolledWin.$r <Right> "$this reg_select_right"
- if {![pref get gdb/mode]} {
- bind $ScrolledWin.$r <Return> "$this edit $r"
- }
-
- label $ScrolledWin.$r.lbl -text [fixLength $reg_display($r,name) $regMaxLen left] \
- -relief solid -bd 1 -font src-font
- label $ScrolledWin.$r.val -anchor e -text [fixLength $values($r) $vmax($col) right] \
- -relief ridge -bd 1 -font src-font -bg $tixOption(input1_bg)
-
- grid $ScrolledWin.$r.lbl $ScrolledWin.$r.val -sticky nsew
- grid columnconfigure $ScrolledWin.$r 1 -weight 1
- grid $ScrolledWin.$r -colum $col -row $row -sticky nsew
- # grid rowconfigure $ScrolledWin $row -weight 1
- bind $ScrolledWin.$r.val <1> "$this reg_select $r"
- bind $ScrolledWin.$r.lbl <1> "$this reg_select $r"
- bind $ScrolledWin.$r.val <3> "$this but3 $r %X %Y"
- bind $ScrolledWin.$r.lbl <3> "$this but3 $r %X %Y"
- if {![pref get gdb/mode]} {
- bind $ScrolledWin.$r.lbl <Double-1> "$this edit $r"
- bind $ScrolledWin.$r.val <Double-1> "$this edit $r"
- }
- incr row
- }
- grid columnconfigure $ScrolledWin $col -weight 1
-
-
- if { $mbar } {
- menu $itk_interior.m -tearoff 0
- [winfo toplevel $itk_interior] configure -menu $itk_interior.m
- $itk_interior.m add cascade -menu $itk_interior.m.reg -label "Register" -underline 0
- set m [menu $itk_interior.m.reg]
- if {![pref get gdb/mode]} {
- $m add command -label "Edit" -underline 0 -state disabled
- }
- $m add cascade -menu $itk_interior.m.reg.format -label "Format" -underline 0
- set f [menu $itk_interior.m.reg.format]
- $f add radio -label "Hex" -value x -underline 0 -state disabled \
- -command "$this update"
- $f add radio -label "Decimal" -value d -underline 0 -state disabled \
- -command "$this update"
- $f add radio -label "Natural" -value {} -underline 0 -state disabled \
- -command "$this update"
- $f add radio -label "Binary" -value t -underline 0 -state disabled \
- -command "$this update"
- $f add radio -label "Octal" -value o -underline 0 -state disabled \
- -command "$this update"
- $f add radio -label "Raw" -value r -underline 0 -state disabled \
- -command "$this update"
- $f add radio -label "Floating Point" -value f -underline 0 -state disabled \
- -command "$this update"
- $m add command -label "Remove from Display" -underline 0 -state disabled
- $m add separator
- $m add command -label "Add to Watch" -underline 7 -state disabled
- $m add separator
- $m add command -label "Display All Registers" -underline 0 -state disabled \
- -command "$this display_all"
- set disp_all_menu_item [$m index last]
-
- if {!$all_regs_shown} {
- $m entryconfigure $disp_all_menu_item -state normal
- }
- }
-
- set Menu [menu $ScrolledWin.pop -tearoff 0]
- set disabled_fg [$Menu cget -fg]
- $Menu configure -disabledforeground $disabled_fg
-
- # Clear gdb's changed list
- catch {gdb_changed_register_list}
-
- pack $itk_interior.scrolled -anchor nw -fill both -expand yes
-
- window_name "Registers" "Regs"
-}
-
-# ------------------------------------------------------------------------------
-# NAME: init_reg_display_vars
-# DESC: Initialize the list of registers displayed.
-# args - not used
-# RETURNS:
-# NOTES:
-# ------------------------------------------------------------------------------
-body RegWin::init_reg_display_vars {args} {
- global reg_display max_regs
- set reg_display_list {}
- set regnames [gdb_regnames -numbers]
-
- set i 1
- set x 0
- foreach r $regnames {
- incr x
- set name [lindex $r 0]
- set rn [lindex $r 1]
- set reg_display($rn,name) $name
-
- # All registers shall be considered editable
- # and non-typed until proved otherwise
- set reg_display($rn,typed) 0
- set reg_display($rn,editable) 0
-
- # If user has no preference, show register in hex (if we can)
- set format [pref getd gdb/reg/$name-format]
- if {$format == ""} { set format x }
- set reg_display($rn,format) $format
-
- # Check if the user prefers not to show this register
- if {$args != "" && [pref getd gdb/reg/$name] == "no"} {
- set all_regs_shown 0
- set reg_display($rn,line) 0
- } else {
- set reg_display($rn,line) $i
- lappend reg_display_list $rn
- incr i
- }
- }
-
- set num_regs [expr {$i - 1}]
- set max_regs $x
- set reg_names_dirty 0
-}
-
-body RegWin::handle_set_hook {var value} {
- switch $var {
- disassembly-flavor {
- disassembly_changed
- }
- }
-}
-
-body RegWin::disassembly_changed {} {
- set reg_names_dirty 1
-}
-# ------------------------------------------------------------------------------
-# NAME: save_reg_display_vars
-# DESC: save the list of displayed registers to the preferences file.
-# ------------------------------------------------------------------------------
-body RegWin::save_reg_display_vars {} {
- global reg_display max_regs
- set regnames [gdb_regnames -numbers]
- foreach r $regnames {
- set rn [lindex $r 1]
- set name $reg_display($rn,name)
- if {$reg_display($rn,line) == 0} {
- pref setd gdb/reg/$name no
- } else {
- pref setd gdb/reg/$name {}
- }
- if {$reg_display($rn,format) != "x"} {
- pref setd gdb/reg/$name-format $reg_display($rn,format)
- } else {
- pref setd gdb/reg/$name-format {}
- }
- }
- pref_save ""
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: reg_select_up
-# ------------------------------------------------------------------
-body RegWin::reg_select_up { } {
- if { $selected == -1 || $Running} {
- return
- }
- set current_index [lsearch -exact $reg_display_list $selected]
- set new_reg [lindex $reg_display_list [expr {$current_index - 1}]]
- if { $new_reg != {} } {
- $this reg_select $new_reg
- }
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: reg_select_down
-# ------------------------------------------------------------------
-body RegWin::reg_select_down { } {
- if { $selected == -1 || $Running} {
- return
- }
- set current_index [lsearch -exact $reg_display_list $selected]
- set new_reg [lindex $reg_display_list [expr {$current_index + 1}]]
- if { $new_reg != {} } {
- $this reg_select $new_reg
- }
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: reg_select_right
-# ------------------------------------------------------------------
-body RegWin::reg_select_right { } {
- if { $selected == -1 || $Running} {
- return
- }
- set current_index [lsearch -exact $reg_display_list $selected]
- set new_reg [lindex $reg_display_list [expr {$current_index + $nRows}]]
- if { $new_reg != {} } {
- $this reg_select $new_reg
- }
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: reg_select_left
-# ------------------------------------------------------------------
-body RegWin::reg_select_left { } {
- if { $selected == -1 || $Running} {
- return
- }
- set current_index [lsearch -exact $reg_display_list $selected]
- set new_reg [lindex $reg_display_list [expr {$current_index - $nRows}]]
- if { $new_reg != {} } {
- $this reg_select $new_reg
- }
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: reg_select - select a register
-# ------------------------------------------------------------------
-body RegWin::reg_select { r } {
- global reg_display tixOption
-
- if {$Running} { return }
- if {$selected != -1} {
- catch {$ScrolledWin.$selected.lbl configure -fg $tixOption(fg) -bg $tixOption(bg)}
- catch {$ScrolledWin.$selected.val configure -fg $tixOption(fg) \
- -bg $tixOption(input1_bg)}
- }
-
- # if we click on the same line, unselect it and return
- if {$selected == $r} {
- set selected -1
- $itk_interior.m.reg entryconfigure 0 -state disabled
- $itk_interior.m.reg entryconfigure 2 -state disabled
- for {set i 0} {$i < 7} {incr i} {
- $itk_interior.m.reg.format entryconfigure $i -state disabled
- }
- return
- }
-
- if {$Editing != -1} {
- unedit
- }
-
- $ScrolledWin.$r.lbl configure -fg $tixOption(select_fg) -bg $tixOption(select_bg)
- $ScrolledWin.$r.val configure -fg $tixOption(fg) -bg $tixOption(bg)
-
- if {![pref get gdb/mode] && $reg_display($r,editable)} {
- $itk_interior.m.reg entryconfigure 0 -state normal -command "$this edit $r"
- }
- $itk_interior.m.reg entryconfigure 2 -state normal \
- -command "$this delete_from_display_list $r"
- if {$reg_display($r,typed)} {
- set state disabled
- } else {
- set state normal
- }
- for {set i 0} {$i < 7} {incr i} {
- debug "format $i $state"
- $itk_interior.m.reg.format entryconfigure $i -state $state \
- -variable reg_display($r,format)
- }
- $itk_interior.m.reg entryconfigure 4 -state normal \
- -command "$this addToWatch $r"
- focus -force $ScrolledWin.$r
- set selected $r
-}
-
-# ------------------------------------------------------------------
-# PRIVATE METHOD: dimensions - determine square-like dimensions for
-# register window
-# ------------------------------------------------------------------
-body RegWin::dimensions {} {
- set rows [pref get gdb/reg/rows]
- # set rows [expr int(floor(sqrt($num_regs)))]
- set cols [expr {int(ceil(sqrt($num_regs)))}]
-
- return [list $rows $cols]
-}
-
-# ------------------------------------------------------------------------------
-# NAME:
-# private method RegWin::fixLength
-#
-# SYNOPSIS:
-# fixLength {s size where}
-#
-# DESC:
-# Makes a string into a fixed-length string, inserting spaces as
-# necessary. If 'where' is "left" spaces will be added to the left,
-# if 'where' is "right" spaces will be added to the right.
-# ARGS:
-# s - input string
-# size - size of string to output
-# where - "left" or "right"
-#
-# RETURNS:
-# Padded string of length 'size'
-#
-# NOTES:
-# This should really be a proc, not a method.
-# ------------------------------------------------------------------------------
-body RegWin::fixLength {s size where} {
- set blank " "
- set len [string length $s]
- set bl [expr {$size - $len}]
- set b [string range $blank 0 $bl]
-
- switch $where {
- left { set fl "$s$b"}
- right { set fl "$b$s"}
- }
- return $fl
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: but3 - generate and display a popup window on button 3
-# over the register value
-# ------------------------------------------------------------------
-body RegWin::but3 {rn X Y} {
- global reg_display max_regs
-
- if {!$Running} {
- $Menu delete 0 end
- $Menu add command -label $reg_display($rn,name) -state disabled
- $Menu add separator
- if {!$reg_display($rn,typed)} {
- $Menu add radio -label "Hex" -command "$this update" \
- -value x -variable reg_display($rn,format)
- $Menu add radio -label "Decimal" -command "$this update" \
- -value d -variable reg_display($rn,format)
- $Menu add radio -label "Natural" -command "$this update" \
- -value {} -variable reg_display($rn,format)
- $Menu add radio -label "Binary" -command "$this update" \
- -value t -variable reg_display($rn,format) -underline 0
- $Menu add radio -label "Octal" -command "$this update" \
- -value o -variable reg_display($rn,format)
- $Menu add radio -label "Raw" -command "$this update" \
- -value r -variable reg_display($rn,format)
- $Menu add radio -label "Floating Point" -command "$this update" \
- -value f -variable reg_display($rn,format)
- $Menu add separator
- }
- $Menu add command -command "$this addToWatch $rn" \
- -label "Add $reg_display($rn,name) to Watch"
- $Menu add separator
- $Menu add command -command "$this delete_from_display_list $rn" \
- -label "Remove $reg_display($rn,name) from Display"
- if {$max_regs != $num_regs} {
- $Menu add separator
- $Menu add command -command "$this display_all" \
- -label "Display all registers"
- }
- tk_popup $Menu $X $Y
- }
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: display_all - add all registers to the display list
-# ------------------------------------------------------------------
-body RegWin::display_all {} {
- init_reg_display_vars
- $itk_interior.m.reg entryconfigure $disp_all_menu_item -state disabled
- set all_regs_shown 1
- reconfig
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: delete_from_display_list - remove a register from the
-# display list
-# ------------------------------------------------------------------
-body RegWin::delete_from_display_list {rn} {
- global reg_display max_regs
- set reg_display($rn,line) 0
- set reg_display_list {}
- set regnames [gdb_regnames -numbers]
- set i 0
- foreach r $regnames {
- set rnx [lindex $r 1]
- if {$reg_display($rnx,line) > 0} {
- lappend reg_display_list $rnx
- incr i
- set reg_display($rnx,line) $i
- }
- }
- set num_regs $i
- reconfig
- $itk_interior.m.reg entryconfigure 6 -state normal
-}
-
-
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: edit - edit a cell
-# ------------------------------------------------------------------
-body RegWin::edit {r} {
- global reg_display
- if {$Running} { return }
- if {!$reg_display($r,editable)} {return}
- unedit
-
- set Editing $r
- set txt [$ScrolledWin.$r.val cget -text]
- set len [string length $txt]
- set entry [entry $ScrolledWin.$r.ent -width $len -bd 0 -font src-font]
- $entry insert 0 $txt
-
- grid remove $ScrolledWin.$r.val
- grid $entry -row 0 -col 1
- bind $entry <Return> "$this acceptEdit $r"
- bind $entry <Escape> "$this unedit"
- $entry selection to end
- focus $entry
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: acceptEdit - callback invoked when enter key pressed
-# in an editing entry
-# ------------------------------------------------------------------
-body RegWin::acceptEdit {r} {
- global reg_display
-
- set value [string trimleft [$ScrolledWin.$r.ent get]]
- debug "value=${value}="
- if {$value == ""} {
- set value 0
- }
- if {[catch {gdb_cmd "set \$$reg_display($r,name)=$value"} result]} {
- tk_messageBox -icon error -type ok -message $result \
- -title "Error in Expression" -parent [winfo toplevel $itk_interior]
- focus $ScrolledWin.$r.ent
- $ScrolledWin.$r.ent selection to end
- } else {
- unedit
- gdbtk_update
- }
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: addToWatch - add a register to the watch window
-# ------------------------------------------------------------------
-body RegWin::addToWatch {reg} {
- global reg_display
- [ManagedWin::open WatchWin] add "\$$reg_display($reg,name)"
-}
-
-# ------------------------------------------------------------------
-# PUBLIC METHOD: unedit - clear any editing entry on the screen
-# ------------------------------------------------------------------
-body RegWin::unedit {} {
- if {$Editing != -1} {
- destroy $ScrolledWin.$Editing.ent
-
- # Fill the entry with the old label, updating value
- grid $ScrolledWin.$Editing.val -column 1 -row 0
- focus -force $ScrolledWin.$Editing
- set Editing -1
- update
- }
-}
-
-# ------------------------------------------------------------------
-# PRIVATE METHOD: update - update widget when PC changes
-# ------------------------------------------------------------------
-body RegWin::update {} {
- global reg_display
- debug "START REGISTER UPDATE CALLBACK"
- if {$reg_display_list == ""
- || [catch {eval gdb_changed_register_list $reg_display_list} changed_reg_list]} {
- set changed_reg_list {}
- }
-
- set row 0
- set col 0
- foreach r $reg_display_list {
- if {$row == 0} {
- # A minimum of 10 so the appearence is nice
- set vmax($col) 10
- }
-
- # Typed registers natural values start with a brace (escaped by a slash)
- if {[catch {gdb_fetch_registers {} $r} valtest]} {
- set values($r) ""
- } else {
- if {[string index $valtest 1] == "\{"} {
- # If it is a typed register, we print it raw
- set format r
- set reg_display($r,format) r
- set reg_display($r,typed) 1
- set reg_display($r,editable) 0
- } else {
- set format $reg_display($r,format)
- set reg_display($r,editable) 1
- }
- if {[catch {gdb_fetch_registers $format $r} values($r)]} {
- set values($r) ""
- } else {
- set values($r) [string trim $values($r) \ ]
- }
- }
-
- set l [string length $values($r)]
- if {$l > $vmax($col)} {
- set vmax($col) $l
- }
- incr row
- if {$row == $nRows} {
- set row 0
- incr col
- }
- }
-
- set row 0
- set col 0
- foreach r $reg_display_list {
- if {[lsearch -exact $changed_reg_list $r] != -1} {
- set fg $HighlightForeground
- } else {
- set fg $NormalForeground
- }
- $ScrolledWin.$r.val configure -text [fixLength $values($r) $vmax($col) right] \
- -fg $fg
- incr row
- if {$row == $nRows} {
- set row 0
- incr col
- }
- }
- debug "END REGISTER UPDATE CALLBACK"
-}
-
-body RegWin::idle {} {
- [winfo toplevel $itk_interior] configure -cursor {}
- set Running 0
-}
-
-# ------------------------------------------------------------------
-# PRIVATE METHOD: reconfig - used when preferences change
-# ------------------------------------------------------------------
-body RegWin::reconfig {} {
- if {$reg_names_dirty} {
- init_reg_display_vars
- }
- destroy $Menu $itk_interior.g $itk_interior.scrolled $itk_interior.m
- gdbtk_busy
- build_win
- gdbtk_idle
-}
-
-# ------------------------------------------------------------------
-# PRIVATE METHOD: busy - gdb_busy_hook
-# ------------------------------------------------------------------
-body RegWin::busy {} {
- # Cancel edits
- unedit
-
- # Fencepost
- set Running 1
-
- # cursor
- [winfo toplevel $itk_interior] configure -cursor watch
-}
View Lorry Controller Status