[pushed,gdb/testsuite] Add Term::get_line_with_attrs
Commit Message
Add a new proc Term::get_line_with_attrs, similar to Term::get_line, that
annotates a tuiterm line with the active attributes.
For instance, the line representing the TUI status window with attribute mode
standout looks like this with Term::get_line:
...
exec No process In: ... L?? PC: ??
...
but like this with Term::get_line_with_attrs:
...
<reverse:1>exec No process In: ... L?? PC: ?? <reverse:0>
...
Also add Term::dump_screen_with_attrs, a Term::dump_screen variant that uses
Term::get_line_with_attrs instead of Term::get_line.
Tested by re-running the TUI test-cases (gdb.tui/*.exp and gdb.python/tui*.exp)
on x86_64-linux.
---
gdb/testsuite/gdb.tui/basic.exp | 8 +++++
gdb/testsuite/lib/tuiterm.exp | 58 +++++++++++++++++++++++++++++----
2 files changed, 59 insertions(+), 7 deletions(-)
base-commit: a01399ff21e35422868c3853a31811c301a73883
@@ -106,3 +106,11 @@ Term::check_contents "split layout contents" \
Term::check_box "source box in split layout" 0 0 80 8
Term::check_box "asm box in split layout" 0 7 80 8
+
+set re_noattr "\[^<\]"
+
+set status_window_line 15
+
+set status [Term::get_line_with_attrs $status_window_line]
+gdb_assert { [regexp "^<reverse:1>$re_noattr*<reverse:0>$" $status] == 1} \
+ "status window: reverse"
@@ -875,10 +875,25 @@ namespace eval Term {
wait_for "^$str"
}
- # Return the text of screen line N, without attributes. Lines are
- # 0-based. If C is given, stop before column C. Columns are also
- # zero-based.
- proc get_line {n {c ""}} {
+ # Apply the attribute list in ATTRS to attributes array UPVAR_NAME.
+ # Return a string annotating the changed attributes.
+ proc apply_attrs { upvar_name attrs } {
+ set res ""
+ upvar $upvar_name var
+ foreach { attr val } $attrs {
+ if { $var($attr) != $val } {
+ append res "<$attr:$val>"
+ set var($attr) $val
+ }
+ }
+
+ return $res
+ }
+
+ # Return the text of screen line N. Lines are 0-based. If C is given,
+ # stop before column C. Columns are also zero-based. If ATTRS, annotate
+ # with attributes.
+ proc get_line_1 {n c attrs} {
variable _rows
# This can happen during resizing, if the cursor seems to
# temporarily be off-screen.
@@ -891,13 +906,37 @@ namespace eval Term {
variable _chars
set c [_default $c $_cols]
set x 0
+ if { $attrs } {
+ _reset_attrs line_attrs
+ }
while {$x < $c} {
+ if { $attrs } {
+ set char_attrs [lindex $_chars($x,$n) 1]
+ append result [apply_attrs line_attrs $char_attrs]
+ }
append result [lindex $_chars($x,$n) 0]
incr x
}
+ if { $attrs } {
+ _reset_attrs zero_attrs
+ set char_attrs [array get zero_attrs]
+ append result [apply_attrs line_attrs $char_attrs]
+ }
return $result
}
+ # Return the text of screen line N, without attributes. Lines are
+ # 0-based. If C is given, stop before column C. Columns are also
+ # zero-based.
+ proc get_line {n {c ""} } {
+ return [get_line_1 $n $c 0]
+ }
+
+ # As get_line, but annotate with attributes.
+ proc get_line_with_attrs {n {c ""}} {
+ return [get_line_1 $n $c 1]
+ }
+
# Get just the character at (X, Y).
proc get_char {x y} {
variable _chars
@@ -1079,8 +1118,8 @@ namespace eval Term {
}
# A debugging function to dump the current screen, with line
- # numbers.
- proc dump_screen {} {
+ # numbers. If ATTRS, annotate with attributes.
+ proc dump_screen { {attrs 0} } {
variable _rows
variable _cols
variable _cur_row
@@ -1090,10 +1129,15 @@ namespace eval Term {
for {set y 0} {$y < $_rows} {incr y} {
set fmt [format %5d $y]
- verbose -log "$fmt [get_line $y]"
+ verbose -log "$fmt [get_line_1 $y "" $attrs]"
}
}
+ # As dump_screen, but with attributes annotation.
+ proc dump_screen_with_attrs {} {
+ return [dump_screen 1]
+ }
+
# A debugging function to dump a box from the current screen, with line
# numbers.
proc dump_box { x y width height } {