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