Applied comm patch. r5_1_6p4
authorPat Thoyts <patthoyts@users.sourceforge.net>
Fri, 1 Mar 2002 23:47:01 +0000 (23:47 +0000)
committerPat Thoyts <patthoyts@users.sourceforge.net>
Fri, 1 Mar 2002 23:47:01 +0000 (23:47 +0000)
ChangeLog
stl-lite/tk_util.tcl
tkinspect.tcl

index 76f88d3d77d90fc877cce9832f683a9483b90402..bd3650f1e9c5cfb83e2cb0bcc754696430db85c8 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+Fri Mar  1 23:37:21 2002  Pat Thoyts <Pat.Thoyts@bigfoot.com>
+       
+       * tkinspect: applied John LoVerso's 1996 comm patch to support
+       systems without the Tk send command.
+
 Sun Dec 14 19:46:05 1997  Paul Healy <ei9gl@indigo.ie>
        
        * tkinspect: describe patch procedure to get around diff/patch/RCS
@@ -7,7 +12,7 @@ Sun Nov 23 22:14:36 1997  Paul Healy <ei9gl@indigo.ie>
        
        * tkinspect: handle procedures and variables inside namespaces
        
-Sun Oct 05 20:09:10 1997  Paul Healy <ei9gl@indigo.ie>
+Sun Oct  5 20:09:10 1997  Paul Healy <ei9gl@indigo.ie>
 
        * tkinspect: handle the disappearance of the tkerror proc in tk8.0
        Released p2.
index b5ab468e670d2205fad9c69ea0f2070b98d0aa62..231e7a279a9e5d382c40da328f63752533731f34 100644 (file)
@@ -32,3 +32,10 @@ proc center_window {win} {
     wm geometry $win +[expr {($sw-$w)/2}]+[expr {($sh-$h)/2}]
     wm deiconify $win
 }
+
+proc under_mouse {win} {
+    set xy [winfo pointerxy $win]
+    wm withdraw $win
+    wm geometry $win +[expr [lindex $xy 0] - 10]+[expr [lindex $xy 1] - 10]
+    wm deiconify $win
+}
index dbccae982d0b0a515444e90fad160fb8d1e5e22b..a903e6e9e69a06d0b6199bfce4c8aea726cc2973 100644 (file)
@@ -28,6 +28,28 @@ if [file exists @tkinspect_library@/tclIndex] {
     lappend auto_path [set tkinspect_library .]
 }
 
+# Provide non-send based support using tklib's comm package.
+if {![catch {package require comm}]} {
+    # defer the cleanup for 2 seconds to allow other events to process
+    comm::comm hook lost {after 2000 set x 1; vwait x}
+
+    #
+    # replace send with version that does both send and comm
+    #
+    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::comm send [list $app] $args
+        } else {
+            eval tk_send [list $app] $args
+        }
+    }
+}
+
 stl_lite_init
 version_init
 
@@ -68,8 +90,12 @@ dialog tkinspect_main {
            -underline 0
        pack $self.menu.file -side left
        set m [menu $self.menu.file.m]
-       $m add cascade -label "Select Interpreter" -underline 0 \
+       $m add cascade -label "Select Interpreter (send)" -underline 0 \
            -menu $self.menu.file.m.interps
+       $m add cascade -label "Select Interpreter (comm)" -underline 21 \
+           -menu $self.menu.file.m.comminterps
+       $m add command -label "Connect to (comm)" -underline 0 \
+           -command "$self connect_dialog"  
        $m add command -label "Update Lists" -underline 0 \
            -command "$self update_lists"
        $m add separator
@@ -89,6 +115,8 @@ dialog tkinspect_main {
            -command tkinspect_exit
        menu $self.menu.file.m.interps -tearoff 0 \
            -postcommand "$self fill_interp_menu"
+       menu $self.menu.file.m.comminterps -tearoff 0 \
+           -postcommand "$self fill_comminterp_menu"
        menubutton $self.menu.help -menu $self.menu.help.m -text "Help" \
            -underline 0
        pack $self.menu.help -side right
@@ -141,8 +169,9 @@ dialog tkinspect_main {
        foreach cmdline $slot(cmdlines) {
            $cmdline set_target $target
        }
-       $self status "Remote interpreter is \"$target\""
-       wm title $self "Tkinspect: $target"
+       set name [file tail [send $target set argv0]]
+       $self status "Remote interpreter is \"$target\" ($name)"
+       wm title $self "Tkinspect: $target ($name)"
     }
     method update_lists {} {
        if {$slot(target) == ""} return
@@ -160,6 +189,15 @@ dialog tkinspect_main {
        $self.value set_send_filter [list $list send_filter]
        $self status "Showing \"$item\""
     }
+    method connect_dialog {} {
+       if ![winfo exists $self.connect] {
+           connect_interp $self.connect -value $self
+           under_mouse $self.connect
+       } else {
+           wm deiconify $self.connect
+           under_mouse $self.connect
+       }
+    }
     method fill_interp_menu {} {
        set m $self.menu.file.m.interps
        catch {$m delete 0 last}
@@ -168,6 +206,19 @@ dialog tkinspect_main {
                -command [list $self set_target $interp]
        }
     }
+    method fill_comminterp_menu {} {
+       set m $self.menu.file.m.comminterps
+       catch {$m delete 0 last}
+       foreach interp [comm::comm interps] {
+           if [string match [comm::comm self] $interp] {
+               set label "$interp (self)"
+           } else {
+               set label "$interp ([file tail [send $interp set argv0]])"
+           }
+           $m add command -label $label \
+               -command [list $self set_target $interp]
+       }
+    }
     method status {msg} {
        $self.status.l config -text $msg
     }
@@ -282,3 +333,30 @@ tkinspect_create_main_window
 if [file exists .tkinspect_init] {
     source .tkinspect_init
 }
+
+dialog connect_interp {
+    param value
+    method create {} {
+       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> "$self 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
+    }
+    method reconfig {} {
+    }
+    method connect {} {
+       set text [$self.e get]
+       if ![string match {[0-9]*} $text] return
+       comm::comm connect $text
+       wm withdraw $self
+       $slot(value) set_target $text
+    }
+}