archie/tk3.6/library/demos/rmt

#!/usr/local/bin/wish -f
#
# This script implements a simple remote-control mechanism for
# Tk applications.  It allows you to select an application and
# then type commands to that application.

wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
wm minsize . 1 1

# The global variable below keeps track of the remote application
# that we're sending to.  If it's an empty string then we execute
# the commands locally.

set app "local"

# The global variable below keeps track of whether we're in the
# middle of executing a command entered via the text.

set executing 0

# The global variable below keeps track of the last command executed,
# so it can be re-executed in response to !! commands.

set lastCommand ""

# Create menu bar.  Arrange to recreate all the information in the
# applications sub-menu whenever it is cascaded to.

frame .menu -relief raised -bd 2
pack .menu -side top -fill x
menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
menu .menu.file.m
.menu.file.m add cascade -label "Select Application" -command fillAppsMenu \
	-menu .menu.file.m.apps -underline 0
.menu.file.m add command -label "Quit" -command "destroy ." -underline 0
menu .menu.file.m.apps
pack .menu.file -side left
tk_menuBar .menu .menu.file

# Create text window and scrollbar, and set up bindings for text
# window to foward commands to a remote application.

text .t -relief raised -bd 2 -yscrollcommand ".s set" -setgrid true
scrollbar .s -relief flat -command ".t yview"
pack .s -side right -fill both
pack .t -side left

bind .t <1> {
    set tk_priv(selectMode) char
    %W mark set anchor @%x,%y
    if {[lindex [%W config -state] 4] == "normal"} {focus %W}
}
bind .t <Double-1> {
    set tk_priv(selectMode) word
    tk_textSelectTo %W @%x,%y
}
bind .t <Triple-1> {
    set tk_priv(selectMode) line
    tk_textSelectTo %W @%x,%y
}
bind .t <Control-u> {
    .t delete {promptEnd + 1 char} insert
    .t yview -pickplace insert
}
bind .t <Return> {.t insert insert \n; invoke}
bind .t <BackSpace> backspace
bind .t <Delete> backspace
bind .t <Control-h> backspace
bind .t <Control-v> {
    .t insert insert [selection get]
    .t yview -pickplace insert
    if [string match *.0 [.t index insert]] {
	invoke
    }
}

.t tag configure bold -font *-Courier-Bold-R-Normal-*-120-*

# The procedure below is used to print out a prompt at the
# insertion point (which should be at the beginning of a line
# right now).

proc prompt {} {
    global app
    .t insert insert "$app: "
    .t mark set promptEnd {insert - 1 char}
    .t tag add bold {promptEnd linestart} promptEnd
}

# The procedure below executes a command (it takes everything on the
# current line after the prompt and either sends it to the remote
# application or executes it locally, depending on "app".

proc invoke {} {
    global app executing lastCommand
    set cmd [.t get promptEnd+1c insert]
    incr executing 1
    if [info complete $cmd] {
	if {$cmd == "!!\n"} {
	    set cmd $lastCommand
	} else {
	    set lastCommand $cmd
	}
	if {$app == "local"} {
	    set result [catch [list uplevel #0 $cmd] msg]
	} else {
	    set result [catch [list send $app $cmd] msg]
	}
	if {$result != 0} {
	    .t insert insert "Error: $msg\n"
	} else {
	    if {$msg != ""} {
		.t insert insert $msg\n
	    }
	}
	prompt
	.t mark set promptEnd insert-1c
    }
    incr executing -1
    .t yview -pickplace insert
}

# The following procedure is invoked to change the application that
# we're talking to.  It also updates the prompt for the current
# command, unless we're in the middle of executing a command from
# the text item (in which case a new prompt is about to be output
# so there's no need to change the old one).

proc newApp appName {
    global app executing
    set app $appName
    if !$executing {
	.t delete "promptEnd linestart" promptEnd
	.t insert promptEnd "$appName:"
	.t tag add bold "promptEnd linestart" promptEnd
    }
    return {}
}

# The following procedure below handles backspaces, being careful not
# to backspace over the prompt.

proc backspace {} {
    if {[.t index promptEnd] != [.t index {insert - 1 char}]} {
	.t delete insert-1c insert
	.t yview -pickplace insert
    }
}

# The procedure below will fill in the applications sub-menu with a list
# of all the applications that currently exist.

proc fillAppsMenu {} {
    catch {.menu.file.m.apps delete 0 last}
    foreach i [lsort [winfo interps]] {
	.menu.file.m.apps add command -label $i -command [list newApp $i]
    }
    .menu.file.m.apps add command -label local -command {newApp local}
}

set app [winfo name .]
prompt
focus .t