2 # the next line restarts using wish \
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 # RCS: @(#) $Id: rmt,v 1.6 2007/12/13 15:27:07 dgp Exp $
12 package require Tcl
8.4
15 wm title .
"Tk Remote Controller"
16 wm iconname .
"Tk Remote"
19 # The global variable below keeps track of the remote application
20 # that we're sending to. If it's an empty string then we execute
21 # the commands locally.
25 # The global variable below keeps track of whether we're in the
26 # middle of executing a command entered via the text.
30 # The global variable below keeps track of the last command executed,
31 # so it can be re-executed in response to !! commands.
35 # Create menu bar. Arrange to recreate all the information in the
36 # applications sub-menu whenever it is cascaded to.
38 . configure
-menu [menu .menu
]
40 menu .menu.
file.apps
-postcommand fillAppsMenu
41 .menu add cascade
-label "File" -underline 0 -menu .menu.
file
42 .menu.
file add cascade
-label "Select Application" -underline 0 \
44 .menu.
file add
command -label "Quit" -command "destroy ." -underline 0
46 # Create text window and scrollbar.
48 text .t
-yscrollcommand ".s set" -setgrid true
49 scrollbar .s
-command ".t yview"
50 grid .t .s
-sticky nsew
51 grid rowconfigure .
0 -weight 1
52 grid columnconfigure .
0 -weight 1
54 # Create a binding to forward commands to the target application,
55 # plus modify many of the built-in bindings so that only information
56 # in the current command can be deleted (can still set the cursor
57 # earlier in the text and select and insert; just can't delete).
59 bindtags .t
{.t Text . all
}
61 .t mark
set insert
{end
- 1c
}
67 catch
{.t tag remove sel sel.first promptEnd
}
68 if {[.t tag nextrange sel
1.0 end
] eq
""} {
69 if {[.t compare insert
< promptEnd
]} {
75 catch
{.t tag remove sel sel.first promptEnd
}
76 if {[.t tag nextrange sel
1.0 end
] eq
""} {
77 if {[.t compare insert
<= promptEnd
]} {
83 if {[.t compare insert
< promptEnd
]} {
88 if {[.t compare insert
< promptEnd
]} {
89 .t mark
set insert promptEnd
93 if {[.t compare insert
< promptEnd
]} {
98 if {[.t compare insert
< promptEnd
]} {
102 bind .t
<Meta-BackSpace
> {
103 if {[.t compare insert
<= promptEnd
]} {
107 bind .t
<Control-h
> {
108 if {[.t compare insert
<= promptEnd
]} {
112 ### This next bit *isn't* nice - DKF ###
113 auto_load tk
::TextInsert
114 proc tk
::TextInsert
{w s
} {
120 [$w compare sel.first
<= insert
] && [$w compare sel.last
>= insert
]
122 $w tag remove sel sel.first promptEnd
123 $w delete sel.first sel.last
130 .t configure
-font {Courier
12}
131 .t tag configure bold
-font {Courier
12 bold
}
133 # The procedure below is used to print out a prompt at the
134 # insertion point (which should be at the beginning of a line
139 .t insert insert
"$app: "
140 .t mark
set promptEnd
{insert
}
141 .t mark gravity promptEnd left
142 .t tag add bold
{promptEnd linestart
} promptEnd
145 # The procedure below executes a command (it takes everything on the
146 # current line after the prompt and either sends it to the remote
147 # application or executes it locally, depending on "app".
150 global app executing lastCommand
151 set cmd
[.t get promptEnd insert
]
153 if {[info complete
$cmd]} {
154 if {$cmd eq
"!!\n"} {
159 if {$app eq
"local"} {
160 set result
[catch
[list uplevel
#0 $cmd] msg]
162 set result
[catch
[list send
$app $cmd] msg
]
165 .t insert insert
"Error: $msg\n"
166 } elseif
{$msg ne
""} {
167 .t insert insert
$msg\n
170 .t mark
set promptEnd insert
173 .t yview
-pickplace insert
176 # The following procedure is invoked to change the application that
177 # we're talking to. It also updates the prompt for the current
178 # command, unless we're in the middle of executing a command from
179 # the text item (in which case a new prompt is about to be output
180 # so there's no need to change the old one).
182 proc newApp appName
{
186 .t mark gravity promptEnd right
187 .t delete
"promptEnd linestart" promptEnd
188 .t insert promptEnd
"$appName: "
189 .t tag add bold
"promptEnd linestart" promptEnd
190 .t mark gravity promptEnd left
195 # The procedure below will fill in the applications sub-menu with a list
196 # of all the applications that currently exist.
198 proc fillAppsMenu
{} {
199 set m .menu.
file.apps
200 catch
{$m delete
0 last
}
201 foreach i
[lsort
[winfo interps
]] {
202 $m add
command -label $i -command [list newApp
$i]
204 $m add
command -label local -command {newApp
local}
207 set app
[winfo name .
]