[gdb/testsuite] Add Term::get_line_with_attrs
authorTom de Vries <tdevries@suse.de>
Mon, 22 May 2023 10:02:43 +0000 (12:02 +0200)
committerTom de Vries <tdevries@suse.de>
Mon, 22 May 2023 10:02:43 +0000 (12:02 +0200)
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
gdb/testsuite/lib/tuiterm.exp

index ec1e9945e8f37eca22865d4a2d3e6e7ef82547d3..2c55c2b95bc6737572f98165430e906a294528ab 100644 (file)
@@ -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"
index 361fce83a7908d961c92b83366b9beabbabd4191..5c0be85ee738bab29039420a1d71023f317589e0 100644 (file)
@@ -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 } {