Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | #!/bin/sh |
2 | # the next line restarts using wish \ | |
3 | exec wish8.4 "$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: rmt,v 1.3 2001/10/29 16:23:32 dkf Exp $ | |
11 | ||
12 | wm title . "Tk Remote Controller" | |
13 | wm iconname . "Tk Remote" | |
14 | wm minsize . 1 1 | |
15 | ||
16 | # The global variable below keeps track of the remote application | |
17 | # that we're sending to. If it's an empty string then we execute | |
18 | # the commands locally. | |
19 | ||
20 | set app "local" | |
21 | ||
22 | # The global variable below keeps track of whether we're in the | |
23 | # middle of executing a command entered via the text. | |
24 | ||
25 | set executing 0 | |
26 | ||
27 | # The global variable below keeps track of the last command executed, | |
28 | # so it can be re-executed in response to !! commands. | |
29 | ||
30 | set lastCommand "" | |
31 | ||
32 | # Create menu bar. Arrange to recreate all the information in the | |
33 | # applications sub-menu whenever it is cascaded to. | |
34 | ||
35 | . configure -menu [menu .menu] | |
36 | menu .menu.file | |
37 | menu .menu.file.apps -postcommand fillAppsMenu | |
38 | .menu add cascade -label "File" -underline 0 -menu .menu.file | |
39 | .menu.file add cascade -label "Select Application" -underline 0 \ | |
40 | -menu .menu.file.apps | |
41 | .menu.file add command -label "Quit" -command "destroy ." -underline 0 | |
42 | ||
43 | # Create text window and scrollbar. | |
44 | ||
45 | text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true | |
46 | scrollbar .s -command ".t yview" | |
47 | grid .t .s -sticky nsew | |
48 | grid rowconfigure . 0 -weight 1 | |
49 | grid columnconfigure . 0 -weight 1 | |
50 | ||
51 | # Create a binding to forward commands to the target application, | |
52 | # plus modify many of the built-in bindings so that only information | |
53 | # in the current command can be deleted (can still set the cursor | |
54 | # earlier in the text and select and insert; just can't delete). | |
55 | ||
56 | bindtags .t {.t Text . all} | |
57 | bind .t <Return> { | |
58 | .t mark set insert {end - 1c} | |
59 | .t insert insert \n | |
60 | invoke | |
61 | break | |
62 | } | |
63 | bind .t <Delete> { | |
64 | catch {.t tag remove sel sel.first promptEnd} | |
65 | if {[.t tag nextrange sel 1.0 end] == ""} { | |
66 | if [.t compare insert < promptEnd] { | |
67 | break | |
68 | } | |
69 | } | |
70 | } | |
71 | bind .t <BackSpace> { | |
72 | catch {.t tag remove sel sel.first promptEnd} | |
73 | if {[.t tag nextrange sel 1.0 end] == ""} { | |
74 | if [.t compare insert <= promptEnd] { | |
75 | break | |
76 | } | |
77 | } | |
78 | } | |
79 | bind .t <Control-d> { | |
80 | if [.t compare insert < promptEnd] { | |
81 | break | |
82 | } | |
83 | } | |
84 | bind .t <Control-k> { | |
85 | if [.t compare insert < promptEnd] { | |
86 | .t mark set insert promptEnd | |
87 | } | |
88 | } | |
89 | bind .t <Control-t> { | |
90 | if [.t compare insert < promptEnd] { | |
91 | break | |
92 | } | |
93 | } | |
94 | bind .t <Meta-d> { | |
95 | if [.t compare insert < promptEnd] { | |
96 | break | |
97 | } | |
98 | } | |
99 | bind .t <Meta-BackSpace> { | |
100 | if [.t compare insert <= promptEnd] { | |
101 | break | |
102 | } | |
103 | } | |
104 | bind .t <Control-h> { | |
105 | if [.t compare insert <= promptEnd] { | |
106 | break | |
107 | } | |
108 | } | |
109 | auto_load tkTextInsert | |
110 | proc tkTextInsert {w s} { | |
111 | if {$s == ""} { | |
112 | return | |
113 | } | |
114 | catch { | |
115 | if {[$w compare sel.first <= insert] | |
116 | && [$w compare sel.last >= insert]} { | |
117 | $w tag remove sel sel.first promptEnd | |
118 | $w delete sel.first sel.last | |
119 | } | |
120 | } | |
121 | $w insert insert $s | |
122 | $w see insert | |
123 | } | |
124 | ||
125 | .t configure -font {Courier 12} | |
126 | .t tag configure bold -font {Courier 12 bold} | |
127 | ||
128 | # The procedure below is used to print out a prompt at the | |
129 | # insertion point (which should be at the beginning of a line | |
130 | # right now). | |
131 | ||
132 | proc prompt {} { | |
133 | global app | |
134 | .t insert insert "$app: " | |
135 | .t mark set promptEnd {insert} | |
136 | .t mark gravity promptEnd left | |
137 | .t tag add bold {promptEnd linestart} promptEnd | |
138 | } | |
139 | ||
140 | # The procedure below executes a command (it takes everything on the | |
141 | # current line after the prompt and either sends it to the remote | |
142 | # application or executes it locally, depending on "app". | |
143 | ||
144 | proc invoke {} { | |
145 | global app executing lastCommand | |
146 | set cmd [.t get promptEnd insert] | |
147 | incr executing 1 | |
148 | if [info complete $cmd] { | |
149 | if {$cmd == "!!\n"} { | |
150 | set cmd $lastCommand | |
151 | } else { | |
152 | set lastCommand $cmd | |
153 | } | |
154 | if {$app == "local"} { | |
155 | set result [catch [list uplevel #0 $cmd] msg] | |
156 | } else { | |
157 | set result [catch [list send $app $cmd] msg] | |
158 | } | |
159 | if {$result != 0} { | |
160 | .t insert insert "Error: $msg\n" | |
161 | } else { | |
162 | if {$msg != ""} { | |
163 | .t insert insert $msg\n | |
164 | } | |
165 | } | |
166 | prompt | |
167 | .t mark set promptEnd insert | |
168 | } | |
169 | incr executing -1 | |
170 | .t yview -pickplace insert | |
171 | } | |
172 | ||
173 | # The following procedure is invoked to change the application that | |
174 | # we're talking to. It also updates the prompt for the current | |
175 | # command, unless we're in the middle of executing a command from | |
176 | # the text item (in which case a new prompt is about to be output | |
177 | # so there's no need to change the old one). | |
178 | ||
179 | proc newApp appName { | |
180 | global app executing | |
181 | set app $appName | |
182 | if !$executing { | |
183 | .t mark gravity promptEnd right | |
184 | .t delete "promptEnd linestart" promptEnd | |
185 | .t insert promptEnd "$appName: " | |
186 | .t tag add bold "promptEnd linestart" promptEnd | |
187 | .t mark gravity promptEnd left | |
188 | } | |
189 | return {} | |
190 | } | |
191 | ||
192 | # The procedure below will fill in the applications sub-menu with a list | |
193 | # of all the applications that currently exist. | |
194 | ||
195 | proc fillAppsMenu {} { | |
196 | set m .menu.file.apps | |
197 | catch {$m delete 0 last} | |
198 | foreach i [lsort [winfo interps]] { | |
199 | $m add command -label $i -command [list newApp $i] | |
200 | } | |
201 | $m add command -label local -command {newApp local} | |
202 | } | |
203 | ||
204 | set app [winfo name .] | |
205 | prompt | |
206 | focus .t | |
207 | ||
208 | # Local Variables: | |
209 | # mode: tcl | |
210 | # End: |