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: rmt,v 1.3 2001/10/29 16:23:32 dkf Exp $ 11 12wm title . "Tk Remote Controller" 13wm iconname . "Tk Remote" 14wm 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 20set 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 25set 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 30set 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] 36menu .menu.file 37menu .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 45text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true 46scrollbar .s -command ".t yview" 47grid .t .s -sticky nsew 48grid rowconfigure . 0 -weight 1 49grid 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 56bindtags .t {.t Text . all} 57bind .t <Return> { 58 .t mark set insert {end - 1c} 59 .t insert insert \n 60 invoke 61 break 62} 63bind .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} 71bind .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} 79bind .t <Control-d> { 80 if [.t compare insert < promptEnd] { 81 break 82 } 83} 84bind .t <Control-k> { 85 if [.t compare insert < promptEnd] { 86 .t mark set insert promptEnd 87 } 88} 89bind .t <Control-t> { 90 if [.t compare insert < promptEnd] { 91 break 92 } 93} 94bind .t <Meta-d> { 95 if [.t compare insert < promptEnd] { 96 break 97 } 98} 99bind .t <Meta-BackSpace> { 100 if [.t compare insert <= promptEnd] { 101 break 102 } 103} 104bind .t <Control-h> { 105 if [.t compare insert <= promptEnd] { 106 break 107 } 108} 109auto_load tkTextInsert 110proc 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 132proc 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 144proc 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 179proc 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 195proc 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 204set app [winfo name .] 205prompt 206focus .t 207 208# Local Variables: 209# mode: tcl 210# End: 211