Index: library/lib/doc-assets/method.html.tmpl
===================================================================
diff -u
--- library/lib/doc-assets/method.html.tmpl (revision 0)
+++ library/lib/doc-assets/method.html.tmpl (revision fee959816f9851be0afd54905e906854680fccb2)
@@ -0,0 +1,71 @@
+
+
+
+
[:? {[info exists :@return] && [${:@return} spec] ne ""} {<[[${:@return} spec] spec]>} ]
+ ${:name}
+ [:parameters]
+
+ [:? {[:has_property interally-called]} {
+
Internally called method, can be redefined.
+ }]
+ [:? {[[[:partof] name] info methods ${:name}] ne "" &&
+ [::nsf::methodproperty [[:partof] name] ${:name} redefine-protected]} {
+
Method is redefine-protected
+ }]
+
+ [:as_text]
+
+
+
+ [:?var :@method {
+
+ [:for sm [:get_sub_methods] {
+ [$sm render -initscript [list set supermethod [current]] submethod.html.tmpl]
+ }]
+ } - {
+ [:? {[info exists :@param]} {
+
+ - Method parameters:
+ [:for param ${:@param} {
+ -
+
[$param name]
+ [:? {[$param eval {info exists :spec}] && [$param spec] ne ""} {<[$param spec]>}]
+
+ [$param as_text]
+ [:? {[$param eval {info exists :default}]} {
+
+ Default Value: [$param default]
+
+ }]
+
+ }]
+
+ }]
+
+ [:? {[info exists :@return]} {
+ [:let rparam ${:@return}]
+
+ - Returns:
+
+
+ - [$rparam as_text]
+
+ }]
+ }]
+
+ [:? {[info exists :@deprecated]} {
+
+ Deprecated ${:@deprecated}
+
+ }]
+
+ [:? {[[[:partof] name] info methods ${:name}] ne ""} {
+
Method type: [[[:partof] name] info method type ${:name}]
+ }]
+
+
+
+
+
+
Index: library/lib/doc-assets/submethod.html.tmpl
===================================================================
diff -u
--- library/lib/doc-assets/submethod.html.tmpl (revision 0)
+++ library/lib/doc-assets/submethod.html.tmpl (revision fee959816f9851be0afd54905e906854680fccb2)
@@ -0,0 +1,37 @@
+[:let name [:get_combined name]]
+
+
+
+
[:? {[info exists :@return] && [${:@return} spec] ne ""} {<[${:@return} spec]>} ]
+ [$supermethod name]
+ $name
+ [:parameters]
+
+
+ [:as_text]
+ [:? {[info exists :@param]} {
+
+ - Submethod parameters:
+ [:for param ${:@param} {
+ -
+
[$param name]
+ [:? {[$param eval {info exists :spec}] && [$param spec] ne ""} {<[$param spec]>}]
+
+ [$param as_text]
+
+ }]
+
+ }]
+ [:? {[info exists :@return]} {
+
+ - Returns:
+
+
+ - [${:@return} as_text]
+
+ }]
+
+
+
+
Index: library/lib/doc-tools.tcl
===================================================================
diff -u -rf20a7f81bcae20a40c4990afd431615ca1914c51 -rfee959816f9851be0afd54905e906854680fccb2
--- library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision f20a7f81bcae20a40c4990afd431615ca1914c51)
+++ library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision fee959816f9851be0afd54905e906854680fccb2)
@@ -94,7 +94,7 @@
return $result
}
- Class create EntityClass -superclass Class {
+ Class create Tag -superclass Class {
# A meta-class for named documenation entities. It sets some
# shared properties (e.g., generation rules for tag names based on
# entity class names, ...). Most importantly, it provides the
@@ -107,18 +107,7 @@
:attribute {tag {[string trimleft [string tolower [namespace tail [current]]] @]}}
:attribute {root_namespace "::nx::doc::entities"}
- :attribute owned_part_attributes:object,type=::nx::doc::PartAttribute,multivalued {
- set :incremental 1
- }
-
namespace eval ::nx::doc::entities {}
-
- :method get_fully_qualified_name {name} {
- if {![string match "::*" $name]} {
- error "You need to provide a fully-qualified (absolute) entity name for '$name'."
- }
- return $name
- }
# @method id
#
@@ -130,22 +119,41 @@
# @return An identifier string, e.g., {{{ ::nx::doc::entities::object::ns1::Foo }}}
# @see tag
# @see root_namespace
- :method id {name} {
+
+ :method id {
+ -partof_name
+ {-scope ""}
+ 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]"
- return "[:root_namespace]::${subns}[:get_fully_qualified_name $name]"
+ if {[info exists partof_name]} {
+ set partof_name [string trimleft $partof_name :]
+ return [join [list [:root_namespace] $subns $partof_name {*}$scope $name] ::]
+ } else {
+ return "[:root_namespace]::${subns}$name"
+ }
}
- :method new {-name:required args} {
+ :method new {
+ -part_attribute
+ -partof:object,type=::nx::doc::Entity
+ -name:required
+ args
+ } {
# A refined frontend for object construction/resolution which
# provides for generating an explicit name, according to the
# rules specific to the entity type.
#
# @param name The of the documented entity
# @return The identifier of the newly generated or resolved entity object
- set fq_name [:get_fully_qualified_name $name]
- :createOrConfigure [:id $name] -name $fq_name {*}$args
+ # set fq_name [:get_fully_qualified_name $name]
+ set ingredients [list]
+ if {[info exists partof]} {
+ lappend ingredients -partof_name [$partof name]
+ lappend ingredients -scope [expr {[info exists part_attribute]?[$part_attribute scope]:""}]
+ }
+ lappend ingredients $name
+ :createOrConfigure [:id {*}$ingredients] -name $name {*}$args
}
:method createOrConfigure {id args} {
@@ -161,6 +169,7 @@
namespace eval $id {}
if {[::nsf::isobject $id]} {
$id configure {*}$args
+ # return $id
} else {
:create $id {*}$args
}
@@ -175,24 +184,67 @@
# similar to \[namespace tail], but the "tail" might be an object with a namespace
return [string trimleft [string map [list [:root_namespace] ""] $qualified_name] ":"]
}
+ :method get_tail_name {qualified_name} {
+ return [string trimleft [string map [list ${:tag} ""] [:get_unqualified_name $qualified_name]] ":"]
+ }
}
- Class create PartClass -superclass EntityClass {
- :method id {partof_object scope name} {
- # ::Foo class foo
- set subns [string trimleft [namespace tail [current]] @]
- set partof_name [string trimleft $partof_object :]
- # puts stderr "ID -> [join [list [:root_namespace] $subns $partof_name $scope $name] ::]"
- return [join [list [:root_namespace] $subns $partof_name $scope $name] ::]
+ Class create QualifierTag -superclass Tag {
+ :method get_fully_qualified_name {name} {
+ if {![string match "::*" $name]} {
+ error "You need to provide a fully-qualified (absolute) entity name for '$name'."
+ }
+ return $name
}
+ :method id {
+ -partof_name
+ {-scope ""}
+ name
+ } {
+ if {[info exists partof_name]} {
+ #puts stderr "QUALIFIER=[join [list $partof_name $name] ::]"
+ #next [join [list $partof_name $name] ::]
+ next
+ } else {
+ set n [:get_fully_qualified_name $name]
+# puts stderr FINALNAME=$n
+ next $n
+ }
+ }
+
+ :method new {
+ -part_attribute
+ -partof:object,type=::nx::doc::Entity
+ -name:required
+ args
+ } {
+ set id_name $name
+ if {[info exists partof]} {
+ #set name [join [list [$partof name] $name] ::]
+ set id_name ::[join [list [[$partof info class] get_tail_name $partof] $name] ::]
+ } else {
+ set name [:get_fully_qualified_name $name]
+ }
+ :createOrConfigure [:id $id_name] \
+ {*}[expr {[info exists part_attribute]?"-part_attribute $part_attribute":""}] \
+ {*}[expr {[info exists partof]?"-partof $partof":""}] \
+ -name $name {*}$args
+ }
+ }
+
+ Class create PartTag -superclass Tag {
+ :method id {partof_name scope name} {
+ next -partof_name $partof_name -scope $scope $name
+ }
+
:method new {
- -part_attribute
- -partof:required
+ -part_attribute:required
+ -partof:object,type=::nx::doc::Entity
-name
args
} {
- :createOrConfigure [:id [:get_fully_qualified_name [$partof name]] [$part_attribute scope] $name] {*}[current args]
+ :createOrConfigure [:id [$partof name] [$part_attribute scope] $name] {*}[current args]
}
}
@@ -229,19 +281,31 @@
# needs to be verified -> @author returns ""
# :default ""
if {![info exists :scope]} {
- set :scope class
+ set :scope ""
regexp -- {@(.*)-.*} [namespace tail [current]] _ :scope
}
next
- # :owning_entity_class owned_part_attributes add [current]
}
+ :method id {domain prop value} {
+ #puts stderr "PARTATTRIBUTE-ID: [current args]"
+ if {![info exists :part_class]} {
+ error "Requested id generation from a simple part attribute!"
+ }
+ return [${:part_class} id [$domain name] ${:scope} $value]
+ }
+
:method require_part {domain prop value} {
if {[info exists :part_class]} {
if {[::nsf::is object $value] && \
[$value info has type ${:part_class}]} {
return $value
}
+ # puts stderr "NEWWWWWW ${:part_class} new \
+ # -name [lindex $value 0] \
+ # -partof $domain \
+ # -part_attribute [current] \
+ # -@doc [lrange $value 1 end]"
return [${:part_class} new \
-name [lindex $value 0] \
-partof $domain \
@@ -272,8 +336,6 @@
}
}
-
-
Class create Entity {
#
# Entity is the base class for the documentation classes
@@ -287,6 +349,9 @@
# an optional initcmd
:method objectparameter args {next {@doc:optional __initcmd:initcmd,optional}}
+ :attribute partof:object,type=::nx::doc::StructuredEntity
+ :attribute part_attribute:object,type=::nx::doc::PartAttribute
+
:attribute @doc:multivalued {set :incremental 1}
:attribute @see -slotclass ::nx::doc::PartAttribute
:attribute @properties -slotclass ::nx::doc::PartAttribute
@@ -296,21 +361,6 @@
expr {$prop in ${:@properties}}
}
- :method owned_parts {} {
- set slots [:info slotobjects]
- set r [dict create]
- # puts stderr SLOTS=$slots
- foreach s $slots {
- 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]} {
- dict set r $accessor [sorted [:$accessor] name]
- }
- }
- return $r
- }
-
# @method _doc
#
# The method _doc can be use to obtain the value of the documentation
@@ -345,13 +395,15 @@
:method as_list {} {
if {[info exists :@doc] && ${:@doc} ne ""} {
+ #puts stderr DOC=${:@doc}
set non_empty_elements [lsearch -all -not -exact ${:@doc} ""]
return [lrange ${:@doc} [lindex $non_empty_elements 0] [lindex $non_empty_elements end]]
}
}
:method as_text {} {
set doc [list]
+ set lines [:as_list]
foreach l [:as_list] {
lappend doc [string trimleft $l]
}
@@ -364,16 +416,34 @@
}
- Class create ContainerEntity -superclass Entity {
+ Class create StructuredEntity -superclass Entity {
+ :method owned_parts {} {
+ set slots [:info slotobjects]
+ set r [dict create]
+# puts stderr SLOTS=$slots
+ foreach s $slots {
+ 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]} {
+ dict set r $accessor [sorted [:$accessor] name]
+ }
+ }
+ return $r
+ }
+ }
+
+
+ Class create ContainerEntity -superclass StructuredEntity {
Class create [current]::Resolvable {
:object attribute container:object,type=[:info parent]
:method get_fully_qualified_name {name} {
set container [[current class] container]
if {![string match "::*" $name]} {
- # puts -nonewline stderr "--- EXPANDING name $name"
- set name [$container namespace]::$name
- # puts stderr " to name $name"
+# puts -nonewline stderr "--- EXPANDING name $name"
+ set name [$container @namespace]::$name
+# puts stderr " to name $name"
}
next $name
}
@@ -383,30 +453,34 @@
# TODO: check the interaction of required, per-object attribute and ::nsf::assertion
#:object attribute container:object,type=[:info parent],required
:object attribute container:object,type=[:info parent]
- :method init args {
+ :method create args {
#
# Note: preserve the container currently set at this callstack
# level. [next] will cause the container to change if another
# container entity is initialised in the following!
#
if {[[current class] eval {info exists :container}]} {
set container [[current class] container]
- next
- $container register [current]
+ set obj [next]
+ if {![$obj eval {info exists :partof}]} {
+ $container register $obj
+ }
+ return $obj
} else {
next
}
}
}
# Note: The default "" corresponds to the top-level namespace "::"!
- :attribute {namespace ""}
+ :attribute {@namespace ""}
:attribute @class -slotclass ::nx::doc::PartAttribute {
set :part_class @class
}
:attribute @object -slotclass ::nx::doc::PartAttribute {
set :part_class @object
}
+
:attribute @command -slotclass ::nx::doc::PartAttribute {
set :part_class @command
}
@@ -425,9 +499,10 @@
:method init {} {
next
- EntityClass mixin add [current class]::Resolvable
+ QualifierTag mixin add [current class]::Resolvable
[current class]::Resolvable container [current]
- # Entity mixin add [current class]::Containable
+ QualifierTag mixin add [current class]::Containable
+ @package object mixin add [current class]::Containable
[current class]::Containable container [current]
}
@@ -439,7 +514,7 @@
}
}
- EntityClass create @project -superclass ContainerEntity {
+ Tag create @project -superclass ContainerEntity {
:attribute url
:attribute license
:attribute creationdate
@@ -468,12 +543,12 @@
# - ...
#
- EntityClass create @package -superclass ContainerEntity -mixin ContainerEntity::Containable {
+ Tag create @package -superclass ContainerEntity {
:attribute @require -slotclass ::nx::doc::PartAttribute
:attribute @version -slotclass ::nx::doc::PartAttribute
}
- EntityClass create @command -superclass Entity -mixin ContainerEntity::Containable {
+ QualifierTag create @command -superclass StructuredEntity {
:attribute @param -slotclass ::nx::doc::PartAttribute {
set :part_class @param
}
@@ -485,8 +560,10 @@
}
set :part_class @param
}
- :attribute @subcommand -slotclass ::nx::doc::PartAttribute {
- set :part_class @subcommand
+
+ :forward @sub-command %self @command
+ :attribute @command -slotclass ::nx::doc::PartAttribute {
+ set :part_class @command
}
:method parameters {} {
set params [list]
@@ -503,11 +580,38 @@
}
}
- EntityClass create @object \
- -superclass Entity \
+ QualifierTag create @object \
+ -superclass StructuredEntity \
-mixin ContainerEntity::Containable {
:attribute @author -slotclass ::nx::doc::PartAttribute
+ :forward @object %self @child-object
+ :attribute @child-object -slotclass ::nx::doc::PartAttribute {
+ set :part_class @object
+ :method id {domain prop value} {
+# puts stderr "CHILD-OBJECT: [current args]"
+ # if {![info exists :part_class]} {
+ # error "Requested id generation from a simple part attribute!"
+ # }
+ return [${:part_class} id [join [list [$domain name] $value] ::]]
+# return [${:part_class} id -partof_name [$domain name] -scope ${:scope} $value]
+ }
+
+ }
+
+ :forward @class %self @child-class
+ :attribute @child-class -slotclass ::nx::doc::PartAttribute {
+ set :part_class @class
+ :method id {domain prop value} {
+ #puts stderr "CHILD-CLASS: [current args]"
+ # if {![info exists :part_class]} {
+ # error "Requested id generation from a simple part attribute!"
+ # }
+ return [${:part_class} id [join [list [$domain name] $value] ::]]
+ #return [${:part_class} id -partof_name [$domain name] -scope ${:scope} $value]
+ }
+ }
+
:forward @method %self @object-method
:attribute @object-method -slotclass ::nx::doc::PartAttribute {
set :part_class @method
@@ -532,9 +636,8 @@
}
}
- EntityClass create @class \
- -superclass @object \
- -mixin ContainerEntity::Containable {
+ QualifierTag create @class \
+ -superclass @object {
:attribute @superclass -slotclass ::nx::doc::PartAttribute
:forward @param %self @class-param
@@ -572,21 +675,13 @@
}
}
}
-
-
- # @object ::nx::doc::Part
- #
- # A Part is a part of a documentation entity, defined by a
- # separate object. Every Part is associated to another
- # documentation entity and is identified by a name.
- #
- Class create Part -superclass Entity {
-
- #:method objectparameter args {next {doc -use}}
- :attribute partof:required
- :attribute use
- :attribute part_attribute
+
+
+ Class create PartEntity -superclass Entity {
+ :attribute partof:object,type=::nx::doc::StructuredEntity,required
+ :attribute part_attribute:object,type=::nx::doc::PartAttribute,required
}
+
# @object ::nx::doc::@method
#
@@ -595,8 +690,8 @@
# "use" parameter for registered aliases to be able to refer to the
# documentation of the original method.
#
- PartClass create @method \
- -superclass Part {
+ PartTag create @method \
+ -superclass StructuredEntity {
:attribute {@modifier public} -slotclass ::nx::doc::PartAttribute
:attribute @param -slotclass ::nx::doc::PartAttribute {
set :part_class @param
@@ -617,6 +712,45 @@
}
set :part_class @param
}
+
+ :object method new {
+ -part_attribute:required
+ -partof:object,type=::nx::doc::Entity
+ -name
+ args
+ } {
+ # 1) Are we in a sub-method?
+ if {[$partof info has type [current]]} {
+ :createOrConfigure [:id [:get_tail_name $partof] "" $name] {*}[current args]
+ } else {
+ next
+ }
+ }
+
+
+
+ :forward @class-method %self @method
+ :forward @object-method %self @method
+ :forward @sub-method %self @method
+ :attribute @method -slotclass ::nx::doc::PartAttribute {
+ set :part_class @method
+ :method id {domain prop name} {
+ # TODO: ${:part_class} resolves to the local slot
+ # [current], rather than ::nx::doc::@method. Why?
+ if {[$domain info has type ::nx::doc::@method]} {
+ set id [::nx::doc::@method id [::nx::doc::@method get_tail_name $domain] "" $name]
+ return $id
+ } else {
+ return [::nx::doc::@method id [$domain name] ${:scope} $name]
+ }
+ }
+
+ # :method require_part {domain prop value} {
+ # set partof [$domain partof]
+ # next $partof $prop [join [list [[$domain part_attribute] scope] [$domain name] $value] ::]
+ # }
+ }
+
:method parameters {} {
set params [list]
if {[info exists :@param]} {
@@ -665,8 +799,16 @@
#set handle ::nsf::signature($object-class-${:name})
#if {[info exists $handle]} {append comment
[set $handle]}
} else {
- set actualParams [$object info method parameter ${:name}]
- set syntax [$object info method parametersyntax ${:name}]
+ # TODO: requesting the param spec of an ensemble
+ # object (info) does not work right now? How to deal
+ # with it?
+ if {($object eq "::nx::Object" || $object eq "::nx::Class") && ${:name} eq "info"} {
+ set actualParams ""
+ set syntax ""
+ } else {
+ set actualParams [$object info method parameter ${:name}]
+ set syntax [$object info method parametersyntax ${:name}]
+ }
}
if {$actualParams eq $params} {
set comment "
Perfect match"
@@ -684,42 +826,63 @@
}
return $params
}
- :method process {
- {-initial_section:optional "context"}
- comment_block
- } {
- next \
- -initial_section $initial_section \
- -entity [current] $comment_block
+
+ :method get_sub_methods {} {
+ if {[info exists :@method]} {
+ set leaves [list]
+ foreach m ${:@method} {
+ if {![$m eval {info exists :@method}]} {
+ lappend leaves $m
+ } else {
+ lappend leaves {*}[$m get_sub_methods]
+ }
+ }
+# puts stderr LEAVES=$leaves
+ #puts stderr [::nx::doc::entities::method::nx::Object::class::info::has @method]
+ return $leaves
+ }
}
+ :method get_combined {what} {
+ set result [list]
+ if {[info exists :partof] && [${:partof} info has type [current class]]} {
+ lappend result {*}[${:partof} get_combined $what] [:$what]
+ }
+ return $result
+ }
+
}; # @method
- PartClass create @subcommand -superclass {Part @command}
+ # PartTag create @subcommand -superclass {Part @command}
+ # PartTag create @subcommand -superclass {Part @command}
# @object ::nx::doc::@param
#
# The entity type "@param" represents the documentation unit
# for several parameter types, e.g., object, method, and
# command parameters.
#
- # @superclass ::nx::doc::entities::object::nx::doc::Part
- PartClass create @param \
- -superclass Part {
+ PartTag create @param \
+ -superclass PartEntity {
:attribute spec
:attribute default
- :object method id {partof name} {
- # The method contains the parameter-specific name production rules.
- #
- # @param partof Refers to the entity object which contains this part
- # @param name Stores the name of the documented parameter
- # @modifier protected
- set partof_fragment [:get_unqualified_name ${partof}]
- return [:root_namespace]::${:tag}::${partof_fragment}::${name}
+ :object method id {partof_name scope name} {
+ next [:get_unqualified_name ${partof_name}] $scope $name
}
+ # :object method id {partof_name name} {
+ # # The method contains the parameter-specific name production rules.
+ # #
+ # # @param partof Refers to the entity object which contains this part
+ # # @param name Stores the name of the documented parameter
+ # # @modifier protected
+
+ # set partof_fragment [:get_unqualified_name ${partof_name}]
+ # return [:root_namespace]::${:tag}::${partof_fragment}::${name}
+ # }
+
# @object-method new
#
# The per-object method refinement indirects entity creation
@@ -739,7 +902,7 @@
lassign $name name def
set spec ""
regexp {^(.*):(.*)$} $name _ name spec
- :createOrConfigure [:id $partof $name] \
+ :createOrConfigure [:id $partof [$part_attribute scope] $name] \
-spec $spec \
-name $name \
-partof $partof \
@@ -778,13 +941,17 @@
} else {
set tmpl [file normalize $path]
}
- if {![file exists $tmpl] || ![file isfile $tmpl]} {
- error "The template file '$path' was not found."
+
+ if {![[current class] eval [list info exists :templates($tmpl)]]} {
+ if {![file exists $tmpl] || ![file isfile $tmpl]} {
+ error "The template file '$path' was not found."
+ }
+ set fh [open $tmpl r]
+ [current class] eval [list set :templates($tmpl) [read $fh]]
+ catch {close $fh}
}
- set fh [open $tmpl r]
- set content [read $fh]
- catch {close $fh}
- return $content
+
+ return [[current class] eval [list set :templates($tmpl)]]
}
}
@@ -965,7 +1132,7 @@
}
}
} elseif {[:info has type ::nx::doc::@command]} {
- set features @subcommand
+ set features @command
foreach feature $features {
if {[info exists :$feature]} {
set instances [sorted [set :$feature] name]
@@ -997,7 +1164,7 @@
set id [$entity_type id {*}$args]
if {![::nsf::is object $id]} return;
set pof ""
- if {[$id info has type ::nx::doc::Part]} {
+ if {[$id eval {info exists :partof}]} {
set pof "[[$id partof] name]#"
set filename [[$id partof] filename]
} else {
@@ -1305,7 +1472,7 @@
return $comment_blocks
}
- :method analyze_initcmd {docKind name initcmd} {
+ :method analyze_initcmd {{-parsing_level 1} docKind name initcmd} {
set first_block 1
set failed_blocks [list]
foreach {line_offset block} [:comment_blocks $initcmd] {
@@ -1342,7 +1509,7 @@
# TODO: Passing $id as partof_entity appears unnecessary,
# clean up the logic in CommentBlockParser->process()!!!
#puts stderr "==== CommentBlockParser process -partof_entity $id {*}$arguments"
- set cbp [CommentBlockParser process -partof_entity $id {*}$arguments]
+ set cbp [CommentBlockParser process -parsing_level $parsing_level -partof_entity $id {*}$arguments]
# if {[catch {CommentBlockParser process -partof_entity $id {*}$arguments} msg]} {
# lappend failed_blocks $line_offset
@@ -1356,6 +1523,28 @@
# hierarchy?)
:method process=@class {entity} {
set name [$entity name]
+
+
+ # attributes
+ foreach slot [$name info slots] {
+ if {[$slot eval {info exists :__initcmd}]} {
+ set blocks [:comment_blocks [$slot eval {set :__initcmd}]]
+ foreach {line_offset block} $blocks {
+ if {$line_offset > 1} break;
+ set scope [expr {[$slot per-object]?"object":"class"}]
+ set id [$entity @${scope}-param [$slot name]]
+ CommentBlockParser process \
+ -parsing_level 2 \
+ -partof_entity $entity \
+ -initial_section description \
+ -entity $id \
+ $block
+ }
+
+ # :analyze_initcmd -parsing_level 2 @class $name [$name eval {set :__initcmd}]
+ }
+ }
+
foreach methodName [${name} info methods -methodtype scripted] {
# TODO: should the comment_blocks parser relocated?
set blocks [:comment_blocks [${name} info method \
@@ -1364,18 +1553,22 @@
if {$line_offset > 1} break;
set id [$entity @class-method $methodName]
CommentBlockParser process \
+ -parsing_level 2 \
-partof_entity $entity \
-initial_section description \
-entity $id \
$block
}
- :process=@object $entity object
}
+
+ :process=@object $entity object
+
}
:method process=@object {entity {scope ""}} {
set name [$entity name]
+ # methods
foreach methodName [${name} {*}$scope info methods\
-methodtype scripted] {
@@ -1385,6 +1578,7 @@
if {$line_offset > 1} break;
set id [$entity @object-method $methodName]
CommentBlockParser :process \
+ -parsing_level 2 \
-partof_entity $name \
-initial_section description \
-entity $id \
@@ -1473,7 +1667,7 @@
}
}
}
- puts stderr TOP_LEVEL_ENTITIES=$top_level_entities
+# puts stderr TOP_LEVEL_ENTITIES=$top_level_entities
# set entities [concat [sorted [@package info instances] name] \
# [sorted [@command info instances] name] \
# [sorted [@object info instances] name]]
@@ -1492,12 +1686,12 @@
# puts stderr "we have [llength $entities] documentation entities ($entities)"
:write $index [file join $project_path "index.$ext"]
set values [join [dict values $top_level_entities]]
- puts stderr "VALUES=$values"
+# puts stderr "VALUES=$values"
foreach e $values {
#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]"
+# puts stderr "$e written to [file join $project_path [$e filename].$ext]"
}
}
@@ -1516,15 +1710,20 @@
# events which are then signalled to the parsed entity.
#
Class create CommentBlockParser {
+
+ :attribute {parsing_level:integer 0}
+
:attribute {message ""}
:attribute {status:in "COMPLETED"} {
+
set :incremental 1
set :statuscodes {
COMPLETED
INVALIDTAG
MISSINGPARTOF
STYLEVIOLATION
+ LEVELMISMATCH
}
:method type=in {name value} {
@@ -1548,7 +1747,7 @@
: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"
+# 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]
}
@@ -1560,21 +1759,22 @@
:object method process {
{-partof_entity ""}
{-initial_section context}
+ {-parsing_level 0}
-entity
block
} {
if {![info exists entity]} {
- set entity [Entity]
- }
+ set entity [Entity]
+ }
- set parser_obj [:new -current_entity $entity]
- $parser_obj [current proc] \
- -partof_entity $partof_entity \
- -initial_section $initial_section \
- $block
- return $parser_obj
- }
+ set parser_obj [:new -current_entity $entity -parsing_level $parsing_level]
+ $parser_obj [current proc] \
+ -partof_entity $partof_entity \
+ -initial_section $initial_section \
+ $block
+ return $parser_obj
+ }
:forward has_next expr {${:idx} < [llength ${:comment_block}]}
:method dequeue {} {
@@ -1583,7 +1783,6 @@
return $r
}
:forward rewind incr :idx -1
-# :forward fastforward set :idx {% expr {[llength ${:comment_block}] - 1} }
:forward fastforward set :idx {% llength ${:comment_block}}
:method cancel {statuscode {msg ""}} {
@@ -1646,16 +1845,26 @@
${:current_entity} on_exit $line
}
- if {[${:processed_section} info mixinof -scope object ${:current_entity}] ne ""} {
- set scope [expr {[${:current_entity} info is class]?"object":""}]
- ${:current_entity} {*}$scope mixin delete ${:processed_section}
- }
-
- # if {$failure ne ""} {
- # # puts stderr ERRORINFO=$::errorInfo
- # return -code error -errorinfo $::errorInfo $failure
+ # ISSUE: In case of some sub-method definitions (namely "info
+ # mixin"), the sub-method entity object for "mixin" replaces the
+ # forward handlers of the mixin relation slot. So, any slot-like
+ # interactions such as delete() won't work anymore. We need to
+ # bypass it by using ::nsf::relation, for the time being. This
+ # is a clear con of the explicit naming of entity objects (or at
+ # least the current scheme)!
+
+ # if {[${:processed_section} info mixinof -scope object ${:current_entity}] ne ""} {
+ # ${:current_entity} {*}$scope mixin delete ${:processed_section}
# }
-
+
+ set scope [expr {[${:current_entity} info is class]?"object":""}]
+ set mixins [${:current_entity} {*}$scope info mixin classes]
+ if {${:processed_section} in $mixins} {
+ set idx [lsearch -exact $mixins ${:processed_section}]
+ set mixins [lreplace $mixins $idx $idx]
+ ::nsf::relation ${:current_entity} object-mixin $mixins
+ }
+
}; # CommentBlockParser->process()
}
@@ -1740,18 +1949,15 @@
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
- ${:block_parser} cancel INVALIDTAG "The tag '$tag' is not supported for the entity type '[namespace tail [:info class]]"
+ set msg "The tag '$tag' is not supported for the entity type '[namespace tail [:info class]]"
+ ${:block_parser} cancel INVALIDTAG $msg
}
- puts stderr ":$tag [lrange $line 1 end]"
+# puts stderr ":$tag [lrange $line 1 end]"
:$tag [lrange $line 1 end]
}
:method parse@text {line} {
- #puts stderr "ADDLINE :@doc add $line end"
+# puts stderr "ADDLINE([current]) :@doc add $line end"
:@doc add $line end
}
:method parse@space {line} {;}
@@ -1821,7 +2027,7 @@
# '[namespace tail [$partof_entity info class]]'
# }]] throw
}
- # puts stderr "1. $partof_entity $tag $nq_name {*}$args"
+# puts stderr "$partof_entity $tag $nq_name {*}$args"
set current_entity [$partof_entity $tag $nq_name {*}$args]
} else {
@@ -1830,13 +2036,13 @@
# processed without a resolved context = its partof entity).
# It is not an entity type, because it merely is a "scoped"
# @method. It won't resolve then as a proper instance of
- # EntityClass, hence we observe an InvalidTag exception. For
+ # Tag, hence we observe an InvalidTag exception. For
# now, we just ignore and bypass this issue by allowing
# InvalidTag exceptions in analyze()
#
set qualified_tag [namespace qualifiers [current]]::$tag
${:block_parser} cancel INVALIDTAG "The entity type '$tag' is not available"
- # if {[EntityClass info instances -closure $qualified_tag] eq ""} {
+ # if {[Tag info instances -closure $qualified_tag] eq ""} {
# [InvalidTag new -message [subst {
# The entity type '$tag' is not available
# }]] throw
@@ -1855,39 +2061,77 @@
}
:method parse@tag {line} {
- lassign $line axes names args
-
+ set args [lassign $line axes names]
set operand ${:partof_entity}
set axes [split [string trimleft $axes @] .]
+
+ # 1) get the parsing level from the comment block parser
+ set start_idx [lindex [lsearch -all -not -exact $axes ""] 0]
+# puts stderr "AXES=$axes, [${:block_parser} parsing_level], $start_idx, operand $operand"
+
+ set pl [${:block_parser} parsing_level]
+ if {$pl != $start_idx} {
+ ${:block_parser} cancel LEVELMISMATCH "Parsing level mismatch: Tag is meant for level '$start_idx', we are at '$pl'."
+ #error "Parsing level mismatch: Tag waits for level '$start_idx', we are at '$pl'"
+ }
+
+ # 2) stash away a number of empty axes according to the parsing level
+ set axes [lrange $axes $pl end]
+
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
+ ${:block_parser} cancel STYLEVIOLATION "Imbalanced tag line specification in '$line'."
}
+
+ #
+ # expand shortcuts
+ #
+ set expanded_axes [list]
+ foreach n $names {
+ lappend expanded_axes {*}[lrepeat [llength $n] [lindex $axes [lsearch -exact $names $n]]]
+ }
+
+# puts stderr "FOLDED AXES $axes EXPANDED $expanded_axes NAMES $names"
+ set axes $expanded_axes
+ set names [concat {*}$names]
+
+ set leaf(axis) [lindex $axes end]
+ set axes [lrange $axes 0 end-1]
+ set leaf(name) [lindex $names end]
+ set names [lrange $names 0 end-1]
+
foreach axis $axes value $names {
- puts stderr "axis $axis value $value"
+# puts stderr "axis $axis value $value operand $operand"
if {$operand eq ""} {
- if {[EntityClass info instances @$axis] eq ""} {
+ if {[QualifierTag info instances @$axis] eq "" && [Tag 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]
+# puts stderr "FIRST LEVEL: @$axis new -name $value"
+ # set operand [@$axis new -name $value ]
+ set operand [@$axis id $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]
+# puts stderr "$operand @$axis id $value"
+ set operand [$operand @$axis id $value]
+ if {![::nsf::isobject $operand] || ![$operand info has type ::nx::doc::Entity]} {
+ ${:block_parser} cancel STYLEVIOLATION "The spec did not match an existing documentation entity."
+ }
}
}
- $operand @doc $args
+# puts stderr "LEAF -> $operand @$leaf(axis) $leaf(name) $args"
+ if {$operand eq ""} {
+ if {[QualifierTag info instances @$leaf(axis)] eq "" && [Tag info instances @$leaf(axis)] eq ""} {
+ ${:block_parser} cancel INVALIDTAG "The entity type '@$leaf(axis)' is not available."
+ }
+ set operand [@$leaf(axis) new -name $leaf(name) $args]
+ } else {
+ if {[$operand info callable methods -application @$leaf(axis)] eq ""} {
+ ${:block_parser} cancel INVALIDTAG "The tag '$leaf(axis)' is not supported for the entity type '[namespace tail [$operand info class]]'"
+ }
+ set operand [$operand @$leaf(axis) [list $leaf(name) {*}$args]]
+ # $operand @doc $args
+ }
${:block_parser} current_entity $operand
${:block_parser} processed_section [current class]
@@ -1942,21 +2186,23 @@
} {
# realise the parse events specific to the substates of description
:method on_enter {line} {
- puts stderr "ENTERING part $line, current section [${:block_parser} processed_section]"
+# puts stderr "ENTERING part $line, current section [${:block_parser} processed_section]"
unset -nocomplain :current_part
next
}
:method parse@tag {line} {
- puts stderr "PART parse@tag [current]"
+# puts stderr "PART parse@tag [current]"
set r [next]
+# puts stderr GOT=$r
if {[::nsf::isobject $r] && [$r info has type ::nx::doc::Entity]} {
set :current_part $r
}
return $r
}
:method parse@text {line} {
- puts stderr "PART parse@text [current]"
+# puts stderr "PART parse@text [current]"
if {[info exists :current_part]} {
+# puts stderr "${:current_part} @doc add $line end"
${:current_part} @doc add $line end
} else {
:event=next $line
@@ -1966,4 +2212,4 @@
}
}
-puts stderr "Doc Tools loaded: [info command ::nx::doc::*]"
\ No newline at end of file
+# puts stderr "Doc Tools loaded: [info command ::nx::doc::*]"
\ No newline at end of file
Index: library/nx/nx.tcl
===================================================================
diff -u -rc88fac9594630181e97e2f936891a0bdb9065cca -rfee959816f9851be0afd54905e906854680fccb2
--- library/nx/nx.tcl (.../nx.tcl) (revision c88fac9594630181e97e2f936891a0bdb9065cca)
+++ library/nx/nx.tcl (.../nx.tcl) (revision fee959816f9851be0afd54905e906854680fccb2)
@@ -1,4 +1,7 @@
-# @package nx
+# TODO: decide how to deal with @package and @project names (don't
+# need namespace delimiters!)
+
+# @package ::nx
#
# The Next Scripting Language is a compact and expressive object-oriented language
# extension for Tcl. The object system model is highly influenced by
@@ -9,6 +12,7 @@
#
# @require Tcl
# @version 1.0.0a
+# @namespace ::nx
package provide nx 2.0
package require nsf
@@ -24,14 +28,14 @@
# First create the ::nx object system.
#
- # @class ::nx::Object
+ # @class Object
#
# Next Scripting Language (NSL)programs are constructed out of
# objects. This class describes common structural and behavioural
# features for all NSL objects. It is the root object-class in the
# NSL object system.
- # @class ::nx::Class
+ # @class Class
#
# A class defines a family of object types which own a common set of
# attributes (see {{@class ::nx::Attribute}}) and methods. Classes
@@ -41,7 +45,7 @@
#
# @superclass ::nx::doc::entities::class::nx::Object
- # @class.method {::nx::Class alloc}
+ # @class.method {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 +59,7 @@
# @param name The object identifier assigned to the object storage to be allocated.
# @return The name of the allocated, uninitialized object
- # @class.method {::nx::Class create}
+ # @class.method {Class create}
#
# Provides for creating application-level classes and objects. If
# the method receiver is a meta-class, a class will be
@@ -107,7 +111,7 @@
# procedure used to initialize the object.
# @return The name of the created, fully initialized object.
- # @class.method {::nx::Class dealloc}
+ # @class.method {Class dealloc}
#
# Marks objects for physical deletion in memory. Beware the fact
# that calling {{{dealloc}}} does not necessarily cause the object
@@ -122,7 +126,7 @@
# @properties interally-called
# @param object The name of the object to be scheduled for deletion.
- # @method ::nx::Class#recreate
+ # @class.method {Class recreate}
#
# This method is called upon recreating an object. Recreation is the
# scheme for resolving object naming conflicts in the dynamic and
@@ -157,7 +161,7 @@
# @param args Arbitrary vector of arguments
# @return The name of the recreated object
- # @class.method {::nx::Object residualargs}
+ # @class.method {Object residualargs}
#
# @properties interally-called
# @param args
@@ -182,11 +186,11 @@
#
namespace eval ::nsf {}
- # @command ::nx::next
+ # @command next
#
# @use ::nsf::command
- # @command ::nx::current
+ # @command current
#
# @use ::nsf::current
@@ -201,7 +205,7 @@
::nsf::alias Object $cmdName $cmd
}
- # @class.method {::nx::Object configure}
+ # @class.method {Object configure}
#
# This method participates in the object creation process. It is
# automatically invoked after having produced a new object by
@@ -219,7 +223,7 @@
# @properties interally-called
# @param args The variable argument vector stores the object parameters and their values
- # @class.method {::nx::Object destroy}
+ # @class.method {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 +254,15 @@
# or mixin class.
#
- # @class.method {::nx::Object uplevel}
+ # @class.method {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
- # @class.method {::nx::Object upvar}
+ # @class.method {Object upvar}
#
# This helper allows you to bind a local variable to a variable
# residing at a different callstack level (frame).
@@ -268,7 +272,7 @@
# @param targetVar ... which is a local variable in a method scope
# @see ...
- # @class.method {::nx::Object volatile}
+ # @class.method {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 +297,7 @@
# class methods
#
- # @class.method {::nx::Class new}
+ # @class.method {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 +398,7 @@
# define method "method" for Class and Object
- # @class.method {::nx::Class method}
+ # @class.method {Class method}
#
# Defines a per-class method, similarly to Tcl specifying
# {{{procs}}}. Optionally assertions may be specified by two
@@ -431,7 +435,7 @@
return $r
}
- # @class.method {::nx::Object method}
+ # @class.method {Object method}
#
# Defines a per-object method, similarly to Tcl specifying
# {{{procs}}}. Optionally assertions may be specified by two
@@ -551,7 +555,7 @@
# define forward methods
- # @class.method {::nx::Object forward}
+ # @class.method {Object forward}
#
# Register a per-object method (similar to a {{{proc}}}) for
# forward-delegating calls to a callee (target Tcl command, other
@@ -596,7 +600,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?}
- # @class.method {::nx::Class forward}
+ # @class.method {Class forward}
#
# Register a per-class method (similar to a {{{proc}}}) for
# forward-delegating calls to a callee (target Tcl command, other
@@ -843,6 +847,112 @@
########################
# we have to use "eval", since objectParameters are not defined yet
+
+ # @class.method {Object info}
+ #
+ # Provides introspection on objects. A variety of introspection
+ # options exists. {{{info}}} is implemented as en ensemble
+ # object. Hence, the introspection options turn into proper
+ # sub-methods.
+ #
+ # @sub-method callable
+ # @sub-method has
+ # @sub-method filter
+ # @sub-method is Binds all introspection facilities offered by
+ # {{{::nsf::is}}} to the object, i.e., the object is automatically
+ # folded in as the first argument passed to {{{::nsf::is}}}
+ # @sub-method mixin
+
+ # @class.method {Object "info callable method"}
+ #
+ # Verifies whether there is a method under a given name available
+ # for invocation upon the object. In case, the introspective call
+ # returns the corresponding method handle. If there is no so named
+ # method available, an empty string is returned.
+
+ # @class.method {Object "info callable filter"}
+ #
+ # Search for a method which is currently registered as a filter (in
+ # the invocation scope of the given object). If found, the
+ # corresponding method handle is returned.
+
+ # @class.method {Object "info children"}
+ #
+ # Computes the list of aggregated (or nested) objects. The resulting
+ # list reports the fully qualified object names. If a name pattern
+ # was specified, all matching child objects are returned. Otherwise,
+ # all children are reported.
+
+
+ # @class.method {Object "info class"}
+ #
+ # Gives the name of the class of the current object.
+
+ # @class.method {Object "info filter guard"}
+ #
+ # Returns the guards for filter identified by a filter name
+
+ # @class.method {Object "info filter methods"}
+ #
+ # Returns a list of methods registered as filters.
+
+ # @class.method {Object "info forward"}
+ #
+ # Provides you with the list of forwarders defined for the given
+ # object.
+
+ # @class.method {Object "info has mixin"}
+ #
+ # Verifies in a boolean test whether the object has the given class
+ # registered as a mixin class.
+
+ # @class.method {Object "info has namespace"} Some words on info has type
+ #
+ # Tells you whether the object has a companion, per-object Tcl
+ # namespace. Note that the results do not necessarily correspond to
+ # those yielded by {{{[namespace exists /obj/]}}}.
+
+ # @class.method {Object "info has type"}
+ #
+ # Tests whether the class passed as the argument is a type of the
+ # object, i.e., whether the object is an instance of the given class
+ # or of one of the class's superclasses.
+
+ # @class.method {Object "info methods"}
+ #
+ # Allows you to query the methods (of various kinds) defined on the
+ # object.
+
+ # @class.method {Object "info mixin guard"}
+ #
+ # Retrieves the guards applied to the mixin class idenitified by the
+ # mixin class name
+
+ # @class.method {Object "info mixin classes"}
+ #
+ # The list of per-object mixin classes currently registered for the
+ # object is returned.
+
+ # @class.method {Object "info parent"}
+ #
+ # Resolves the fully qualified name of the parent object (or "::" if
+ # there is no parent object).
+
+ # @class.method {Object "info precedence"}
+ #
+ # Presents to you the list of classes the object is inheriting
+ # attributes and methods, ordered according to their precedence.
+
+ # @class.method {Object "info slotobjects"}
+ #
+ # Assembles the list of slot objects which apply the given
+ # object. They are resolved by following the class precedence list
+ # upward and coercing the lists of slots provided by these classes.
+
+ # @class.method {Object "info vars"}
+ #
+ # Yields a list of variable names created and defined on the object.
+
Object eval {
:alias "info callable" ::nsf::cmd::ObjectInfo::callable
:alias "info children" ::nsf::cmd::ObjectInfo::children
@@ -1036,7 +1146,7 @@
}
namespace eval ::nx {
- # @class ::nx::Slot
+ # @class Slot
#
# A slot is a meta-object that manages property changes of
# objects. A property is either an attribute or a role taken by an
@@ -1051,7 +1161,7 @@
# @superclass ::nx::doc::entities::class::nx::Object
MetaSlot create ::nx::Slot
- # @class ::nx::ObjectParameterSlot
+ # @class ObjectParameterSlot
#
# @superclass ::nx::doc::entities::class::nx::Slot
@@ -1110,23 +1220,23 @@
# Define slots for slots
############################################
- # @class.param {::nx::Slot name}
+ # @class.param {Slot name}
#
# Name of the slot which can be used to access the slot from an object
- # @class.param {::nx::Slot multivalued}
+ # @class.param {Slot multivalued}
#
# Boolean value for specifying single or multiple values (lists)
- # @class.param {::nx::Slot required}
+ # @class.param {Slot required}
#
# Denotes whether a value must be provided
- # @class.param {::nx::Slot default}
+ # @class.param {Slot default}
#
# Allows you to define a default value (to be set upon object creation)
- # @class.param {::nx::Slot type}
+ # @class.param {Slot type}
#
# You may specify a type constraint on the value range to managed by the slot
@@ -1138,31 +1248,31 @@
type
}
- # @class.param {::nx::ObjectParameterSlot name}
+ # @class.param {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.
- # @class.param {::nx::ObjectParameterSlot methodname}
+ # @class.param {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.
- # @class.param {::nx::ObjectParameterSlot domain}
+ # @class.param {ObjectParameterSlot domain}
#
# The domain (object or class) of a slot on which it can be used
- # @class.param {::nx::ObjectParameterSlot defaultmethods}
+ # @class.param {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.
- # @class.param {::nx::ObjectParameterSlot manager}
+ # @class.param {ObjectParameterSlot manager}
#
# The manager object of the slot (per default, the slot object takes
# this role, i.e. {{{[self]}}})
- # @class.param {::nx::ObjectParameterSlot per-object}
+ # @class.param {ObjectParameterSlot per-object}
#
# If set to {{{true}}}, the accessor methods are registered with the
# domain object scope only. It defaults to {{{false}}}.
@@ -1455,7 +1565,7 @@
############################################
proc ::nsf::register_system_slots {os} {
- # @class.param {::nx::Class superclass}
+ # @class.param {Class superclass}
#
# Specifies superclasses for a given class. As a setter ***
# generell: setter kann hier mit der methode namens "setter"
@@ -1476,7 +1586,7 @@
::nx::RelationSlot create ${os}::Class::slot::superclass
::nsf::alias ${os}::Class::slot::superclass assign ::nsf::relation
- # @class.param {::nx::Object class}
+ # @class.param {Object class}
#
# Sets or retrieves the class of an object. When {{{class}}} is
# called without arguments, it returns the current class of the
@@ -1486,7 +1596,7 @@
::nx::RelationSlot create ${os}::Object::slot::class -multivalued false
::nsf::alias ${os}::Object::slot::class assign ::nsf::relation
- # @class.param {::nx::Object mixin}
+ # @class.param {Object mixin}
#
# As a setter, {{{mixin}}} specifies a list of mixins to
# set. Every mixin must be an existing class. In getter mode, you
@@ -1496,7 +1606,7 @@
::nx::RelationSlot create ${os}::Object::slot::mixin \
-methodname object-mixin
- # @class.param {::nx::Object filter}
+ # @class.param {Object filter}
#
# In its setter mode, {{{filter}}} allows you to register methods
# as per-object filters. Every filter must be an existing method
@@ -1510,7 +1620,7 @@
-methodname object-filter
- # @class.param {::nx::Class mixin}
+ # @class.param {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
@@ -1520,7 +1630,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
- # @class.param {::nx::Class filter}
+ # @class.param {Class filter}
#
# In its setter mode, {{{filter}}} allows you to register methods
# as per-class filters. Every filter must be an existing method
@@ -1581,7 +1691,7 @@
############################################
::nsf::invalidateobjectparameter MetaSlot
- # @class ::nx::Attribute
+ # @class Attribute
#
# Attribute slots are used to manage the access, mutation, and
# querying of instance variables. One defines Attribute slots
Index: tests/doc.tcl
===================================================================
diff -u -rd9b42d77f43db84a9983cc3bbc4124cf0b52df29 -rfee959816f9851be0afd54905e906854680fccb2
--- tests/doc.tcl (.../doc.tcl) (revision d9b42d77f43db84a9983cc3bbc4124cf0b52df29)
+++ tests/doc.tcl (.../doc.tcl) (revision fee959816f9851be0afd54905e906854680fccb2)
@@ -8,30 +8,6 @@
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
#
@@ -45,46 +21,8 @@
return 1
}
-# Class create ::nx::doc::CommentState::Log {
-# :method on_enter {line} {
-# puts -nonewline stderr "ENTER -> [namespace tail [:info class]]#[namespace tail [self]]"
-# next
-# }
-# :method on_exit {line} {
-# next
-# puts -nonewline stderr "EXIT -> [namespace tail [:info class]]#[namespace tail [self]]"
-# }
-# }
-
-# Class create ::nx::doc::CommentLine::Log {
-# :method on_enter {line} {
-# puts -nonewline stderr "\t"; next; puts stderr " -> LINE = ${:processed_line}"
-# }
-# :method on_exit {line} {
-# puts -nonewline stderr "\t"; next; puts stderr " -> LINE = ${:processed_line}"
-# }
-# }
-
-# Class create ::nx::doc::CommentSection::Log {
-# :method on_enter {line} {
-# next; puts -nonewline stderr "\n"
-# }
-# :method on_exit {line} {
-# next; puts -nonewline stderr "\n";
-# }
-# }
-
-# set log false
-
-# if {$log} {
-# ::nx::doc::CommentState mixin add ::nx::doc::CommentState::Log
-# ::nx::doc::CommentLine mixin add ::nx::doc::CommentLine::Log
-# ::nx::doc::CommentSection mixin add ::nx::doc::CommentSection::Log
-# }
-
# --
-
Test case scanning {
set lines {
@@ -155,7 +93,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? COMPLETED] 1
- # ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0
set block {
{}
@@ -164,9 +101,7 @@
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
# (i.e., a tag or text line, depending on the section: context
@@ -181,19 +116,14 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? STYLEVIOLATION] 1
- # ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1
-
set block {
{command ::cc}
{}
}
- set cbp [CommentBlockParser process $block]
+ 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}
@@ -202,8 +132,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? STYLEVIOLATION] 1
-# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1
-
set block {
{@command ::cc}
{}
@@ -216,9 +144,6 @@
? [list $cbp status ? STYLEVIOLATION] 0
? [list $cbp status ? COMPLETED] 1
-
- #? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0
-
set block {
{@command ::cc}
{}
@@ -231,8 +156,6 @@
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 {
@@ -273,8 +196,6 @@
? [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.
#
@@ -292,8 +213,6 @@
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?
#
@@ -310,8 +229,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? STYLEVIOLATION] 1
-# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1
-
set block {
{@command ::cc}
{}
@@ -327,7 +244,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? STYLEVIOLATION] 1
-# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 1
set block {
{@command ::cc}
@@ -343,8 +259,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? STYLEVIOLATION] 0
-# ? [list StyleViolation thrown_by? [list CommentBlockParser process $block]] 0
-
set block {
{@object ::cc}
{}
@@ -358,8 +272,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? INVALIDTAG] 1
- # ? [list InvalidTag thrown_by? [list CommentBlockParser process $block]] 1
-
set block {
{@class ::cc}
{}
@@ -373,8 +285,6 @@
set cbp [CommentBlockParser process $block]
? [list $cbp status ? INVALIDTAG] 1
- # ? [list InvalidTag thrown_by? [list CommentBlockParser process $block]] 1
-
#
# testing the doc object construction
#
@@ -418,7 +328,7 @@
{}
{some text on the class entity}
{}
- {@class-param attr1 Here, we check whether we can get a valid description block}
+ {@class-param attr1 Here! we check whether we can get a valid description block}
{for text spanning multiple lines}
}
@@ -431,7 +341,7 @@
? [list $entity as_text] "some text on the class entity";
? [list llength [$entity @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"
+ ? [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)
@@ -444,7 +354,7 @@
# @author gustaf.neumann@wu-wien.ac.at
# @author ssoberni@wu.ac.at
- # @param attr1
+ # @.param attr1
#
# This attribute 1 is wonderful
#
@@ -454,7 +364,7 @@
:attribute attr2
:attribute attr3
- # @method foo
+ # @.method foo
#
# This describes the foo method
#
@@ -473,8 +383,7 @@
? [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]
+ set entity [@param id [@class id ::Foo] class attr1]
? [list ::nsf::is object $entity] 1
? [list $entity info has type ::nx::doc::@param] 1
? [list $entity @see] "::nx::Attribute ::nx::MetaSlot";
@@ -572,8 +481,7 @@
# TODO: Fix the [@param id] programming scheme to allow (a) for
# entities to be passed and the (b) documented structures
- #set entity [@param id ::Bar class attr1]
- set entity [@param id $entity attr1]
+ set entity [@param id [@class id ::Bar] class attr1]
? [list $i eval [list ::nsf::is object $entity]] 1
? [list $i eval [list $entity info has type ::nx::doc::@param]] 1
? [list $i eval [list $entity @see]] "::nx::Attribute ::nx::MetaSlot";
@@ -590,6 +498,8 @@
} {
? [list expr [list [$i eval [list $p as_text]] eq $expected]] 1;
}
+
+
set entity [@method id ::Bar object foo]
? [list $i eval [list [@class id ::Bar] @object-method]] $entity
? [list $i eval [list ::nsf::is object $entity]] 1
@@ -603,8 +513,425 @@
} {
? [list expr [list [$i eval [list $p as_text]] eq $expected]] 1;
}
+
interp delete $i
+
+
+ #
+ # Some tests on structured/navigatable tag notations
+ #
+
+ # adding support for parsing levels
+
+ # -- @class.object.object {::D o1 o2}
+ set block {
+ {@..object o2 We have a tag notation sensitive to the parsing level}
+ }
+
+ set entity [[@ @class ::D] @object o1]
+ set cbp [CommentBlockParser process -parsing_level 1 -partof_entity $entity $block]
+ ? [list $cbp status ? LEVELMISMATCH] 1
+ set cbp [CommentBlockParser process -parsing_level 2 -partof_entity $entity $block]
+ ? [list $cbp status ? COMPLETED] 1
+ set entity [$cbp current_entity]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@object] 1
+ ? [list $entity as_text] "We have a tag notation sensitive to the parsing level"
+
+ set block {
+ {@..object {o2 o3} We still look for balanced specs}
+ }
+
+ set entity [[@ @class ::D] @object o1]
+ set cbp [CommentBlockParser process -parsing_level 2 -partof_entity $entity $block]
+ ? [list $cbp status ? STYLEVIOLATION] 1
+
+ # This fails because we do not allow uninitialised/non-existing
+ # entity objects (@object o) along the resolution path ...
+ set block {
+ {@class.object.param {::C o attr1} We have an invalid specification}
+ }
+
+ set cbp [CommentBlockParser process $block]
+ ? [list $cbp status ? STYLEVIOLATION] 1
+# ? [list $cbp message] "The tag 'object' is not supported for the entity type '@class'"
+
+ set block {
+ {@class.method.param attr1 We have an imbalanced specification (the names are underspecified!)}
+ }
+ set cbp [CommentBlockParser process $block]
+ ? [list $cbp status ? STYLEVIOLATION] 1
+ ? [list $cbp message] "Imbalanced tag line specification in '@class.method.param attr1 We have an imbalanced specification (the names are underspecified!)'."
+
+ # For now, we do not verify and use a fixed scope of permissive tag
+ # names. So, punctuation errors or typos are most probably reported
+ # as imbalanced specs. In the mid-term run, this should rather
+ # become an INVALIDTAG condition.
+ set block {
+ {@cla.ss.method.param {::C foo p1} We mistyped a tag fragment}
+ }
+ set cbp [CommentBlockParser process $block]
+ ? [list $cbp status ? STYLEVIOLATION] 1
+ ? [list $cbp message] "Imbalanced tag line specification in '@cla.ss.method.param {::C foo p1} We mistyped a tag fragment'."
+
+ set block {
+ {@cla,ss.method.param {::C foo p1} We mistyped a tag fragment}
+ }
+ set cbp [CommentBlockParser process $block]
+ ? [list $cbp status ? INVALIDTAG] 1
+ ? [list $cbp message] "The entity type '@cla,ss' is not available."
+
+ set script {
+ # @class ::C
+ #
+ # The global description of ::C
+ #
+ # @param attr1 Here we can only provide a description block for object parameters
+
+ # @class.param {::C attr1} Here, we could also write '@class.class-param \{::C attr1\}', @param is a mere forwarder! In the context section, only one-liners are allowed!
+
+ # @class.object.param {::C foo p1} A short description is ...
+ #
+ # .. is overruled by a long one ...
+
+ # If addressing to a nested object, one strategy would be to use
+ # @object and provide the object identifier (which reflects the
+ # nesting, e.g. ::C::foo). However, we cannot distinguish between
+ # namespace qualifiers denoting an object, class or owning
+ # namespace!
+ #
+ # ISSUE: If specifying an axis ".object", we would have to define
+ # a part attribute @object on @class and @object. However, @object
+ # would be ambiguous now: It could be called in a freestanding
+ # (absolute) manner AND in a contextualised manner (in an initcmd
+ # script). In the latter case, it would fail because we would have
+ # to provide a FQ'ed name (which defeats the purpose of a nested =
+ # contextualised notation).
+ #
+ # SO: for now, we introduce a part attribute child-object (and
+ # child-class?) to discrimate between the two situations ...
+ #
+ # TODO: How to register this so created @object entity as nested
+ # object with the doc entity represented the parent object?
+
+ Class create C {
+ # This is the initcmd-level description of ::C which overwrites the
+ # global description (see above)
+
+ # @.param attr1
+ #
+ # This is equivalent to writing "@class-param attr1"
+ :attribute attr1 {
+ # This description does not apply to the object parameter
+ # "attr1" owned by the ::C class, rather it is a description
+ # of the attribute slot object! How should we deal with this
+ # situation? Should this level overwrite the top-level and
+ # initcmd-level descriptions?
+ }
+
+ # @.object-param attr2 Carries a short desc only
+ :object attribute attr2
+
+ # @.method foo
+ #
+ # @param p1
+ set fooHandle [:method foo {p1} {
+ # Here goes some method-body-level description
+ #
+ # @param p1 The most specific level!
+ return [current method]-$p1-[current]
+ }]
+
+ # @.object-method.param {bar p1}
+ #
+ # This extended form allows to describe a method parameter with all
+ # its structural features!
+ set barHandle [:object method bar {p1} {
+ return [current method]-$p1-[current]
+ }]
+
+ # @.object foo 'foo' needs to be defined before referencing any of its parts!
+
+ # @.object.param {foo p1}
+ #
+ # The first element in the name list is resolved into a fully
+ # qualified (absolute) entity, based on the object owning the
+ # initcmd!
+ Object create [current]::foo {
+ # Adding a line for the first time (not processed in the initcmd phase!)
+
+ # @..param p1
+ #
+ # This is equivalent to stating "@object-param p1"
+ :attribute p1
+ }
+
+ # @.class Foo X
+ #
+ # By providing a fully-qualified identifier ("::Foo") you leave the
+ # context of the initcmd-owning object, i.e. you would NOT refer to
+ # a nested class object named "Foo" anymore!
+
+ # @.class.param {Foo p1}
+ #
+ # This is equivalent to stating "@child-class.class-param {Foo p1}"
+
+ # @.class.object-param {Foo p2} Y
+ Class create [current]::Foo {
+
+ # @..param p1
+ #
+ #
+ # This is equivalent to stating "@class-param p1"; or
+ # '@class.object.param {::C Foo p1}' from the top-level.
+ :attribute p1
+
+ # @..object-param p2
+ :object attribute p2
+ }
+
+
+ # @.object-method.sub-method {sub foo}
+ #
+ # ISSUE: Should submethods be navigatable through "method" (i.e.,
+ # "@method.method.method ...") or "submethod" (i.e.,
+ # "@method.submethod.submethod ...")? ISSUE: Should it be sub* with
+ # "-" (to correspond to "@object-method", "@class-method")? Also, we
+ # could allow both (@sub-method is the attribute name, @method is a
+ # forwarder in the context of an owning @method object!)
+ #
+ # @param p1 Some words on p1
+ :object alias "sub foo" $fooHandle
+
+ # @.method sub
+ #
+ # The desc of the ensemble object 'sub'
+ #
+ # @sub-method bar Only description available here ...
+
+ # ISSUE: Should the helper object "sub" be documentable in its own
+ # right? This would be feasible with the dotted notation from
+ # within and outside the initcmd script block, e.g. "@object sub" or
+ # "@class.object {::C sub}"
+ #
+ # ISSUE: Is it correct to say the sub appears as per-object method
+ # and so do its submethods? Or is it misleading to document it that
+ # way? Having an "@object-submethod" would not make much sense to
+ # me?!
+ :alias "sub bar" $barHandle
+
+ # @.object-method sub A brief desc
+
+ # @.object-method {"sub foo2"}
+ #
+ # could allow both (@sub-method is the attribute name, @method is a
+ # forwarder in the context of an owning @method object!)
+ #
+ # @param p1 Some words on p1
+ # @see anotherentity
+ # @author ss@thinkersfoot.net
+ :object alias "sub foo2" $fooHandle
+ }
+ }
+
+ #
+ # 1) process the top-level comments (PARSING LEVEL 0)
+ #
+
+ doc analyze -noeval true $script
+
+ # --testing-- "@class ::C"
+ set entity [@class id ::C]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@class] 1
+ ? [list $entity as_text] "The global description of ::C";
+ # --testing-- "@class.param {::C attr1}"
+ set entity [@param id $entity class attr1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@param] 1
+ ? [list $entity as_text] "Here, we could also write '@class.class-param {::C attr1}', @param is a mere forwarder! In the context section, only one-liners are allowed!"
+
+ # --testing-- "@class.object.param {::C foo p1} A short description is ..."
+ # set entity [@param id $entity class attr1]
+ # set entity [@object id -partof_name ::C -scope child foo]
+ # ? [list ::nsf::isobject $entity] 1
+ # ? [list $entity info has type ::nx::doc::@object] 1
+ # ? [list $entity as_text] ""
+ # set entity [@param id $entity object p1]
+ # ? [list ::nsf::isobject $entity] 1
+ # ? [list $entity info has type ::nx::doc::@param] 1
+ # ? [list $entity as_text] ".. is overruled by a long one ..."
+
+ set entity [@object id ::C::foo]
+ ? [list ::nsf::isobject $entity] 0
+ set entity [@param id $entity object p1]
+ ? [list ::nsf::isobject $entity] 0
+ # ? [list $entity info has type ::nx::doc::@param] 1
+ # ? [list $entity as_text] ".. is overruled by a long one ..."
+
+ # --testing-- @object-param attr2 (its non-existance)
+ set entity [@param id [@class id ::C] object attr2]
+ ? [list ::nsf::isobject $entity] 0
+ # --testing-- @child-class Foo (its non-existance)
+ set entity [@class id ::C::Foo]
+ ? [list ::nsf::isobject $entity] 0
+ # --testing -- @method foo (its non-existance)
+ set entity [@method id ::C class foo]
+ ? [list ::nsf::isobject $entity] 0
+ # --testing-- @object-method.param {bar p1} (its non-existance)
+ set entity [@param id [@method id ::C object bar] "" p1]
+ ? [list ::nsf::isobject $entity] 0
+ # --testing-- @child-object.param {foo p1} (its non-existance)
+ set cl [@class id ::C::Foo]
+ ? [list ::nsf::isobject $entity] 0
+ set entity [@param id $cl class p1]
+ ? [list ::nsf::isobject $entity] 0
+ set entity [@param id $cl object p2]
+ ? [list ::nsf::isobject $entity] 0
+
+ #
+ # 2) process the initcmd comments (PARSING LEVEL 1)
+ #
+
+ eval $script
+
+ doc analyze_initcmd @class ::C [::C eval {set :__initcmd}]
+
+ # a) existing, but modified ...
+
+ set entity [@class id ::C]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@class] 1
+ ? [list $entity as_text] "This is the initcmd-level description of ::C which overwrites the global description (see above)"
+
+ set entity [@param id $entity class attr1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@param] 1
+ ? [list $entity as_text] {This is equivalent to writing "@class-param attr1"}
+
+
+ set entity [@object id ::C::foo]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@object] 1
+ ? [list $entity as_text] "'foo' needs to be defined before referencing any of its parts!"; # still empty!
+ set entity [@param id $entity object p1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@param] 1
+ ? [list $entity as_text] "The first element in the name list is resolved into a fully qualified (absolute) entity, based on the object owning the initcmd!"
+
+ # b) newly added ...
+
+ # --testing-- @object-param attr2
+ set entity [@param id [@class id ::C] object attr2]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@param] 1
+ ? [list $entity as_text] "Carries a short desc only";
+
+ # --testing-- @child-class Foo
+ # TODO: provide a check against fully-qualified names in part specifications
+ set entity [@class id ::C::Foo]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@class] 1
+ ? [list $entity as_text] {By providing a fully-qualified identifier ("::Foo") you leave the context of the initcmd-owning object, i.e. you would NOT refer to a nested class object named "Foo" anymore!}
+
+ set entity [@param id [@class id ::C] class p1]
+ ? [list ::nsf::isobject $entity] 0; # should be 0 at this stage!
+
+ # --testing -- @method foo
+ set entity [@method id ::C class foo]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] ""
+ # --testing-- @object-method.param {bar p1} (its non-existance) It
+ # still cannot exist as a documented entity, as the object method
+ # has not been initialised before!
+ set entity [@param id [@method id ::C object bar] "" p1]
+ ? [list ::nsf::isobject $entity] 0
+ # --testing-- @child-class.param {foo p1} (its non-existance)
+ # --testing-- @child-class.object-param {foo p2} (its non-existance)
+ set cl [@class id ::C::Foo]
+ ? [list ::nsf::isobject $cl] 1
+ set entity [@param id $cl class p1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] {This is equivalent to stating "@child-class.class-param {Foo p1}"}
+ set entity [@param id $cl object p2]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "Y"
+
+ set entity [@method id ::C class sub]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "The desc of the ensemble object 'sub'"
+
+ set entity [@method id ::C class sub::bar]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "Only description available here ..."
+
+ set entity [@method id ::C object sub]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "A brief desc"
+
+ set entity [@method id ::C object sub::foo2]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@method] 1
+ ? [list $entity as_text] "could allow both (@sub-method is the attribute name, @method is a forwarder in the context of an owning @method object!)"
+ ? [list $entity @see] "anotherentity"
+ # TODO: @author not supported for @method (fine so?)
+ # ? [list $entity @author] "ss@thinkersfoot"
+ set entity [@param id $entity "" p1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "Some words on p1"
+
+ #
+ # 3a) process the attribute initcmds and method bodies (PARSING LEVEL 2)!
+ #
+
+ doc process=@class [@class id ::C]
+
+ # methods ...
+
+ set entity [@method id ::C class foo]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "Here goes some method-body-level description"
+ set entity [@param id [@method id ::C class foo] "" p1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] "The most specific level!"
+
+ # attributes ...
+
+ # attr1
+ set entity [@param id [@class id ::C] class attr1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@param] 1
+ ? [list $entity as_text] {This description does not apply to the object parameter "attr1" owned by the ::C class, rather it is a description of the attribute slot object! How should we deal with this situation? Should this level overwrite the top-level and initcmd-level descriptions?}
+
+ #
+ # 3b) nested objects/ classes (PARSING LEVEL 2)!
+ #
+
+ doc analyze_initcmd -parsing_level 2 @object ::C::foo [::C::foo eval {set :__initcmd}]
+ doc process=@object [@object id ::C::foo]
+
+ set entity [@object id ::C::foo]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@object] 1
+ ? [list $entity as_text] "Adding a line for the first time (not processed in the initcmd phase!)"; # still empty!
+ set entity [@param id $entity object p1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity info has type ::nx::doc::@param] 1
+ ? [list $entity as_text] {This is equivalent to stating "@object-param p1"}
+
+ doc analyze_initcmd -parsing_level 2 @class ::C::Foo [::C::Foo eval {set :__initcmd}]
+ doc process=@class [@class id ::C::Foo]
+
+ set cl [@class id ::C::Foo]
+ ? [list ::nsf::isobject $cl] 1
+ set entity [@param id $cl class p1]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] {This is equivalent to stating "@class-param p1"; or '@class.object.param {::C Foo p1}' from the top-level.}
+ set entity [@param id $cl object p2]
+ ? [list ::nsf::isobject $entity] 1
+ ? [list $entity as_text] ""
+
puts stderr =================================================
#
# self documentation
@@ -651,26 +978,28 @@
-name ::NextScriptingFramework \
-url http://www.next-scripting.org/ \
-version 1.0.0a \
- -namespace "::nsf"]
+ -@namespace "::nsf"]
doc process -noeval true generic/predefined.tcl
::nx::doc::make doc \
- -renderer ::nx::doc::NxDocTemplateData \
- -outdir [::nsf::tmpdir] \
- -project $project
+ -renderer ::nx::doc::NxDocTemplateData \
+ -outdir [::nsf::tmpdir] \
+ -project $project
puts stderr TIMING=[time {
set project [::nx::doc::@project new \
- -name ::NextScriptingLanguage \
- -url http://www.next-scripting.org/ \
- -version 1.0.0a \
- -namespace "::nx"]
+ -name ::NextScriptingLanguage \
+ -url http://www.next-scripting.org/ \
+ -version 1.0.0a \
+ -@namespace "::nx"]
+ # ISSUE: If calling '-namespace "::nx"' instead of '-@namespace
+ # "::nx"', we get an irritating failure. VERIFY!
doc process -noeval true library/nx/nx.tcl
::nx::doc::make doc \
- -renderer ::nx::doc::NxDocTemplateData \
- -outdir [::nsf::tmpdir] \
- -project $project
+ -renderer ::nx::doc::NxDocTemplateData \
+ -outdir [::nsf::tmpdir] \
+ -project $project
} 1]
}
@@ -707,16 +1036,9 @@
# # # # # # # # # # # # # # # # # # # #
# 1) Test case scoping rules -> in Object->eval()
-# Why does [info] intropsection not work as expected in eval()?
Test case issues? {
- # TODO: is [autoname -instance] really needed?
- # is autoname needed in Next Scripting?
-
- # TODO: why is XOTclNextObjCmd/::nsf::next not in gentclAPI.decls?
- # why should it be there? there are pros and cons, and very little benefit, or?
-
# TODO: where to locate the @ comments (in predefined.xotcl, in
# gentclAPI.decls)? how to deal with ::nsf::* vs. ::nx::*
@@ -728,31 +1050,8 @@
# after create(), then cleanup() is missing a configure() call to
# set defaults, etc!
# ?? cleanup does not set defaults; depending on "softrecreate", it
- # deletes instances, childobjects, procs, instprocs, ....
+ # deletes instances, childobjects, procs, instprocs, ...
- # TODO: exists and bestandteil von info() oder selbstständig?
- # ausserdem: erlauben von :-präfix?!
-
- # we have discussed this already
-
- # TODO: should we keep a instvar variant (i support this!)
-
- # what means "keep". next scripting should be mininmal,
- # "instvar" is not needed and error-prone. We have now
- # "::nx::var import" and ::nsf::importvar
- # (of you want, similar to variable or global).
-
- # TODO: verify the use of filtersearch()? should it return a method
- # handle and the filter name? how to deal with it when refactoring
- # procsearch()?
-
- # ?? what does it return? What is the issue?
-
- # TODO: mixinguard doc is missing in old doc
-
- # mixinguard is described in the tutorial, it should have been documented
- # in the langref as well
-
# TODO: what is Object->__next() for?
# See the following script:
@@ -775,10 +1074,6 @@
# but seems - at least in this usecase broken. Deactivated
# in source for now.
- # TODO: what to do with hasNamespace()? [Object info is namespace]?
-
- # what is wrong with ":info hashNamespace"?
-
# TODO: why is XOTclOUplevelMethodStub/XOTclOUplevelMethod defined
# with "args" while it logically uses the stipulated parameter
# signature (level ...). is this because of the first pos, optional
@@ -796,21 +1091,11 @@
# with nonpos arguments, which might be values for positional arguments
# as well.... not, sure, it is worth to invest much time here.
- # TODO: is Object->uplevel still needed with an integrated cs management?
-
- # yes, this is completely unrelated with the kind of callstack implemtation.
- # the methods upvar and uplevel are interceptor transparent, which means
- # that an uplevel will work for a method the same way, when a mixin or filter
- # are registered.
-
# TODO: how is upvar affected by the ":"-prefixing? -> AVOID_RESOLVERS ...
# this is a tcl question, maybe version dependent.
- # TODO: do all member-creating operations return valid, canonical handles!
- # what are member-creating operations? if you mean "method-creating methods"
- # they should (in next scripting) (i.e. necessary for e.g. method modifiers).
# TODO: the objectsystems subcommand of ::nsf::configure does
# not really fit in there because it does not allow for configuring
@@ -841,46 +1126,7 @@
# but if we would fold these into tcl-info, conflicts with
# tcl will arise.
- # TODO: extend [info level] & [info frame]!
- #
- # Why and what exactly?
- # If we would do it the tcloo-way, it would be very expensive.
- # whe have "info frame" implemnted with a less expensive approach since March 1
- # TODO: there is still --noArgs on [next], which does not correspond
- # to single-dashed flags used elsewhere. Why?
- #
- # (a) backward compatibility and (b) do you have suggestions?
-
- # TODO: renaming of self to current?
- #
- # what do you mean by "renaming"? both commands were available
- # since a while. Maybe we should not import "self" into next scripting.
- #
- # DONE (self is not imported anymore, all occurrences in next tests are changed)
- # Not sure, we should keep since, since it will be a problem in many scripts
- # (e.g. in all slots, since slots are always next objects; maybe some advanced
- # OpenACS users will be hit).
- #
-
- # TODO: is [self callingclass] == [[self callingobject] info class]?
- #
- # no
-
- # TODO: "# @subcommand next Returns the name of the method next on
- # the precedence path as a string" shouldn't these kinds of
- # introspective commands return method handles (in the sense of
- # alias)? Retrieving the name from a handle is the more specific
- # operation (less generic). ... same for "filterreg"
- #
- # this is most likely "self next" and "self filterreg",
- # but applies as well for .e.g "info filter ... -order ..."
- # there are already changes to xotcl (see migration guide).
- # since the handle works now as well for "info method",
- # this could be effectively done, but it requires
- # backward compatibility.
- #
- # DONE
}
# if {$log} {