210 lines
		
	
	
	
		
			5.2 KiB
		
	
	
	
		
			Tcl
		
	
	
	
	
	
			
		
		
	
	
			210 lines
		
	
	
	
		
			5.2 KiB
		
	
	
	
		
			Tcl
		
	
	
	
	
	
#!/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.
 | 
						|
#
 | 
						|
# RCS: @(#) $Id: rmt,v 1.3 2001/10/29 16:23:32 dkf Exp $
 | 
						|
 | 
						|
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.
 | 
						|
 | 
						|
. configure -menu [menu .menu]
 | 
						|
menu .menu.file
 | 
						|
menu .menu.file.apps  -postcommand fillAppsMenu
 | 
						|
.menu add cascade  -label "File"  -underline 0  -menu .menu.file
 | 
						|
.menu.file add cascade  -label "Select Application"  -underline 0 \
 | 
						|
	-menu .menu.file.apps
 | 
						|
.menu.file add command  -label "Quit"  -command "destroy ."  -underline 0
 | 
						|
 | 
						|
# Create text window and scrollbar.
 | 
						|
 | 
						|
text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
 | 
						|
scrollbar .s -command ".t yview"
 | 
						|
grid .t .s -sticky nsew
 | 
						|
grid rowconfigure . 0 -weight 1
 | 
						|
grid columnconfigure . 0 -weight 1
 | 
						|
 | 
						|
# 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 configure -font {Courier 12}
 | 
						|
.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 {} {
 | 
						|
    set m .menu.file.apps
 | 
						|
    catch {$m delete 0 last}
 | 
						|
    foreach i [lsort [winfo interps]] {
 | 
						|
	$m add command -label $i -command [list newApp $i]
 | 
						|
    }
 | 
						|
    $m add command -label local -command {newApp local}
 | 
						|
}
 | 
						|
 | 
						|
set app [winfo name .]
 | 
						|
prompt
 | 
						|
focus .t
 | 
						|
 | 
						|
# Local Variables:
 | 
						|
# mode: tcl
 | 
						|
# End:
 |