Added help file for the classes window.
Fixed font error in the command window.
Fixed the About help dialog.
Hitched the version patchlevel.
-Fri Mar 1 23:37:21 2002 Pat Thoyts <Pat.Thoyts@bigfoot.com>
+Thu Mar 14 12:09:24 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * classes_list.tcl: Updated to support itcl 3.2 info syntax
+ * objects_list.tcl: Updated to support itcl 3.2 info syntax
+ * Classes.html: new page to describe the classes list window.
+ * tkinspect.tcl: fixed the About help menu item.
+ * version.tcl: incremented version to p6.
+
+Fri Mar 2 00:13:08 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * tkinspect: applied T. Schotanus incr Tcl support patch. This
+ provides itcl support for older (pre 3.x?) itcl versions.
+
+Fri Mar 1 23:37:21 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
* tkinspect: applied John LoVerso's 1996 comm patch to support
systems without the Tk send command.
--- /dev/null
+<!doctype HTML public "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+ <title>Classes List</title>
+ <!-- $Id$ -->
+ </head>
+
+ <body>
+ <h1><center>Classes List</center></h1>
+
+ <p>The <b>Classes List</b> contains a list of the incr Tcl classes
+ defined in the target application.</p>
+
+ <p>The display uses the incr Tcl <b>info</b> command to reconstruct the
+ class definition showing the member variable definitions and the class
+ method code. Only the itcl builtin methods are hidden (these
+ include the cget, configure and info methods).</p>
+
+ <hr>
+
+<!-- hhmts start -->
+Last modified: Thu Mar 14 23:16:22 GMT 2002
+<!-- hhmts end -->
+
+ </body>
+</html>
-<html> <head>
-<title>What's New?</title>
-<!-- $Id$ -->
-</head>
+<!doctype HTML public "-//W3C//DTD HTML 3.2 Final//EN">
+<html>
+ <head>
+ <title>What's New?</title>
+ <!-- $Id$ -->
+ </head>
-<body>
-<center><h1>What's New?</h1></center>
+ <body>
+ <h1><center>What's New?</center></h1>
-See the <a href=ChangeLog.html>ChangeLog</a> for more details.
+ See the <a href="ChangeLog">ChangeLog</a> for more details.
+
+ <h2>Changes in release 5.1.6p6 (14 Mar 2002)</h2>
+
+ The original code plus some patches have been collected together and
+ added to the <a href="http://sourceforge.net/projects/tkcon">tkcon</a>
+ project as <a href="http://sourceforge.net/">SourceForge</a>. Some
+ general work has been done to bring tkinspect up to date for use with
+ Tcl 8.3 and 8.4 and incr Tcl 3.2.
+
+ <h2>Changes in release 5.1.6 (23 June 1995)</h2>
+
+ 5.1.6 has only 2 bug fixes, see the
+ <a href="ChangeLog">ChangeLog</a> if you're really interested.
+
+ <h2>Changes in release 5.1.4 (21 June 1995)</h2>
+
+ 5.1.4 adds more browsing lists, and has a few refinements.
+
+ <ul>
+ <li> Added 3 new lists: <a href="Images.html">images</a>,
+ <a href="Menus.html">menus</a>, and
+ <a href="Canvases.html">canvases</a>. The images
+ list was contributed by Gero Kohnert
+ <tt><gero@marvin.franken.de></tt>.
+ <li> Added <tt>button-3</tt> bindings on lists and value (brings
+ up menu.)
+ <li> Added <b>Update This List</b> menu item to lists.
+ <li> Cleaned up some things for Tk 4.0b4.
+ <li> Renamed the <a href="Miscellany.html">interface function</a>
+ <tt>tkinspect_value_text_window</tt> to
+ <tt>tkinspect_value_text_widget</tt> (now returns the Tk text
+ widget.) Added <tt>tkinspect_display_image</tt>,
+ <tt>tkinspect_show_list</tt>, and <tt>tkinspect_remove_list</tt>.
+ </ul>
-<h2>Changes in release 5.1.6 (23 June 1995)</h2>
-
-5.1.6 has only 2 bug fixes, see the <a
-href=ChangeLog.html>ChangeLog</a> if you're really interested.
-
-<h2>Changes in release 5.1.4 (21 June 1995)</h2>
-
-5.1.4 adds more browsing lists, and has a few refinements.
-
-<ul>
- <li> Added 3 new lists: <a href=Images.html>images</a>, <a
- href=Menus.html>menus</a>, and <a
- href=Canvases.html>canvases</a>. The images
- list was contributed by Gero Kohnert
- <tt><gero@marvin.franken.de></tt>.
- <li> Added <tt>button-3</tt> bindings on lists and value (brings
- up menu.)
- <li> Added <b>Update This List</b> menu item to lists.
- <li> Cleaned up some things for Tk 4.0b4.
- <li> Renamed the <a href=Miscellany.html>interface function</a>
- <tt>tkinspect_value_text_window</tt> to
- <tt>tkinspect_value_text_widget</tt> (now returns the Tk text
- widget.) Added <tt>tkinspect_display_image</tt>,
- <tt>tkinspect_show_list</tt>, and <tt>tkinspect_remove_list</tt>.
-</ul>
-
-<h2>Changes in release 5.1 (5 June 1995)</h2>
-
-5.1 fills in the missing holes of 5.0, fixes a few bugs, and adds some
-features.
-
-<ul>
- <li> Fixed the bug (?) that caused no interpreters to show up under
- Tk 4.0b3.
- <li> Added this HTML help system (renderer based on code from Angel Li
- <tt><angel@flipper.rsmas.miami.edu></tt>.)
- <li> Added the command line interface.
- <li> Cleaned up the menus, added some keyboard bindings.
- <li> <b>tkinspect</b> nows reads <tt>~/.tkinspect_opts</tt> and
- <tt>.tkinspect_init</tt> (in the current directory.)
- <li> There's an external interface available. See <a
- href=Miscellany>the miscellany help page</a>.
-
-</ul>
-
-
-<h2>Changes in release 5.0 (February 1995)</h2>
-
-Release 5.0 was a complete rewrite of previous versions of
-<b>tkinspect</b>. This version runs only with Tk 4.0.
-
-<hr>
+ <h2>Changes in release 5.1 (5 June 1995)</h2>
+
+ 5.1 fills in the missing holes of 5.0, fixes a few bugs, and adds some
+ features.
+
+ <ul>
+ <li> Fixed the bug (?) that caused no interpreters to show up under
+ Tk 4.0b3.
+ <li> Added this HTML help system (renderer based on code from Angel Li
+ <tt><angel@flipper.rsmas.miami.edu></tt>.)
+ <li> Added the command line interface.
+ <li> Cleaned up the menus, added some keyboard bindings.
+ <li> <b>tkinspect</b> nows reads <tt>~/.tkinspect_opts</tt> and
+ <tt>.tkinspect_init</tt> (in the current directory.)
+ <li> There's an external interface available. See
+ <a href="Miscellany">the miscellany help page</a>.
+
+ </ul>
+
+
+ <h2>Changes in release 5.0 (February 1995)</h2>
+
+ Release 5.0 was a complete rewrite of previous versions of
+ <b>tkinspect</b>. This version runs only with Tk 4.0.
+
+ <hr>
<!-- hhmts start -->
-Last modified: Fri Jun 23 01:10:55 1995
+Last modified: Thu Mar 14 23:34:01 GMT 2002
<!-- hhmts end -->
-</body> </html>
+
+ </body>
+</html>
dialog about {
param obliqueFont -*-helvetica-medium-o-*-*-12-* Font
param font -*-helvetica-medium-r-*-*-12-* Font
- param boldFont -*-helvetica-bold-r-*-*-18-* Font
+ param boldFont -*-helvetica-bold-r-*-*-18-* Font
method create {} {
global tkinspect tkinspect_library
wm withdraw $self
label $self.ver \
-text "Release $tkinspect(release) ($tkinspect(release_date))" \
-font $slot(font)
- label $self.com -text "Send comments, suggestions, bugs to:" \
+ label $self.com -text "\nBugs, suggestions and patches to:\n\
+ http://sourceforge.net/projects/tkcon/\n" \
-font $slot(obliqueFont)
frame $self.mug -bd 4
- label $self.mug.l -text "Sam Shen <slshen@lbl.gov>"
+ label $self.mug.l -text "Originally by\nSam Shen <slshen@lbl.gov>"
global about_priv
if ![info exists about_priv(mug_image)] {
set about_priv(mug_image) \
# E-mail: sst@bouw.tno.nl
# URL: http://huizen.dds.nl/~quintess
#
+# Itcl 3.2 support by Pat Thoyts <patthoyts@users.sourceforge.net>
+# The original code is renamed to base_class_list and if a newer
+# version of incr Tcl is found then we shall override some methods.
+#
-widget class_list {
- object_include tkinspect_list
- param title "Classes"
-
- method get_item_name {} {
- return class
- }
+widget base_class_list {
+ object_include tkinspect_list
+ param title "Classes"
+
+ method get_item_name {} {
+ return class
+ }
+
+ method update {target} {
+ $self clear
+ set classes [lsort [send $target itcl_info classes]]
+ foreach class $classes {
+ $self append $class
+ }
+ }
+
+ method retrieve {target class} {
+ set res "itcl_class $class {\n"
+
+ set cmd [list $class :: info inherit]
+ set inh [send $target $cmd]
+ if {$inh != ""} {
+ set res "$res\tinherit $inh\n\n"
+ } else {
+ set res "$res\n"
+ }
+
+ set pubs [send $target [list $class :: info public]]
+ foreach arg $pubs {
+ regsub {(.*)::} $arg {} a
+ set res "$res\tpublic $a\n"
+ }
+ if {$pubs != ""} {
+ set res "$res\n"
+ }
+
+ set prots [send $target [list $class :: info protected]]
+ foreach arg $prots {
+ regsub {(.*)::} $arg {} a
+ if {$a != "this"} {
+ set res "$res\tprotected $a\n"
+ }
+ }
+ if {$prots != ""} {
+ set res "$res\n"
+ }
+
+ set coms [send $target [list $class :: info common]]
+ foreach arg $coms {
+ regsub {(.*)::} $arg {} a
+ set cmd [list $class :: info common $a]
+ set com [send $target $cmd]
+ set res "$res\tcommon $a [list [lindex $com 2]] (default: [list [lindex $com 1]])\n"
+ }
+ if {$coms != ""} {
+ set res "$res\n"
+ }
+
+ set meths [send $target [list $class :: info method]]
+ foreach arg $meths {
+ if {[string first $class $arg] == 0} {
+ regsub {(.*)::} $arg {} a
+ set cmd [list $class :: info method $a]
+ set meth [send $target $cmd]
+ if {$a != "constructor" && $a != "destructor"} {
+ set nm "method "
+ } else {
+ set nm ""
+ }
+ if {[lindex $meth 1] != "<built-in>"} {
+ set res "$res\t$nm$a [lrange $meth 1 end]\n\n"
+ }
+ }
+ }
+
+ set procs [send $target [list $class :: info proc]]
+ foreach arg $procs {
+ if {[string first $class $arg] == 0} {
+ regsub {(.*)::} $arg {} a
+ set cmd [list $class :: info proc $a]
+ set proc [send $target $cmd]
+ if {[lindex $proc 1] != "<built-in>"} {
+ set res "$res\tproc $a [lrange $proc 1 end]\n\n"
+ }
+ }
+ }
+
+ set res "$res}\n"
+ return $res
+ }
+
+ method send_filter {value} {
+ return $value
+ }
+}
- method update {target} {
- $self clear
- set classes [lsort [send $target itcl_info classes]]
- foreach class $classes {
- $self append $class
- }
- }
+# -------------------------------------------------------------------------
+# Handle new versions of incr Tcl
+# -------------------------------------------------------------------------
- method retrieve {target class} {
- set res "itcl_class $class {\n"
+if {[catch {package versions Itcl} itcl_version]} {
+ set itcl_version 0
+}
- set cmd [list $class :: info inherit]
- set inh [send $target $cmd]
- if {$inh != ""} {
- set res "$res\tinherit $inh\n\n"
- } else {
- set res "$res\n"
- }
+if {$itcl_version < 3.2} {
- set pubs [send $target [list $class :: info public]]
- foreach arg $pubs {
- regsub {(.*)::} $arg {} a
- set res "$res\tpublic $a\n"
- }
- if {$pubs != ""} {
- set res "$res\n"
- }
+ # Older incr Tcl versions
- set prots [send $target [list $class :: info protected]]
- foreach arg $prots {
- regsub {(.*)::} $arg {} a
- if {$a != "this"} {
- set res "$res\tprotected $a\n"
- }
- }
- if {$prots != ""} {
- set res "$res\n"
- }
+ widget class_list {
+ object_include tkinspect_list
+ object_include base_class_list
+ }
- set coms [send $target [list $class :: info common]]
- foreach arg $coms {
- regsub {(.*)::} $arg {} a
- set cmd [list $class :: info common $a]
- set com [send $target $cmd]
- set res "$res\tcommon $a [list [lindex $com 2]] (default: [list [lindex $com 1]])\n"
- }
- if {$coms != ""} {
- set res "$res\n"
- }
+} else {
- set meths [send $target [list $class :: info method]]
- foreach arg $meths {
- if {[string first $class $arg] == 0} {
- regsub {(.*)::} $arg {} a
- set cmd [list $class :: info method $a]
- set meth [send $target $cmd]
- if {$a != "constructor" && $a != "destructor"} {
- set nm "method "
- } else {
- set nm ""
- }
- if {[lindex $meth 1] != "<built-in>"} {
- set res "$res\t$nm$a [lrange $meth 1 end]\n\n"
- }
- }
- }
+ # incr Tcl 3.2+
- set procs [send $target [list $class :: info proc]]
- foreach arg $procs {
- if {[string first $class $arg] == 0} {
- regsub {(.*)::} $arg {} a
- set cmd [list $class :: info proc $a]
- set proc [send $target $cmd]
- if {[lindex $proc 1] != "<built-in>"} {
- set res "$res\tproc $a [lrange $proc 1 end]\n\n"
- }
- }
- }
+ widget class_list {
+ object_include tkinspect_list
+ object_include base_class_list
+
+ method retrieve {target class} {
+ set res "itcl::class $class {\n"
+
+ set cmd [list namespace eval $class {info inherit}]
+ set inh [send $target $cmd]
+ if {$inh != ""} {
+ append res " inherit $inh\n\n"
+ } else {
+ append res "\n"
+ }
+
+ set vars [send $target namespace eval $class {info variable}]
+ foreach var $vars {
+ set name [namespace tail $var]
+ set cmd [list namespace eval $class \
+ [list info variable $name -protection -type -name -init]]
+ set text [send $target $cmd]
+ append res " $text\n"
+ }
+ append res "\n"
+
+
+ set funcs [send $target [list namespace eval $class {info function}]]
+ foreach func [lsort $funcs] {
+ set qualclass "::[string trimleft $class :]"
+ if {[string first $qualclass $func] == 0} {
+ set name [namespace tail $func]
+ set cmd [list namespace eval $class [list info function $name]]
+ set text [send $target $cmd]
- set res "$res}\n"
- return $res
- }
+ if {![string match "@itcl-builtin*" [lindex $text 4]]} {
+ switch -exact -- $name {
+ constructor {
+ append res " $name [lrange $text 3 end]\n"
+ }
+ destructor {
+ append res " $name [lrange $text 4 end]\n"
+ }
+ default {
+ append res " [lindex $text 0] [lindex $text 1] $name\
+ [lrange $text 3 end]\n"
+ }
+ }
+ }
+ }
+ }
+
+ append res "}\n"
+ return $res
+ }
+ }
- method send_filter {value} {
- return $value
- }
-}
+}
\ No newline at end of file
# Provide a command line interface to an application (much of the
# code is lifted out of the Tk demo rmt).
#
+# [PT]: this should be replaced by tkcon...
dialog command_line {
param main
}
bind $self.t <Key> "command_line:text_insert $self %A; break"
$self.t tag configure bold \
- -font -*-Courier-Bold-R-Normal-*-120-*-*-*-*-*-*
+ -font {Courier 12 bold}
+ #-font -*-Courier-Bold-R-Normal-*-120-*-*-*-*-*-*
$self prompt
}
method destroy {} {
dialog help_window {
param topics {}
- param width 50
+ param width 100
param height 35
param helpdir .
member history {}
# E-mail: sst@bouw.tno.nl
# URL: http://huizen.dds.nl/~quintess
#
+# Itcl 3.2 support by Pat Thoyts <patthoyts@users.sourceforge.net>
+# The original code is renamed to base_class_list and if a newer
+# version of incr Tcl is found then we shall override some methods.
+#
-widget object_list {
+widget base_object_list {
object_include tkinspect_list
param title "Objects"
return $value
}
}
+
+# -------------------------------------------------------------------------
+# Handle new versions of incr Tcl
+# -------------------------------------------------------------------------
+
+if {[catch {package versions Itcl} itcl_version]} {
+ set itcl_version 0
+}
+
+if {$itcl_version < 3.2} {
+
+ # Older incr Tcl versions
+
+ widget object_list {
+ object_include tkinspect_list
+ object_include base_object_list
+ }
+
+} else {
+
+ # incr Tcl 3.2+
+
+ widget object_list {
+ object_include tkinspect_list
+ object_include base_object_list
+
+ method retrieve {target object} {
+ set class [send $target [list $object info class]]
+ set res "$class $object {\n"
+
+ set cmd [list $object info inherit]
+ set inh [send $target $cmd]
+ if {$inh != ""} {
+ append res " inherit $inh\n\n"
+ } else {
+ append res "\n"
+ }
+
+ set vars [send $target $object info variable]
+ foreach var $vars {
+ set name [namespace tail $var]
+ set cmd [list $object info variable $name]
+ set text [send $target $cmd]
+ append res " $text\n"
+ }
+ append res "\n"
+
+
+ set funcs [send $target [list $object info function]]
+ foreach func [lsort $funcs] {
+ set qualclass "::[string trimleft $class :]"
+ if {[string first $qualclass $func] == 0} {
+ set name [namespace tail $func]
+ set cmd [list $object info function $name]
+ set text [send $target $cmd]
+
+ if {![string match "@itcl-builtin*" [lindex $text 4]]} {
+ switch -exact -- $name {
+ constructor {
+ append res " $name [lrange $text 3 end]\n"
+ }
+ destructor {
+ append res " $name [lrange $text 4 end]\n"
+ }
+ default {
+ append res " [lindex $text 0] [lindex $text 1] $name\
+ [lrange $text 3 end]\n"
+ }
+ }
+ }
+ }
+ }
+
+ append res "}\n"
+ return $res
+ }
+
+ }
+
+}
\ No newline at end of file
}
set tkinspect(help_topics) {
Intro Value Lists Procs Globals Windows Images Canvases Menus
- Value Miscellany Notes WhatsNew ChangeLog
+ Classes Value Miscellany Notes WhatsNew ChangeLog
}
if {[info commands itcl_info] != ""} {
}
}
-proc tkinspect_about {} {
+proc tkinspect_about {parent} {
catch {destroy .about}
about .about
+ wm transient .about $parent
.about run
}
-underline 0
pack $self.menu.help -side right
set m [menu $self.menu.help.m]
- $m add command -label "About..." -command tkinspect_about \
+ $m add command -label "About..." -command [list tkinspect_about $self]\
-underline 0
foreach topic $tkinspect(help_topics) {
$m add command -label $topic -command [list $self help $topic] \
proc version_init {} {
global tkinspect tk_version tk_patchLevel
- set tkinspect(release) 5.1.6p3
- set tkinspect(release_date) "Nov 23, 1997"
+ set tkinspect(release) 5.1.6p6
+ set tkinspect(release_date) "14 Mar 2002"
scan $tk_version "%d.%d" major minor
if {$major < 8} {
puts stderr \
- "tkinspect-5.1.6.p3 requires Tk 8.x, you appear to be running Tk $major.$minor"
+ "tkinspect-$tkinspect(release) 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} {
tk_dialog .warning "Warning!" \
-"tkinspect-$tkinspect(release) has only been tested on 4.0b4. You might have problems running on $tk_patchLevel." warning 0 Ok
+ "tkinspect-$tkinspect(release) has only been tested on 4.0b4.\
+ You might have problems running on $tk_patchLevel." warning 0 Ok
}
}
projects / tkinspect / commitdiff