util/src/TclTk/tk8.6.12/library/demos/rmt

   1 #!/bin/sh
   2 # the next line restarts using wish \
   3 exec wish "$0" ${1+"$@"}
   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 package require Tk
  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 -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] eq ""} {
  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] eq ""} {
  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 ### This next bit *isn't* nice - DKF ###
 110 auto_load tk::TextInsert
 111 proc tk::TextInsert {w s} {
 112     if {$s eq ""} {
 113         return
 114     }
 115     catch {
 116         if {
 117             [$w compare sel.first <= insert] && [$w compare sel.last >= insert]
 118         } then {
 119             $w tag remove sel sel.first promptEnd
 120             $w delete sel.first sel.last
 121         }
 122     }
 123     $w insert insert $s
 124     $w see insert
 125 }
 126
 127 .t configure -font {Courier 12}
 128 .t tag configure bold -font {Courier 12 bold}
 129
 130 # The procedure below is used to print out a prompt at the
 131 # insertion point (which should be at the beginning of a line
 132 # right now).
 133
 134 proc prompt {} {
 135     global app
 136     .t insert insert "$app: "
 137     .t mark set promptEnd {insert}
 138     .t mark gravity promptEnd left
 139     .t tag add bold {promptEnd linestart} promptEnd
 140 }
 141
 142 # The procedure below executes a command (it takes everything on the
 143 # current line after the prompt and either sends it to the remote
 144 # application or executes it locally, depending on "app".
 145
 146 proc invoke {} {
 147     global app executing lastCommand
 148     set cmd [.t get promptEnd insert]
 149     incr executing 1
 150     if {[info complete $cmd]} {
 151         if {$cmd eq "!!\n"} {
 152             set cmd $lastCommand
 153         } else {
 154             set lastCommand $cmd
 155         }
 156         if {$app eq "local"} {
 157             set result [catch [list uplevel #0 $cmd] msg]
 158         } else {
 159             set result [catch [list send $app $cmd] msg]
 160         }
 161         if {$result != 0} {
 162             .t insert insert "Error: $msg\n"
 163         } elseif {$msg ne ""} {
 164             .t insert insert $msg\n
 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: