211 lines
		
	
	
	
		
			5.2 KiB
		
	
	
	
		
			Text
		
	
	
	
	
	
		
		
			
		
	
	
			211 lines
		
	
	
	
		
			5.2 KiB
		
	
	
	
		
			Text
		
	
	
	
	
	
|  | #!/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: |