Index: generic/predefined.tcl =================================================================== diff -u -r6458c13882afd52e8719ee0e0e054b42e9aee696 -re29308a6c15da697df375716a3ae3787ade64218 --- generic/predefined.tcl (.../predefined.tcl) (revision 6458c13882afd52e8719ee0e0e054b42e9aee696) +++ generic/predefined.tcl (.../predefined.tcl) (revision e29308a6c15da697df375716a3ae3787ade64218) @@ -20,7 +20,8 @@ # @param object:object # @param -per-object:switch # @param methodName - # @param methodproperty Accepts one of: {{{protected}}}, {{{redefine-protected}}}, {{{returns}}}, {{{slotobj}}} + # @param methodproperty Accepts one of: {{{protected}}}, + # {{{redefine-protected}}}, {{{returns}}}, {{{slotobj}}} # @param value # @command setter @@ -51,7 +52,8 @@ # @command objectproperty # # @param object:object - # @param objectkind Accepts one of: {{{type}}}, {{{object}}}, {{{class}}}, {{{baseclass}}}, {{{metaclass}}}, {{{hasmixin}}} + # @param objectkind Accepts one of: {{{type}}}, {{{object}}}, + # {{{class}}}, {{{baseclass}}}, {{{metaclass}}}, {{{hasmixin}}} # @param value:optional # @command importvar @@ -125,17 +127,50 @@ # It comes with a variety of subcommands to query different bits of # callstack information. See below. # - # @subcommand class Returns the name of the class holding the currently executing per-class method, if and only if called from within a per-class method. Note, that this method-owning class may be different to the class of the current object. If called from within a per-object method, it returns an empty string. + # @subcommand class Returns the name of the class holding the + # currently executing per-class method, if and only if called from + # within a per-class method. Note, that this method-owning class may + # be different to the class of the current object. If called from + # within a per-object method, it returns an empty string. + # # @subcommand proc Returns the name of the currently executing method. - # @subcommand callingclass Returns the name of the class which is calling into the executing method. - # @subcommand callingobject Returns the name of the object which is calling into the executing method. - # @subcommand calledclass Returns the name of the class that holds the originally (and now shadowed) target method (applicable in mixin classes and filters). - # @subcommand calledproc Returns the name of the target method (applicable in a filter only). - # @subcommand isnextcall Returns 1 if the executing method was invoked via {{@command ::nx::next}}, 0 otherwise. - # @subcommand next Returns the name of the method next on the precedence path as a string. - # @subcommand filterreg In a method serving as active filter, returns the name of the object (class) on which the method is registered as a filter. - # @subcommand callinglevel Returns the "original" callstack level calling into the executing method. Intermediary {{{next}}} calls are ignored in this computation. The level is returned in a form so that it can be used as first argument in {{@method ::nx::Object class uplevel}} or {{@method ::nx::Object class upvar}}. - # @subcommand activelevel Returns the actual callstack level calling into the executing method. The active might correspond the {{{callinglevel}}}, but this is not necessarily the case. The {{{activelevel}}} counts {{@command ::nx::next}} call. The level is returned in a form so that it can be used as first argument in {{@method ::nx::Object class uplevel}} or {{@method ::nx::Object class upvar}}. + # + # @subcommand callingclass Returns the name of the class which is + # calling into the executing method. + # + # @subcommand callingobject Returns the name of the object which is + # calling into the executing method. + # + # @subcommand calledclass Returns the name of the class that holds + # the originally (and now shadowed) target method (applicable in + # mixin classes and filters). + # + # @subcommand calledproc Returns the name of the target method + # (applicable in a filter only). + # + # @subcommand isnextcall Returns 1 if the executing method was + # invoked via {{@command ::nx::next}}, 0 otherwise. + # + # @subcommand next Returns the name of the method next on the + # precedence path as a string. + # + # @subcommand filterreg In a method serving as active filter, + # returns the name of the object (class) on which the method is + # registered as a filter. + # + # @subcommand callinglevel Returns the "original" callstack level + # calling into the executing method. Intermediary {{{next}}} calls + # are ignored in this computation. The level is returned in a form + # so that it can be used as first argument in {{@method ::nx::Object + # class uplevel}} or {{@method ::nx::Object class upvar}}. + # + # @subcommand activelevel Returns the actual callstack level calling + # into the executing method. The active might correspond the + # {{{callinglevel}}}, but this is not necessarily the case. The + # {{{activelevel}}} counts {{@command ::nx::next}} call. The level + # is returned in a form so that it can be used as first argument in + # {{@method ::nx::Object class uplevel}} or {{@method ::nx::Object + # class upvar}}. namespace export next current # Symbols reused in XOTcl @@ -146,7 +181,7 @@ # properties of the "Next" object system for the scope of an entire # {{{interp}}}. - # @subcommand configure#filter + # @command.subcommand {configure filter} # # Allows turning on or off filters globally for the current # interpreter. By default, the filter state is turned off. This @@ -157,7 +192,7 @@ # @param toggle Accepts either "on" or "off" # @return The current filter activation state - # @subcommand configure#softrecreate + # @command.subcommand {configure softrecreate} # # Allows controlling the scheme applied when recreating an object or a # class. By default, it is set to {{{off}}}. This means that the @@ -181,7 +216,7 @@ # @return The current toggle value - # @subcommand configure#objectsystems + # @command.subcommand {configure objectsystems} # # A mere introspection subcommand. It gives you the top level of the # current object system, i.e., the ruling root class and root @@ -193,7 +228,7 @@ # # @return The active pair of root class and root meta-class - # @subcommand configure#keepinitcmd + # @command.subcommand {configure keepinitcmd} # # Usually, initcmd scripts are discarded by the {{{interp}}} once # having been evaluated (in contrast to {{{proc}}} and {{{method}}} @@ -208,8 +243,13 @@ # @command alias # - # @param object:object The target object which becomes the owner of the aliased command (method, object or command). - # @param -per-object:switch If the target object is a class, one can specify the binding scope (i.e., per-object or per-class) of the aliased command + # @param object:object The target object which becomes the owner of + # the aliased command (method, object or command). + # + # @param -per-object:switch If the target object is a class, one can + # specify the binding scope (i.e., per-object or per-class) of the + # aliased command + # # @param methodName The name of the alias. # @param -nonleaf:switch ... # @param -objscope:switch ... Index: library/lib/doc-assets/entity.html.tmpl =================================================================== diff -u -rdbddbce63d4a499de52ff07fdc63c02017960c79 -re29308a6c15da697df375716a3ae3787ade64218 --- library/lib/doc-assets/entity.html.tmpl (.../entity.html.tmpl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) +++ library/lib/doc-assets/entity.html.tmpl (.../entity.html.tmpl) (revision e29308a6c15da697df375716a3ae3787ade64218) @@ -17,16 +17,16 @@

[$project name]

${:name}  - [:? {[:info is type ::nx::doc::@package]} { + [:? {[:info has type ::nx::doc::@package]} { [:?var :@version {${:@version}} ] } - { [$project version] }]

[$project name] - [:? {[:info is type ::nx::doc::@package]} { + [:? {[:info has type ::nx::doc::@package]} { > ${:name} - } ? {[:info is type ::nx::doc::@class]} { + } ? {[:info has type ::nx::doc::@class]} { > [:?var :partof {[${:partof} name] >}] ${:name} }]
@@ -42,13 +42,13 @@
- [:? {[:info is type ::nx::doc::@package]} { + [:? {[:info has type ::nx::doc::@package]} { [:include package.html.tmpl] - } ? {[:info is type ::nx::doc::@class]} { + } ? {[:info has type ::nx::doc::@class]} { [:include class.html.tmpl] - } ? {[:info is type ::nx::doc::@command]} { + } ? {[:info has type ::nx::doc::@command]} { [:include command.html.tmpl] - } ? {[:info is type ::nx::doc::@project]} { + } ? {[:info has type ::nx::doc::@project]} {
This is the API documentation for the [:name] project. @@ -65,7 +65,7 @@
    [:for package $(@package) { [:let css "" ] - [:? {[:info is type ::nx::doc::@package] && [current] eq $package} { + [:? {[:info has type ::nx::doc::@package] && [current] eq $package} { [:let css "selected" ] }]
  • [:fit [$package name] 30]
    • @@ -80,7 +80,7 @@
      [:for class $(@class) { [:let css "" ] - [:? {[:info is type ::nx::doc::@class] && [current] eq $class} { + [:? {[:info has type ::nx::doc::@class] && [current] eq $class} { [:let css "selected" ] }]
    • [:fit [$class name] 30]
      • @@ -95,7 +95,7 @@
        [:for command $(@command) { [:let css "" ] - [:? {[:info is type ::nx::doc::@command] && [current] eq $command} { + [:? {[:info has type ::nx::doc::@command] && [current] eq $command} { [:let css "selected"] }]
      • [$command name]
        • Index: library/lib/doc-tools.tcl =================================================================== diff -u -r18122dd21b99cf0d5b4cd01635048641a23aa051 -re29308a6c15da697df375716a3ae3787ade64218 --- library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision 18122dd21b99cf0d5b4cd01635048641a23aa051) +++ library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision e29308a6c15da697df375716a3ae3787ade64218) @@ -94,84 +94,6 @@ return $result } - # @method ::nx::doc::ExceptionClass#behind? - # - # This helper method can be used to decide whether a message - # caught in error propagation qualifies as a valid exception - # object. - # - # @param error_msg Stands for the intercepted string which assumingly represents an exception object identifier - # @return 0 or 1 - Class create ExceptionClass -superclass Class { - # A meta-class which defines common behaviour for exceptions - # types, used to indicate particular events when processing - # comment blocks. - - :method behind? {error_msg} { - return [expr {[::nsf::is $error_msg object] && \ - [::nsf::is $error_msg type [current]]}] - } - - # @method thrown_by? - # - # This helper method realises a special-purpose catch variant to - # safely evaluate scripts which are expected to produce exception - # objects - # - # @return 1 iff an exception object is caught, 0 if the script did - # not blow or it returned an error message not pointing to an - # exception object - :method thrown_by? {script} { - if {[uplevel 1 [list ::catch $script msg]]} { - return [:behind? [uplevel 1 [list set msg]]] - } - return 0 - } - - } - - ExceptionClass create Exception { - # The base class for exception objects - # - # @param message An explanatory message meant for the developer - :attribute message:required - # @param stack_trace Contains the stack trace as saved at the time of throwing the exception object - :attribute stack_trace - - # @method throw - # - # The method makes sure that an Exception object is propagated - # through the Tcl ::error mechanism, starting from the call site's - # scope - :method throw {} { - if {![info exists :stack_trace] && [info exists ::errorInfo]} { - :stack_trace $::errorInfo - } - # - # uplevel: throw at the call site - # - uplevel 1 [list ::error [current]] - } - } - - ExceptionClass create StyleViolation -superclass Exception { - # This exception indicates from within the parsing machinery that - # a comment block was malformed (according to the rules layed out - # by the statechart-like parsing specification. - } - ExceptionClass create InvalidTag -superclass Exception { - # This exception is thrown upon situations that invalid tags are - # used at various levels of entity/part nesting. This usually - # hints at typos in tag labels or the misuse of tags in certain - # contexts. - } - ExceptionClass create MissingPartofEntity -superclass Exception { - # This exception occurs when parts are defined without providing - # an owning (i.e., partof) entity. This might be caused by - # failures in resolving this context. - } - - Class create EntityClass -superclass Class { # A meta-class for named documenation entities. It sets some # shared properties (e.g., generation rules for tag names based on @@ -211,7 +133,7 @@ :method id {name} { set subns [string trimleft [namespace tail [current]] @] #return [:root_namespace]::${subns}::[string trimleft $name :] - puts stderr "[current callingproc] -> [:root_namespace]::${subns}[:get_fully_qualified_name $name]" + # puts stderr "[current callingproc] -> [:root_namespace]::${subns}[:get_fully_qualified_name $name]" return "[:root_namespace]::${subns}[:get_fully_qualified_name $name]" } @@ -227,7 +149,7 @@ } :method createOrConfigure {id args} { - puts stderr "createOrConfigure id $id" + # puts stderr "createOrConfigure id $id" # This method handles verifies whether an entity object based on # the given id exists. If so, it returns the resolved name. If # not, it provides for generating an object with the precomputed @@ -263,17 +185,13 @@ # puts stderr "ID -> [join [list [:root_namespace] $subns $partof_name $scope $name] ::]" return [join [list [:root_namespace] $subns $partof_name $scope $name] ::] } + :method new { -part_attribute - {-partof:substdefault {[[MissingPartofEntity new \ - -message [subst { - Parts of type '[namespace tail [current]]' - require a partof entity to be set - }]] throw]}} + -partof:required -name args } { - puts stderr "+++ PART [current args]" :createOrConfigure [:id [:get_fully_qualified_name [$partof name]] [$part_attribute scope] $name] {*}[current args] } } @@ -321,7 +239,7 @@ :method require_part {domain prop value} { if {[info exists :part_class]} { if {[::nsf::is $value object] && \ - [::nsf::is $value type ${:part_class}]} { + [$value info has type ${:part_class}]} { return $value } return [${:part_class} new \ @@ -384,7 +302,7 @@ # puts stderr SLOTS=$slots foreach s $slots { # [$s info is type ::nx::doc::PartAttribute] - if {![::nsf::objectproperty $s type ::nx::doc::PartAttribute] || ![$s eval {info exists :part_class}]} continue; + if {![$s info has type ::nx::doc::PartAttribute] || ![$s eval {info exists :part_class}]} continue; set accessor [$s name] # puts stderr "PROCESSING ACCESSOR $accessor, [info exists :$accessor]" if {[info exists :$accessor]} { @@ -475,7 +393,6 @@ if {[[current class] eval {info exists :container}]} { set container [[current class] container] next - puts stderr "--- entity [current] starts living, register with $container" $container register [current] } else { next @@ -509,18 +426,15 @@ :method init {} { next - puts stderr "APPLYING Resolvable container [current]" EntityClass mixin add [current class]::Resolvable [current class]::Resolvable container [current] - puts stderr "APPLYING Containable container [current]" # Entity mixin add [current class]::Containable [current class]::Containable container [current] } :method register {containable:object,type=::nx::doc::Entity} { set tag [[$containable info class] tag] if {[:info callable methods -application "@$tag"] ne ""} { - puts stderr "REGISTERING: tag $tag containable $containable on [current]" :@$tag $containable } } @@ -639,7 +553,7 @@ # partof object, which is the object behind [$domain name]? if {[info exists :scope] && ![::nsf::objectproperty [$domain name] ${:scope}]} { - error "The object '[$domain name]' does not qualify as '[$part_attribute scope]'" + error "The entity '[$domain name]' does not qualify as '${:scope}'" } next } @@ -767,7 +681,6 @@ } else { set comment "cannot check object, probably not instantiated" } - #puts stderr "XXXX [current] ${:name} is part of ${:partof} // [${:partof} name]" return [concat $params
        $comment] } return $params @@ -819,11 +732,7 @@ # @param args :object method new { -part_attribute - {-partof:substdefault {[[MissingPartofEntity new \ - -message [subst { - Parts of type '[namespace tail [current]]' - require a partof entity to be set - }]] throw]}} + -partof:required -name args } { @@ -842,8 +751,7 @@ } namespace export CommentBlockParser @command @object @class @package @project @method \ - @param @ Exception StyleViolation InvalidTag \ - MissingPartofEntity ExceptionClass + @param @ } @@ -1028,7 +936,7 @@ :method list_structural_features {} { set entry {{"access": "$access", "host": "$host", "name": "$name", "url": "$url", "type": "$type"}} set entries [list] - if {[:info is type ::nx::doc::@package]} { + if {[:info has type ::nx::doc::@package]} { set features [list @object @command] foreach feature $features { set instances [sorted [$feature info instances] name] @@ -1041,7 +949,7 @@ lappend entries [subst $entry] } } - } elseif {[:info is type ::nx::doc::@object]} { + } elseif {[:info has type ::nx::doc::@object]} { # TODO: fix support for @object-method! set features [list @method @param] foreach feature $features { @@ -1057,7 +965,7 @@ } } } - } elseif {[:info is type ::nx::doc::@command]} { + } elseif {[:info has type ::nx::doc::@command]} { set features @subcommand foreach feature $features { if {[info exists :$feature]} { @@ -1090,7 +998,7 @@ set id [$entity_type id {*}$args] if {![::nsf::is $id object]} return; set pof "" - if {[$id info is type ::nx::doc::Part]} { + if {[$id info has type ::nx::doc::Part]} { set pof "[[$id partof] name]#" set filename [[$id partof] filename] } else { @@ -1100,7 +1008,10 @@ } :method as_text {} { - return [string map {"\n\n" "

        "} [next]] + set pre [next] + set post [string map {"\n\n" "

        "} $pre] + return $post + #return [string map {"\n\n" "

        "} [next]] } } @@ -1314,14 +1225,17 @@ # (most blocks, especially in initcmd and method blocks, are # not qualified, so they are set to fail. however, record the # failing ones for the time being - if {[catch {::nx::doc::CommentBlockParser process $block} msg]} { - if {![InvalidTag behind? $msg] && ![StyleViolation behind? $msg] && ![MissingPartofEntity behind? $msg]} { - if {[Exception behind? $msg]} { - error [$msg info class]->[$msg message] - } - error $msg - } - } + set cbp [::nx::doc::CommentBlockParser process $block] + # TODO: How to handle contingent (recoverable) conditions here? + # if {[catch {::nx::doc::CommentBlockParser process $block} msg]} { + # if {![InvalidTag behind? $msg] && ![StyleViolation behind? $msg] && ![MissingPartofEntity behind? $msg]} { + # if {[Exception behind? $msg]} { + # ::return -code error -errorinfo $::errorInfo "[$msg info class]->[$msg message]" + # # error [$msg info class]->[$msg message] + # } + # ::return -code error -errorinfo $::errorInfo $msg + # } + # } } # 3) process the recorded object additions, i.e., the stored # initcmds and method bodies. @@ -1429,9 +1343,11 @@ # TODO: Passing $id as partof_entity appears unnecessary, # clean up the logic in CommentBlockParser->process()!!! #puts stderr "==== CommentBlockParser process -partof_entity $id {*}$arguments" - if {[catch {CommentBlockParser process -partof_entity $id {*}$arguments} msg]} { - lappend failed_blocks $line_offset - } + set cbp [CommentBlockParser process -partof_entity $id {*}$arguments] + +# if {[catch {CommentBlockParser process -partof_entity $id {*}$arguments} msg]} { +# lappend failed_blocks $line_offset +# } } }; # analyze_initcmd method @@ -1579,7 +1495,7 @@ set values [join [dict values $top_level_entities]] puts stderr "VALUES=$values" foreach e $values { - puts stderr "PROCESSING=$e render -initscript $init $tmpl" + #puts stderr "PROCESSING=$e render -initscript $init $tmpl" set content [$e render -initscript $init $tmpl] :write $content [file join $project_path "[$e filename].$ext"] puts stderr "$e written to [file join $project_path [$e filename].$ext]" @@ -1601,38 +1517,64 @@ # events which are then signalled to the parsed entity. # Class create CommentBlockParser { + :attribute {message ""} + :attribute {status:in "COMPLETED"} { + set :incremental 1 + + set :statuscodes { + COMPLETED + INVALIDTAG + MISSINGPARTOF + STYLEVIOLATION + } + + :method type=in {name value} { + if {$value ni ${:statuscodes}} { + error "Invalid statuscode '$code'." + } + return $value + } + + :method ? [list obj var value:in,slot=[current object]] { + return [expr {[:get $obj $var] eq $value}] + } + :method is {obj var value} { + return [expr {$value in ${:statuscodes}}] + } + } + :attribute processed_section { set :incremental 1 :method assign {domain prop value} { set current_entity [$domain current_entity] set scope [expr {[$current_entity info is class]?"object mixin":"mixin"}] puts stderr "Switching: [$current_entity {*}$scope] --> target $value" - if {[$domain eval [list info exists :$prop]] && [:get $domain $prop] in [$current_entity {*}$scope]} { - $current_entity {*}$scope delete [:get $domain $prop] + if {[$domain eval [list info exists :$prop]] && [:get $domain $prop] in [$current_entity {*}$scope]} { + $current_entity {*}$scope delete [:get $domain $prop] + } + $current_entity {*}$scope add [next $domain $prop $value] } - $current_entity {*}$scope add [next $domain $prop $value] } - } - :attribute current_entity:object - - :object method process { - {-partof_entity ""} - {-initial_section context} - -entity - block - } { + :attribute current_entity:object - if {![info exists entity]} { + :object method process { + {-partof_entity ""} + {-initial_section context} + -entity + block + } { + + if {![info exists entity]} { set entity [Entity] } - set parser_obj [:new -current_entity $entity -volatile] + set parser_obj [:new -current_entity $entity] $parser_obj [current proc] \ -partof_entity $partof_entity \ -initial_section $initial_section \ $block - return [$parser_obj current_entity] + return $parser_obj } :forward has_next expr {${:idx} < [llength ${:comment_block}]} @@ -1642,10 +1584,15 @@ return $r } :forward rewind incr :idx -1 -# :forward fastforward set :idx {% expr {[llength ${:comment_block}] - 1} } +# :forward fastforward set :idx {% expr {[llength ${:comment_block}] - 1} } :forward fastforward set :idx {% llength ${:comment_block}} - + :method cancel {statuscode {msg ""}} { + :fastforward + :status $statuscode + :message $msg + uplevel 1 [list ::return -code error $statuscode] + } # # everything below assumes that the current class is an active mixin # on an instance of an Entity subclass! @@ -1671,7 +1618,7 @@ ${:current_entity} eval [list set :partof_entity $partof_entity] set is_first_iteration 1 - set failure "" +# set failure "" # # Note: Within the while-loop, two object variables constantly @@ -1688,11 +1635,12 @@ } if {[catch { - puts stderr "PROCESS ${:current_entity} event=process $line" + # puts stderr "PROCESS ${:current_entity} event=process $line" ${:current_entity} event=process $line } failure]} { - puts stderr ERRORINFO=$::errorInfo - :fastforward + if {![:status is $failure]} { + ::return -code error -errorinfo $::errorInfo + } } } if {!$is_first_iteration} { @@ -1704,9 +1652,10 @@ ${:current_entity} {*}$scope mixin delete ${:processed_section} } - if {$failure ne ""} { - error $failure - } + # if {$failure ne ""} { + # # puts stderr ERRORINFO=$::errorInfo + # return -code error -errorinfo $::errorInfo $failure + # } }; # CommentBlockParser->process() @@ -1756,9 +1705,9 @@ } else { append msg "A ${src_line_type} line is followed by a ${tgt_line_type} line" } - [StyleViolation new -message $msg] throw + ${:block_parser} cancel STYLEVIOLATION $msg + # [StyleViolation new -message $msg] throw } - return [list $tgt_line_type $transitions(${src_line_type}->${tgt_line_type})] } @@ -1792,10 +1741,11 @@ set line [split [string trimleft $line]] set tag [lindex $line 0] if {[:info callable methods -application $tag] eq ""} { - [InvalidTag new -message [subst { - The tag '$tag' is not supported for the entity type - '[namespace tail [:info class]]' - }]] throw + # [InvalidTag new -message [subst { + # The tag '$tag' is not supported for the entity type + # '[namespace tail [:info class]]' + # }]] throw + ${:block_parser} cancel INVALIDTAG "The tag '$tag' is not supported for the entity type '[namespace tail [:info class]]" } puts stderr ":$tag [lrange $line 1 end]" :$tag [lrange $line 1 end] @@ -1865,12 +1815,14 @@ lassign [:resolve_partof_entity $tag $name] nq_name partof_entity if {$partof_entity ne ""} { if {[$partof_entity info callable methods -application $tag] eq ""} { - [InvalidTag new -message [subst { - The tag '$tag' is not supported for the entity type - '[namespace tail [$partof_entity info class]]' - }]] throw + ${:block_parser} cancel INVALIDTAG "The tag '$tag' is not supported for the entity type + '[namespace tail [$partof_entity info class]]'" + # [InvalidTag new -message [subst { + # The tag '$tag' is not supported for the entity type + # '[namespace tail [$partof_entity info class]]' + # }]] throw } - puts stderr "1. $partof_entity $tag $nq_name {*}$args" + # puts stderr "1. $partof_entity $tag $nq_name {*}$args" set current_entity [$partof_entity $tag $nq_name {*}$args] } else { @@ -1884,11 +1836,12 @@ # InvalidTag exceptions in analyze() # set qualified_tag [namespace qualifiers [current]]::$tag - if {[EntityClass info instances -closure $qualified_tag] eq ""} { - [InvalidTag new -message [subst { - The entity type '$tag' is not available - }]] throw - } + ${:block_parser} cancel INVALIDTAG "The entity type '$tag' is not available" + # if {[EntityClass info instances -closure $qualified_tag] eq ""} { + # [InvalidTag new -message [subst { + # The entity type '$tag' is not available + # }]] throw + # } set current_entity [$tag new -name $nq_name {*}$args] } # @@ -1901,6 +1854,48 @@ $current_entity current_comment_line_type ${:current_comment_line_type} $current_entity block_parser ${:block_parser} } + + :method parse@tag {line} { + lassign $line axes names args + + set operand ${:partof_entity} + set axes [split [string trimleft $axes @] .] + if {[llength $axes] != [llength $names]} { + ${:block_parser} cancel STYLEVIOLATION "Invalid tag line specification in '$line'." + # [StyleViolation new -message [subst { + # Invalid tag line specification in '$line'. + # }]] throw + } + foreach axis $axes value $names { + puts stderr "axis $axis value $value" + if {$operand eq ""} { + if {[EntityClass info instances @$axis] eq ""} { + ${:block_parser} cancel INVALIDTAG "The entity type '@$axis' is not available." + # [InvalidTag new -message [subst { + # The entity type '@$axis' is not available + # }]] throw + } + puts stderr "FIRST LEVEL: @$axis new -name $value" + set operand [@$axis new -name $value] + } else { + if {[$operand info callable methods -application @$axis] eq ""} { + ${:block_parser} cancel INVALIDTAG "The tag '$axis' is not supported for the entity type '[namespace tail [$operand info class]]'" + # [InvalidTag new -message [subst { + # The tag '$axis' is not supported for the entity type + # '[namespace tail [$operand info class]]' + # }]] throw + } + set operand [$operand @$axis $value] + } + } + $operand @doc $args + + ${:block_parser} current_entity $operand + ${:block_parser} processed_section [current class] + $operand current_comment_line_type ${:current_comment_line_type} + $operand block_parser ${:block_parser} + } + # :method parse@text {line} { next } # :method parse@space {line} { next } @@ -1913,7 +1908,7 @@ ->text parse ->tag next text->text parse - text->space "" + text->space parse space->text parse space->space parse space->tag next @@ -1954,11 +1949,19 @@ } :method parse@tag {line} { puts stderr "PART parse@tag [current]" - set :current_part [next] + set r [next] + if {[::nsf::objectproperty $r object] && [$r info has type ::nx::doc::Entity]} { + set :current_part $r + } + return $r } :method parse@text {line} { puts stderr "PART parse@text [current]" - ${:current_part} @doc add $line end + if {[info exists :current_part]} { + ${:current_part} @doc add $line end + } else { + :event=next $line + } } # :method parse@space {line} {;} } Index: library/nx/nx.tcl =================================================================== diff -u -r1008a85cf8fe5d95365568f6c765a83389028ff2 -re29308a6c15da697df375716a3ae3787ade64218 --- library/nx/nx.tcl (.../nx.tcl) (revision 1008a85cf8fe5d95365568f6c765a83389028ff2) +++ library/nx/nx.tcl (.../nx.tcl) (revision e29308a6c15da697df375716a3ae3787ade64218) @@ -41,7 +41,7 @@ # # @superclass ::nx::doc::entities::class::nx::Object - # @method ::nx::Class#alloc + # @class.method {::nx::Class alloc} # # Creates a bare object or class which is not # fully initialized. {{{alloc}}} is used by {{@method ::nx::Class class create}} to @@ -55,7 +55,7 @@ # @param name The object identifier assigned to the object storage to be allocated. # @return The name of the allocated, uninitialized object - # @method ::nx::Class#create + # @class.method {::nx::Class create} # # Provides for creating application-level classes and objects. If # the method receiver is a meta-class, a class will be @@ -107,7 +107,7 @@ # procedure used to initialize the object. # @return The name of the created, fully initialized object. - # @method ::nx::Class#dealloc + # @class.method {::nx::Class dealloc} # # Marks objects for physical deletion in memory. Beware the fact # that calling {{{dealloc}}} does not necessarily cause the object @@ -157,7 +157,7 @@ # @param args Arbitrary vector of arguments # @return The name of the recreated object - # @method ::nx::Object#residualargs + # @class.method {::nx::Object residualargs} # # @properties interally-called # @param args @@ -201,7 +201,7 @@ ::nsf::alias Object $cmdName $cmd } - # @method ::nx::Object#configure + # @class.method {::nx::Object configure} # # This method participates in the object creation process. It is # automatically invoked after having produced a new object by @@ -219,7 +219,7 @@ # @properties interally-called # @param args The variable argument vector stores the object parameters and their values - # @method ::nx::Object#destroy + # @class.method {::nx::Object destroy} # # The standard destructor for an object. The method {{@method ::nx::Object class destroy}} # triggers the physical destruction of the object. The method {{{destroy}}} can be refined @@ -250,15 +250,15 @@ # or mixin class. # - # @method ::nx::Object#uplevel + # @class.method {::nx::Object uplevel} # # This helper allows you to evaluate a script in the context of # another callstack level (i.e., callstack frame). # # @param level:optional The starting callstack level (defaults to the value of {{{[current callinglevel]}}}) # @param script:list The script to be evaluated in the targeted callstack level - # @method ::nx::Object#upvar + # @class.method {::nx::Object upvar} # # This helper allows you to bind a local variable to a variable # residing at a different callstack level (frame). @@ -268,7 +268,7 @@ # @param targetVar ... which is a local variable in a method scope # @see ... - # @method ::nx::Object#volatile + # @class.method {::nx::Object volatile} # # By calling on this method, the object is bound in its lifetime to # the one of call site (e.g., the given Tcl proc or method scope): @@ -293,7 +293,7 @@ # class methods # - # @method ::nx::Class#new + # @class.method {::nx::Class new} # # A convenience method to create auto-named objects and classes. It is # a front-end to {{@method ::nx::Class class create}}. For instance: @@ -394,7 +394,7 @@ # define method "method" for Class and Object - # @method ::nx::Class#method + # @class.method {::nx::Class method} # # Defines a per-class method, similarly to Tcl specifying # {{{procs}}}. Optionally assertions may be specified by two @@ -431,7 +431,7 @@ return $r } - # @method ::nx::Object#method + # @class.method {::nx::Object method} # # Defines a per-object method, similarly to Tcl specifying # {{{procs}}}. Optionally assertions may be specified by two @@ -551,7 +551,7 @@ # define forward methods - # @method ::nx::Object#forward + # @class.method {::nx::Object forward} # # Register a per-object method (similar to a {{{proc}}}) for # forward-delegating calls to a callee (target Tcl command, other @@ -596,7 +596,7 @@ ::nsf::forward Object forward ::nsf::forward %self -per-object #set ::nsf::signature(::nx::Object-method-forward) {(methodName) obj forward name ?-default default? ?-earlybinding? ?-methodprefix name? ?-objscope? ?-onerror proc? ?-verbose? target ?args?} - # @method ::nx::Class#forward + # @class.method {::nx::Class forward} # # Register a per-class method (similar to a {{{proc}}}) for # forward-delegating calls to a callee (target Tcl command, other @@ -632,11 +632,18 @@ # left to right and should be used in ascending order. # # @param name The name of the delegating or forward method - # @param -objscope:optional Causes the target to be evaluated in the scope of the object. - # @param -methodprefix Prepends the specified prefix to the second argument of the invocation. - # @param -default Is used for default method names (only in connection with %1) - # @param -earlybinding Look up the function pointer of the called Tcl command at definition time of the forwarder instead of invocation time. This option should only be used for calling C-implemented Tcl commands, no scripted procs - # @param -verbose Print the substituted command to stderr before executing + # @param -objscope:optional Causes the target to be evaluated in the + # scope of the object. + # @param -methodprefix Prepends the specified prefix to the second + # argument of the invocation. + # @param -default Is used for default method names (only in + # connection with %1) + # @param -earlybinding Look up the function pointer of the called + # Tcl command at definition time of the forwarder instead of + # invocation time. This option should only be used for calling + # C-implemented Tcl commands, no scripted procs + # @param -verbose Print the substituted command to stderr before + # executing # @param callee # @param args @@ -1105,23 +1112,23 @@ # Define slots for slots ############################################ - # @param ::nx::Slot#name + # @class.param {::nx::Slot name} # # Name of the slot which can be used to access the slot from an object - # @param ::nx::Slot#multivalued + # @class.param {::nx::Slot multivalued} # # Boolean value for specifying single or multiple values (lists) - # @param ::nx::Slot#required + # @class.param {::nx::Slot required} # # Denotes whether a value must be provided - # @param ::nx::Slot#default + # @class.param {::nx::Slot default} # # Allows you to define a default value (to be set upon object creation) - # @param ::nx::Slot#type + # @class.param {::nx::Slot type} # # You may specify a type constraint on the value range to managed by the slot @@ -1133,31 +1140,31 @@ type } - # @param ::nx::ObjectParameterSlot#name + # @class.param {::nx::ObjectParameterSlot name} # # Name of the slot which can be used to access the slot from an # object. It defaults to unqualified name of an instance. - # @param ::nx::ObjectParameterSlot#methodname + # @class.param {::nx::ObjectParameterSlot methodname} # # The name of the accessor methods to be registed on behalf of the # slot object with its domains can vary from the slot name. - # @param ::nx::ObjectParameterSlot#domain + # @class.param {::nx::ObjectParameterSlot domain} # # The domain (object or class) of a slot on which it can be used - # @param ::nx::ObjectParameterSlot#defaultmethods + # @class.param {::nx::ObjectParameterSlot defaultmethods} # # A list of two elements for specifying which methods are called per # default, when no slot method is explicitly specified in a call. - # @param ::nx::ObjectParameterSlot#manager + # @class.param {::nx::ObjectParameterSlot manager} # # The manager object of the slot (per default, the slot object takes # this role, i.e. {{{[self]}}}) - # @param ::nx::ObjectParameterSlot#per-object + # @class.param {::nx::ObjectParameterSlot per-object} # # If set to {{{true}}}, the accessor methods are registered with the # domain object scope only. It defaults to {{{false}}}. @@ -1444,7 +1451,7 @@ ############################################ proc ::nsf::register_system_slots {os} { - # @param ::nx::Class#superclass + # @class.param {::nx::Class superclass} # # Specifies superclasses for a given class. As a setter *** # generell: setter kann hier mit der methode namens "setter" @@ -1465,7 +1472,7 @@ ::nx::RelationSlot create ${os}::Class::slot::superclass ::nsf::alias ${os}::Class::slot::superclass assign ::nsf::relation - # @param ::nx::Object#class + # @class.param {::nx::Object class} # # Sets or retrieves the class of an object. When {{{class}}} is # called without arguments, it returns the current class of the @@ -1475,7 +1482,7 @@ ::nx::RelationSlot create ${os}::Object::slot::class -multivalued false ::nsf::alias ${os}::Object::slot::class assign ::nsf::relation - # @param ::nx::Object#mixin + # @class.param {::nx::Object mixin} # # As a setter, {{{mixin}}} specifies a list of mixins to # set. Every mixin must be an existing class. In getter mode, you @@ -1485,7 +1492,7 @@ ::nx::RelationSlot create ${os}::Object::slot::mixin \ -methodname object-mixin - # @param ::nx::Object#filter + # @class.param {::nx::Object filter} # # In its setter mode, {{{filter}}} allows you to register methods # as per-object filters. Every filter must be an existing method @@ -1499,7 +1506,7 @@ -methodname object-filter - # @param ::nx::Class#mixin + # @class.param {::nx::Class mixin} # # As a setter, {{{mixin}}} specifies a list of mixins to set for # the class. Every mixin must be an existing class. In getter @@ -1509,7 +1516,7 @@ # @return :list If called as a getter (without arguments), {{{mixin}}} returns the list of current mixin classes registered with the class ::nx::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin - # @param ::nx::Class#filter + # @class.param {::nx::Class filter} # # In its setter mode, {{{filter}}} allows you to register methods # as per-class filters. Every filter must be an existing method @@ -1591,9 +1598,13 @@ # } # }}} # - # @param incremental A boolean value, only useful for multivalued slots. When set, one can add/delete incrementally values to the multivalued set (e.g., through an incremental {{{add}}}) - # @param valuecmd A Tcl command to be executed whenever the managed object variable is read - # @param valuechangedcmd A Tcl command to be executed whenever the value of the managed object variable changes + # @param incremental A boolean value, only useful for multivalued + # slots. When set, one can add/delete incrementally values to the + # multivalued set (e.g., through an incremental {{{add}}}) + # @param valuecmd A Tcl command to be executed whenever the managed + # object variable is read + # @param valuechangedcmd A Tcl command to be executed whenever the + # value of the managed object variable changes # @param arg # @superclass ::nx::doc::entities::class::nx::ObjectParameterSlot Index: tests/doc.tcl =================================================================== diff -u -r5f765b6d8713f416a443cc2367c3a47903cc2f83 -re29308a6c15da697df375716a3ae3787ade64218 --- tests/doc.tcl (.../doc.tcl) (revision 5f765b6d8713f416a443cc2367c3a47903cc2f83) +++ tests/doc.tcl (.../doc.tcl) (revision e29308a6c15da697df375716a3ae3787ade64218) @@ -8,6 +8,30 @@ Test parameter count 1 +# Class create ::C + +# set taglines { +# {@class.param {::C attr1}} +# {@class.object-param {::C attr2}} +# {@class.method {::C foo}} +# {@class.object-method.param {::C bar p2}} +# } + +# foreach tl $taglines { +# lassign $tl axes values +# set operand "" +# foreach axis [split [string trimleft $axes @] .] value $values { +# puts stderr "axis $axis value $value" +# if {$operand eq ""} { +# set operand [@$axis new -name $value] +# } else { +# set operand [$operand @$axis $value] +# } +# } +# puts stderr RESULT=$operand +# } + + # # some helper # @@ -129,13 +153,19 @@ {@command ::cc} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? COMPLETED] 1 + # ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 set block { {} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? COMPLETED] 0 + ? [list $cbp status ? STYLEVIOLATION] 1 + puts stderr [$cbp message] + # ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 # # For now, a valid comment block must start with a non-space line @@ -147,22 +177,33 @@ {} {@command ::cc} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 - set block { - {command ::cc} - {} + # ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + + set block { + {command ::cc} + {} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 + +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + set block { {@command ::cc} {some description} } + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 + +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 - set block { {@command ::cc} {} @@ -171,8 +212,13 @@ {@see ::o} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 0 + ? [list $cbp status ? COMPLETED] 1 + + #? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set block { {@command ::cc} {} @@ -181,8 +227,12 @@ {} {} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 0 + +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + # Note: We do allow description blocks with intermediate space # lines, for now. set block { @@ -193,7 +243,9 @@ {} {an erroreneous description line, for now} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 0 # # TODO: Do not enforce space line between the context and immediate @@ -216,8 +268,13 @@ {@command ::cc} {@see someOtherEntity} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 + + +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + # # TODO: Disallow space lines between parts? Check back with Javadoc spec. # @@ -231,8 +288,12 @@ {@see SomeOtherEntity2} {} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 + + # ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + # # TODO: Should we enforce a mandatory space line between description and part block? # @@ -245,8 +306,12 @@ {@see entity3} {@see SomeOtherEntity2} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 + +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 + set block { {@command ::cc} {} @@ -259,9 +324,11 @@ {} {an erroreneous description line, for now} } + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 1 +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1 - set block { {@command ::cc} {} @@ -272,8 +339,12 @@ {} {@see SomeOtherEntity2} } - ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? STYLEVIOLATION] 0 + +# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0 + set block { {@object ::cc} {} @@ -283,8 +354,12 @@ {@see SomeOtherEntity2} {@xyz SomeOtherEntity2} } - ? [list InvalidTag thrown_by? [list CommentBlockParser process $block]] 1 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? INVALIDTAG] 1 + + # ? [list InvalidTag thrown_by? [list CommentBlockParser process $block]] 1 + set block { {@class ::cc} {} @@ -294,8 +369,12 @@ {@see SomeOtherEntity2} {@xyz SomeOtherEntity2} } - ? [list InvalidTag thrown_by? [list CommentBlockParser process $block]] 1 + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? INVALIDTAG] 1 + + # ? [list InvalidTag thrown_by? [list CommentBlockParser process $block]] 1 + # # testing the doc object construction # @@ -308,23 +387,29 @@ {@author stefan.sobernig@wu.ac.at} {@author gustaf.neumann@wu-wien.ac.at} } - set entity [CommentBlockParser process $block] + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? COMPLETED] 1 + set entity [$cbp current_entity] ? [list ::nsf::is $entity object] 1 - ? [list $entity info is type ::nx::doc::@object] 1 + ? [list $entity info has type ::nx::doc::@object] 1 ? [list $entity @author] "stefan.sobernig@wu.ac.at gustaf.neumann@wu-wien.ac.at"; ? [list $entity as_text] "some more text and another line for the description"; - + set block { {@command ::c} {} {some text on the command} {} {@see ::o} } - set entity [CommentBlockParser process $block] - puts stderr ENTITY=$entity + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? COMPLETED] 1 + set entity [$cbp current_entity] + ? [list ::nsf::is $entity object] 1 - ? [list $entity info is type ::nx::doc::@command] 1 + ? [list $entity info has type ::nx::doc::@command] 1 ? [list $entity as_text] "some text on the command"; ? [list $entity @see] "::o"; @@ -336,19 +421,22 @@ {@class-param attr1 Here, we check whether we can get a valid description block} {for text spanning multiple lines} } - set entity [CommentBlockParser process $block] + + set cbp [CommentBlockParser process $block] + ? [list $cbp status ? COMPLETED] 1 + set entity [$cbp current_entity] + ? [list ::nsf::is $entity object] 1 - ? [list $entity info is type ::nx::doc::@class] 1 + ? [list $entity info has type ::nx::doc::@class] 1 ? [list $entity as_text] "some text on the class entity"; ? [list llength [$entity @param]] 1 - ? [list [$entity @param] info is type ::nx::doc::@param] 1 + ? [list [$entity @param] info has type ::nx::doc::@param] 1 ? [list [$entity @param] as_text] "Here, we check whether we can get a valid description block for text spanning multiple lines" # # basic test for in-situ documentation (initcmd block) # # - set script { Class create Foo { # The class Foo defines the behaviour for all Foo objects @@ -380,21 +468,21 @@ doc process ::Foo set entity [@class id ::Foo] ? [list ::nsf::is $entity object] 1 - ? [list $entity info is type ::nx::doc::@class] 1 + ? [list $entity info has type ::nx::doc::@class] 1 ? [list $entity as_text] "The class Foo defines the behaviour for all Foo objects"; ? [list $entity @author] "gustaf.neumann@wu-wien.ac.at ssoberni@wu.ac.at" # TODO: Fix the [@param id] programming scheme to allow (a) for # entities to be passed and the (b) documented structures #set entity [@param id ::Foo class attr1] set entity [@param id $entity attr1] ? [list ::nsf::is $entity object] 1 - ? [list $entity info is type ::nx::doc::@param] 1 + ? [list $entity info has type ::nx::doc::@param] 1 ? [list $entity @see] "::nx::Attribute ::nx::MetaSlot"; set entity [@method id ::Foo class foo] ? [list [@class id ::Foo] @method] $entity ? [list ::nsf::is $entity object] 1 - ? [list $entity info is type ::nx::doc::@method] 1 + ? [list $entity info has type ::nx::doc::@method] 1 ? [list $entity as_text] "This describes the foo method"; foreach p [$entity @param] expected { @@ -404,7 +492,6 @@ ? [list expr [list [$p as_text] eq $expected]] 1; } - # TODO: how to realise scanning and parsing for mixed ex- and # in-situ documentation? That is, how to differentiate between # absolutely and relatively qualified comment blocks in line-based @@ -419,21 +506,22 @@ # @author gustaf.neumann@wu-wien.ac.at # @author ssoberni@wu.ac.at - # @param ::Bar#attr1 + # @class.param {::Bar attr1} # # This attribute 1 is wonderful # # @see ::nx::Attribute # @see ::nx::MetaSlot - # @method ::Bar#foo + # @class.class-method {::Bar foo} # + # # This describes the foo method # # @param a Provides a first value # @param b Provides a second value - # @object-method ::Bar#foo + # @class.object-method {::Bar foo} # # This describes the per-object foo method # @@ -478,7 +566,7 @@ set entity [@class id ::Bar] ? [list $i eval [list ::nsf::is $entity object]] 1 - ? [list $i eval [list $entity info is type ::nx::doc::@class]] 1 + ? [list $i eval [list $entity info has type ::nx::doc::@class]] 1 ? [list $i eval [list $entity as_text]] "The class Bar defines the behaviour for all Bar objects"; ? [list $i eval [list $entity @author]] "gustaf.neumann@wu-wien.ac.at ssoberni@wu.ac.at" @@ -487,13 +575,13 @@ #set entity [@param id ::Bar class attr1] set entity [@param id $entity attr1] ? [list $i eval [list ::nsf::is $entity object]] 1 - ? [list $i eval [list $entity info is type ::nx::doc::@param]] 1 + ? [list $i eval [list $entity info has type ::nx::doc::@param]] 1 ? [list $i eval [list $entity @see]] "::nx::Attribute ::nx::MetaSlot"; set entity [@method id ::Bar class foo] ? [list $i eval [list [@class id ::Bar] @method]] $entity ? [list $i eval [list ::nsf::is $entity object]] 1 - ? [list $i eval [list $entity info is type ::nx::doc::@method]] 1 + ? [list $i eval [list $entity info has type ::nx::doc::@method]] 1 ? [list $i eval [list $entity as_text]] "This describes the foo method in the method body"; foreach p [$i eval [list $entity @param]] expected { @@ -505,7 +593,7 @@ set entity [@method id ::Bar object foo] ? [list $i eval [list [@class id ::Bar] @object-method]] $entity ? [list $i eval [list ::nsf::is $entity object]] 1 - ? [list $i eval [list $entity info is type ::nx::doc::@method]] 1 + ? [list $i eval [list $entity info has type ::nx::doc::@method]] 1 ? [list $i eval [list $entity as_text]] "This describes the per-object foo method in the method body"; foreach p [$i eval [list $entity @param]] expected { @@ -559,7 +647,6 @@ namespace import ::nx::doc::* # 1) NSF documentation project - set project [::nx::doc::@project new \ -name ::NextScriptingFramework \ -url http://www.next-scripting.org/ \ @@ -573,6 +660,7 @@ -outdir [::nsf::tmpdir] \ -project $project + puts stderr TIMING=[time { set project [::nx::doc::@project new \ -name ::NextScriptingLanguage \ -url http://www.next-scripting.org/ \ @@ -583,6 +671,7 @@ -renderer ::nx::doc::NxDocTemplateData \ -outdir [::nsf::tmpdir] \ -project $project + } 1] } interp delete $i