Initial revision

1 files changed, 205 insertions, 0 deletions

diff --git a/library/demos/rmt b/library/demos/rmt
new file mode 100644
index 0000000..9310475
--- /dev/null
+++ b/library/demos/rmt
@@ -0,0 +1,205 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# rmt --
+# This script implements a simple remote-control mechanism for
+# Tk applications.  It allows you to select an application and
+# then type commands to that application.
+#
+# SCCS: @(#) rmt 1.10 96/06/24 16:42:38
+
+wm title . "Tk Remote Controller"
+wm iconname . "Tk Remote"
+wm minsize . 1 1
+
+# The global variable below keeps track of the remote application
+# that we're sending to.  If it's an empty string then we execute
+# the commands locally.
+
+set app "local"
+
+# The global variable below keeps track of whether we're in the
+# middle of executing a command entered via the text.
+
+set executing 0
+
+# The global variable below keeps track of the last command executed,
+# so it can be re-executed in response to !! commands.
+
+set lastCommand ""
+
+# Create menu bar.  Arrange to recreate all the information in the
+# applications sub-menu whenever it is cascaded to.
+
+frame .menu -relief raised -bd 2
+pack .menu -side top -fill x
+menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add cascade -label "Select Application" \
+	-menu .menu.file.m.apps -underline 0
+.menu.file.m add command -label "Quit" -command "destroy ." -underline 0
+menu .menu.file.m.apps  -postcommand fillAppsMenu
+pack .menu.file -side left
+
+# Create text window and scrollbar.
+
+text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
+scrollbar .s -command ".t yview"
+pack .s -side right -fill both
+pack .t -side left
+
+# Create a binding to forward commands to the target application,
+# plus modify many of the built-in bindings so that only information
+# in the current command can be deleted (can still set the cursor
+# earlier in the text and select and insert;  just can't delete).
+
+bindtags .t {.t Text . all}
+bind .t <Return> {
+    .t mark set insert {end - 1c}
+    .t insert insert \n
+    invoke
+    break
+}
+bind .t <Delete> {
+    catch {.t tag remove sel sel.first promptEnd}
+    if {[.t tag nextrange sel 1.0 end] == ""} {
+	if [.t compare insert < promptEnd] {
+	    break
+	}
+    }
+}
+bind .t <BackSpace> {
+    catch {.t tag remove sel sel.first promptEnd}
+    if {[.t tag nextrange sel 1.0 end] == ""} {
+	if [.t compare insert <= promptEnd] {
+	    break
+	}
+    }
+}
+bind .t <Control-d> {
+    if [.t compare insert < promptEnd] {
+	break
+    }
+}
+bind .t <Control-k> {
+    if [.t compare insert < promptEnd] {
+	.t mark set insert promptEnd
+    }
+}
+bind .t <Control-t> {
+    if [.t compare insert < promptEnd] {
+	break
+    }
+}
+bind .t <Meta-d> {
+    if [.t compare insert < promptEnd] {
+	break
+    }
+}
+bind .t <Meta-BackSpace> {
+    if [.t compare insert <= promptEnd] {
+	break
+    }
+}
+bind .t <Control-h> {
+    if [.t compare insert <= promptEnd] {
+	break
+    }
+}
+auto_load tkTextInsert
+proc tkTextInsert {w s} {
+    if {$s == ""} {
+	return
+    }
+    catch {
+	if {[$w compare sel.first <= insert]
+		&& [$w compare sel.last >= insert]} {
+	    $w tag remove sel sel.first promptEnd
+	    $w delete sel.first sel.last
+	}
+    }
+    $w insert insert $s
+    $w see insert
+}
+
+.t tag configure bold -font {Courier 12 bold}
+
+# The procedure below is used to print out a prompt at the
+# insertion point (which should be at the beginning of a line
+# right now).
+
+proc prompt {} {
+    global app
+    .t insert insert "$app: "
+    .t mark set promptEnd {insert}
+    .t mark gravity promptEnd left
+    .t tag add bold {promptEnd linestart} promptEnd
+}
+
+# The procedure below executes a command (it takes everything on the
+# current line after the prompt and either sends it to the remote
+# application or executes it locally, depending on "app".
+
+proc invoke {} {
+    global app executing lastCommand
+    set cmd [.t get promptEnd insert]
+    incr executing 1
+    if [info complete $cmd] {
+	if {$cmd == "!!\n"} {
+	    set cmd $lastCommand
+	} else {
+	    set lastCommand $cmd
+	}
+	if {$app == "local"} {
+	    set result [catch [list uplevel #0 $cmd] msg]
+	} else {
+	    set result [catch [list send $app $cmd] msg]
+	}
+	if {$result != 0} {
+	    .t insert insert "Error: $msg\n"
+	} else {
+	    if {$msg != ""} {
+		.t insert insert $msg\n
+	    }
+	}
+	prompt
+	.t mark set promptEnd insert
+    }
+    incr executing -1
+    .t yview -pickplace insert
+}
+
+# The following procedure is invoked to change the application that
+# we're talking to.  It also updates the prompt for the current
+# command, unless we're in the middle of executing a command from
+# the text item (in which case a new prompt is about to be output
+# so there's no need to change the old one).
+
+proc newApp appName {
+    global app executing
+    set app $appName
+    if !$executing {
+	.t mark gravity promptEnd right
+	.t delete "promptEnd linestart" promptEnd
+	.t insert promptEnd "$appName: "
+	.t tag add bold "promptEnd linestart" promptEnd
+	.t mark gravity promptEnd left
+    }
+    return {}
+}
+
+# The procedure below will fill in the applications sub-menu with a list
+# of all the applications that currently exist.
+
+proc fillAppsMenu {} {
+    catch {.menu.file.m.apps delete 0 last}
+    foreach i [lsort [winfo interps]] {
+	.menu.file.m.apps add command -label $i -command [list newApp $i]
+    }
+    .menu.file.m.apps add command -label local -command {newApp local}
+}
+
+set app [winfo name .]
+prompt
+focus .t