Applied the incr Tcl patch from Tako Schotanus (1995)

diff --git a/classes_list.tcl b/classes_list.tcl
new file mode 100644 (file)
index 0000000..8fba400
--- /dev/null
+++ b/classes_list.tcl
@@ -0,0 +1,103 @@
+#
+# $Id$
+#
+# Written by: T. Schotanus
+# E-mail:     sst@bouw.tno.nl
+# URL:        http://huizen.dds.nl/~quintess
+#
+
+widget 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
+       }
+}

diff --git a/install.tcl b/install.tcl
index 9bb0b2751c4947ddbd70f54c325a1b13d465750a..c5c70ffbd580fc948f3b664d02b3120b890da7fc 100644 (file)
--- a/install.tcl
+++ b/install.tcl
@@ -173,7 +173,8 @@ 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 names.tcl tclIndex
+       cmdline.tcl interface.tcl tclIndex
+       names.tcl classes_list.tcl objects_list.tcl
        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/objects_list.tcl b/objects_list.tcl
new file mode 100644 (file)
index 0000000..08668e0
--- /dev/null
+++ b/objects_list.tcl
@@ -0,0 +1,109 @@
+#
+# $Id$
+#
+# Written by: T. Schotanus
+# E-mail:     sst@bouw.tno.nl
+# URL:        http://huizen.dds.nl/~quintess
+#
+
+widget object_list {
+       object_include tkinspect_list
+       param title "Objects"
+
+       method get_item_name {} {
+               return object
+       }
+
+       method update {target} {
+               $self clear
+               set objects [lsort [send $target itcl_info objects]]
+               foreach object $objects {
+                       $self append $object
+               }
+       }
+
+       method retrieve {target object} {
+               set class [send $target [list $object info class]]
+               set res "$class $object {\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 $object info public]]
+               foreach arg $pubs {
+                       regsub {(.*)::} $arg {} a
+                       set cmd [list $object info public $a]
+                       set pub [send $target $cmd]
+                       set res "$res\tpublic $a [list [lindex $pub 2] [lindex $pub 3]] (default: [list [lindex $pub 1]])\n"
+               }
+               if {$pubs != ""} {
+                       set res "$res\n"
+               }
+
+               set prots [send $target [list $object info protected]]
+               foreach arg $prots {
+                       regsub {(.*)::} $arg {} a
+                       if {$a == "this"} {
+                               continue
+                       }
+                       set cmd [list $object info protected $a]
+                       set prot [send $target $cmd]
+                       set res "$res\tprotected $a [list [lindex $prot 2]] (default: [list [lindex $prot 1]])\n"
+               }
+               if {$prots != ""} {
+                       set res "$res\n"
+               }
+
+               set coms [send $target [list $object info common]]
+               foreach arg $coms {
+                       regsub {(.*)::} $arg {} a
+                       set cmd [list $object 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 $object info method]]
+               foreach arg $meths {
+                       if {[string first $class $arg] == 0} {
+                               regsub {(.*)::} $arg {} a
+                               set cmd [list $object 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 $object info proc]]
+               foreach arg $procs {
+                       if {[string first $class $arg] == 0} {
+                               regsub {(.*)::} $arg {} a
+                               set cmd [list $object 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
+       }
+}

diff --git a/tkinspect.tcl b/tkinspect.tcl
index a903e6e9e69a06d0b6199bfce4c8aea726cc2973..9fc608365eeddb5298c25ee03bbb208db2842c59 100644 (file)
--- a/tkinspect.tcl
+++ b/tkinspect.tcl
@@ -14,12 +14,26 @@ set tkinspect(list_classes) {
     "images_list Images"
     "menus_list Menus"
     "canvas_list Canvases"
+    "class_list Classes"
+    "object_list Objects"
+}
+set tkinspect(list_class_files) {
+    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 classes_list.tcl
+    objects_list.tcl names.tcl
 }
 set tkinspect(help_topics) {
     Intro Value Lists Procs Globals Windows Images Canvases Menus
     Value Miscellany Notes WhatsNew ChangeLog
 }
 
+if {[info commands itcl_info] != ""} {
+       set tkinspect(default_lists) "object_list procs_list globals_list windows_list"
+} else {
+       set tkinspect(default_lists) "procs_list globals_list windows_list"
+}
+
 wm withdraw .
 
 if [file exists @tkinspect_library@/tclIndex] {
@@ -60,11 +74,9 @@ proc tkinspect_exit {} {
 
 proc tkinspect_widgets_init {} {
     global tkinspect_library
-    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 names.tcl
-    } {
+    global tkinspect
+
+    foreach file $tkinspect(list_class_files) {
        uplevel #0 source $tkinspect_library/$file
     }
 }
@@ -76,7 +88,6 @@ proc tkinspect_about {} {
 }
 
 dialog tkinspect_main {
-    param default_lists "procs_list globals_list windows_list"
     param target ""
     member last_list {}
     member lists ""
@@ -141,7 +152,7 @@ dialog tkinspect_main {
        pack [frame $self.lists -bd 0] -side top -fill both
        value $self.value -main $self
        pack $self.value -side top -fill both -expand 1
-       foreach list_class $slot(default_lists) {
+       foreach list_class $tkinspect(default_lists) {
            $self add_list $list_class
            set slot(${list_class}_is_on) 1
        }
@@ -360,3 +371,4 @@ dialog connect_interp {
        $slot(value) set_target $text
     }
 }
+