Index: library/lib/xotcl1.xotcl =================================================================== diff -u -rf6be3f63eadda89d7f419a090d86669c6be84c3b -r666f7ad2cb2562f3d62fc9aea54efb9b0826f6b0 --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision f6be3f63eadda89d7f419a090d86669c6be84c3b) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 666f7ad2cb2562f3d62fc9aea54efb9b0826f6b0) @@ -93,21 +93,9 @@ Object create ::xotcl::objectInfo Object create ::xotcl::classInfo - foreach cmd [::info command ::xotcl::cmd::ObjectInfo::*] { - ::xotcl::alias ::xotcl::objectInfo [namespace tail $cmd] $cmd - ::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd - } - foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] { - ::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd - } - ::xotcl::alias ::xotcl::objectInfo is ::xotcl::is - ::xotcl::alias ::xotcl::classInfo is ::xotcl::is - ::xotcl::alias ::xotcl::classInfo classparent ::xotcl::cmd::ObjectInfo::parent - ::xotcl::alias ::xotcl::classInfo classchildren ::xotcl::cmd::ObjectInfo::children - # note, we are using ::xotcl::infoError defined earlier - Object instforward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self} - Class instforward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self} + Object forward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self} + Class forward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self} objectInfo method info {obj} { set methods [list] @@ -135,6 +123,20 @@ error "[::xotcl::self] unknown info option \"$method\"; [.info info]" } + foreach cmd [::info command ::xotcl::cmd::ObjectInfo::*] { + set cmdName [namespace tail $cmd] + if {$cmdName eq "method"} continue + ::xotcl::alias ::xotcl::objectInfo $cmdName $cmd + ::xotcl::alias ::xotcl::classInfo $cmdName $cmd + } + foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] { + ::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd + } + ::xotcl::alias ::xotcl::objectInfo is ::xotcl::is + ::xotcl::alias ::xotcl::classInfo is ::xotcl::is + ::xotcl::alias ::xotcl::classInfo classparent ::xotcl::cmd::ObjectInfo::parent + ::xotcl::alias ::xotcl::classInfo classchildren ::xotcl::cmd::ObjectInfo::children + # # Backward compatibility info subcommands; # @@ -154,28 +156,38 @@ # info instnonposargs # info instdefault # - # => maybe instead of "info params" and "info instparams" - # info params ?-per-object? + # => maybe instead of "info params" and "info instparams" + # info params ?-per-object? # - # => TODO: use "params" in serializer, and all other occurances + # => info method .... replaces + # info body + # info instbody # - # TODO: not yet emulated: + # => info methods .... replaces + # info commands + # info instcommands + # info procs + # info instprocs + # info parametercmd + # info instparametercmd # - # => info is (bzw. ::xotcl::is) replaces - # isobject - # isclass - # ismetaclass - # ismixin - # istype + # => info is (resp. ::xotcl::is) replaces + # info isobject + # info isclass + # info ismetaclass + # info ismixin + # info istype # - # => method (should get pre- and postconditions via positional params) + # => method .... replaces # proc # instproc # + # => TODO: use "params" in serializer, and all other occurances + # + # # TODO mark all absolete calls at least as deprecated in library # - # TODO move unknown handler for Class into a library, make sure that - # regression test and library function use explicit "creates". + # TODO move unknown handler for Class into a library # proc ::xotcl::info_args {inst o method} { @@ -224,41 +236,44 @@ .method nonposargs {o method} {::xotcl::info_nonposargs "" $o $method} .method instdefault {o method arg var} {::xotcl::info_default inst $o $method $arg $var} .method default {o method arg var} {::xotcl::info_default "" $o $method $arg $var} - .method instprocs {o pattern:optional} { - if {[::info exists pattern]} { - ::xotcl::cmd::ObjectInfo::methods $o -defined -methodtype scripted $pattern - } { - ::xotcl::cmd::ObjectInfo::methods $o -defined -methodtype scripted - } + + # info options emulated by "info method" + .method instbody {o methodName} { + lindex [::xotcl::cmd::ObjectInfo::method $o definition $methodName] end } - .method procs {o pattern:optional} { - if {[::info exists pattern]} { - ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object -methodtype scripted $pattern - } { - ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object -methodtype scripted - } + + # info options emulated by "info methods" + .method instcommands {o {pattern:optional ""}} { + ::xotcl::cmd::ObjectInfo::methods $o -defined {*}$pattern } - .method parametercmd {o pattern:optional} { - if {[::info exists pattern]} { - ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object -methodtype setter $pattern - } { - ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object -methodtype setter - } + .method instprocs {o {pattern:optional ""}} { + ::xotcl::cmd::ObjectInfo::methods $o -defined -methodtype scripted {*}$pattern } + .method parametercmd {o {pattern:optional ""}} { + ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object -methodtype setter {*}$pattern + } + .method instparametercmd {o {pattern:optional ""}} { + ::xotcl::cmd::ObjectInfo::methods $o -defined -methodtype setter {*}$pattern + } } objectInfo eval { .method args {o method} {::xotcl::info_args "" $o $method} .method nonposargs {o method} {::xotcl::info_nonposargs "" $o $method} .method default {o method arg var} {::xotcl::info_default "" $o $method $arg $var} - .method procs {o pattern:optional} { - if {[::info exists pattern]} { - ::xotcl::cmd::ObjectInfo::methods $o -defined -methodtype scripted $pattern - } { - ::xotcl::cmd::ObjectInfo::methods $o -defined -methodtype scripted - } + + # info options emulated by "info method" + .method body {o methodName} { + lindex [::xotcl::cmd::ObjectInfo::method $o -per-object definition $methodName] end } + # info options emulated by "info methods" + .method commands {o {pattern:optional ""}} { + ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object {*}$pattern + } + .method procs {o {pattern:optional ""}} { + ::xotcl::cmd::ObjectInfo::methods $o -defined -per-object -methodtype scripted {*}$pattern + } .method methods { o -nocmds:switch -noprocs:switch -incontext:switch pattern:optional } { @@ -271,18 +286,22 @@ eval $cmd } } - # define methods on classInfo as well to overload the default behavior - ::xotcl::alias classInfo methods objectInfo::methods + # define info methods from objectInfo on classInfo as well + ::xotcl::alias classInfo body objectInfo::body + ::xotcl::alias classInfo commands objectInfo::commands + ::xotcl::alias classInfo methods objectInfo::methods + ::xotcl::alias classInfo procs objectInfo::procs - # emulation of isobject, ... + + # emulation of isobject, isclass ... Object method isobject {{object:substdefault "[self]"}} {::xotcl::is $object object} Object method isclass {{class:substdefault "[self]"}} {::xotcl::is $class class} Object method ismetaclass {{class:substdefault "[self]"}} {::xotcl::is $class metaclass} Object method ismixin {class} {::xotcl::is [self] mixin $class} Object method istype {class} {::xotcl::is [self] type $class} ::xotcl::alias ::xotcl::Object contains ::xotcl::classes::xotcl2::Object::contains - ::xotcl::Class instforward slots %self contains \ + ::xotcl::Class forward slots %self contains \ -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot} # # define proc and instproc in terms of method @@ -293,6 +312,7 @@ if {[info exists postcondition]} {lappend cmd -postcondition $postcondition} eval $cmd } + Object forward parametercmd %self setter Class method proc {name arglist body precondition:optional postcondition:optional} { set cmd [list my method -per-object $name $arglist $body] if {[info exists precondition]} {lappend cmd -precondition $precondition} @@ -305,6 +325,16 @@ if {[info exists postcondition]} {lappend cmd -postcondition $postcondition} eval $cmd } + Class forward parametercmd %self setter -per-object + Class forward instparametercmd %self setter + + # we are changing the the semantics from forward -> instforward + ::xotcl::alias Class instforward ::xotcl::cmd::Class::forward + ::xotcl::alias Class forward ::xotcl::cmd::Object::forward + #Class method forward {name args} { + # ::xotcl::dispatch [self] ::xotcl::cmd::Class::forward -per-object $name {*}$args + #} + Object method abstract {methtype methname arglist} { if {$methtype ne "proc" && $methtype ne "instproc" && $methtype ne "method"} { error "invalid method type '$methtype', \