Index: library/lib/doc-assets/class.html.tmpl =================================================================== diff -u -N -rc4cc0944433a7cc9ae99612039aa0237ae70ec08 -rdbddbce63d4a499de52ff07fdc63c02017960c79 --- library/lib/doc-assets/class.html.tmpl (.../class.html.tmpl) (revision c4cc0944433a7cc9ae99612039aa0237ae70ec08) +++ library/lib/doc-assets/class.html.tmpl (.../class.html.tmpl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) @@ -5,7 +5,7 @@

- [:? {[${:name} info is class]} { Class } - { Object }] + Class ${:name} [:?var :@superclass { @@ -26,11 +26,12 @@
-[:?var :@param {
-

Slots

+

Class parameters

- [:for attr ${:@param} { +[:?var :@class-param { + + [:for attr ${:@class-param} {

[$attr name]

@@ -57,17 +58,18 @@
}] -
+}] +
-} ] - [:let iattrs [:inherited @param]] + + [:let iattrs [:inherited @class-param]] [:? {$iattrs ne ""} {
[:for superclass [dict keys $iattrs] { [:let attrs [dict get $iattrs $superclass]]
-

Slots inherited +

Object parameters inherited from [$superclass name]:

@@ -89,12 +91,50 @@ }]
+
+
+

Object parameters

+
+[:?var :@object-param { + + [:for attr ${:@object-param} { +
+

[$attr name] +

+
+
+ [$attr text] +
+
+ + + [:? {[$attr eval {info exists :default}]} { +
+ Default Value: [$attr default] +
+ }] + + [:? {[$attr eval {info exists :deprecated}]} { +
+ Deprecated: [$attr] +
+ }] + +
+
+ + }] +}] +
+
+
+
-[:?var :@method {
-

Methods

+

Class methods

- [:for method ${:@method} { +[:?var :@class-method { + [:for method ${:@class-method} {

[$method name]

@@ -163,10 +203,11 @@
}] + }]
- }] - [:let imethods [:inherited @method]] + + [:let imethods [:inherited @class-method]] [:? {$imethods ne ""} {
[:for superclass [dict keys $imethods] { @@ -203,7 +244,7 @@ [:?var :@object-method {
-

Per-object methods

+

Object methods

[:for omethod ${:@object-method} {
Index: library/lib/doc-assets/entity.html.tmpl =================================================================== diff -u -N -r6458c13882afd52e8719ee0e0e054b42e9aee696 -rdbddbce63d4a499de52ff07fdc63c02017960c79 --- library/lib/doc-assets/entity.html.tmpl (.../entity.html.tmpl) (revision 6458c13882afd52e8719ee0e0e054b42e9aee696) +++ library/lib/doc-assets/entity.html.tmpl (.../entity.html.tmpl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) @@ -1,6 +1,3 @@ -[:let packages [sorted [@package info instances] name]] -[:let objects [sorted [@object info instances] name]] -[:let commands [sorted [@command info instances] name]] @@ -29,7 +26,7 @@ [$project name] [:? {[:info is type ::nx::doc::@package]} { > ${:name} - } ? {[:info is type ::nx::doc::@object]} { + } ? {[:info is type ::nx::doc::@class]} { > [:?var :partof {[${:partof} name] >}] ${:name} }]
@@ -47,8 +44,8 @@
[:? {[:info is type ::nx::doc::@package]} { [:include package.html.tmpl] - } ? {[:info is type ::nx::doc::@object]} { - [:include object.html.tmpl] + } ? {[:info is type ::nx::doc::@class]} { + [:include class.html.tmpl] } ? {[:info is type ::nx::doc::@command]} { [:include command.html.tmpl] } ? {[:info is type ::nx::doc::@project]} { @@ -62,11 +59,11 @@
- [:? {$packages ne ""} { + [:? {[info exists (@package)]} {

Packages

    - [:for package $packages { + [:for package $(@package) { [:let css "" ] [:? {[:info is type ::nx::doc::@package] && [current] eq $package} { [:let css "selected" ] @@ -77,26 +74,26 @@
}] - [:? {$objects ne ""} { + [:? {[info exists (@class)]} {
-

Objects

+

Classes

    - [:for object $objects { + [:for class $(@class) { [:let css "" ] - [:? {[:info is type ::nx::doc::@object] && [current] eq $object} { + [:? {[:info is type ::nx::doc::@class] && [current] eq $class} { [:let css "selected" ] }] -
  • [:fit [$object name] 30]
    • +
  • [:fit [$class name] 30]
    • }]
}] - [:? {$commands ne ""} { + [:? {[info exists (@command)]} {

Commands

    - [:for command $commands { + [:for command $(@command) { [:let css "" ] [:? {[:info is type ::nx::doc::@command] && [current] eq $command} { [:let css "selected"] Index: library/lib/doc-assets/package.html.tmpl =================================================================== diff -u -N -rbb58b68431fe35dd6ff16e69044705e1246d0dda -rdbddbce63d4a499de52ff07fdc63c02017960c79 --- library/lib/doc-assets/package.html.tmpl (.../package.html.tmpl) (revision bb58b68431fe35dd6ff16e69044705e1246d0dda) +++ library/lib/doc-assets/package.html.tmpl (.../package.html.tmpl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) @@ -1,5 +1,5 @@ + -- a @package instance -->

    Package: ${:name}

    @@ -17,31 +17,48 @@
    - [:?var objects { -

    This package contains [llength $objects] objects:

    + [:?var :@class { +

    This package contains [llength ${:@class}] classes:

    + } ] + [:?var :@object { +

    This package contains [llength ${:@object}] objects:

    + +
    +
      + [:let idx 0] + [:for obj ${:@object} { +
    • [${obj} name]
      • + [incr idx; return] + } ] +
    +
    } ] - [:?var objects { -

    This package contains [llength $commands] commands:

    + + + [:?var :@command { +

    This package contains [llength ${:@command}] commands:

      [:let idx 0] - [:for cmd $commands { + [:for cmd ${:@command} {
    • [$cmd name]
      • [incr idx; return] } ] Index: library/lib/doc-tools.tcl =================================================================== diff -u -N -r6458c13882afd52e8719ee0e0e054b42e9aee696 -rdbddbce63d4a499de52ff07fdc63c02017960c79 --- library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision 6458c13882afd52e8719ee0e0e054b42e9aee696) +++ library/lib/doc-tools.tcl (.../doc-tools.tcl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) @@ -185,6 +185,10 @@ :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} { @@ -298,6 +302,7 @@ :attribute part_class:optional,class :attribute scope + # :forward owning_entity_class {% [[:info parent] info parent] } :method init args { :defaultmethods [list get append] :multivalued true @@ -310,6 +315,7 @@ regexp -- {@(.*)-.*} [namespace tail [current]] _ :scope } next + # :owning_entity_class owned_part_attributes add [current] } :method require_part {domain prop value} { @@ -372,6 +378,21 @@ 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 is 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 @@ -430,7 +451,7 @@ set container [[current class] container] if {![string match "::*" $name]} { # puts -nonewline stderr "--- EXPANDING name $name" - set name [$container namespace]::[string trimleft $name :] + set name [$container namespace]::$name # puts stderr " to name $name" } next $name @@ -447,10 +468,14 @@ # level. [next] will cause the container to change if another # container entity is initialised in the following! # - set container [[current class] container] - next - puts stderr "--- entity [current] starts living, register with $container" - $container register [current] + 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 + } } } # Note: The default "" corresponds to the top-level namespace "::"! @@ -466,20 +491,32 @@ set :part_class @command } + # :attribute @class:object,type=::nx::doc::@class,multivalued { + # set :incremental 1 + # } + + # :attribute @object:object,type=::nx::doc::@object,multivalued { + # set :incremental 1 + # } + + # :attribute @command:object,type=::nx::doc::@command,multivalued { + # set :incremental 1 + # } + :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 + # 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] - puts stderr "REGISTERING: tag $tag containable $containable on [current]" if {[:info callable methods -application "@$tag"] ne ""} { + puts stderr "REGISTERING: tag $tag containable $containable on [current]" :@$tag $containable } } @@ -514,12 +551,12 @@ # - ... # - EntityClass create @package -superclass ContainerEntity { + EntityClass create @package -superclass ContainerEntity -mixin ContainerEntity::Containable { :attribute @require -slotclass ::nx::doc::PartAttribute :attribute @version -slotclass ::nx::doc::PartAttribute } - EntityClass create @command -superclass Entity { + EntityClass create @command -superclass Entity -mixin ContainerEntity::Containable { :attribute @param -slotclass ::nx::doc::PartAttribute { set :part_class @param } @@ -550,7 +587,8 @@ } EntityClass create @object \ - -superclass Entity { + -superclass Entity \ + -mixin ContainerEntity::Containable { :attribute @author -slotclass ::nx::doc::PartAttribute :forward @method %self @object-method @@ -577,54 +615,56 @@ } } - EntityClass create @class -superclass @object { - :attribute @superclass -slotclass ::nx::doc::PartAttribute - - :forward @param %self @class-param - :attribute @class-param -slotclass ::nx::doc::PartAttribute { - set :part_class @param - } - - :forward @method %self @class-method - :attribute @class-method -slotclass ::nx::doc::PartAttribute { - set :part_class @method - :method require_part {domain prop value} { - # TODO: verify whether these scoping checks are sufficient - # and/or generalisable: For instance, is the scope - # requested (from the part_attribute) applicable to the - # 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]'" + EntityClass create @class \ + -superclass @object \ + -mixin ContainerEntity::Containable { + :attribute @superclass -slotclass ::nx::doc::PartAttribute + + :forward @param %self @class-param + :attribute @class-param -slotclass ::nx::doc::PartAttribute { + set :part_class @param } - next - } - } - - :method inherited {member} { - if {[${:name} info is class]} { - set inherited [dict create] - foreach c [lreverse [${:name} info heritage]] { - set entity [[::nsf::current class] id $c] - if {![::nsf::is $entity object]} continue - if {[$entity eval [list info exists :${member}]]} { - dict set inherited $entity [$entity $member] + + :forward @method %self @class-method + :attribute @class-method -slotclass ::nx::doc::PartAttribute { + set :part_class @method + :method require_part {domain prop value} { + # TODO: verify whether these scoping checks are sufficient + # and/or generalisable: For instance, is the scope + # requested (from the part_attribute) applicable to the + # 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]'" + } + next } } - return $inherited + + :method inherited {member} { + if {[${:name} info is class]} { + set inherited [dict create] + foreach c [lreverse [${:name} info heritage]] { + set entity [[::nsf::current class] id $c] + if {![::nsf::is $entity object]} continue + if {[$entity eval [list info exists :${member}]]} { + dict set inherited $entity [$entity $member] + } + } + return $inherited + } + } } - } - } - + # @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 @@ -1204,7 +1244,7 @@ } else { set additions [dict keys [dict get $additions objects]] } - # puts stderr ADDITIONS=$additions + # puts stderr ADDITIONS=$additions } set blocks [:comment_blocks $script] # :log "blocks: '$blocks'" @@ -1241,7 +1281,7 @@ # scripts. The process=@object ressembles some ::nx::doc # methods, so relocated and call the parser from within. set entity [@ $kind $addition] - ::nx::doc::CommentBlockParser process=$kind $entity + :process=$kind $entity } } @@ -1338,7 +1378,48 @@ }; # analyze_initcmd method + # TODO: how can I obtain some reuse here when later @class is + # distinguished from @object (dispatch along the inheritance + # hierarchy?) + :method process=@class {entity} { + set name [$entity name] + foreach methodName [${name} info methods -methodtype scripted] { + # TODO: should the comment_blocks parser relocated? + set blocks [:comment_blocks [${name} info method \ + body $methodName]] + foreach {line_offset block} $blocks { + if {$line_offset > 1} break; + set id [$entity @class-method $methodName] + CommentBlockParser process \ + -partof_entity $entity \ + -initial_section description \ + -entity $id \ + $block + } + :process=@object $entity object + } + } + :method process=@object {entity {scope ""}} { + set name [$entity name] + + foreach methodName [${name} {*}$scope info methods\ + -methodtype scripted] { + + set blocks [:comment_blocks [${name} {*}$scope info method \ + body $methodName]] + foreach {line_offset block} $blocks { + if {$line_offset > 1} break; + set id [$entity @object-method $methodName] + CommentBlockParser :process \ + -partof_entity $name \ + -initial_section description \ + -entity $id \ + $block + } + } + } + # activate the recoding of initcmds ::nsf::configure keepinitcmd true @@ -1411,11 +1492,21 @@ # rather: *.html.tmpl -> *.html. [file extension] just returns # the trailing extension. set ext [lindex [split [file tail $tmpl] .] end-1] - set entities [concat [sorted [@package info instances] name] \ - [sorted [@command info instances] name] \ - [sorted [@object info instances] name]] + set top_level_entities [$project owned_parts] + if {[dict exists $top_level_entities @package]} { + foreach p [dict get $top_level_entities @package] { + foreach {entity_type pkg_entities} [$p owned_parts] { + dict lappend top_level_entities $entity_type {*}$pkg_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]] set init [subst -nocommands { set project $project + array set "" [list $top_level_entities] }] set project_path [file join $outdir [string trimleft [$project name] :]] if {![catch {file mkdir $project_path} msg]} { @@ -1427,7 +1518,10 @@ set index [$project render -initscript $init $tmpl] # puts stderr "we have [llength $entities] documentation entities ($entities)" :write $index [file join $project_path "index.$ext"] - foreach e $entities { + set values [join [dict values $top_level_entities]] + 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]" @@ -1551,58 +1645,6 @@ }; # CommentBlockParser->process() - # TODO: how can I obtain some reuse here when later @class is - # distinguished from @object (dispatch along the inheritance - # hierarchy?) - :object method process=@class {entity} { - set name [$entity name] - foreach methodName [${name} info methods -methodtype scripted] { - # TODO: should the comment_blocks parser relocated? - set blocks [doc comment_blocks [${name} info method \ - body $methodName]] - foreach {line_offset block} $blocks { - if {$line_offset > 1} break; - set id [$entity @class-method $methodName] - :process \ - -partof_entity $entity \ - -initial_section description \ - -entity $id \ - $block - } - :process=@object $entity object - } - } - - :object method process=@object {entity {scope ""}} { - set name [$entity name] - # - # process the initcmd ! - # - - # if {[$name eval {info exists :__initcmd}]} { - # doc analyze_initcmd @object $name [$name eval {set :__initcmd}] - # } - - foreach methodName [${name} {*}$scope info methods\ - -methodtype scripted] { - - set blocks [doc comment_blocks [${name} {*}$scope info method \ - body $methodName]] - foreach {line_offset block} $blocks { - if {$line_offset > 1} break; - set id [$entity @object-method $methodName] - :process \ - -partof_entity $name \ - -initial_section description \ - -entity $id \ - $block - } - } - } - # :method process=@method args {method_entity} { - - # } - } Class create CommentBlockParsingState -superclass Class { Index: library/nx/nx.tcl =================================================================== diff -u -N -r851e2c38fe3ae9d84f531605d55defe2e1308a02 -rdbddbce63d4a499de52ff07fdc63c02017960c79 --- library/nx/nx.tcl (.../nx.tcl) (revision 851e2c38fe3ae9d84f531605d55defe2e1308a02) +++ library/nx/nx.tcl (.../nx.tcl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) @@ -3,8 +3,8 @@ # The Next Scripting Language is a compact and expressive object-oriented language # extension for Tcl. The object system model is highly influenced by # CLOS. This package provides the basic object system for the Next -# language. It defines the basic language entities {{@object ::nx::Object}} and -# {{@object ::nx::Class}}, as well as essential language primitives +# language. It defines the basic language entities {{@class ::nx::Object}} and +# {{@class ::nx::Class}}, as well as essential language primitives # (e.g., {{@command ::nx::next}} and {{@command ::nx::self}}). # # @require Tcl @@ -24,22 +24,22 @@ # First create the ::nx object system. # - # @object ::nx::Object + # @class ::nx::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. - # @object ::nx::Class + # @class ::nx::Class # # A class defines a family of object types which own a common set of - # attributes (see {{@object ::nx::Attribute}}) and methods. Classes + # attributes (see {{@class ::nx::Attribute}}) and methods. Classes # are organised according to their similarities and differences in # classification hierarchies. This object represents the root # meta-class in the "Next" object system. # - # @superclass ::nx::doc::entities::object::nx::Object + # @superclass ::nx::doc::entities::class::nx::Object # @method ::nx::Class#alloc # @@ -1024,24 +1024,24 @@ } namespace eval ::nx { - # @object ::nx::Slot + # @class ::nx::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 # object in an inter-object relation (e.g., in system slots). The # predefined system slots are {{{class}}}, {{{superclass}}}, # {{{mixin}}}, and {{{filter}}}. These slots appear as methods of - # {{@object ::nx::Object}} or {{@object ::nx::Class}}. The slots + # {{@class ::nx::Object}} or {{@class ::nx::Class}}. The slots # provide a common getter and setter interface. Every multivalued # slot provides e.g. a method {{{add}}} to append a value to the # list of values, and a method {{{delete}}} which removes it. # - # @superclass ::nx::doc::entities::object::nx::Object + # @superclass ::nx::doc::entities::class::nx::Object MetaSlot create ::nx::Slot - # @object ::nx::ObjectParameterSlot + # @class ::nx::ObjectParameterSlot # - # @superclass ::nx::doc::entities::object::nx::Slot + # @superclass ::nx::doc::entities::class::nx::Slot MetaSlot create ::nx::ObjectParameterSlot ::nsf::relation ObjectParameterSlot superclass Slot @@ -1563,7 +1563,7 @@ ############################################ ::nsf::invalidateobjectparameter MetaSlot - # @object ::nx::Attribute + # @class ::nx::Attribute # # Attribute slots are used to manage the access, mutation, and # querying of instance variables. One defines Attribute slots @@ -1588,7 +1588,7 @@ # @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::object::nx::ObjectParameterSlot + # @superclass ::nx::doc::entities::class::nx::ObjectParameterSlot MetaSlot create ::nx::Attribute -superclass ObjectParameterSlot Index: tests/doc.tcl =================================================================== diff -u -N -r6458c13882afd52e8719ee0e0e054b42e9aee696 -rdbddbce63d4a499de52ff07fdc63c02017960c79 --- tests/doc.tcl (.../doc.tcl) (revision 6458c13882afd52e8719ee0e0e054b42e9aee696) +++ tests/doc.tcl (.../doc.tcl) (revision dbddbce63d4a499de52ff07fdc63c02017960c79) @@ -527,9 +527,11 @@ # # core documentation # - set path [file join [::nsf::tmpdir] NextScriptingFramework] - if {[file exists $path]} { - file delete -force $path + foreach path [list [file join [::nsf::tmpdir] NextScriptingFramework] \ + [file join [::nsf::tmpdir] NextScriptingLanguage]] { + if {[file exists $path]} { + file delete -force $path + } } set i [interp create] @@ -547,11 +549,22 @@ -namespace "::nsf"] doc process -noeval true generic/predefined.tcl - + ::nx::doc::make doc \ -renderer ::nx::doc::TemplateData \ -outdir [::nsf::tmpdir] \ -project $project + + set project [::nx::doc::@project new \ + -name ::NextScriptingLanguage \ + -url http://www.next-scripting.org/ \ + -version 1.0.0a \ + -namespace "::nx"] + doc process -noeval true library/nx/nx.tcl + ::nx::doc::make doc \ + -renderer ::nx::doc::TemplateData \ + -outdir [::nsf::tmpdir] \ + -project $project } interp delete $i