blob: d7eff97879d72f2c53acebdeb01842c148ea4bfd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
# tty.tcl - xterm as tty for the inferior
# Copyright (C) 1996, 2000 Red Hat, Inc
# Written by Tom Tromey <tromey@cygnus.com>
#
# Interface to the inferior's terminal. This is very rough, and is
# guaranteed to only work on Unix machines (if even there).
#
namespace eval tty {
namespace export create
variable _xterm_fd {}
proc create {} {
variable _xterm_fd
destroy
# Tricky: we exec /bin/cat so that the xterm will exit whenever we
# close the write end of the pipe. Note that the stdin
# redirection must come after tty is run; tty looks at its stdin.
set shcmd {/bin/sh -c 'exec 1>&7; tty; exec /bin/cat 0<&6'}
set fg [option get . foreground Foreground]
if {$fg == ""} then {
set fg black
}
set bg [. cget -background]
if {$bg == ""} then {
set bg [lindex [. configure -background] 3]
}
set xterm [list /bin/sh -c "exec xterm -T 'Gdb Child' -n Gdb -bg '$bg' -fg '$fg' -e $shcmd 6<&0 7>&1"]
# Need both read and write access to xterm process.
set _xterm_fd [open "| $xterm" w+]
set tty [gets $_xterm_fd]
# On failure we don't try the tty command.
if {$tty != ""} {
gdb_cmd "tty $tty"
}
}
proc destroy {} {
variable _xterm_fd
if {$_xterm_fd != ""} then {
# We don't care if this fails.
catch {close $_xterm_fd}
}
set _xterm_fd {}
}
}
|
