Subversion Repositories or1k

#!../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 "+        add"

        puts "-            drop"

        puts "where  is an X display name such as nist.gov or nist.gov:0.0"

        puts "and  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

        }

}

exit -onexit {

        unset pid2display([pid])        ;# avoid killing self

        foreach pid [array names pid2display] {

                catch {exec kill -9 $pid}

        }

}

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

        } -output $prog

        -input ids -output $prog

        -input $prog -output $user_spawn_id -output ids

}