2 # the next line restarts using wish \
3 exec wish85
"$0" ${1+"$@"}
6 # This script implements a simple remote-control mechanism for
7 # Tk applications. It allows you to select an application and
8 # then type commands to that application.
10 package require Tcl
8.4
13 wm title .
"Tk Remote Controller"
14 wm iconname .
"Tk Remote"
17 # The global variable below keeps track of the remote application
18 # that we're sending to. If it's an empty string then we execute
19 # the commands locally.
23 # The global variable below keeps track of whether we're in the
24 # middle of executing a command entered via the text.
28 # The global variable below keeps track of the last command executed,
29 # so it can be re-executed in response to !! commands.
33 # Create menu bar. Arrange to recreate all the information in the
34 # applications sub-menu whenever it is cascaded to.
36 . configure
-menu [menu .menu
]
38 menu .menu.
file.apps
-postcommand fillAppsMenu
39 .menu add cascade
-label "File" -underline 0 -menu .menu.
file
40 .menu.
file add cascade
-label "Select Application" -underline 0 \
42 .menu.
file add
command -label "Quit" -command "destroy ." -underline 0
44 # Create text window and scrollbar.
46 text .t
-yscrollcommand ".s set" -setgrid true
47 scrollbar .s
-command ".t yview"
48 grid .t .s
-sticky nsew
49 grid rowconfigure .
0 -weight 1
50 grid columnconfigure .
0 -weight 1
52 # Create a binding to forward commands to the target application,
53 # plus modify many of the built-in bindings so that only information
54 # in the current command can be deleted (can still set the cursor
55 # earlier in the text and select and insert; just can't delete).
57 bindtags .t
{.t Text . all
}
59 .t mark
set insert
{end
- 1c
}
65 catch
{.t tag remove sel sel.first promptEnd
}
66 if {[.t tag nextrange sel
1.0 end
] eq
""} {
67 if {[.t compare insert
< promptEnd
]} {
73 catch
{.t tag remove sel sel.first promptEnd
}
74 if {[.t tag nextrange sel
1.0 end
] eq
""} {
75 if {[.t compare insert
<= promptEnd
]} {
81 if {[.t compare insert
< promptEnd
]} {
86 if {[.t compare insert
< promptEnd
]} {
87 .t mark
set insert promptEnd
91 if {[.t compare insert
< promptEnd
]} {
96 if {[.t compare insert
< promptEnd
]} {
100 bind .t
<Meta-BackSpace
> {
101 if {[.t compare insert
<= promptEnd
]} {
105 bind .t
<Control-h
> {
106 if {[.t compare insert
<= promptEnd
]} {
110 ### This next bit *isn't* nice - DKF ###
111 auto_load tk
::TextInsert
112 proc tk
::TextInsert
{w s
} {
118 [$w compare sel.first
<= insert
] && [$w compare sel.last
>= insert
]
120 $w tag remove sel sel.first promptEnd
121 $w delete sel.first sel.last
128 .t configure
-font {Courier
12}
129 .t tag configure bold
-font {Courier
12 bold
}
131 # The procedure below is used to print out a prompt at the
132 # insertion point (which should be at the beginning of a line
137 .t insert insert
"$app: "
138 .t mark
set promptEnd
{insert
}
139 .t mark gravity promptEnd left
140 .t tag add bold
{promptEnd linestart
} promptEnd
143 # The procedure below executes a command (it takes everything on the
144 # current line after the prompt and either sends it to the remote
145 # application or executes it locally, depending on "app".
148 global app executing lastCommand
149 set cmd
[.t get promptEnd insert
]
151 if {[info complete
$cmd]} {
152 if {$cmd eq
"!!\n"} {
157 if {$app eq
"local"} {
158 set result
[catch
[list uplevel
#0 $cmd] msg]
160 set result
[catch
[list send
$app $cmd] msg
]
163 .t insert insert
"Error: $msg\n"
164 } elseif
{$msg ne
""} {
165 .t insert insert
$msg\n
168 .t mark
set promptEnd insert
171 .t yview
-pickplace insert
174 # The following procedure is invoked to change the application that
175 # we're talking to. It also updates the prompt for the current
176 # command, unless we're in the middle of executing a command from
177 # the text item (in which case a new prompt is about to be output
178 # so there's no need to change the old one).
180 proc newApp appName
{
184 .t mark gravity promptEnd right
185 .t delete
"promptEnd linestart" promptEnd
186 .t insert promptEnd
"$appName: "
187 .t tag add bold
"promptEnd linestart" promptEnd
188 .t mark gravity promptEnd left
193 # The procedure below will fill in the applications sub-menu with a list
194 # of all the applications that currently exist.
196 proc fillAppsMenu
{} {
197 set m .menu.
file.apps
198 catch
{$m delete
0 last
}
199 foreach i
[lsort
[winfo interps
]] {
200 $m add
command -label $i -command [list newApp
$i]
202 $m add
command -label local -command {newApp
local}
205 set app
[winfo name .
]