From a878078696cc10f9e539adcd413dd97c9d6facdf Mon Sep 17 00:00:00 2001 From: sls Date: Fri, 2 Jun 1995 06:42:22 +0000 Subject: [PATCH] Initial revision --- cmdline.tcl | 177 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 cmdline.tcl 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 { + %W mark set insert {end - 1c} + %W insert insert "\n" + regexp "(.*)\\.t$" %W dummy self + command_line:invoke $self + break + } + bind $self.t { + 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 { + 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 { + if [%W compare insert < promptEnd] { + break + } + } + bind $self.t { + if [%W compare insert < promptEnd] { + %W mark set insert promptEnd + } + } + bind $self.t { + if [%W compare insert < promptEnd] { + break + } + } + bind $self.t { + if [%W compare insert < promptEnd] { + break + } + } + bind $self.t { + if [%W compare insert <= promptEnd] { + break + } + } + bind $self.t { + if [%W compare insert <= promptEnd] { + break + } + } + bind $self.t { + %W tag remove sel sel.first promptEnd + } + bind $self.t "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 + } +} -- 2.23.0