aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom de Vries <tdevries@suse.de>2025-08-14 18:38:30 +0200
committerTom de Vries <tdevries@suse.de>2025-08-14 18:38:30 +0200
commit5ed142657c5dd9dfd5e0897ab45f2f269a8b97d2 (patch)
tree955b88787df12f6e57034de771f2e86adae51566
parent809c1abc19d487daeed75842da867ce633159210 (diff)
downloadbinutils-5ed142657c5dd9dfd5e0897ab45f2f269a8b97d2.zip
binutils-5ed142657c5dd9dfd5e0897ab45f2f269a8b97d2.tar.gz
binutils-5ed142657c5dd9dfd5e0897ab45f2f269a8b97d2.tar.bz2
[gdb/testsuite] Remove useless indentation in lib/tuiterm.exp
In lib/tuiterm.exp we have: ... namespace eval Term { variable ... ... } ... with everything within the namespace (which is basically the entire file) indented, which wastes screen space and makes editing more involved. We could maybe fix this by moving the "namespace eval Term" to tuiterm_env, but I don't think it's a good idea to move it out of the file. Another idea is to have the file include itself, wrapped in the namespace: ... if { ![info exists Term::_in_namespace] } { namespace eval Term { # Read the rest of this file, wrapped in this namespace. variable _in_namespace set _in_namespace 1 source $::srcdir/lib/tuiterm.exp unset _in_namespace return } } variable ... ... but this was considered unnecessarily complex. Fix this in the style of lib/ton.tcl and lib/completion-support.exp: - only declare the variables in the namespace, and - define the procs using a Term:: prefix. As a side-effect, this works around an emacs bug that makes editing lib/tuiterm.exp in its current form problematic because the auto-indentation keeps removing required indentation of all but the first proc [1]. Tested on x86_64-linux. [1] https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-11/msg01674.html
-rw-r--r--gdb/testsuite/lib/tuiterm.exp2210
1 files changed, 1105 insertions, 1105 deletions
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 2164017..ecb2c30 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -32,1387 +32,1387 @@ namespace eval Term {
variable _last_char
variable _resize_count
+}
- proc _log { what } {
- verbose "+++ $what"
- }
+proc Term::_log { what } {
+ verbose "+++ $what"
+}
- # Call BODY, then log WHAT along with the original and new cursor position.
- proc _log_cur { what body } {
- variable _cur_row
- variable _cur_col
+# Call BODY, then log WHAT along with the original and new cursor position.
+proc Term::_log_cur { what body } {
+ variable _cur_row
+ variable _cur_col
- set orig_cur_row $_cur_row
- set orig_cur_col $_cur_col
+ set orig_cur_row $_cur_row
+ set orig_cur_col $_cur_col
- set code [catch {uplevel $body} result]
+ set code [catch {uplevel $body} result]
- _log "$what, cursor: ($orig_cur_row, $orig_cur_col) -> ($_cur_row, $_cur_col)"
+ _log "$what, cursor: ($orig_cur_row, $orig_cur_col) -> ($_cur_row, $_cur_col)"
- if { $code == 1 } {
- global errorInfo errorCode
- return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
- } else {
- return -code $code $result
- }
+ if { $code == 1 } {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
}
+}
- # If ARG is empty, return DEF: otherwise ARG. This is useful for
- # defaulting arguments in CSIs.
- proc _default {arg def} {
- if {$arg == ""} {
- return $def
- }
- return $arg
+# If ARG is empty, return DEF: otherwise ARG. This is useful for
+# defaulting arguments in CSIs.
+proc Term::_default {arg def} {
+ if {$arg == ""} {
+ return $def
}
+ return $arg
+}
- # Erase in the line Y from SX to just before EX.
- proc _clear_in_line {sx ex y} {
- variable _attrs
- variable _chars
- set lattr [array get _attrs]
- while {$sx < $ex} {
- set _chars($sx,$y) [list " " $lattr]
- incr sx
- }
+# Erase in the line Y from SX to just before EX.
+proc Term::_clear_in_line {sx ex y} {
+ variable _attrs
+ variable _chars
+ set lattr [array get _attrs]
+ while {$sx < $ex} {
+ set _chars($sx,$y) [list " " $lattr]
+ incr sx
}
+}
- # Erase the lines from SY to just before EY.
- proc _clear_lines {sy ey} {
- variable _cols
- while {$sy < $ey} {
- _clear_in_line 0 $_cols $sy
- incr sy
- }
+# Erase the lines from SY to just before EY.
+proc Term::_clear_lines {sy ey} {
+ variable _cols
+ while {$sy < $ey} {
+ _clear_in_line 0 $_cols $sy
+ incr sy
}
+}
- # Beep.
- proc _ctl_0x07 {} {
- }
+# Beep.
+proc Term::_ctl_0x07 {} {
+}
- # Return 1 if tuiterm has the bw/auto_left_margin enabled.
- proc _have_bw {} {
- return [expr \
- [string equal $Term::_TERM "ansiw"] \
- || [string equal $Term::_TERM "ansis"]]
+# Return 1 if tuiterm has the bw/auto_left_margin enabled.
+proc Term::_have_bw {} {
+ return [expr \
+ [string equal $Term::_TERM "ansiw"] \
+ || [string equal $Term::_TERM "ansis"]]
+}
+
+# Backspace.
+proc Term::_ctl_0x08 { {bw -1} } {
+ if { $bw == -1 } {
+ set bw [_have_bw]
}
+ _log_cur "Backspace, bw == $bw" {
+ variable _cur_col
+ variable _cur_row
+ variable _cols
- # Backspace.
- proc _ctl_0x08 { {bw -1} } {
- if { $bw == -1 } {
- set bw [_have_bw]
+ if { $_cur_col > 0 } {
+ # No wrapping needed.
+ incr _cur_col -1
+ return
}
- _log_cur "Backspace, bw == $bw" {
- variable _cur_col
- variable _cur_row
- variable _cols
-
- if { $_cur_col > 0 } {
- # No wrapping needed.
- incr _cur_col -1
- return
- }
-
- if { ! $bw } {
- # Wrapping not enabled.
- return
- }
- if { $_cur_row == 0 } {
- # Can't wrap.
- return
- }
+ if { ! $bw } {
+ # Wrapping not enabled.
+ return
+ }
- # Wrap to previous line.
- set _cur_col [expr $_cols - 1]
- incr _cur_row -1
+ if { $_cur_row == 0 } {
+ # Can't wrap.
+ return
}
+
+ # Wrap to previous line.
+ set _cur_col [expr $_cols - 1]
+ incr _cur_row -1
}
+}
- # Linefeed.
- proc _ctl_0x0a {} {
- _log_cur "Line feed" {
- variable _cur_row
- variable _rows
- variable _cols
- variable _chars
-
- incr _cur_row 1
- while {$_cur_row >= $_rows} {
- # Scroll the display contents. We scroll one line at
- # a time here; as _cur_row was only increased by one,
- # a single line scroll should be enough to put the
- # cursor back on the screen. But we wrap the
- # scrolling inside a while loop just to be on the safe
- # side.
- for {set y 0} {$y < [expr $_rows - 1]} {incr y} {
- set next_y [expr $y + 1]
- for {set x 0} {$x < $_cols} {incr x} {
- set _chars($x,$y) $_chars($x,$next_y)
- }
- }
+# Linefeed.
+proc Term::_ctl_0x0a {} {
+ _log_cur "Line feed" {
+ variable _cur_row
+ variable _rows
+ variable _cols
+ variable _chars
- incr _cur_row -1
+ incr _cur_row 1
+ while {$_cur_row >= $_rows} {
+ # Scroll the display contents. We scroll one line at
+ # a time here; as _cur_row was only increased by one,
+ # a single line scroll should be enough to put the
+ # cursor back on the screen. But we wrap the
+ # scrolling inside a while loop just to be on the safe
+ # side.
+ for {set y 0} {$y < [expr $_rows - 1]} {incr y} {
+ set next_y [expr $y + 1]
+ for {set x 0} {$x < $_cols} {incr x} {
+ set _chars($x,$y) $_chars($x,$next_y)
+ }
}
+
+ incr _cur_row -1
}
}
+}
- # Carriage return.
- proc _ctl_0x0d {} {
- _log_cur "Carriage return" {
- variable _cur_col
+# Carriage return.
+proc Term::_ctl_0x0d {} {
+ _log_cur "Carriage return" {
+ variable _cur_col
- set _cur_col 0
- }
+ set _cur_col 0
}
+}
- # Insert Character.
- #
- # https://vt100.net/docs/vt510-rm/ICH.html
- proc _csi_@ {args} {
- set n [_default [lindex $args 0] 1]
-
- _log_cur "Insert Character ($n)" {
- variable _cur_col
- variable _cur_row
- variable _cols
- variable _chars
+# Insert Character.
+#
+# https://vt100.net/docs/vt510-rm/ICH.html
+proc Term::_csi_@ {args} {
+ set n [_default [lindex $args 0] 1]
- # Move characters right of the cursor right by N positions,
- # starting with the rightmost one.
- for {set in_col [expr $_cols - $n - 1]} {$in_col >= $_cur_col} {incr in_col -1} {
- set out_col [expr $in_col + $n]
- set _chars($out_col,$_cur_row) $_chars($in_col,$_cur_row)
- }
+ _log_cur "Insert Character ($n)" {
+ variable _cur_col
+ variable _cur_row
+ variable _cols
+ variable _chars
- # Write N blank spaces starting from the cursor.
- _clear_in_line $_cur_col [expr $_cur_col + $n] $_cur_row
+ # Move characters right of the cursor right by N positions,
+ # starting with the rightmost one.
+ for {set in_col [expr $_cols - $n - 1]} {$in_col >= $_cur_col} {incr in_col -1} {
+ set out_col [expr $in_col + $n]
+ set _chars($out_col,$_cur_row) $_chars($in_col,$_cur_row)
}
- }
- # Horizontal Position Absolute.
- #
- # https://vt100.net/docs/vt510-rm/HPA.html
- proc _csi_` {args} {
- # Same as Cursor Horizontal Absolute.
- return [Term::_csi_G {*}$args]
+ # Write N blank spaces starting from the cursor.
+ _clear_in_line $_cur_col [expr $_cur_col + $n] $_cur_row
}
+}
- # Cursor Up.
- #
- # https://vt100.net/docs/vt510-rm/CUU.html
- proc _csi_A {args} {
- set arg [_default [lindex $args 0] 1]
+# Horizontal Position Absolute.
+#
+# https://vt100.net/docs/vt510-rm/HPA.html
+proc Term::_csi_` {args} {
+ # Same as Cursor Horizontal Absolute.
+ return [Term::_csi_G {*}$args]
+}
- _log_cur "Cursor Up ($arg)" {
- variable _cur_row
+# Cursor Up.
+#
+# https://vt100.net/docs/vt510-rm/CUU.html
+proc Term::_csi_A {args} {
+ set arg [_default [lindex $args 0] 1]
- set _cur_row [expr {max ($_cur_row - $arg, 0)}]
- }
+ _log_cur "Cursor Up ($arg)" {
+ variable _cur_row
+
+ set _cur_row [expr {max ($_cur_row - $arg, 0)}]
}
+}
- # Cursor Down.
- #
- # https://vt100.net/docs/vt510-rm/CUD.html
- proc _csi_B {args} {
- set arg [_default [lindex $args 0] 1]
+# Cursor Down.
+#
+# https://vt100.net/docs/vt510-rm/CUD.html
+proc Term::_csi_B {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Cursor Down ($arg)" {
- variable _cur_row
- variable _rows
+ _log_cur "Cursor Down ($arg)" {
+ variable _cur_row
+ variable _rows
- set _cur_row [expr {min ($_cur_row + $arg, $_rows - 1)}]
- }
+ set _cur_row [expr {min ($_cur_row + $arg, $_rows - 1)}]
}
+}
- # Cursor Forward.
- #
- # https://vt100.net/docs/vt510-rm/CUF.html
- proc _csi_C {args} {
- set arg [_default [lindex $args 0] 1]
+# Cursor Forward.
+#
+# https://vt100.net/docs/vt510-rm/CUF.html
+proc Term::_csi_C {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Cursor Forward ($arg)" {
- variable _cur_col
- variable _cols
+ _log_cur "Cursor Forward ($arg)" {
+ variable _cur_col
+ variable _cols
- set _cur_col [expr {min ($_cur_col + $arg, $_cols - 1)}]
- }
+ set _cur_col [expr {min ($_cur_col + $arg, $_cols - 1)}]
}
+}
- # Cursor Backward.
- #
- # https://vt100.net/docs/vt510-rm/CUB.html
- proc _csi_D {args} {
- set arg [_default [lindex $args 0] 1]
+# Cursor Backward.
+#
+# https://vt100.net/docs/vt510-rm/CUB.html
+proc Term::_csi_D {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Cursor Backward ($arg)" {
- variable _cur_col
+ _log_cur "Cursor Backward ($arg)" {
+ variable _cur_col
- set _cur_col [expr {max ($_cur_col - $arg, 0)}]
- }
+ set _cur_col [expr {max ($_cur_col - $arg, 0)}]
}
+}
- # Cursor Next Line.
- #
- # https://vt100.net/docs/vt510-rm/CNL.html
- proc _csi_E {args} {
- set arg [_default [lindex $args 0] 1]
+# Cursor Next Line.
+#
+# https://vt100.net/docs/vt510-rm/CNL.html
+proc Term::_csi_E {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Cursor Next Line ($arg)" {
- variable _cur_col
- variable _cur_row
- variable _rows
+ _log_cur "Cursor Next Line ($arg)" {
+ variable _cur_col
+ variable _cur_row
+ variable _rows
- set _cur_col 0
- set _cur_row [expr {min ($_cur_row + $arg, $_rows - 1)}]
- }
+ set _cur_col 0
+ set _cur_row [expr {min ($_cur_row + $arg, $_rows - 1)}]
}
+}
- # Cursor Previous Line.
- #
- # https://vt100.net/docs/vt510-rm/CPL.html
- proc _csi_F {args} {
- set arg [_default [lindex $args 0] 1]
+# Cursor Previous Line.
+#
+# https://vt100.net/docs/vt510-rm/CPL.html
+proc Term::_csi_F {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Cursor Previous Line ($arg)" {
- variable _cur_col
- variable _cur_row
- variable _rows
+ _log_cur "Cursor Previous Line ($arg)" {
+ variable _cur_col
+ variable _cur_row
+ variable _rows
- set _cur_col 0
- set _cur_row [expr {max ($_cur_row - $arg, 0)}]
- }
+ set _cur_col 0
+ set _cur_row [expr {max ($_cur_row - $arg, 0)}]
}
+}
- # Cursor Horizontal Absolute.
- #
- # https://vt100.net/docs/vt510-rm/CHA.html
- proc _csi_G {args} {
- set arg [_default [lindex $args 0] 1]
+# Cursor Horizontal Absolute.
+#
+# https://vt100.net/docs/vt510-rm/CHA.html
+proc Term::_csi_G {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Cursor Horizontal Absolute ($arg)" {
- variable _cur_col
- variable _cols
+ _log_cur "Cursor Horizontal Absolute ($arg)" {
+ variable _cur_col
+ variable _cols
- set _cur_col [expr {min ($arg, $_cols)} - 1]
- }
+ set _cur_col [expr {min ($arg, $_cols)} - 1]
}
+}
- # Cursor Position.
- #
- # https://vt100.net/docs/vt510-rm/CUP.html
- proc _csi_H {args} {
- set row [_default [lindex $args 0] 1]
- set col [_default [lindex $args 1] 1]
+# Cursor Position.
+#
+# https://vt100.net/docs/vt510-rm/CUP.html
+proc Term::_csi_H {args} {
+ set row [_default [lindex $args 0] 1]
+ set col [_default [lindex $args 1] 1]
- _log_cur "Cursor Position ($row, $col)" {
- variable _cur_col
- variable _cur_row
+ _log_cur "Cursor Position ($row, $col)" {
+ variable _cur_col
+ variable _cur_row
- set _cur_row [expr {$row - 1}]
- set _cur_col [expr {$col - 1}]
- }
+ set _cur_row [expr {$row - 1}]
+ set _cur_col [expr {$col - 1}]
}
+}
- # Cursor Horizontal Forward Tabulation.
- #
- # https://vt100.net/docs/vt510-rm/CHT.html
- proc _csi_I {args} {
- set n [_default [lindex $args 0] 1]
+# Cursor Horizontal Forward Tabulation.
+#
+# https://vt100.net/docs/vt510-rm/CHT.html
+proc Term::_csi_I {args} {
+ set n [_default [lindex $args 0] 1]
- _log_cur "Cursor Horizontal Forward Tabulation ($n)" {
- variable _cur_col
- variable _cols
+ _log_cur "Cursor Horizontal Forward Tabulation ($n)" {
+ variable _cur_col
+ variable _cols
- incr _cur_col [expr {$n * 8 - $_cur_col % 8}]
- if {$_cur_col >= $_cols} {
- set _cur_col [expr {$_cols - 1}]
- }
+ incr _cur_col [expr {$n * 8 - $_cur_col % 8}]
+ if {$_cur_col >= $_cols} {
+ set _cur_col [expr {$_cols - 1}]
}
}
+}
- # Erase in Display.
- #
- # https://vt100.net/docs/vt510-rm/ED.html
- proc _csi_J {args} {
- set arg [_default [lindex $args 0] 0]
-
- _log_cur "Erase in Display ($arg)" {
- variable _cur_col
- variable _cur_row
- variable _rows
- variable _cols
-
- if {$arg == 0} {
- # Cursor (inclusive) to end of display.
- _clear_in_line $_cur_col $_cols $_cur_row
- _clear_lines [expr {$_cur_row + 1}] $_rows
- } elseif {$arg == 1} {
- # Beginning of display to cursor (inclusive).
- _clear_lines 0 $_cur_row
- _clear_in_line 0 [expr $_cur_col + 1] $_cur_row
- } elseif {$arg == 2} {
- # Entire display.
- _clear_lines 0 $_rows
- }
+# Erase in Display.
+#
+# https://vt100.net/docs/vt510-rm/ED.html
+proc Term::_csi_J {args} {
+ set arg [_default [lindex $args 0] 0]
+
+ _log_cur "Erase in Display ($arg)" {
+ variable _cur_col
+ variable _cur_row
+ variable _rows
+ variable _cols
+
+ if {$arg == 0} {
+ # Cursor (inclusive) to end of display.
+ _clear_in_line $_cur_col $_cols $_cur_row
+ _clear_lines [expr {$_cur_row + 1}] $_rows
+ } elseif {$arg == 1} {
+ # Beginning of display to cursor (inclusive).
+ _clear_lines 0 $_cur_row
+ _clear_in_line 0 [expr $_cur_col + 1] $_cur_row
+ } elseif {$arg == 2} {
+ # Entire display.
+ _clear_lines 0 $_rows
}
}
+}
- # Erase in Line.
- #
- # https://vt100.net/docs/vt510-rm/EL.html
- proc _csi_K {args} {
- set arg [_default [lindex $args 0] 0]
-
- _log_cur "Erase in Line ($arg)" {
- variable _cur_col
- variable _cur_row
- variable _cols
-
- if {$arg == 0} {
- # Cursor (inclusive) to end of line.
- _clear_in_line $_cur_col $_cols $_cur_row
- } elseif {$arg == 1} {
- # Beginning of line to cursor (inclusive).
- _clear_in_line 0 [expr $_cur_col + 1] $_cur_row
- } elseif {$arg == 2} {
- # Entire line.
- _clear_in_line 0 $_cols $_cur_row
- }
+# Erase in Line.
+#
+# https://vt100.net/docs/vt510-rm/EL.html
+proc Term::_csi_K {args} {
+ set arg [_default [lindex $args 0] 0]
+
+ _log_cur "Erase in Line ($arg)" {
+ variable _cur_col
+ variable _cur_row
+ variable _cols
+
+ if {$arg == 0} {
+ # Cursor (inclusive) to end of line.
+ _clear_in_line $_cur_col $_cols $_cur_row
+ } elseif {$arg == 1} {
+ # Beginning of line to cursor (inclusive).
+ _clear_in_line 0 [expr $_cur_col + 1] $_cur_row
+ } elseif {$arg == 2} {
+ # Entire line.
+ _clear_in_line 0 $_cols $_cur_row
}
}
+}
- # Insert Line
- #
- # https://vt100.net/docs/vt510-rm/IL.html
- proc _csi_L {args} {
- set arg [_default [lindex $args 0] 1]
+# Insert Line
+#
+# https://vt100.net/docs/vt510-rm/IL.html
+proc Term::_csi_L {args} {
+ set arg [_default [lindex $args 0] 1]
- _log_cur "Insert Line ($arg)" {
- variable _cur_col
- variable _cur_row
- variable _rows
- variable _cols
- variable _chars
+ _log_cur "Insert Line ($arg)" {
+ variable _cur_col
+ variable _cur_row
+ variable _rows
+ variable _cols
+ variable _chars
- set y [expr $_rows - 2]
- set next_y [expr $y + $arg]
- while {$y >= $_cur_row} {
- for {set x 0} {$x < $_cols} {incr x} {
- set _chars($x,$next_y) $_chars($x,$y)
- }
- incr y -1
- incr next_y -1
+ set y [expr $_rows - 2]
+ set next_y [expr $y + $arg]
+ while {$y >= $_cur_row} {
+ for {set x 0} {$x < $_cols} {incr x} {
+ set _chars($x,$next_y) $_chars($x,$y)
}
-
- _clear_lines $_cur_row [expr $_cur_row + $arg]
+ incr y -1
+ incr next_y -1
}
+
+ _clear_lines $_cur_row [expr $_cur_row + $arg]
}
+}
- # Delete line.
- #
- # https://vt100.net/docs/vt510-rm/DL.html
- proc _csi_M {args} {
- set count [_default [lindex $args 0] 1]
+# Delete line.
+#
+# https://vt100.net/docs/vt510-rm/DL.html
+proc Term::_csi_M {args} {
+ set count [_default [lindex $args 0] 1]
- _log_cur "Delete line ($count)" {
- variable _cur_row
- variable _rows
- variable _cols
- variable _chars
+ _log_cur "Delete line ($count)" {
+ variable _cur_row
+ variable _rows
+ variable _cols
+ variable _chars
- set y $_cur_row
- set next_y [expr {$y + $count}]
- while {$next_y < $_rows} {
- for {set x 0} {$x < $_cols} {incr x} {
- set _chars($x,$y) $_chars($x,$next_y)
- }
- incr y
- incr next_y
+ set y $_cur_row
+ set next_y [expr {$y + $count}]
+ while {$next_y < $_rows} {
+ for {set x 0} {$x < $_cols} {incr x} {
+ set _chars($x,$y) $_chars($x,$next_y)
}
- _clear_lines $y $_rows
+ incr y
+ incr next_y
}
+ _clear_lines $y $_rows
}
+}
- # Delete Character.
- #
- # https://vt100.net/docs/vt510-rm/DCH.html
- proc _csi_P {args} {
- set count [_default [lindex $args 0] 1]
-
- _log_cur "Delete character ($count)" {
- variable _cur_row
- variable _cur_col
- variable _chars
- variable _cols
+# Delete Character.
+#
+# https://vt100.net/docs/vt510-rm/DCH.html
+proc Term::_csi_P {args} {
+ set count [_default [lindex $args 0] 1]
- # Move all characters right of the cursor N positions left.
- set out_col [expr $_cur_col]
- set in_col [expr $_cur_col + $count]
+ _log_cur "Delete character ($count)" {
+ variable _cur_row
+ variable _cur_col
+ variable _chars
+ variable _cols
- while {$in_col < $_cols} {
- set _chars($out_col,$_cur_row) $_chars($in_col,$_cur_row)
- incr in_col
- incr out_col
- }
+ # Move all characters right of the cursor N positions left.
+ set out_col [expr $_cur_col]
+ set in_col [expr $_cur_col + $count]
- # Clear the rest of the line.
- _clear_in_line $out_col $_cols $_cur_row
+ while {$in_col < $_cols} {
+ set _chars($out_col,$_cur_row) $_chars($in_col,$_cur_row)
+ incr in_col
+ incr out_col
}
+
+ # Clear the rest of the line.
+ _clear_in_line $out_col $_cols $_cur_row
}
+}
- # Pan Down
- #
- # https://vt100.net/docs/vt510-rm/SU.html
- proc _csi_S {args} {
- set count [_default [lindex $args 0] 1]
+# Pan Down
+#
+# https://vt100.net/docs/vt510-rm/SU.html
+proc Term::_csi_S {args} {
+ set count [_default [lindex $args 0] 1]
- _log_cur "Pan Down ($count)" {
- variable _cur_col
- variable _cur_row
- variable _cols
- variable _rows
- variable _chars
+ _log_cur "Pan Down ($count)" {
+ variable _cur_col
+ variable _cur_row
+ variable _cols
+ variable _rows
+ variable _chars
- # The following code is written without consideration for
- # the scroll margins. At this time this comment was
- # written the tuiterm library doesn't support the scroll
- # margins. If/when that changes, then the following will
- # need to be updated.
+ # The following code is written without consideration for
+ # the scroll margins. At this time this comment was
+ # written the tuiterm library doesn't support the scroll
+ # margins. If/when that changes, then the following will
+ # need to be updated.
- set dy 0
- set y $count
+ set dy 0
+ set y $count
- while {$y < $_rows} {
- for {set x 0} {$x < $_cols} {incr x} {
- set _chars($x,$dy) $_chars($x,$y)
- }
- incr y 1
- incr dy 1
+ while {$y < $_rows} {
+ for {set x 0} {$x < $_cols} {incr x} {
+ set _chars($x,$dy) $_chars($x,$y)
}
-
- _clear_lines $dy $_rows
+ incr y 1
+ incr dy 1
}
+
+ _clear_lines $dy $_rows
}
+}
- # Pan Up
- #
- # https://vt100.net/docs/vt510-rm/SD.html
- proc _csi_T {args} {
- set count [_default [lindex $args 0] 1]
+# Pan Up
+#
+# https://vt100.net/docs/vt510-rm/SD.html
+proc Term::_csi_T {args} {
+ set count [_default [lindex $args 0] 1]
- _log_cur "Pan Up ($count)" {
- variable _cur_col
- variable _cur_row
- variable _cols
- variable _rows
- variable _chars
+ _log_cur "Pan Up ($count)" {
+ variable _cur_col
+ variable _cur_row
+ variable _cols
+ variable _rows
+ variable _chars
- # The following code is written without consideration for
- # the scroll margins. At this time this comment was
- # written the tuiterm library doesn't support the scroll
- # margins. If/when that changes, then the following will
- # need to be updated.
+ # The following code is written without consideration for
+ # the scroll margins. At this time this comment was
+ # written the tuiterm library doesn't support the scroll
+ # margins. If/when that changes, then the following will
+ # need to be updated.
- set y [expr $_rows - $count]
- set dy $_rows
+ set y [expr $_rows - $count]
+ set dy $_rows
- while {$dy >= $count} {
- for {set x 0} {$x < $_cols} {incr x} {
- set _chars($x,$dy) $_chars($x,$y)
- }
- incr y -1
- incr dy -1
+ while {$dy >= $count} {
+ for {set x 0} {$x < $_cols} {incr x} {
+ set _chars($x,$dy) $_chars($x,$y)
}
-
- _clear_lines 0 $count
+ incr y -1
+ incr dy -1
}
+
+ _clear_lines 0 $count
}
+}
- # Erase chars.
- #
- # https://vt100.net/docs/vt510-rm/ECH.html
- proc _csi_X {args} {
- set n [_default [lindex $args 0] 1]
-
- _log_cur "Erase chars ($n)" {
- # Erase characters but don't move cursor.
- variable _cur_col
- variable _cur_row
- variable _attrs
- variable _chars
-
- set lattr [array get _attrs]
- set x $_cur_col
- for {set i 0} {$i < $n} {incr i} {
- set _chars($x,$_cur_row) [list " " $lattr]
- incr x
- }
+# Erase chars.
+#
+# https://vt100.net/docs/vt510-rm/ECH.html
+proc Term::_csi_X {args} {
+ set n [_default [lindex $args 0] 1]
+
+ _log_cur "Erase chars ($n)" {
+ # Erase characters but don't move cursor.
+ variable _cur_col
+ variable _cur_row
+ variable _attrs
+ variable _chars
+
+ set lattr [array get _attrs]
+ set x $_cur_col
+ for {set i 0} {$i < $n} {incr i} {
+ set _chars($x,$_cur_row) [list " " $lattr]
+ incr x
}
}
+}
- # Cursor Backward Tabulation.
- #
- # https://vt100.net/docs/vt510-rm/CBT.html
- proc _csi_Z {args} {
- set n [_default [lindex $args 0] 1]
+# Cursor Backward Tabulation.
+#
+# https://vt100.net/docs/vt510-rm/CBT.html
+proc Term::_csi_Z {args} {
+ set n [_default [lindex $args 0] 1]
- _log_cur "Cursor Backward Tabulation ($n)" {
- variable _cur_col
+ _log_cur "Cursor Backward Tabulation ($n)" {
+ variable _cur_col
- set _cur_col [expr {max (int (($_cur_col - 1) / 8) * 8 - ($n - 1) * 8, 0)}]
- }
+ set _cur_col [expr {max (int (($_cur_col - 1) / 8) * 8 - ($n - 1) * 8, 0)}]
}
+}
- # Repeat.
- #
- # https://www.xfree86.org/current/ctlseqs.html (See `(REP)`)
- proc _csi_b {args} {
- set n [_default [lindex $args 0] 1]
+# Repeat.
+#
+# https://www.xfree86.org/current/ctlseqs.html (See `(REP)`)
+proc Term::_csi_b {args} {
+ set n [_default [lindex $args 0] 1]
- _log_cur "Repeat ($n)" {
- variable _last_char
+ _log_cur "Repeat ($n)" {
+ variable _last_char
- _insert [string repeat $_last_char $n]
- }
+ _insert [string repeat $_last_char $n]
}
+}
- # Vertical Line Position Absolute.
- #
- # https://vt100.net/docs/vt510-rm/VPA.html
- proc _csi_d {args} {
- set row [_default [lindex $args 0] 1]
+# Vertical Line Position Absolute.
+#
+# https://vt100.net/docs/vt510-rm/VPA.html
+proc Term::_csi_d {args} {
+ set row [_default [lindex $args 0] 1]
- _log_cur "Vertical Line Position Absolute ($row)" {
- variable _cur_row
- variable _rows
+ _log_cur "Vertical Line Position Absolute ($row)" {
+ variable _cur_row
+ variable _rows
- set _cur_row [expr min ($row - 1, $_rows - 1)]
- }
+ set _cur_row [expr min ($row - 1, $_rows - 1)]
}
+}
- # Reset the attributes in attributes array UPVAR_NAME to the default values.
- proc _reset_attrs { upvar_name } {
- upvar $upvar_name var
- array set var {
- intensity normal
- fg default
- bg default
- underline 0
- reverse 0
- invisible 0
- blinking 0
- }
+# Reset the attributes in attributes array UPVAR_NAME to the default values.
+proc Term::_reset_attrs { upvar_name } {
+ upvar $upvar_name var
+ array set var {
+ intensity normal
+ fg default
+ bg default
+ underline 0
+ reverse 0
+ invisible 0
+ blinking 0
}
+}
- # Translate the color numbers as used in proc _csi_m to a name.
- proc _color_attr { n } {
- switch -exact -- $n {
- 0 {
- return black
- }
- 1 {
- return red
- }
- 2 {
- return green
- }
- 3 {
- return yellow
- }
- 4 {
- return blue
- }
- 5 {
- return magenta
- }
- 6 {
- return cyan
- }
- 7 {
- return white
- }
- default { error "unsupported color number: $n" }
+# Translate the color numbers as used in proc _csi_m to a name.
+proc Term::_color_attr { n } {
+ switch -exact -- $n {
+ 0 {
+ return black
+ }
+ 1 {
+ return red
+ }
+ 2 {
+ return green
}
+ 3 {
+ return yellow
+ }
+ 4 {
+ return blue
+ }
+ 5 {
+ return magenta
+ }
+ 6 {
+ return cyan
+ }
+ 7 {
+ return white
+ }
+ default { error "unsupported color number: $n" }
}
+}
- # Select Graphic Rendition.
- #
- # https://vt100.net/docs/vt510-rm/SGR.html
- proc _csi_m {args} {
- if { [llength $args] == 0 } {
- # Apply default.
- set args [list 0]
- }
+# Select Graphic Rendition.
+#
+# https://vt100.net/docs/vt510-rm/SGR.html
+proc Term::_csi_m {args} {
+ if { [llength $args] == 0 } {
+ # Apply default.
+ set args [list 0]
+ }
- _log_cur "Select Graphic Rendition ([join $args {, }])" {
- variable _attrs
+ _log_cur "Select Graphic Rendition ([join $args {, }])" {
+ variable _attrs
- foreach item $args {
- switch -exact -- $item {
- "" - 0 {
- _reset_attrs _attrs
- }
- 1 {
- set _attrs(intensity) bold
- }
- 2 {
- set _attrs(intensity) dim
- }
- 4 {
- set _attrs(underline) 1
- }
- 5 {
- set _attrs(blinking) 1
- }
- 7 {
- set _attrs(reverse) 1
- }
- 8 {
- set _attrs(invisible) 1
- }
- 22 {
- set _attrs(intensity) normal
- }
- 24 {
- set _attrs(underline) 0
- }
- 25 {
- set _attrs(blinking) 0
- }
- 27 {
- set _attrs(reverse) 0
- }
- 28 {
- set _attrs(invisible) 0
- }
- 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 {
- set _attrs(fg) [_color_attr [expr $item - 30]]
- }
- 39 {
- set _attrs(fg) default
- }
- 40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 {
- set _attrs(bg) [_color_attr [expr $item - 40]]
- }
- 49 {
- set _attrs(bg) default
- }
+ foreach item $args {
+ switch -exact -- $item {
+ "" - 0 {
+ _reset_attrs _attrs
+ }
+ 1 {
+ set _attrs(intensity) bold
+ }
+ 2 {
+ set _attrs(intensity) dim
+ }
+ 4 {
+ set _attrs(underline) 1
+ }
+ 5 {
+ set _attrs(blinking) 1
+ }
+ 7 {
+ set _attrs(reverse) 1
+ }
+ 8 {
+ set _attrs(invisible) 1
+ }
+ 22 {
+ set _attrs(intensity) normal
+ }
+ 24 {
+ set _attrs(underline) 0
+ }
+ 25 {
+ set _attrs(blinking) 0
+ }
+ 27 {
+ set _attrs(reverse) 0
+ }
+ 28 {
+ set _attrs(invisible) 0
+ }
+ 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 {
+ set _attrs(fg) [_color_attr [expr $item - 30]]
+ }
+ 39 {
+ set _attrs(fg) default
+ }
+ 40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 {
+ set _attrs(bg) [_color_attr [expr $item - 40]]
+ }
+ 49 {
+ set _attrs(bg) default
}
}
}
}
+}
+
+# Request Terminal Parameters (DECREQTPARM)
+#
+# https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
+# https://vt100.net/docs/vt100-ug/chapter3.html
+proc Term::_csi_x {} {
+ # Ignore.
+}
+
+# Insert string at the cursor location.
+proc Term::_insert {str} {
+ _log_cur "Inserted string '$str'" {
+ _log "Inserting string '$str'"
- # Request Terminal Parameters (DECREQTPARM)
- #
- # https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
- # https://vt100.net/docs/vt100-ug/chapter3.html
- proc _csi_x {} {
- # Ignore.
- }
-
- # Insert string at the cursor location.
- proc _insert {str} {
- _log_cur "Inserted string '$str'" {
- _log "Inserting string '$str'"
-
- variable _cur_col
- variable _cur_row
- variable _rows
- variable _cols
- variable _attrs
- variable _chars
- set lattr [array get _attrs]
- foreach char [split $str {}] {
- _log_cur " Inserted char '$char'" {
- set _chars($_cur_col,$_cur_row) [list $char $lattr]
- incr _cur_col
- if {$_cur_col >= $_cols} {
- set _cur_col 0
- incr _cur_row
- if {$_cur_row >= $_rows} {
- error "FIXME scroll"
- }
+ variable _cur_col
+ variable _cur_row
+ variable _rows
+ variable _cols
+ variable _attrs
+ variable _chars
+ set lattr [array get _attrs]
+ foreach char [split $str {}] {
+ _log_cur " Inserted char '$char'" {
+ set _chars($_cur_col,$_cur_row) [list $char $lattr]
+ incr _cur_col
+ if {$_cur_col >= $_cols} {
+ set _cur_col 0
+ incr _cur_row
+ if {$_cur_row >= $_rows} {
+ error "FIXME scroll"
}
}
}
}
}
+}
- # Move the cursor to the (0-based) COL and ROW positions.
- proc _move_cursor { col row } {
- variable _cols
- variable _rows
- variable _cur_col
- variable _cur_row
+# Move the cursor to the (0-based) COL and ROW positions.
+proc Term::_move_cursor { col row } {
+ variable _cols
+ variable _rows
+ variable _cur_col
+ variable _cur_row
- if { $col < 0 || $col >= $_cols } {
- error "_move_cursor: invalid col value: $col"
- }
+ if { $col < 0 || $col >= $_cols } {
+ error "_move_cursor: invalid col value: $col"
+ }
- if { $row < 0 || $row >= $_rows } {
- error "_move_cursor: invalid row value: $row"
- }
+ if { $row < 0 || $row >= $_rows } {
+ error "_move_cursor: invalid row value: $row"
+ }
- set _cur_col $col
- set _cur_row $row
- }
+ set _cur_col $col
+ set _cur_row $row
+}
- # Initialize.
- proc _setup {rows cols} {
- global stty_init
- set stty_init "rows $rows columns $cols"
+# Initialize.
+proc Term::_setup {rows cols} {
+ global stty_init
+ set stty_init "rows $rows columns $cols"
- variable _rows
- variable _cols
- variable _cur_col
- variable _cur_row
- variable _attrs
- variable _resize_count
+ variable _rows
+ variable _cols
+ variable _cur_col
+ variable _cur_row
+ variable _attrs
+ variable _resize_count
- set _rows $rows
- set _cols $cols
- set _cur_col 0
- set _cur_row 0
- set _resize_count 0
- _reset_attrs _attrs
-
- _clear_lines 0 $_rows
- }
-
- # Accept some output from gdb and update the screen.
- # Return 1 if successful, or 0 if a timeout occurred.
- proc accept_gdb_output { } {
- global expect_out
- gdb_expect {
- -re "^\[\x07\x08\x0a\x0d\]" {
- scan $expect_out(0,string) %c val
- set hexval [format "%02x" $val]
- _log "wait_for: _ctl_0x${hexval}"
- _ctl_0x${hexval}
- }
- -re "^\x1b(\[0-9a-zA-Z\])" {
- _log "wait_for: unsupported escape"
- error "unsupported escape"
- }
- -re "^\x1b\\\[(\[0-9;\]*)(\[a-zA-Z@`\])" {
- set cmd $expect_out(2,string)
- set params [split $expect_out(1,string) ";"]
- _log "wait_for: _csi_$cmd <<<$expect_out(1,string)>>>"
- eval _csi_$cmd $params
- }
- -re "^\[^\x07\x08\x0a\x0d\x1b\]+" {
- _insert $expect_out(0,string)
- variable _last_char
- set _last_char [string index $expect_out(0,string) end]
- }
+ set _rows $rows
+ set _cols $cols
+ set _cur_col 0
+ set _cur_row 0
+ set _resize_count 0
+ _reset_attrs _attrs
- timeout {
- # Assume a timeout means we somehow missed the
- # expected result, and carry on.
- warning "timeout in accept_gdb_output"
- dump_screen
- return 0
- }
+ _clear_lines 0 $_rows
+}
+
+# Accept some output from gdb and update the screen.
+# Return 1 if successful, or 0 if a timeout occurred.
+proc Term::accept_gdb_output { } {
+ global expect_out
+ gdb_expect {
+ -re "^\[\x07\x08\x0a\x0d\]" {
+ scan $expect_out(0,string) %c val
+ set hexval [format "%02x" $val]
+ _log "wait_for: _ctl_0x${hexval}"
+ _ctl_0x${hexval}
+ }
+ -re "^\x1b(\[0-9a-zA-Z\])" {
+ _log "wait_for: unsupported escape"
+ error "unsupported escape"
+ }
+ -re "^\x1b\\\[(\[0-9;\]*)(\[a-zA-Z@`\])" {
+ set cmd $expect_out(2,string)
+ set params [split $expect_out(1,string) ";"]
+ _log "wait_for: _csi_$cmd <<<$expect_out(1,string)>>>"
+ eval _csi_$cmd $params
+ }
+ -re "^\[^\x07\x08\x0a\x0d\x1b\]+" {
+ _insert $expect_out(0,string)
+ variable _last_char
+ set _last_char [string index $expect_out(0,string) end]
}
- return 1
+ timeout {
+ # Assume a timeout means we somehow missed the
+ # expected result, and carry on.
+ warning "timeout in accept_gdb_output"
+ dump_screen
+ return 0
+ }
}
- # Print arg using "verbose -log" if DEBUG_TUI_MATCHING == 1.
- proc debug_tui_matching { arg } {
- set debug 0
- if { [info exists ::DEBUG_TUI_MATCHING] } {
- set debug $::DEBUG_TUI_MATCHING
- }
+ return 1
+}
- if { ! $debug } {
- return
- }
+# Print arg using "verbose -log" if DEBUG_TUI_MATCHING == 1.
+proc Term::debug_tui_matching { arg } {
+ set debug 0
+ if { [info exists ::DEBUG_TUI_MATCHING] } {
+ set debug $::DEBUG_TUI_MATCHING
+ }
- verbose -log "$arg"
+ if { ! $debug } {
+ return
}
- # Accept some output from gdb and update the screen. WAIT_FOR is
- # a regexp matching the line to wait for. Return 0 on timeout, 1
- # on success.
- proc wait_for {wait_for} {
- global gdb_prompt
- variable _cur_col
- variable _cur_row
+ verbose -log "$arg"
+}
- set fn "wait_for"
+# Accept some output from gdb and update the screen. WAIT_FOR is
+# a regexp matching the line to wait for. Return 0 on timeout, 1
+# on success.
+proc Term::wait_for {wait_for} {
+ global gdb_prompt
+ variable _cur_col
+ variable _cur_row
- set prompt_wait_for "(^|\\|)$gdb_prompt \$"
- if { $wait_for == "" } {
- set wait_for $prompt_wait_for
- }
+ set fn "wait_for"
- debug_tui_matching "$fn: regexp: '$wait_for'"
+ set prompt_wait_for "(^|\\|)$gdb_prompt \$"
+ if { $wait_for == "" } {
+ set wait_for $prompt_wait_for
+ }
- while 1 {
- if { [accept_gdb_output] == 0 } {
- return 0
- }
+ debug_tui_matching "$fn: regexp: '$wait_for'"
- # If the cursor appears just after the prompt, return. It
- # isn't reliable to check this only after an insertion,
- # because curses may make "unusual" redrawing decisions.
- if {$wait_for == "$prompt_wait_for"} {
- set prev [get_line $_cur_row $_cur_col]
- } else {
- set prev [get_line $_cur_row]
- }
+ while 1 {
+ if { [accept_gdb_output] == 0 } {
+ return 0
+ }
- if { ![regexp -- $wait_for $prev] } {
+ # If the cursor appears just after the prompt, return. It
+ # isn't reliable to check this only after an insertion,
+ # because curses may make "unusual" redrawing decisions.
+ if {$wait_for == "$prompt_wait_for"} {
+ set prev [get_line $_cur_row $_cur_col]
+ } else {
+ set prev [get_line $_cur_row]
+ }
+
+ if { ![regexp -- $wait_for $prev] } {
+ debug_tui_matching "$fn: mismatch: '$prev'"
+ continue
+ }
+
+ if {$wait_for == "$prompt_wait_for"} {
+ # We've detected that the cursor is just after the prompt.
+ # Now check that there's nothing else on the line.
+ set prev [get_line $_cur_row]
+ if { ![regexp -- "(^|\\|)$gdb_prompt +($|\\||\\+)" $prev] } {
debug_tui_matching "$fn: mismatch: '$prev'"
continue
}
+ }
- if {$wait_for == "$prompt_wait_for"} {
- # We've detected that the cursor is just after the prompt.
- # Now check that there's nothing else on the line.
- set prev [get_line $_cur_row]
- if { ![regexp -- "(^|\\|)$gdb_prompt +($|\\||\\+)" $prev] } {
- debug_tui_matching "$fn: mismatch: '$prev'"
- continue
- }
- }
-
- debug_tui_matching "$fn: match: '$prev'"
-
- if {$wait_for == "$prompt_wait_for"} {
- # Matched the prompt, we're done.
- break
- }
+ debug_tui_matching "$fn: match: '$prev'"
- # Now try to match the prompt.
- set wait_for $prompt_wait_for
- debug_tui_matching "$fn: regexp prompt: '$wait_for'"
+ if {$wait_for == "$prompt_wait_for"} {
+ # Matched the prompt, we're done.
+ break
}
- return 1
+ # Now try to match the prompt.
+ set wait_for $prompt_wait_for
+ debug_tui_matching "$fn: regexp prompt: '$wait_for'"
}
- # Accept some output from gdb and update the screen. Wait for the screen
- # region X/Y/WIDTH/HEIGTH to matches REGEXP. Return 0 on timeout, 1 on
- # success.
- proc wait_for_region_contents {x y width height regexp} {
- while 1 {
- if { [accept_gdb_output] == 0 } {
- return 0
- }
+ return 1
+}
- if { [check_region_contents_p $x $y $width $height $regexp] } {
- break
- }
+# Accept some output from gdb and update the screen. Wait for the screen
+# region X/Y/WIDTH/HEIGTH to matches REGEXP. Return 0 on timeout, 1 on
+# success.
+proc Term::wait_for_region_contents {x y width height regexp} {
+ while 1 {
+ if { [accept_gdb_output] == 0 } {
+ return 0
}
- return 1
+ if { [check_region_contents_p $x $y $width $height $regexp] } {
+ break
+ }
}
- # Accept some output from gdb and update the screen. Wait for the current
- # screen line to match REGEXP and cursor position POS, unless POS is empty.
- # Return 0 on timeout, 1 on success.
- proc wait_for_line { regexp {pos ""} } {
- variable _cur_row
- variable _cur_col
- variable _cols
+ return 1
+}
- while 1 {
- if { [accept_gdb_output] == 0 } {
- return 0
- }
+# Accept some output from gdb and update the screen. Wait for the current
+# screen line to match REGEXP and cursor position POS, unless POS is empty.
+# Return 0 on timeout, 1 on success.
+proc Term::wait_for_line { regexp {pos ""} } {
+ variable _cur_row
+ variable _cur_col
+ variable _cols
- if { ![check_region_contents_p 0 $_cur_row $_cols 1 $regexp] } {
- continue
- }
+ while 1 {
+ if { [accept_gdb_output] == 0 } {
+ return 0
+ }
- if { $pos == "" || $_cur_col == $pos } {
- break
- }
+ if { ![check_region_contents_p 0 $_cur_row $_cols 1 $regexp] } {
+ continue
}
- return 1
+ if { $pos == "" || $_cur_col == $pos } {
+ break
+ }
}
- # Setup the terminal with dimensions ROWSxCOLS, TERM=ansi, and execute
- # BODY.
- proc with_tuiterm {rows cols body} {
- global env stty_init
- variable _TERM
- save_vars {env(TERM) env(NO_COLOR) stty_init} {
- if { [ishost *-*-*bsd*] } {
- setenv TERM ansiw
- } else {
- setenv TERM ansi
- }
- # Save active TERM variable.
- set Term::_TERM $env(TERM)
-
- setenv NO_COLOR ""
- _setup $rows $cols
+ return 1
+}
- uplevel $body
+# Setup the terminal with dimensions ROWSxCOLS, TERM=ansi, and execute
+# BODY.
+proc Term::with_tuiterm {rows cols body} {
+ global env stty_init
+ variable _TERM
+ save_vars {env(TERM) env(NO_COLOR) stty_init} {
+ if { [ishost *-*-*bsd*] } {
+ setenv TERM ansiw
+ } else {
+ setenv TERM ansi
}
- }
+ # Save active TERM variable.
+ set Term::_TERM $env(TERM)
- # Like ::clean_restart, but ensures that gdb starts in an
- # environment where the TUI can work. ROWS and COLS are the size
- # of the terminal. EXECUTABLE, if given, is passed to
- # clean_restart.
- proc clean_restart {rows cols {executable {}}} {
- with_tuiterm $rows $cols {
- save_vars { ::GDBFLAGS } {
- # Make GDB not print the directory names. Use this setting to
- # remove the differences in test runs due to varying directory
- # names.
- append ::GDBFLAGS " -ex \"set filename-display basename\""
-
- if {$executable == ""} {
- ::clean_restart
- } else {
- ::clean_restart $executable
- }
- }
+ setenv NO_COLOR ""
+ _setup $rows $cols
- ::gdb_test_no_output "set pagination off"
- }
+ uplevel $body
}
+}
- # Generate prompt on TUIterm.
- proc gen_prompt {} {
- # Generate a prompt.
- send_gdb "echo\n"
-
- # Drain the output before the prompt.
- gdb_expect {
- -re "echo\r\n" {
+# Like ::clean_restart, but ensures that gdb starts in an
+# environment where the TUI can work. ROWS and COLS are the size
+# of the terminal. EXECUTABLE, if given, is passed to
+# clean_restart.
+proc Term::clean_restart {rows cols {executable {}}} {
+ with_tuiterm $rows $cols {
+ save_vars { ::GDBFLAGS } {
+ # Make GDB not print the directory names. Use this setting to
+ # remove the differences in test runs due to varying directory
+ # names.
+ append ::GDBFLAGS " -ex \"set filename-display basename\""
+
+ if {$executable == ""} {
+ ::clean_restart
+ } else {
+ ::clean_restart $executable
}
}
- # Interpret prompt using TUIterm.
- wait_for ""
+ ::gdb_test_no_output "set pagination off"
}
+}
- # Setup ready for starting the tui, but don't actually start it.
- # Returns 1 on success, 0 if TUI tests should be skipped.
- proc prepare_for_tui {} {
- if { [is_remote host] } {
- # In clean_restart, we're using "setenv TERM ansi", which has
- # effect on build. If we have [is_remote host] == 0, so
- # build == host, then it also has effect on host. But for
- # [is_remote host] == 1, it has no effect on host.
- return 0
- }
+# Generate prompt on TUIterm.
+proc Term::gen_prompt {} {
+ # Generate a prompt.
+ send_gdb "echo\n"
- if {![allow_tui_tests]} {
- return 0
+ # Drain the output before the prompt.
+ gdb_expect {
+ -re "echo\r\n" {
}
+ }
+
+ # Interpret prompt using TUIterm.
+ wait_for ""
+}
- gdb_test_no_output "set tui border-kind ascii"
- gdb_test_no_output "maint set tui-resize-message on"
- # When matching GDB output using Term::wait_for, the number of
- # matching attempts in wait_for can be influenced by CLI styling.
- # Disable it by default to avoid this.
- gdb_test_no_output "set style enabled off"
- return 1
+# Setup ready for starting the tui, but don't actually start it.
+# Returns 1 on success, 0 if TUI tests should be skipped.
+proc Term::prepare_for_tui {} {
+ if { [is_remote host] } {
+ # In clean_restart, we're using "setenv TERM ansi", which has
+ # effect on build. If we have [is_remote host] == 0, so
+ # build == host, then it also has effect on host. But for
+ # [is_remote host] == 1, it has no effect on host.
+ return 0
}
- # Start the TUI. Returns 1 on success, 0 if TUI tests should be
- # skipped.
- proc enter_tui {} {
- if {![prepare_for_tui]} {
- return 0
- }
+ if {![allow_tui_tests]} {
+ return 0
+ }
- command_no_prompt_prefix "tui enable"
- return 1
- }
-
- # Send the command CMD to gdb, then wait for a gdb prompt to be
- # seen in the TUI. CMD should not end with a newline -- that will
- # be supplied by this function.
- proc command {cmd} {
- global gdb_prompt
- send_gdb "$cmd\n"
- set str [string_to_regexp $cmd]
- set str "(^|\\|)$gdb_prompt $str"
- wait_for $str
- }
-
- # As proc command, but don't wait for an initial prompt. This is used for
- # initial terminal commands, where there's no prompt yet.
- proc command_no_prompt_prefix {cmd} {
- gen_prompt
- command $cmd
- }
-
- # 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
- }
- }
+ gdb_test_no_output "set tui border-kind ascii"
+ gdb_test_no_output "maint set tui-resize-message on"
+ # When matching GDB output using Term::wait_for, the number of
+ # matching attempts in wait_for can be influenced by CLI styling.
+ # Disable it by default to avoid this.
+ gdb_test_no_output "set style enabled off"
+ return 1
+}
- return $res
+# Start the TUI. Returns 1 on success, 0 if TUI tests should be
+# skipped.
+proc Term::enter_tui {} {
+ if {![prepare_for_tui]} {
+ return 0
}
- # Return the text of screen line N. Lines are 0-based. Start at column
- # X. If C is non-empty, stop before column C. Columns are also
- # zero-based. If ATTRS, annotate with attributes.
- proc get_string {n x c {attrs 0}} {
- variable _rows
- # This can happen during resizing, if the cursor seems to
- # temporarily be off-screen.
- if {$n >= $_rows} {
- return ""
- }
+ command_no_prompt_prefix "tui enable"
+ return 1
+}
- set result ""
- variable _cols
- variable _chars
- set c [_default $c $_cols]
- 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
+# Send the command CMD to gdb, then wait for a gdb prompt to be
+# seen in the TUI. CMD should not end with a newline -- that will
+# be supplied by this function.
+proc Term::command {cmd} {
+ global gdb_prompt
+ send_gdb "$cmd\n"
+ set str [string_to_regexp $cmd]
+ set str "(^|\\|)$gdb_prompt $str"
+ wait_for $str
+}
+
+# As proc command, but don't wait for an initial prompt. This is used for
+# initial terminal commands, where there's no prompt yet.
+proc Term::command_no_prompt_prefix {cmd} {
+ gen_prompt
+ command $cmd
+}
+
+# Apply the attribute list in ATTRS to attributes array UPVAR_NAME.
+# Return a string annotating the changed attributes.
+proc Term::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. Start at column
+# X. If C is non-empty, stop before column C. Columns are also
+# zero-based. If ATTRS, annotate with attributes.
+proc Term::get_string {n x c {attrs 0}} {
+ variable _rows
+ # This can happen during resizing, if the cursor seems to
+ # temporarily be off-screen.
+ if {$n >= $_rows} {
+ return ""
+ }
+
+ set result ""
+ variable _cols
+ variable _chars
+ set c [_default $c $_cols]
+ if { $attrs } {
+ _reset_attrs line_attrs
+ }
+ while {$x < $c} {
if { $attrs } {
- _reset_attrs zero_attrs
- set char_attrs [array get zero_attrs]
+ set char_attrs [lindex $_chars($x,$n) 1]
append result [apply_attrs line_attrs $char_attrs]
}
- return $result
+ append result [lindex $_chars($x,$n) 0]
+ incr x
}
-
- # Return the text of screen line N. Lines are 0-based. Start at column
- # X. If C is non-empty, stop before column C. Columns are also
- # zero-based. Annotate with attributes.
- proc get_string_with_attrs { n x c } {
- return [get_string $n $x $c 1]
+ 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. Lines are 0-based. If C is
- # non-empty, stop before column C. Columns are also zero-based. If
- # ATTRS, annotate with attributes.
- proc get_line_1 {n c attrs} {
- return [get_string $n 0 $c $attrs]
- }
+# Return the text of screen line N. Lines are 0-based. Start at column
+# X. If C is non-empty, stop before column C. Columns are also
+# zero-based. Annotate with attributes.
+proc Term::get_string_with_attrs { n x c } {
+ return [get_string $n $x $c 1]
+}
- # 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]
- }
+# Return the text of screen line N. Lines are 0-based. If C is
+# non-empty, stop before column C. Columns are also zero-based. If
+# ATTRS, annotate with attributes.
+proc Term::get_line_1 {n c attrs} {
+ return [get_string $n 0 $c $attrs]
+}
- # As get_line, but annotate with attributes.
- proc get_line_with_attrs {n {c ""}} {
- return [get_line_1 $n $c 1]
- }
+# 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 Term::get_line {n {c ""} } {
+ return [get_line_1 $n $c 0]
+}
- # Get just the character at (X, Y).
- proc get_char {x y} {
- variable _chars
- return [lindex $_chars($x,$y) 0]
- }
+# As get_line, but annotate with attributes.
+proc Term::get_line_with_attrs {n {c ""}} {
+ return [get_line_1 $n $c 1]
+}
- # Get the entire screen as a string.
- proc get_all_lines {} {
- variable _rows
- variable _cols
- variable _chars
+# Get just the character at (X, Y).
+proc Term::get_char {x y} {
+ variable _chars
+ return [lindex $_chars($x,$y) 0]
+}
- set result ""
- for {set y 0} {$y < $_rows} {incr y} {
- for {set x 0} {$x < $_cols} {incr x} {
- append result [lindex $_chars($x,$y) 0]
- }
- append result "\n"
- }
+# Get the entire screen as a string.
+proc Term::get_all_lines {} {
+ variable _rows
+ variable _cols
+ variable _chars
- return $result
+ set result ""
+ for {set y 0} {$y < $_rows} {incr y} {
+ for {set x 0} {$x < $_cols} {incr x} {
+ append result [lindex $_chars($x,$y) 0]
+ }
+ append result "\n"
}
- # Get the text just before the cursor.
- proc get_current_line {} {
- variable _cur_col
- variable _cur_row
- return [get_line $_cur_row $_cur_col]
+ return $result
+}
+
+# Get the text just before the cursor.
+proc Term::get_current_line {} {
+ variable _cur_col
+ variable _cur_row
+ return [get_line $_cur_row $_cur_col]
+}
+
+# Helper function for check_box. Returns empty string if the box
+# is found, description of why not otherwise.
+proc Term::_check_box {x y width height} {
+ set x2 [expr {$x + $width - 1}]
+ set y2 [expr {$y + $height - 1}]
+
+ verbose -log "_check_box x=$x, y=$y, x2=$x2, y2=$y2, width=$width, height=$height"
+
+ set c [get_char $x $y]
+ if {$c != "+"} {
+ return "ul corner is $c, not +"
}
- # Helper function for check_box. Returns empty string if the box
- # is found, description of why not otherwise.
- proc _check_box {x y width height} {
- set x2 [expr {$x + $width - 1}]
- set y2 [expr {$y + $height - 1}]
+ set c [get_char $x $y2]
+ if {$c != "+"} {
+ return "ll corner is $c, not +"
+ }
- verbose -log "_check_box x=$x, y=$y, x2=$x2, y2=$y2, width=$width, height=$height"
+ set c [get_char $x2 $y]
+ if {$c != "+"} {
+ return "ur corner is $c, not +"
+ }
- set c [get_char $x $y]
- if {$c != "+"} {
- return "ul corner is $c, not +"
- }
+ set c [get_char $x2 $y2]
+ if {$c != "+"} {
+ return "lr corner is $c, not +"
+ }
- set c [get_char $x $y2]
- if {$c != "+"} {
- return "ll corner is $c, not +"
- }
+ # Note we do not check the full horizonal borders of the box.
+ # The top will contain a title, and the bottom may as well, if
+ # it is overlapped by some other border. However, at most a
+ # title should appear as '+-VERY LONG TITLE-+', so we can
+ # check for the '+-' on the left, and '-+' on the right.
+ set c [get_char [expr {$x + 1}] $y]
+ if {$c != "-"} {
+ return "ul title padding is $c, not -"
+ }
- set c [get_char $x2 $y]
- if {$c != "+"} {
- return "ur corner is $c, not +"
- }
+ set c [get_char [expr {$x2 - 1}] $y]
+ if {$c != "-"} {
+ return "ul title padding is $c, not -"
+ }
- set c [get_char $x2 $y2]
- if {$c != "+"} {
- return "lr corner is $c, not +"
+ # Now check the vertical borders.
+ for {set i [expr {$y + 1}]} {$i < $y2 - 1} {incr i} {
+ set c [get_char $x $i]
+ if {$c != "|"} {
+ return "left side $i is $c, not |"
}
- # Note we do not check the full horizonal borders of the box.
- # The top will contain a title, and the bottom may as well, if
- # it is overlapped by some other border. However, at most a
- # title should appear as '+-VERY LONG TITLE-+', so we can
- # check for the '+-' on the left, and '-+' on the right.
- set c [get_char [expr {$x + 1}] $y]
- if {$c != "-"} {
- return "ul title padding is $c, not -"
+ set c [get_char $x2 $i]
+ if {$c != "|"} {
+ return "right side $i is $c, not |"
}
+ }
- set c [get_char [expr {$x2 - 1}] $y]
- if {$c != "-"} {
- return "ul title padding is $c, not -"
- }
+ return ""
+}
- # Now check the vertical borders.
- for {set i [expr {$y + 1}]} {$i < $y2 - 1} {incr i} {
- set c [get_char $x $i]
- if {$c != "|"} {
- return "left side $i is $c, not |"
- }
+# Check for a box at the given coordinates.
+proc Term::check_box {test_name x y width height} {
+ dump_box $x $y $width $height
+ set why [_check_box $x $y $width $height]
+ if {$why == ""} {
+ pass $test_name
+ } else {
+ fail "$test_name ($why)"
+ }
+}
- set c [get_char $x2 $i]
- if {$c != "|"} {
- return "right side $i is $c, not |"
- }
+# Wait until a box appears at the given coordinates.
+proc Term::wait_for_box {test_name x y width height} {
+ while 1 {
+ if { [accept_gdb_output] == 0 } {
+ return 0
}
- return ""
- }
-
- # Check for a box at the given coordinates.
- proc check_box {test_name x y width height} {
- dump_box $x $y $width $height
set why [_check_box $x $y $width $height]
if {$why == ""} {
pass $test_name
- } else {
- fail "$test_name ($why)"
+ break
}
}
+}
- # Wait until a box appears at the given coordinates.
- proc wait_for_box {test_name x y width height} {
- while 1 {
- if { [accept_gdb_output] == 0 } {
- return 0
- }
+# Check whether the text contents of the terminal match the
+# regular expression. Note that text styling is not considered.
+proc Term::check_contents {test_name regexp} {
+ dump_screen
+ set contents [get_all_lines]
+ gdb_assert {[regexp -- $regexp $contents]} $test_name
+}
- set why [_check_box $x $y $width $height]
- if {$why == ""} {
- pass $test_name
- break
- }
- }
- }
+# As check_contents, but check that the text contents of the terminal does
+# not match the regular expression.
+proc Term::check_contents_not {test_name regexp} {
+ dump_screen
+ set contents [get_all_lines]
+ gdb_assert {![regexp -- $regexp $contents]} $test_name
+}
- # Check whether the text contents of the terminal match the
- # regular expression. Note that text styling is not considered.
- proc check_contents {test_name regexp} {
- dump_screen
- set contents [get_all_lines]
- gdb_assert {[regexp -- $regexp $contents]} $test_name
- }
+# Get the region of the screen described by X, Y, WIDTH, and
+# HEIGHT, and separate the lines using SEP. If ATTRS is true then
+# include attribute information in the output.
+proc Term::get_region { x y width height sep { attrs false } } {
+ variable _chars
- # As check_contents, but check that the text contents of the terminal does
- # not match the regular expression.
- proc check_contents_not {test_name regexp} {
- dump_screen
- set contents [get_all_lines]
- gdb_assert {![regexp -- $regexp $contents]} $test_name
+ if { $attrs } {
+ _reset_attrs region_attrs
}
- # Get the region of the screen described by X, Y, WIDTH, and
- # HEIGHT, and separate the lines using SEP. If ATTRS is true then
- # include attribute information in the output.
- proc get_region { x y width height sep { attrs false } } {
- variable _chars
-
- if { $attrs } {
- _reset_attrs region_attrs
+ # Grab the contents of the box, join each line together
+ # using $sep.
+ set result ""
+ for {set yy $y} {$yy < [expr {$y + $height}]} {incr yy} {
+ if {$yy > $y} {
+ # Add the end of line sequence only if this isn't the
+ # first line.
+ append result $sep
}
-
- # Grab the contents of the box, join each line together
- # using $sep.
- set result ""
- for {set yy $y} {$yy < [expr {$y + $height}]} {incr yy} {
- if {$yy > $y} {
- # Add the end of line sequence only if this isn't the
- # first line.
- append result $sep
+ for {set xx $x} {$xx < [expr {$x + $width}]} {incr xx} {
+ if { $attrs } {
+ set char_attrs [lindex $_chars($xx,$yy) 1]
+ append result [apply_attrs region_attrs $char_attrs]
}
- for {set xx $x} {$xx < [expr {$x + $width}]} {incr xx} {
- if { $attrs } {
- set char_attrs [lindex $_chars($xx,$yy) 1]
- append result [apply_attrs region_attrs $char_attrs]
- }
- append result [get_char $xx $yy]
- }
+ append result [get_char $xx $yy]
}
- if { $attrs } {
- _reset_attrs zero_attrs
- set char_attrs [array get zero_attrs]
- append result [apply_attrs region_attrs $char_attrs]
- }
- return $result
}
-
- # Check that the region of the screen described by X, Y, WIDTH,
- # and HEIGHT match REGEXP. This is like check_contents except
- # only part of the screen is checked. This can be used to check
- # the contents within a box (though check_box_contents is a better
- # choice for boxes with a border). Return 1 if check succeeded.
- proc check_region_contents_p { x y width height regexp } {
- variable _chars
- dump_box $x $y $width $height
-
- # Now grab the contents of the box, join each line together
- # with a '\r\n' sequence and match against REGEXP.
- set result [get_region $x $y $width $height "\r\n"]
- return [regexp -- $regexp $result]
+ if { $attrs } {
+ _reset_attrs zero_attrs
+ set char_attrs [array get zero_attrs]
+ append result [apply_attrs region_attrs $char_attrs]
}
+ return $result
+}
- # Check that the region of the screen described by X, Y, WIDTH,
- # and HEIGHT match REGEXP. As check_region_contents_p, but produce
- # a pass/fail message.
- proc check_region_contents { test_name x y width height regexp } {
- set ok [check_region_contents_p $x $y $width $height $regexp]
- gdb_assert {$ok} $test_name
- }
+# Check that the region of the screen described by X, Y, WIDTH,
+# and HEIGHT match REGEXP. This is like check_contents except
+# only part of the screen is checked. This can be used to check
+# the contents within a box (though check_box_contents is a better
+# choice for boxes with a border). Return 1 if check succeeded.
+proc Term::check_region_contents_p { x y width height regexp } {
+ variable _chars
+ dump_box $x $y $width $height
- # Check the contents of a box on the screen. This is a little
- # like check_contents, but doesn't check the whole screen
- # contents, only the contents of a single box. This procedure
- # includes (effectively) a call to check_box to ensure there is a
- # box where expected, if there is then the contents of the box are
- # matched against REGEXP.
- proc check_box_contents {test_name x y width height regexp} {
- variable _chars
+ # Now grab the contents of the box, join each line together
+ # with a '\r\n' sequence and match against REGEXP.
+ set result [get_region $x $y $width $height "\r\n"]
+ return [regexp -- $regexp $result]
+}
- dump_box $x $y $width $height
- set why [_check_box $x $y $width $height]
- if {$why != ""} {
- fail "$test_name (box check: $why)"
- return
- }
+# Check that the region of the screen described by X, Y, WIDTH,
+# and HEIGHT match REGEXP. As check_region_contents_p, but produce
+# a pass/fail message.
+proc Term::check_region_contents { test_name x y width height regexp } {
+ set ok [check_region_contents_p $x $y $width $height $regexp]
+ gdb_assert {$ok} $test_name
+}
+
+# Check the contents of a box on the screen. This is a little
+# like check_contents, but doesn't check the whole screen
+# contents, only the contents of a single box. This procedure
+# includes (effectively) a call to check_box to ensure there is a
+# box where expected, if there is then the contents of the box are
+# matched against REGEXP.
+proc Term::check_box_contents {test_name x y width height regexp} {
+ variable _chars
- check_region_contents $test_name [expr {$x + 1}] [expr {$y + 1}] \
- [expr {$width - 2}] [expr {$height - 2}] $regexp
+ dump_box $x $y $width $height
+ set why [_check_box $x $y $width $height]
+ if {$why != ""} {
+ fail "$test_name (box check: $why)"
+ return
}
- # A debugging function to dump the current screen, with line
- # numbers. If ATTRS, annotate with attributes.
- proc dump_screen { {attrs 0} } {
- variable _rows
- variable _cols
- variable _cur_row
- variable _cur_col
+ check_region_contents $test_name [expr {$x + 1}] [expr {$y + 1}] \
+ [expr {$width - 2}] [expr {$height - 2}] $regexp
+}
- verbose -log "Screen Dump (size $_cols columns x $_rows rows, cursor at column $_cur_col, row $_cur_row):"
+# A debugging function to dump the current screen, with line
+# numbers. If ATTRS, annotate with attributes.
+proc Term::dump_screen { {attrs 0} } {
+ variable _rows
+ variable _cols
+ variable _cur_row
+ variable _cur_col
- for {set y 0} {$y < $_rows} {incr y} {
- set fmt [format %5d $y]
- verbose -log "$fmt [get_line_1 $y {} $attrs]"
- }
- }
+ verbose -log "Screen Dump (size $_cols columns x $_rows rows, cursor at column $_cur_col, row $_cur_row):"
- # As dump_screen, but with attributes annotation.
- proc dump_screen_with_attrs {} {
- return [dump_screen 1]
+ for {set y 0} {$y < $_rows} {incr y} {
+ set fmt [format %5d $y]
+ verbose -log "$fmt [get_line_1 $y {} $attrs]"
}
+}
- # A debugging function to dump a box from the current screen, with line
- # numbers.
- proc dump_box { x y width height } {
- verbose -log "Box Dump ($width x $height) @ ($x, $y):"
- set region [get_region $x $y $width $height "\n"]
- set lines [split $region "\n"]
- set nr $y
- foreach line $lines {
- set fmt [format %5d $nr]
- verbose -log "$fmt $line"
- incr nr
- }
+# As dump_screen, but with attributes annotation.
+proc Term::dump_screen_with_attrs {} {
+ return [dump_screen 1]
+}
+
+# A debugging function to dump a box from the current screen, with line
+# numbers.
+proc Term::dump_box { x y width height } {
+ verbose -log "Box Dump ($width x $height) @ ($x, $y):"
+ set region [get_region $x $y $width $height "\n"]
+ set lines [split $region "\n"]
+ set nr $y
+ foreach line $lines {
+ set fmt [format %5d $nr]
+ verbose -log "$fmt $line"
+ incr nr
}
+}
- # Resize the terminal.
- proc _do_resize {rows cols} {
- variable _chars
- variable _rows
- variable _cols
+# Resize the terminal.
+proc Term::_do_resize {rows cols} {
+ variable _chars
+ variable _rows
+ variable _cols
- set old_rows [expr {min ($_rows, $rows)}]
- set old_cols [expr {min ($_cols, $cols)}]
+ set old_rows [expr {min ($_rows, $rows)}]
+ set old_cols [expr {min ($_cols, $cols)}]
- # Copy locally.
- array set local_chars [array get _chars]
- unset _chars
+ # Copy locally.
+ array set local_chars [array get _chars]
+ unset _chars
- set _rows $rows
- set _cols $cols
- _clear_lines 0 $_rows
+ set _rows $rows
+ set _cols $cols
+ _clear_lines 0 $_rows
- for {set x 0} {$x < $old_cols} {incr x} {
- for {set y 0} {$y < $old_rows} {incr y} {
- set _chars($x,$y) $local_chars($x,$y)
- }
+ for {set x 0} {$x < $old_cols} {incr x} {
+ for {set y 0} {$y < $old_rows} {incr y} {
+ set _chars($x,$y) $local_chars($x,$y)
}
}
+}
- proc resize {rows cols {wait_for_msg 1}} {
- variable _rows
- variable _cols
- variable _resize_count
-
- # expect handles each argument to stty separately. This means
- # that gdb will see SIGWINCH twice. Rather than rely on this
- # behavior (which, after all, could be changed), we make it
- # explicit here. This also simplifies waiting for the redraw.
- _do_resize $rows $_cols
- stty rows $_rows < $::gdb_tty_name
- if { $wait_for_msg } {
- wait_for "@@ resize done $_resize_count, size = ${_cols}x${rows}"
- }
- incr _resize_count
- _do_resize $_rows $cols
- stty columns $_cols < $::gdb_tty_name
- if { $wait_for_msg } {
- wait_for "@@ resize done $_resize_count, size = ${_cols}x${rows}"
- }
- incr _resize_count
- }
+proc Term::resize {rows cols {wait_for_msg 1}} {
+ variable _rows
+ variable _cols
+ variable _resize_count
+
+ # expect handles each argument to stty separately. This means
+ # that gdb will see SIGWINCH twice. Rather than rely on this
+ # behavior (which, after all, could be changed), we make it
+ # explicit here. This also simplifies waiting for the redraw.
+ _do_resize $rows $_cols
+ stty rows $_rows < $::gdb_tty_name
+ if { $wait_for_msg } {
+ wait_for "@@ resize done $_resize_count, size = ${_cols}x${rows}"
+ }
+ incr _resize_count
+ _do_resize $_rows $cols
+ stty columns $_cols < $::gdb_tty_name
+ if { $wait_for_msg } {
+ wait_for "@@ resize done $_resize_count, size = ${_cols}x${rows}"
+ }
+ incr _resize_count
}