rmt revision 3f54fd611f536639ec30dd53c48e5ec1897cc7d9
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# rmt --
# 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.
#
# SCCS: @(#) rmt 1.9 96/02/16 10:49:22
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" \
-menu .menu.file.m.apps -underline 0
.menu.file.m add command -label "Quit" -command "destroy ." -underline 0
menu .menu.file.m.apps -postcommand fillAppsMenu
pack .menu.file -side left
# Create text window and scrollbar.
text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
scrollbar .s -command ".t yview"
pack .s -side right -fill both
pack .t -side left
# Create a binding to forward commands to the target application,
# plus modify many of the built-in bindings so that only information
# in the current command can be deleted (can still set the cursor
# earlier in the text and select and insert; just can't delete).
bindtags .t {.t Text . all}
bind .t <Return> {
.t mark set insert {end - 1c}
.t insert insert \n
invoke
break
}
bind .t <Delete> {
catch {.t tag remove sel sel.first promptEnd}
if {[.t tag nextrange sel 1.0 end] == ""} {
if [.t compare insert < promptEnd] {
break
}
}
}
bind .t <BackSpace> {
catch {.t tag remove sel sel.first promptEnd}
if {[.t tag nextrange sel 1.0 end] == ""} {
if [.t compare insert <= promptEnd] {
break
}
}
}
bind .t <Control-d> {
if [.t compare insert < promptEnd] {
break
}
}
bind .t <Control-k> {
if [.t compare insert < promptEnd] {
.t mark set insert promptEnd
}
}
bind .t <Control-t> {
if [.t compare insert < promptEnd] {
break
}
}
bind .t <Meta-d> {
if [.t compare insert < promptEnd] {
break
}
}
bind .t <Meta-BackSpace> {
if [.t compare insert <= promptEnd] {
break
}
}
bind .t <Control-h> {
if [.t compare insert <= promptEnd] {
break
}
}
auto_load tkTextInsert
proc tkTextInsert {w s} {
if {$s == ""} {
return
}
catch {
if {[$w compare sel.first <= insert]
&& [$w compare sel.last >= insert]} {
$w tag remove sel sel.first promptEnd
$w delete sel.first sel.last
}
}
$w insert insert $s
$w see insert
}
.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}
.t mark gravity promptEnd left
.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 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
}
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 mark gravity promptEnd right
.t delete "promptEnd linestart" promptEnd
.t insert promptEnd "$appName: "
.t tag add bold "promptEnd linestart" promptEnd
.t mark gravity promptEnd left
}
return {}
}
# 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