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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
#!/bin/sh
# -*- tcl -*-
# The next line is executed by /bin/sh, but not tcl \
exec tclsh "$0" ${1+"$@"}
package require Expect
# share an xterm with other users
# See xkibitz(1) man page for complete info.
# Compare with kibitz.
# Author: Don Libes, NIST
# Version: 1.2
proc help {} {
puts "Commands Meaning"
puts "-------- -------"
puts "return return to program"
puts "= list"
puts "+ <display> add"
puts "- <tag> drop"
puts "where <display> is an X display name such as nist.gov or nist.gov:0.0"
puts "and <tag> is a tag from the = command."
puts "+ and - require whitespace before argument."
puts {return command must be spelled out ("r", "e", "t", ...).}
}
proc prompt1 {} {
return "xkibitz> "
}
proc h {} help
proc ? {} help
# disable history processing - there seems to be some incestuous relationship
# between history and unknown in Tcl 8.0
proc history {args} {}
proc unknown {args} {
puts "$args: invalid command"
help
}
set tag2pid(0) [pid]
set pid2tty([pid]) "/dev/tty"
if {[info exists env(DISPLAY)]} {
set pid2display([pid]) $env(DISPLAY)
} else {
set pid2display([pid]) ""
}
# small int allowing user to more easily identify display
# maxtag always points at highest in use
set maxtag 0
proc + {display} {
global ids pid2display pid2tag tag2pid maxtag pid2sid
global pid2tty env
if {![string match *:* $display]} {
append display :0.0
}
if {![info exists env(XKIBITZ_XTERM_ARGS)]} {
set env(XKIBITZ_XTERM_ARGS) ""
}
set dummy1 [open /dev/null]
set dummy2 [open /dev/null]
spawn -pty -noecho
close $dummy1
close $dummy2
stty raw -echo < $spawn_out(slave,name)
# Linux needs additional stty, sounds like a bug in its stty to me.
# raw should imply this stuff, no?
stty -icrnl -icanon < $spawn_out(slave,name)
regexp ".*(.)(.)" $spawn_out(slave,name) dummy c1 c2
if {[string compare $c1 "/"] == 0} {
# On Pyramid and AIX, ttynames such as /dev/pts/1
# requre suffix to be padded with a 0
set c1 0
}
set pid [eval exec xterm \
-display $display \
-geometry [stty columns]x[stty rows] \
-S$c1$c2$spawn_out(slave,fd) \
$env(XKIBITZ_XTERM_ARGS) &]
close -slave
# xterm first sends back window id, discard
log_user 0
expect {
eof {wait;return}
\n
}
log_user 1
lappend ids $spawn_id
set pid2display($pid) $display
incr maxtag
set tag2pid($maxtag) $pid
set pid2tag($pid) $maxtag
set pid2sid($pid) $spawn_id
set pid2tty($pid) $spawn_out(slave,name)
return
}
proc = {} {
global pid2display tag2pid pid2tty
puts "Tag Size Display"
foreach tag [lsort -integer [array names tag2pid]] {
set pid $tag2pid($tag)
set tty $pid2tty($pid)
puts [format "%3d [stty columns < $tty]x[stty rows < $tty] $pid2display($pid)" $tag]
}
}
proc - {tag} {
global tag2pid pid2tag pid2display maxtag ids pid2sid
global pid2tty
if {![info exists tag2pid($tag)]} {
puts "no such tag"
return
}
if {$tag == 0} {
puts "cannot drop self"
return
}
set pid $tag2pid($tag)
# close and remove spawn_id from list
set spawn_id $pid2sid($pid)
set index [lsearch $ids $spawn_id]
set ids [lreplace $ids $index $index]
exec kill -9 $pid
close
wait
unset tag2pid($tag)
unset pid2tag($pid)
unset pid2display($pid)
unset pid2sid($pid)
unset pid2tty($pid)
# lower maxtag if possible
while {![info exists tag2pid($maxtag)]} {
incr maxtag -1
}
}
rename exit exitReal
proc exit {} {
global pid2display
unset pid2display([pid]) ;# avoid killing self
foreach pid [array names pid2display] {
catch {exec kill -9 $pid}
}
exitReal
}
trap exit HUP
trap {
set r [stty rows]
set c [stty columns]
stty rows $r columns $c < $app_tty
foreach pid [array names pid2tty] {
if {$pid == [pid]} continue
stty rows $r columns $c < $pid2tty($pid)
}
} WINCH
set escape \035 ;# control-right-bracket
set escape_printable "^\]"
while {[llength $argv]>0} {
set flag [lindex $argv 0]
switch -- $flag \
"-escape" {
set escape [lindex $argv 1]
set escape_printable $escape
set argv [lrange $argv 2 end]
} "-display" {
+ [lindex $argv 1]
set argv [lrange $argv 2 end]
} default {
break
}
}
if {[llength $argv]>0} {
eval spawn -noecho $argv
} else {
spawn -noecho $env(SHELL)
}
set prog $spawn_id
set app_tty $spawn_out(slave,name)
puts "Escape sequence is $escape_printable"
interact {
-input $user_spawn_id -reset $escape {
puts "\nfor help enter: ? or h or help"
interpreter -eof exit
} -output $prog
-input ids -output $prog
-input $prog eof exit -output $user_spawn_id -output ids
}
|
