HP/util/HP/lib/tk8.3/demos/rmt

   1 #!/bin/sh
   2 # the next line restarts using wish \
   3 exec wish8.3 "$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.2 1998/09/14 18:23:29 stanton 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 frame .menu -relief raised -bd 2
  36 pack .menu -side top -fill x
  37 menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
  38 menu .menu.file.m
  39 .menu.file.m add cascade -label "Select Application" \
  40         -menu .menu.file.m.apps -underline 0
  41 .menu.file.m add command -label "Quit" -command "destroy ." -underline 0
  42 menu .menu.file.m.apps  -postcommand fillAppsMenu
  43 pack .menu.file -side left
  44
  45 # Create text window and scrollbar.
  46
  47 text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
  48 scrollbar .s -command ".t yview"
  49 pack .s -side right -fill both
  50 pack .t -side left
  51
  52 # Create a binding to forward commands to the target application,
  53 # plus modify many of the built-in bindings so that only information
  54 # in the current command can be deleted (can still set the cursor
  55 # earlier in the text and select and insert;  just can't delete).
  56
  57 bindtags .t {.t Text . all}
  58 bind .t <Return> {
  59     .t mark set insert {end - 1c}
  60     .t insert insert \n
  61     invoke
  62     break
  63 }
  64 bind .t <Delete> {
  65     catch {.t tag remove sel sel.first promptEnd}
  66     if {[.t tag nextrange sel 1.0 end] == ""} {
  67         if [.t compare insert < promptEnd] {
  68             break
  69         }
  70     }
  71 }
  72 bind .t <BackSpace> {
  73     catch {.t tag remove sel sel.first promptEnd}
  74     if {[.t tag nextrange sel 1.0 end] == ""} {
  75         if [.t compare insert <= promptEnd] {
  76             break
  77         }
  78     }
  79 }
  80 bind .t <Control-d> {
  81     if [.t compare insert < promptEnd] {
  82         break
  83     }
  84 }
  85 bind .t <Control-k> {
  86     if [.t compare insert < promptEnd] {
  87         .t mark set insert promptEnd
  88     }
  89 }
  90 bind .t <Control-t> {
  91     if [.t compare insert < promptEnd] {
  92         break
  93     }
  94 }
  95 bind .t <Meta-d> {
  96     if [.t compare insert < promptEnd] {
  97         break
  98     }
  99 }
 100 bind .t <Meta-BackSpace> {
 101     if [.t compare insert <= promptEnd] {
 102         break
 103     }
 104 }
 105 bind .t <Control-h> {
 106     if [.t compare insert <= promptEnd] {
 107         break
 108     }
 109 }
 110 auto_load tkTextInsert
 111 proc tkTextInsert {w s} {
 112     if {$s == ""} {
 113         return
 114     }
 115     catch {
 116         if {[$w compare sel.first <= insert]
 117                 && [$w compare sel.last >= insert]} {
 118             $w tag remove sel sel.first promptEnd
 119             $w delete sel.first sel.last
 120         }
 121     }
 122     $w insert insert $s
 123     $w see insert
 124 }
 125
 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     catch {.menu.file.m.apps delete 0 last}
 197     foreach i [lsort [winfo interps]] {
 198         .menu.file.m.apps add command -label $i -command [list newApp $i]
 199     }
 200     .menu.file.m.apps add command -label local -command {newApp local}
 201 }
 202
 203 set app [winfo name .]
 204 prompt
 205 focus .t