You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
211 lines
5.2 KiB
211 lines
5.2 KiB
6 years ago
|
#!/bin/sh
|
||
|
# the next line restarts using wish \
|
||
|
exec wish "$0" ${1+"$@"}
|
||
|
|
||
|
# 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.
|
||
|
|
||
|
package require Tk
|
||
|
|
||
|
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.
|
||
|
|
||
|
. configure -menu [menu .menu]
|
||
|
menu .menu.file
|
||
|
menu .menu.file.apps -postcommand fillAppsMenu
|
||
|
.menu add cascade -label "File" -underline 0 -menu .menu.file
|
||
|
.menu.file add cascade -label "Select Application" -underline 0 \
|
||
|
-menu .menu.file.apps
|
||
|
.menu.file add command -label "Quit" -command "destroy ." -underline 0
|
||
|
|
||
|
# Create text window and scrollbar.
|
||
|
|
||
|
text .t -yscrollcommand ".s set" -setgrid true
|
||
|
scrollbar .s -command ".t yview"
|
||
|
grid .t .s -sticky nsew
|
||
|
grid rowconfigure . 0 -weight 1
|
||
|
grid columnconfigure . 0 -weight 1
|
||
|
|
||
|
# 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] eq ""} {
|
||
|
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] eq ""} {
|
||
|
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
|
||
|
}
|
||
|
}
|
||
|
### This next bit *isn't* nice - DKF ###
|
||
|
auto_load tk::TextInsert
|
||
|
proc tk::TextInsert {w s} {
|
||
|
if {$s eq ""} {
|
||
|
return
|
||
|
}
|
||
|
catch {
|
||
|
if {
|
||
|
[$w compare sel.first <= insert] && [$w compare sel.last >= insert]
|
||
|
} then {
|
||
|
$w tag remove sel sel.first promptEnd
|
||
|
$w delete sel.first sel.last
|
||
|
}
|
||
|
}
|
||
|
$w insert insert $s
|
||
|
$w see insert
|
||
|
}
|
||
|
|
||
|
.t configure -font {Courier 12}
|
||
|
.t tag configure bold -font {Courier 12 bold}
|
||
|
|
||
|
# 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 eq "!!\n"} {
|
||
|
set cmd $lastCommand
|
||
|
} else {
|
||
|
set lastCommand $cmd
|
||
|
}
|
||
|
if {$app eq "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"
|
||
|
} elseif {$msg ne ""} {
|
||
|
.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 {} {
|
||
|
set m .menu.file.apps
|
||
|
catch {$m delete 0 last}
|
||
|
foreach i [lsort [winfo interps]] {
|
||
|
$m add command -label $i -command [list newApp $i]
|
||
|
}
|
||
|
$m add command -label local -command {newApp local}
|
||
|
}
|
||
|
|
||
|
set app [winfo name .]
|
||
|
prompt
|
||
|
focus .t
|
||
|
|
||
|
# Local Variables:
|
||
|
# mode: tcl
|
||
|
# End:
|