Index: openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl,v
diff -u -N -r1.58 -r1.58.2.1
--- openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	14 Mar 2008 20:04:57 -0000	1.58
+++ openacs-4/packages/xotcl-core/tcl/05-db-procs.tcl	26 Mar 2008 13:44:45 -0000	1.58.2.1
@@ -421,7 +421,7 @@
     @return table_name
   } {
     return [db_string [my qn get_table_name] {
-      select table_name from acs_object_types where object_type = :object_type
+      select lower(table_name) as table_name from acs_object_types where object_type = :object_type
     } -default ""]
   }
 
@@ -480,19 +480,16 @@
 
     @return class name of the created XOTcl class
   } {
+    # some table_names and id_columns in acs_object_types are unfortunately upper case, 
+    # so we have to convert to lower case here....
     db_1row dbqd..fetch_class {
-      select object_type, supertype, pretty_name, id_column, table_name  
+      select object_type, supertype, pretty_name, lower(id_column) as id_column, lower(table_name) as table_name
       from acs_object_types where object_type = :object_type
     }
     set classname [my object_type_to_class $object_type]
     if {![my isclass $classname]} {
       # the XOTcl class does not exist, we create it
-      #switch $supertype {
-      #acs_object       {set superclass ::xo::db::Object}
-      #content_revision {set superclass ::xo::db::CrItem}
-      #default          {[my object_type_to_class $supertype]}
-      #}
-      #my log "creating class $classname superclass $superclass"
+      #my log "--db create class $classname superclass $supertype"
       ::xo::db::Class create $classname \
           -superclass [my object_type_to_class $supertype] \
           -object_type $object_type \
@@ -502,7 +499,7 @@
           -table_name $table_name \
 	  -noinit
     } else {
-      #my log "we have a class $classname"
+      #my log "--db we have a class $classname"
     }
     set attributes [db_list_of_lists dbqd..get_atts {
       select attribute_name, pretty_name, pretty_plural, datatype, 
@@ -615,10 +612,11 @@
         set n 1
         set function_args [list]
         foreach line [split $prosrc \n] {
-          if {[regexp "alias for \\\$$n" $line]} {
+          if {[regexp -nocase "alias +for +\\\$$n" $line]} {
             regexp {^[^a-zA-Z]+([a-zA-Z0-9_]+)\s} $line _ fq_name
             if {![info exists fq_name]} {
-              ns_log notice "--***** Could not retrieve argument name for $proname argument $n from line '$line' in $prosrc'"
+              ns_log notice "--***** Could not retrieve argument name for $proname\
+			argument $n from line '$line' in $prosrc'"
 	      set fq_name arg$n
             }
             #lappend fq_names $fq_name
Index: openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl,v
diff -u -N -r1.7 -r1.7.2.1
--- openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl	1 Jan 2008 23:30:03 -0000	1.7
+++ openacs-4/packages/xotcl-core/tcl/http-client-procs.tcl	26 Mar 2008 13:44:45 -0000	1.7.2.1
@@ -154,7 +154,7 @@
     #
     # for text, use translation with optional encodings, else set translation binary
     #
-    if {[string match text/* $content_type]} {
+    if {[string match "text/*" $content_type]} {
       if {[regexp {charset=([^ ]+)$} $content_type _ encoding]} {
 	fconfigure [my set S] -translation $text_translation -encoding [string tolower $encoding]
       } else {
Index: openacs-4/packages/xotcl-core/www/show-class-graph.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/show-class-graph.tcl,v
diff -u -N
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/xotcl-core/www/show-class-graph.tcl	26 Mar 2008 13:44:45 -0000	1.7.2.2
@@ -0,0 +1,160 @@
+ad_page_contract {
+  Show an xotcl class or object
+  
+  @author Gustaf Neumann
+  @cvs-id $Id: show-class-graph.tcl,v 1.7.2.2 2008/03/26 13:44:45 gustafn Exp $
+} -query {
+  {classes}
+  {documented_only 1}
+  {with_children 0}
+  {dpi 96}
+}
+
+::xotcl::Object instproc dotquote {e} {
+  return \"$e\" 
+}
+::xotcl::Object instproc dotquotel {l} {
+  set result [list]
+  foreach e $l { lappend result \"$e\" }
+  return $result
+}
+::xotcl::Object instproc dot_append_method {{-documented_methods 1} e methods_ref kind} {
+  my upvar $methods_ref methods
+  set infokind $kind
+  if {$kind eq "instproc"} {append infokind s}
+  ::xotcl::api scope_from_object_reference scope e
+  foreach method [$e info $infokind] {
+    if {$documented_methods} {
+      set proc_index [::xotcl::api proc_index $scope $e $kind $method]
+      #my msg "check $method => [nsv_exists api_proc_doc $proc_index]"
+      if {[nsv_exists api_proc_doc $proc_index]} {
+        lappend methods $method
+      }
+    } else {
+      lappend methods $method
+    }
+  }
+}
+::xotcl::Object instproc dotclass {{-documented_methods 1} e} {
+  set definition ""
+  append definition "[my dotquote $e] \[label=\"\{$e|"
+  foreach slot [$e info slots] {
+    append definition "[$slot name]\\l"
+  }
+  append definition "|"
+  ::xotcl::api scope_from_object_reference scope e
+  set methods [list]
+  my dot_append_method -documented_methods $documented_methods $e methods instproc
+  my dot_append_method -documented_methods $documented_methods $e methods instforward
+  foreach method [lsort $methods] {
+    append definition "$method\\l"
+  }
+  append definition "\}\"\];\n"
+}
+
+
+::xotcl::Object instproc dotcode {
+  {-with_children 0} 
+  {-omit_base_classes 1} 
+  {-documented_methods 1} 
+  {-dpi 96} 
+  things
+} {
+  set classes [list]
+  set objects [list]
+
+  foreach e $things {
+    if {![my isobject $e]} continue
+    if {$omit_base_classes && $e eq "::xotcl::Object" || $e eq "::xotcl::Class"} continue
+    lappend [expr {[my isclass $e] ? "classes" : "objects"}] $e
+  }
+  set instances ""
+  foreach e $things {
+    if {![my isobject $e]} continue
+    if {$omit_base_classes && $e eq "::xotcl::Object" || $e eq "::xotcl::Class"} continue
+    set c [$e info class]
+    if {$omit_base_classes && $c eq "::xotcl::Object" || $c eq "::xotcl::Class"} continue
+    append instances "[my dotquote $e]->[my dotquote $c];\n"
+  }
+  set superclasses ""
+  foreach e $classes {
+    if {![my isobject $e]} continue
+    if {$e eq "::xotcl::Object"} continue
+    set reduced_sc [list]
+    foreach sc [$e info superclass] {
+      if {$omit_base_classes && $sc eq "::xotcl::Object"
+	  || $sc eq "::xotcl::Class"} continue
+      lappend reduced_sc $sc
+    }
+    if {$reduced_sc eq {}} continue
+    append superclasses "[my dotquote $e]->[my dotquotel $reduced_sc];\n"
+  }
+  set children ""
+  set mixins ""
+  foreach e $things {
+    if {![my isobject $e]} continue
+    if {$omit_base_classes && $e eq "::xotcl::Object" || $e eq "::xotcl::Class"} continue
+    if {$with_children} {
+      foreach c [$e info children] {
+        if {[lsearch $things $c] == -1} continue
+        append children "[my dotquote $c]->[my dotquote $e];\n"
+      }
+    }
+    set m [$e info mixin]
+    #puts "-- $e mixin $m"
+    if {$m eq ""} continue
+    append mixins "[my dotquote $e]->[my dotquotel $m];\n"
+  }
+  set tclasses ""
+  set instmixins ""
+  foreach e $classes {
+    set m [$e info instmixin]
+    #puts "-- $e instmixin $m"
+    if {$m eq ""} continue
+    #foreach mixin $m {
+    #  append tclasses [my dotclass -documented_methods $documented_methods $mixin]
+    #}
+    append instmixins "[my dotquote $e]->[my dotquotel $m];\n"
+  }
+
+  foreach e $classes {
+    append tclasses [my dotclass -documented_methods $documented_methods $e]
+  }
+  #label = \".\\n.\\nObject relations of [self]\"
+  #edge \[dir=back, constraint=0\] \"::Decorate_Action\" -> \"::Action\";
+  set objects  [join [my dotquotel $objects] {; }]
+  set classes  [join [my dotquotel $classes] {; }]
+  set imcolor hotpink4
+
+  set font "fontname = \"Helvetica\",fontsize = 8,"
+  #set font "fontname = \"Bitstream Vera Sans\",fontsize = 8,"
+# rankdir = BT; labeldistance = 20;
+  return "digraph {
+   dpi = $dpi;
+   rankdir = BT;
+   node \[$font shape=record\]; $tclasses
+   edge \[arrawohead=empty\]; $superclasses
+   node \[color=Green,shape=ellipse,fontcolor=Blue, style=filled, fillcolor=darkseagreen1\]; $objects
+   edge \[color=Blue,style=dotted\]; $instances
+   edge \[color=pink,arrowhead=diamond, style=dotted\]; $children
+   edge \[label=instmixin,fontsize=10,color=$imcolor,fontcolor=$imcolor,arrowhead=none,arrowtail=vee, style=dashed,dir=back, constraint=0\]; $instmixins
+   edge \[label=mixin,fontsize=10,color=$imcolor,fontcolor=$imcolor,arrowhead=none,arrowtail=vee, style=dashed,dir=back, constraint=0\]; $mixins
+
+}"
+}
+
+set dot_code [::xotcl::Object dotcode -dpi $dpi \
+                  -with_children $with_children -documented_methods $documented_only \
+                  $classes]
+set dot ""
+catch {set dot [::util::which dot]}
+# final ressort for cases, where ::util::which is not available
+if {$dot eq "" && [file executable /usr/bin/dot]} {set dot /usr/bin/dot}
+if {$dot eq ""} {ns_return 404 plain/text "do dot found"; ad_script_abort}
+
+set tmpfile [ns_tmpnam].png
+set f [open "|$dot  -Tpng -o $tmpfile" w]
+puts $f $dot_code
+close $f
+ns_returnfile 200 [ns_guesstype $tmpfile] $tmpfile
+file delete $tmpfile
\ No newline at end of file
Index: openacs-4/packages/xotcl-core/www/show-object.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/show-object.adp,v
diff -u -N -r1.1 -r1.1.8.1
--- openacs-4/packages/xotcl-core/www/show-object.adp	11 Oct 2005 08:41:18 -0000	1.1
+++ openacs-4/packages/xotcl-core/www/show-object.adp	26 Mar 2008 13:44:45 -0000	1.1.8.1
@@ -36,6 +36,9 @@
 <hr>
 
 <h1 class="page-title">@title;noquote@</h1>
+<if @class_hierarchy@ not nil>
+<img style='float: right; max-width: 800px;' src='./show-class-graph?classes=@class_hierarchy@&documented_only=@documented_only@'>
+</if>
 @output;noquote@
 
 <hr>
Index: openacs-4/packages/xotcl-core/www/show-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/show-object.tcl,v
diff -u -N -r1.10 -r1.10.2.1
--- openacs-4/packages/xotcl-core/www/show-object.tcl	9 Dec 2007 21:19:53 -0000	1.10
+++ openacs-4/packages/xotcl-core/www/show-object.tcl	26 Mar 2008 13:44:45 -0000	1.10.2.1
@@ -179,6 +179,20 @@
   append output "<h4>Class Hierarchy of $object</h4>"
   #append output [superclass_hierarchy $object]
   append output [draw_as_tree [superclass_hierarchy $object $scope]]
+  #set class_hierarchy [ns_urlencode [concat $object [$object info heritage]]]
+  #
+  # compute list of classes with siblings
+  set class_hierarchy [list]
+  foreach c [$object info superclass] {
+    if {$c eq "::xotcl::Object"} {continue}
+    eval lappend class_hierarchy [$c info subclass]
+  }
+  eval lappend class_hierarchy [$object info heritage]
+  if {[lsearch -exact $class_hierarchy $object] == -1} {lappend class_hierarchy $object}
+  #::xotcl::Object msg class_hierarchy=$class_hierarchy
+  set class_hierarchy [ns_urlencode $class_hierarchy]
+  set documented_only [expr {$show_methods < 2}]
+  #set class_hierarchy [ns_urlencode [concat $object [$object info heritage]]]
 }
 
 if {[nsv_exists api_library_doc $index]} {