home *** CD-ROM | disk | FTP | other *** search
- #!/usr/skunk/bin/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
- 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)
- 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
- }
- }
-
- exit -onexit {
- unset pid2display([pid]) ;# avoid killing self
-
- foreach pid [array names pid2display] {
- catch {exec kill $pid}
- }
- }
-
- 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
- } -output $prog
- -input ids -output $prog
- -input $prog -output $user_spawn_id -output ids
- }
-
-