From: sls <sls>
Date: Fri, 2 Jun 1995 06:42:22 +0000 (+0000)
Subject: Initial revision
X-Git-Tag: r5_1_1~31
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=a878078696cc10f9e539adcd413dd97c9d6facdf;p=tkinspect

Initial revision
---

diff --git a/cmdline.tcl b/cmdline.tcl
new file mode 100644
index 0000000..a3085c0
--- /dev/null
+++ b/cmdline.tcl
@@ -0,0 +1,177 @@
+#
+# $Id$
+#
+# Provide a command line interface to an application (much of the
+# code is lifted out of the Tk demo rmt).
+#
+
+dialog command_line {
+    param main
+    param target ""
+    member executing 0
+    member last_command ""
+    method create {} {
+	frame $self.menu -bd 2 -relief raised
+	pack $self.menu -side top -fill x
+	menubutton $self.menu.file -text "File" -menu $self.menu.m \
+	    -underline 0 -menu $self.menu.file.m
+	pack $self.menu.file -side left
+	set m [menu $self.menu.file.m]
+	$m add command -label "Close Window" -underline 0 \
+	    -command "destroy $self"
+	text $self.t -yscroll "$self.sb set"
+	scrollbar $self.sb -command "$self.t yview"
+	pack $self.sb -side right -fill both
+	pack $self.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 $self.t "$self.t Text . all"
+	bind $self.t <Return> {
+	    %W mark set insert {end - 1c}
+	    %W insert insert "\n"
+	    regexp "(.*)\\.t$" %W dummy self
+	    command_line:invoke $self
+	    break
+	}
+	bind $self.t <Delete> {
+	    if {[%W tag nextrange sel 1.0 end] != ""} {
+		%W tag remove sel sel.first promptEnd
+	    } else {
+		if [%W compare insert < promptEnd] {
+		    break
+		}
+	    }
+	}
+	bind $self.t <BackSpace> {
+	    if {[%W tag nextrange sel 1.0 end] != ""} {
+		%W tag remove sel sel.first promptEnd
+	    } else {
+		if [%W compare insert <= promptEnd] {
+		    break
+		}
+	    }
+	}
+	bind $self.t <Control-d> {
+	    if [%W compare insert < promptEnd] {
+		break
+	    }
+	}
+	bind $self.t <Control-k> {
+	    if [%W compare insert < promptEnd] {
+		%W mark set insert promptEnd
+	    }
+	}
+	bind $self.t <Control-t> {
+	    if [%W compare insert < promptEnd] {
+		break
+	    }
+	}
+	bind $self.t <Meta-d> {
+	    if [%W compare insert < promptEnd] {
+		break
+	    }
+	}
+	bind $self.t <Meta-BackSpace> {
+	    if [%W compare insert <= promptEnd] {
+		break
+	    }
+	}
+	bind $self.t <Control-h> {
+	    if [%W compare insert <= promptEnd] {
+		break
+	    }
+	}
+	bind $self.t <Control-x> {
+	    %W tag remove sel sel.first promptEnd
+	}
+	bind $self.t <Key> "command_line:text_insert $self %A; break"
+	$self.t tag configure bold \
+	    -font -*-Courier-Bold-R-Normal-*-120-*-*-*-*-*-*
+	$self prompt
+    }
+    method destroy {} {
+	$slot(main) delete_cmdline $self
+    }
+    method reconfig {} {
+    }
+    
+    # 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).
+    method prompt {} {
+	$self.t insert insert "$slot(target): "
+	$self.t mark set promptEnd {insert}
+	$self.t mark gravity promptEnd left
+	$self.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").
+    method invoke {} {
+	set cmd [$self.t get promptEnd insert]
+	incr slot(executing) 1
+	if [info complete $cmd] {
+	    if {$cmd == "!!\n"} {
+		set cmd $slot(last_command)
+	    } else {
+		set slot(last_command) $cmd
+	    }
+	    if {$slot(target) == "local"} {
+		set result [catch [list uplevel #0 $cmd] msg]
+	    } else {
+		set result [catch [list send $slot(target) $cmd] msg]
+	    }
+	    if {$result != 0} {
+		$self.t insert insert "Error: $msg\n"
+	    } else {
+		if {$msg != ""} {
+		    $self.t insert insert $msg\n
+		}
+	    }
+	    $self prompt
+	    $self.t mark set promptEnd insert
+	}
+	incr slot(executing) -1
+	$self.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).
+    method set_target {target} {
+	if ![string length $target] {
+	    set target local
+	}
+	set slot(target) $target
+	if !$slot(executing) {
+	    $self.t mark gravity promptEnd right
+	    $self.t delete "promptEnd linestart" promptEnd
+	    $self.t insert promptEnd "$target: "
+	    $self.t tag add bold "promptEnd linestart" promptEnd
+	    $self.t mark gravity promptEnd left
+	}
+	wm title $self "Command Line: $target"
+	return {}
+    }
+
+    method text_insert {s} {
+	if {$s == ""} {
+	    return
+	}
+	catch {
+	    if {[$self.t compare sel.first <= insert]
+		&& [$self.t compare sel.last >= insert]} {
+		    $self.t tag remove sel sel.first promptEnd
+		    $self.t delete sel.first sel.last
+		}
+	}
+	$self.t insert insert $s
+	$self.t see insert
+    }
+}