From: Pat Thoyts Date: Fri, 1 Mar 2002 00:43:25 +0000 (+0000) Subject: Applied Paul Healy's 1997 patches for 8.0+ support. X-Git-Tag: r5_1_6p3 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=ca0ca7396f87cf982e5c650b532dab6569560ebf;p=tkinspect Applied Paul Healy's 1997 patches for 8.0+ support. --- diff --git a/ChangeLog b/ChangeLog index ea20334..76f88d3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +Sun Dec 14 19:46:05 1997 Paul Healy + + * tkinspect: describe patch procedure to get around diff/patch/RCS + interaction. Released p3. + +Sun Nov 23 22:14:36 1997 Paul Healy + + * tkinspect: handle procedures and variables inside namespaces + +Sun Oct 05 20:09:10 1997 Paul Healy + + * tkinspect: handle the disappearance of the tkerror proc in tk8.0 + Released p2. + Fri Jun 23 00:20:15 1995 Sam Shen * version.tcl: Bump to 5.1.6. diff --git a/globals_list.tcl b/globals_list.tcl index 93f3865..05aca20 100644 --- a/globals_list.tcl +++ b/globals_list.tcl @@ -121,7 +121,7 @@ widget globals_list { } method update {target} { $self clear - foreach var [lsort [send $target info globals]] { + foreach var [lsort [names::vars $target]] { $self append $var } } diff --git a/install.tcl b/install.tcl index ce4b75b..9bb0b27 100644 --- a/install.tcl +++ b/install.tcl @@ -1,4 +1,6 @@ -#!/usr/local/bin/wish4.0 +#!/bin/sh +# \ +exec wish "$0" "$*" # # $Id$ # @@ -78,7 +80,7 @@ pack .title .title2 -side top text .instructions -relief ridge -bd 4 -width 20 -height 4 -wrap word \ -takefocus 0 .instructions insert 1.0 \ -{Fill out the pathnames below and press the install button. Any errors will appear in log window below. If you wish to demo tkinspect w/o installing it, try "wish4.0 -f tkinspect.tcl". +{Fill out the pathnames below and press the install button. Any errors will appear in log window below. If you wish to demo tkinspect w/o installing it, try "wish -f tkinspect.tcl". } pack .instructions -side top -fill both -expand 1 set prefix /usr/local @@ -110,7 +112,7 @@ proc log {msg} { update } -foreach name {wish4.0 wish} { +foreach name {wish8.4 wish8.3 wish8.0 wish4.0 wish} { log "Searching for $name..." foreach dir [split $env(PATH) :] { if [file executable $dir/$name] { @@ -127,7 +129,7 @@ foreach name {wish4.0 wish} { if [info exists wish] { log "using $wish\n" } else { - set wish /usr/local/bin/wish4.0 + set wish /usr/local/bin/wish8.3 log "Hmm, using $wish anways...\n" } @@ -171,7 +173,7 @@ proc install {} { about.tcl defaults.tcl windows_info.tcl lists.tcl globals_list.tcl procs_list.tcl windows_list.tcl images_list.tcl menus_list.tcl canvas_list.tcl value.tcl stl.tcl sls.ppm version.tcl help.tcl - cmdline.tcl interface.tcl tclIndex + cmdline.tcl interface.tcl names.tcl tclIndex Intro.html Lists.html Procs.html Globals.html Windows.html Images.html Canvases.html Menus.html Value.html Miscellany.html Notes.html WhatsNew.html ChangeLog.html diff --git a/names.tcl b/names.tcl new file mode 100644 index 0000000..ee9271d --- /dev/null +++ b/names.tcl @@ -0,0 +1,52 @@ +# +# $Id$ +# + +namespace eval names { + + namespace export names procs vars + + proc unqualify s { + regsub -all "(^| ):+" $s {\1} result + return $result + } + + proc names {target {name ::}} { + set result $name + foreach n [send $target namespace children $name] { + append result " " [names $target $n] + } + return $result + } + + proc procs target { + set result {} + foreach n [names $target] { + foreach p [send $target namespace eval $n info procs] { + lappend result "$n\::$p" + } + } + return [unqualify $result] + } + + proc vars target { + set result {} + foreach n [names $target] { + foreach v [send $target info vars ${n}::*] { + lappend result $v + } + } + return [unqualify $result] + } + +# dump [tk appname] + + proc dump appname { + puts "names: [names $appname]" + puts "" + puts "procs: [procs $appname]" + puts "" + puts "vars: [vars $appname]" + } +} + diff --git a/procs_list.tcl b/procs_list.tcl index a2da5fa..76bdf13 100644 --- a/procs_list.tcl +++ b/procs_list.tcl @@ -8,7 +8,7 @@ widget procs_list { method get_item_name {} { return proc } method update {target} { $self clear - foreach proc [lsort [send $target info procs]] { + foreach proc [lsort [names::procs $target]] { $self append $proc } } diff --git a/tkinspect.tcl b/tkinspect.tcl index c702bb4..dbccae9 100644 --- a/tkinspect.tcl +++ b/tkinspect.tcl @@ -41,7 +41,7 @@ proc tkinspect_widgets_init {} { foreach file { lists.tcl procs_list.tcl globals_list.tcl windows_list.tcl images_list.tcl about.tcl value.tcl help.tcl cmdline.tcl - windows_info.tcl menus_list.tcl canvas_list.tcl + windows_info.tcl menus_list.tcl canvas_list.tcl names.tcl } { uplevel #0 source $tkinspect_library/$file } @@ -263,21 +263,14 @@ proc tkinspect_create_main_window {args} { return $w } -auto_load tkerror -rename tkerror tk_tkerror +# 971005: phealy +# +# With tk8.0 the default tkerror proc is finally gone - bgerror +# takes its place (see the changes tk8.0 changes file). This +# simplified error handling should be ok. +# proc tkinspect_failure {reason} { - global tkinspect - set tkinspect(error_is_failure) 1 - error $reason -} -proc tkerror {message} { - global tkinspect errorInfo - if [info exists tkinspect(error_is_failure)] { - unset tkinspect(error_is_failure) - tk_dialog .failure "Tkinspect Failure" $message warning 0 Ok - } else { - uplevel [list tk_tkerror $message] - } + tk_dialog .failure "Tkinspect Failure" $reason warning 0 Ok } tkinspect_widgets_init diff --git a/version.tcl b/version.tcl index 6ab1801..42fcd45 100644 --- a/version.tcl +++ b/version.tcl @@ -6,12 +6,12 @@ proc version_init {} { global tkinspect tk_version tk_patchLevel - set tkinspect(release) 5.1.6 - set tkinspect(release_date) "June 23, 1995" + set tkinspect(release) 5.1.6p3 + set tkinspect(release_date) "Nov 23, 1997" scan $tk_version "%d.%d" major minor - if {$major != 4} { + if {$major < 8} { puts stderr \ - "tkinspect-5 requires Tk 4.x, you appear to be running Tk $major.$minor" + "tkinspect-5.1.6.p3 requires Tk 8.x, you appear to be running Tk $major.$minor" exit 1 } if {[scan $tk_patchLevel "4.0b%d" beta] == 1 && $beta < 4} {