1#!/bin/sh
2# the next line restarts using wish \
3exec wish "$0" "$@"
4
5# rmt --
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.
9#
10# RCS: @(#) $Id$
11
12package require Tcl 8.4
13package require Tk
14
15wm title . "Tk Remote Controller"
16wm iconname . "Tk Remote"
17wm minsize . 1 1
18
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.
22
23set app "local"
24
25# The global variable below keeps track of whether we're in the
26# middle of executing a command entered via the text.
27
28set executing 0
29
30# The global variable below keeps track of the last command executed,
31# so it can be re-executed in response to !! commands.
32
33set lastCommand ""
34
35# Create menu bar.  Arrange to recreate all the information in the
36# applications sub-menu whenever it is cascaded to.
37
38. configure -menu [menu .menu]
39menu .menu.file
40menu .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 \
43	-menu .menu.file.apps
44.menu.file add command  -label "Quit"  -command "destroy ."  -underline 0
45
46# Create text window and scrollbar.
47
48text .t -yscrollcommand ".s set" -setgrid true
49scrollbar .s -command ".t yview"
50grid .t .s -sticky nsew
51grid rowconfigure . 0 -weight 1
52grid columnconfigure . 0 -weight 1
53
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).
58
59bindtags .t {.t Text . all}
60bind .t <Return> {
61    .t mark set insert {end - 1c}
62    .t insert insert \n
63    invoke
64    break
65}
66bind .t <Delete> {
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]} {
70	    break
71	}
72    }
73}
74bind .t <BackSpace> {
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]} {
78	    break
79	}
80    }
81}
82bind .t <Control-d> {
83    if {[.t compare insert < promptEnd]} {
84	break
85    }
86}
87bind .t <Control-k> {
88    if {[.t compare insert < promptEnd]} {
89	.t mark set insert promptEnd
90    }
91}
92bind .t <Control-t> {
93    if {[.t compare insert < promptEnd]} {
94	break
95    }
96}
97bind .t <Meta-d> {
98    if {[.t compare insert < promptEnd]} {
99	break
100    }
101}
102bind .t <Meta-BackSpace> {
103    if {[.t compare insert <= promptEnd]} {
104	break
105    }
106}
107bind .t <Control-h> {
108    if {[.t compare insert <= promptEnd]} {
109	break
110    }
111}
112### This next bit *isn't* nice - DKF ###
113auto_load tk::TextInsert
114proc tk::TextInsert {w s} {
115    if {$s eq ""} {
116	return
117    }
118    catch {
119	if {
120	    [$w compare sel.first <= insert] && [$w compare sel.last >= insert]
121	} then {
122	    $w tag remove sel sel.first promptEnd
123	    $w delete sel.first sel.last
124	}
125    }
126    $w insert insert $s
127    $w see insert
128}
129
130.t configure -font {Courier 12}
131.t tag configure bold -font {Courier 12 bold}
132
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
135# right now).
136
137proc prompt {} {
138    global app
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
143}
144
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".
148
149proc invoke {} {
150    global app executing lastCommand
151    set cmd [.t get promptEnd insert]
152    incr executing 1
153    if {[info complete $cmd]} {
154	if {$cmd eq "!!\n"} {
155	    set cmd $lastCommand
156	} else {
157	    set lastCommand $cmd
158	}
159	if {$app eq "local"} {
160	    set result [catch [list uplevel #0 $cmd] msg]
161	} else {
162	    set result [catch [list send $app $cmd] msg]
163	}
164	if {$result != 0} {
165	    .t insert insert "Error: $msg\n"
166	} elseif {$msg ne ""} {
167	    .t insert insert $msg\n
168	}
169	prompt
170	.t mark set promptEnd insert
171    }
172    incr executing -1
173    .t yview -pickplace insert
174}
175
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).
181
182proc newApp appName {
183    global app executing
184    set app $appName
185    if {!$executing} {
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
191    }
192    return
193}
194
195# The procedure below will fill in the applications sub-menu with a list
196# of all the applications that currently exist.
197
198proc 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]
203    }
204    $m add command -label local -command {newApp local}
205}
206
207set app [winfo name .]
208prompt
209focus .t
210
211# Local Variables:
212# mode: tcl
213# End:
214