xkibitz   [plain text]

#!../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
}