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