===================================================================
RCS file: bin/RCS/tkcon,v
retrieving revision 4.1
diff -c1 -r4.1 bin/tkcon
*** bin/tkcon	1996/11/18 14:55:33	4.1
--- bin/tkcon	1996/12/16 16:01:38
***************
*** 76,77 ****
--- 76,79 ----
      library		{}
+     usecomm		1
+     commlibs		{cobweb}
      lightbrace		1
***************
*** 170,171 ****
--- 172,174 ----
  	-nontcl	{ set tkCon(nontcl) [regexp -nocase $truth $val] }
+ 	-usecomm { set tkCon(usecomm) [regexp -nocase $truth $val] }
  	-root	{ set tkCon(root) $val }
***************
*** 181,182 ****
--- 184,217 ----
  
+   ## Enable use of comm
+   proc all_interps {} {winfo interps}
+   if {$tkCon(usecomm)} {
+     set lib [file join [file dir [file dir $tkCon(SCRIPT)]] lib]
+ 
+     foreach d $tkCon(commlibs) {
+       if [file isdir [file join $lib $d]] {
+         lappend auto_path [file join $lib $d]
+       }
+     }
+     if {![auto_load comm] && [catch {uplevel #0 source [file join $lib cobweb comm.tcl]}]} {
+       set tkCon(usecomm) 0
+     } else {
+       if [string match send [info command send]] {
+         rename send tk_send
+       } else {
+         proc tk_send args {}
+       }
+       proc send {app args} {
+         if [string match {[0-9]*} $app] {
+             eval comm send [list $app] $args
+         } else {
+             eval tk_send [list $app] $args
+         }
+       }
+       proc all_interps {} {concat [winfo interps] [comm interps]}
+ 
+       # defer the cleanup for 2 seconds to allow other events to process
+       comm hook lost {after 2000 set x 1; vwait x}
+     }
+   }
+ 
    ## Create slave executable
***************
*** 482,484 ****
    if $tkCon(deadapp) {
!     if {[lsearch -exact [winfo interps] $tkCon(app)]<0} {
        return
--- 517,519 ----
    if $tkCon(deadapp) {
!     if {[lsearch -exact [all_interps] $tkCon(app)]<0} {
        return
***************
*** 491,493 ****
    set code [catch {eval send [list $tkCon(app)] $args} result]
!   if {$code && [lsearch -exact [winfo interps] $tkCon(app)]<0} {
      ## Interpreter disappeared
--- 526,528 ----
    set code [catch {eval send [list $tkCon(app)] $args} result]
!   if {$code && [lsearch -exact [all_interps] $tkCon(app)]<0} {
      ## Interpreter disappeared
***************
*** 646,647 ****
--- 681,686 ----
      $m add cascade -label "Attach Console " -un 0 -menu $m.apps
+     if {$tkCon(usecomm)} {
+       $m add command -label "Connect to (comm)" -underline 0 \
+ 	-command tkConCommConnect
+     }
      $m add separator
***************
*** 877,878 ****
--- 916,927 ----
    }
+   if {$tkCon(usecomm)} {
+     foreach i [lremove [comm interps] [comm self]] {
+       if ![info exists tkCon(appnames,$i)] {
+         set tkCon(appnames,$i) [file tail [send $i set argv0]]
+       }
+       $m add radio -label "$i ($tkCon(appnames,$i))" \
+         -var tkCon(app) -value $i \
+         -command "tkConAttach [list $i] interp; $cmd"
+     }
+   }
    $m add separator
***************
*** 1034,1035 ****
--- 1083,1088 ----
        }
+     } elseif {$tkCon(usecomm) && [lsearch [comm interps] $an] > -1} {
+       set app $an
+       set an "$app ($tkCon(appnames,$app))"
+       set type interp
      } else {
***************
*** 3493 ****
--- 3546,3579 ----
  if [catch {winfo exists $tkCon(root)}] tkConInit
+ 
+ proc tkConCommConnect {{what ""}} {
+     set self .conn
+     switch $what \
+     "" {
+ 	toplevel $self
+ 	frame $self.top
+ 	pack $self.top -side top -fill x
+ 	label $self.l -text "Connect to:"
+ 	entry $self.e -bd 2 -relief sunken
+ 	bind $self.e <Return> "tkConCommConnect connect"
+ 	pack $self.l -in $self.top -side left
+ 	pack $self.e -in $self.top -fill x -expand 1
+ 	button $self.close -text "Close" -command "destroy $self"
+ 	pack $self.close -side left
+ 	wm title $self "Connect to Interp.."
+ 	wm iconname $self "Connect to Interp.."
+ 	focus $self.e
+ 	grab $self
+     } \
+     connect {
+ 	set text [$self.e get]
+ 	if ![string match {[0-9]*} $text] return
+ 	comm connect $text
+ 	destroy $self
+ 
+ 	global tkCon
+         set tkCon(appnames,$text) [file tail [send $text set argv0]]
+ 	set tkCon(app) $text
+ 	tkConAttach [list $text] interp
+         tkConPrompt \n [tkConCmdGet $tkCon(console)]
+     }
+ }