[pushed] [gdb/testsuite] Add Term::get_line_with_attrs

[pushed] [gdb/testsuite] Add Term::get_line_with_attrs

[Tom de Vries]

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(-)

diff --git a/gdb/testsuite/gdb.tui/basic.exp b/gdb/testsuite/gdb.tui/basic.exp
index ec1e9945e8f..2c55c2b95bc 100644
--- a/gdb/testsuite/gdb.tui/basic.exp
+++ b/gdb/testsuite/gdb.tui/basic.exp
@@ -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"
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 361fce83a79..5c0be85ee73 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -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 } {

base-commit: a01399ff21e35422868c3853a31811c301a73883
-- 
2.35.3