index.tcl

Show classes defined in the connection threads

Location:
/packages/xotcl-core/www/index.tcl
Author:

Gustaf Neumann

CVS ID:

$Id: index.tcl,v 1.13 2024/10/29 16:40:12 gustafn Exp $
File Contents

ad_page_contract {
  Show classes defined in the connection threads

  @author Gustaf Neumann
  @cvs-id $Id: index.tcl,v 1.13 2024/10/29 16:40:12 gustafn Exp $
} -query {
  {all_classes:notnull 0}
} -properties {
  title:onevalue
  context:onevalue
  output:onevalue
} -validate {
  check_enum -requires all_classes {
    if {$all_classes ni {0 1}} {
      ad_complain "value not in enumeration domain"
    }
  }
}

set title "XOTcl Classes Defined in Connection Threads"
set context [list "XOTcl"]

set dimensional_slider [ad_dimensional {
  {
    all_classes "Show:" 0 {
      { 1 "All Classes" }
      { 0 "Application Classes only" }
    }
  }
}]


proc local_link cl {
  upvar all_classes all_classes
  if {$all_classes || (![string match "::xotcl::*" $cl] && ![string match "::nx::*" $cl])} {
    return "<a href='#$cl'>$cl</a>"
  } else {
    return $cl
  }
}

proc info_classes {cl key {dosort 0}} {
  upvar all_classes all_classes
  set infos ""
  set classes [::apidoc::get_object_property $cl $key]
  if {$dosort} {
    set classes [lsort $classes]
  }
  foreach s $classes {
    append infos [local_link $s] ", "
  }
  set infos [string trimright $infos ", "]
  if {$infos ne ""} {
    return "<li><em>$key</em> $infos</li>\n"
  } else {
    return ""
  }
}

set output "<ul>"
set classes [::xotcl::Class allinstances]
if {[info commands ::nx::Class] ne ""} {
    lappend classes {*}[nx::Class info instances -closure]
}
foreach cl [lsort $classes] {
  if {!$all_classes && ([string match "::xotcl::*" $cl] || [string match "::nx::*" $cl])} {
    continue
  }

  append output "<li><b><a name='$cl'></a>[::xo::api object_link {} $cl]</b> <ul>"

  append output [info_classes $cl superclass]
  append output [info_classes $cl subclass 1]
  append output [info_classes $cl mixin]
  append output [info_classes $cl instmixin]

  foreach key {proc instproc} {
    set infos ""
    foreach i [lsort [::apidoc::get_object_property $cl $key]] {append infos [::xo::api method_link $cl $key $i] ", "}
    set infos [string trimright $infos ", "]
    if {$infos ne ""} {
      append output "<li><em>$key:</em> $infos</li>\n"
    }

  }

  set infos ""
  foreach o [lsort [$cl info instances]] {append infos [::xo::api object_link {} $o] ", "}
  set infos [string trimright $infos ", "]
  if {$infos ne ""} {
    append output "<li><em>instances:</em> $infos</li>\n"
  }


  append output </ul>
}
append output </ul>


# Local variables:
#    mode: tcl
#    tcl-indent-level: 2
#    indent-tabs-mode: nil
# End:
index.tcl

Related Files

File Contents
