From: Pat Thoyts <patthoyts@users.sourceforge.net>
Date: Fri, 1 Mar 2002 23:47:01 +0000 (+0000)
Subject: Applied comm patch.
X-Git-Tag: r5_1_6p4
X-Git-Url: http://test.brassandglass.co.uk/gitweb?a=commitdiff_plain;h=28c577fda8ecb7ce5a7c180ad6ed6b20fde7268f;p=tkinspect
Applied comm patch.
---
diff --git a/ChangeLog b/ChangeLog
index 76f88d3..bd3650f 100644
--- 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.
diff --git a/stl-lite/tk_util.tcl b/stl-lite/tk_util.tcl
index b5ab468..231e7a2 100644
--- a/stl-lite/tk_util.tcl
+++ b/stl-lite/tk_util.tcl
@@ -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
+}
diff --git a/tkinspect.tcl b/tkinspect.tcl
index dbccae9..a903e6e 100644
--- a/tkinspect.tcl
+++ b/tkinspect.tcl
@@ -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
+ }
+}