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 "+ <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
        }
}

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
}