[:for method ${:@method} {
-
+
+
[:? {[$method exists @return]} {<[[$method @return] spec]>} ]
+ [$method name]
+ [$method parameters]
+
[$method text]
@@ -71,9 +109,14 @@
[:for param [$method @param] {
[$param name]
- <[:? {[$param exists spec]} {[$param spec]}]>
+ [:? {[$param exists spec] && [$param spec] ne ""} {<[$param spec]>}]
[$param text]
+ [:? {[$param exists default]} {
+
+ Default Value: [$param default]
+
+ }]
}]
@@ -84,7 +127,6 @@
- Returns:
- [$rparam name]
- [$rparam text]
@@ -107,5 +149,95 @@
}]
+ [:let imethods [:inherited @method]]
+ [:? {$imethods ne ""} {
+
+ [:for superclass [dict keys $imethods] {
+ [:let ms [dict get $imethods $superclass]]
+
+
+
+
+ [:for m $ms {
+
+ [$m name]
+
+ }]
+
+
+
+ }]
+
+
+}]
+
+[:?var :@object-method {
+
+
+
Per-object methods
+
+ [:for omethod ${:@object-method} {
+
+
+
+
[:? {[$omethod exists @return]} {<[[$omethod @return] spec]>} ]
+ [$omethod name]
+ [$omethod parameters]
+
+
+ [$omethod text]
+
+
+
+
+ [:? {[$omethod exists @param]} {
+
+ - Method parameters:
+ [:for param [$omethod @param] {
+ -
+
[$param name]
+ [:? {[$param exists spec] && [$param spec] ne ""} {<[$param spec]>}]
+
+ [$param text]
+
+ }]
+
+ }]
+
+ [:? {[$omethod exists :@return]} {
+ [:let rparam [$omethod @return]]
+
+ - Returns:
+
+
+ - [$rparam text]
+
+ }]
+
+
+ [:? {[$omethod exists :@deprecated]} {
+
+ Deprecated [$method @deprecated]
+
+ }]
+
+
+
+
+
+
+
+ }]
+
+
+
+}]
Index: library/lib/doc-tools.xotcl
===================================================================
diff -u -rcda7278a163020684b886f41aec71c90a2c39535 -r29239ea82b8a38f1100335b3fa8ad7798872d2e3
--- library/lib/doc-tools.xotcl (.../doc-tools.xotcl) (revision cda7278a163020684b886f41aec71c90a2c39535)
+++ library/lib/doc-tools.xotcl (.../doc-tools.xotcl) (revision 29239ea82b8a38f1100335b3fa8ad7798872d2e3)
@@ -36,15 +36,55 @@
# @param class Request an instance of a particular entity class (e.g., @package)
# @param name What is the entity name (e.g., next::doc for a package)
# @param args A vector of arbitrary arguments, provided to the entity when being constructed
+ # @return The identifier of the newly created entity object
+
+ # @subcommand ::nx::doc::@#foo
+ #
+ # This is the first subcommand foo of "@"
+ # {{{
+ # set do 1;
+ # }}}
+ #
+ # @param -param1 do it
+ # @param param2 do it a second time
+ # @return Gives you a "foo" object
+
+ # @subcommand ::nx::doc::@#bar
+ #
+ # This is the second subcommand bar of "@"
+ #
+ # @param -param1 do it
+ # @param param2 do it a second time
+ # @return Gives you a "bar" object
+
proc @ {class name args} {$class new -name $name {*}$args}
+
# @command ::nx::doc::sorted
#
# This proc is used to sort instances by values of a specified
- # attribute
+ # attribute. {{{ set
+ # code 1; puts stderr $code; puts stderr [info script]; set l \{x\}
+ # }}} Und nun gehen wir in eine zweite Zeile ...
#
+ # ... um nach einem Zeilenbruch weiterzumachen
+ # {{{
+ # \# Some comment
+ # set instances [list [Object new] [Object new]]
+ # ::nx::doc::sorted $instances; set l {{{x}}}; # Some comment
+ # {{{ }}}
+ # set instances [list [Object new] [Object new]]
+ # ::nx::doc::sorted $instances
+ # }}}
+ # Here it goes wider ...
+ # {{{
+ # set instances [list [Object new] [Object new]]
+ # ::nx::doc::sorted $instances
+ # }}}
+ #
# @param instances Points to a list of entity instances to sort
# @param sortedBy Indicates the attribte name whose values the sorting will be based on
+ # @return A list of sorted documentation entity instances
proc sorted {instances sortedBy} {
set order [list]
foreach v $instances {lappend order [list $v [$v eval [list set :$sortedBy]]]}
@@ -53,12 +93,33 @@
return $result
}
-
+ # @method ::nx::doc::ExceptionClass#behind?
+ #
+ # This helper method can be used to decide whether a message
+ # caught in error propagation qualifies as a valid exception
+ # object.
+ #
+ # @param error_msg Stands for the intercepted string which assumingly represents an exception object identifier
+ # @return 0 or 1
Class create ExceptionClass -superclass Class {
+ # A meta-class which defines common behaviour for exceptions
+ # types, used to indicate particular events when processing
+ # comment blocks.
+
:method behind? {error_msg} {
return [expr {[::nx::core::is $error_msg object] && \
[::nx::core::is $error_msg type [self]]}]
}
+
+ # @method thrown_by?
+ #
+ # This helper method realises a special-purpose catch variant to
+ # safely evaluate scripts which are expected to produce exception
+ # objects
+ #
+ # @return 1 iff an exception object is caught, 0 if the script did
+ # not blow or it returned an error message not pointing to an
+ # exception object
:method thrown_by? {script} {
if {[uplevel 1 [list ::catch $script msg]]} {
return [:behind? [uplevel 1 [list set msg]]]
@@ -69,9 +130,18 @@
}
ExceptionClass create Exception {
+ # The base class for exception objects
+ #
+ # @param message An explanatory message meant for the developer
:attribute message:required
+ # @param stack_trace Contains the stack trace as saved at the time of throwing the exception object
:attribute stack_trace
-
+
+ # @method throw
+ #
+ # The method makes sure that an Exception object is propagated
+ # through the Tcl ::error mechanism, starting from the call site's
+ # scope
:method throw {} {
if {![info exists :stack_trace] && [info exists ::errorInfo]} {
:stack_trace $::errorInfo
@@ -84,31 +154,72 @@
}
ExceptionClass create StyleViolation -superclass Exception {
- #
+ # This exception indicates from within the parsing machinery that
+ # a comment block was malformed (according to the rules layed out
+ # by the statechart-like parsing specification.
}
- ExceptionClass create InvalidTag -superclass Exception
- ExceptionClass create MissingPartofEntity -superclass Exception
+ ExceptionClass create InvalidTag -superclass Exception {
+ # This exception is thrown upon situations that invalid tags are
+ # used at various levels of entity/part nesting. This usually
+ # hints at typos in tag labels or the misuse of tags in certain
+ # contexts.
+ }
+ ExceptionClass create MissingPartofEntity -superclass Exception {
+ # This exception occurs when parts are defined without providing
+ # an owning (i.e., partof) entity. This might be caused by
+ # failures in resolving this context.
+ }
Class create EntityClass -superclass Class {
+ # A meta-class for named documenation entities. It sets some
+ # shared properties (e.g., generation rules for tag names based on
+ # entity class names, ...). Most importantly, it provides the
+ # basic name-generating mechanisms for documentation entities
+ # based on properties such as entity name, root namespace, etc.
#
- # EntityClass is a meta-class for named doc entities
- #
+ # @param tag Defaults to the tag label to be used in comment tags. It may vary from the auto-generated default!
+ # @param root_namespace You may choose your own root-level namespace hosting the namespace hierarchy of entity objects
+
:attribute {tag {[string trimleft [string tolower [namespace tail [self]]] @]}}
:attribute {root_namespace "::nx::doc::entities"}
namespace eval ::nx::doc::entities {}
-
+
+ # @method id
+ #
+ # A basic generator for the characteristic ideas, based on the
+ # root_namespace, the tag label, and the fully qualified name of
+ # the documented entity
+ #
+ # @param name The name of the documented entity
+ # @return An identifier string, e.g., {{{ ::nx::doc::entities::object::ns1::Foo }}}
+ # @see tag
+ # @see root_namespace
:method id {name} {
set subns [string trimleft [namespace tail [self]] @]
return [:root_namespace]::${subns}::[string trimleft $name :]
}
:method new {-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
:createOrConfigure [:id $name] -name $name {*}$args
}
-
+
:method createOrConfigure {id args} {
+ # This method handles verifies whether an entity object based on
+ # the given id exists. If so, it returns the resolved name. If
+ # not, it provides for generating an object with the precomputed
+ # id for the first time!
+ #
+ # @param id The identifier string generated beforehand
+ # @return The identifier of the newly generated or resolved entity object
+ # @see {{@method id}}
namespace eval $id {}
if {[::nx::core::objectproperty $id object]} {
$id configure {*}$args
@@ -118,6 +229,9 @@
return $id
}
+ # @method get_unqualified_name
+ #
+ # @param qualified_name The fully qualified name (i.e., including the root namespace)
:method get_unqualified_name {qualified_name} {
return [string trim [string map [list [:root_namespace] ""] $qualified_name] ":"]
}
@@ -193,7 +307,7 @@
-name [lindex $value 0] \
-partof $domain \
-part_attribute [self] \
- -@doc [lrange $value 1 end]]
+ -@doc [lrange $value 1 end]]
}
return $value
}
@@ -226,6 +340,9 @@
# Entity is the base class for the documentation classes
#
+ # @param name
+ #
+ # gives you the name (i.e., the Nx object identifier) of the documented entity
:attribute name:required
# every Entity must be created with a "@doc" value and can have
# an optional initcmd
@@ -263,6 +380,9 @@
#
# This is an abstract hook method to be refined by the subclasses
# of Entity
+ #
+ # @param {-initial_section:optional "context"} Describes the section to parse first
+ # @return :integer Indicates the success of process the comment block
:method process {
{-initial_section:optional "context"}
-entity:optional
@@ -281,22 +401,22 @@
# performs substitution on it. The substitution is not essential,
# but looks for now convenient.
#
- :method text {} {
- # TODO: Provide \n replacements for empty lines
- if {[info exists :@doc]} {
- #
- # Here, we apply a second [join] to compensate for the @doc items
- # being lists themselves (that is, quotes etc. might be escaped)
- #
- subst [join [join ${:@doc} " "]]
+ :method text {-as_list:switch} {
+ if {[info exists :@doc] && ${:@doc} ne ""} {
+ set doc ${:@doc}
+ set non_empty_elements [lsearch -all -not -exact $doc ""]
+ set doc [lrange $doc [lindex $non_empty_elements 0] [lindex $non_empty_elements end]]
+ if {$as_list} {
+ return $doc
+ } else {
+ return [subst [join $doc " "]]
+ }
}
}
:method filename {} {
return [[:info class] tag]_[string trimleft [string map {:: __} ${:name}] "_"]
}
-
-
}
@@ -333,12 +453,21 @@
set :part_class @param
}
:attribute @return -slotclass ::nx::doc::PartAttribute {
+ :method require_part {domain prop value} {
+ set value [expr {![string match ":*" $value] ? "__out__: $value": "__out__$value"}]
+ next $domain $prop $value
+ #next $domain $prop "__out__ $value"
+ }
set :part_class @param
}
+ :attribute @subcommand -slotclass ::nx::doc::PartAttribute {
+ set :part_class @subcommand
+ }
}
EntityClass create @object \
-superclass Entity {
+ :attribute @superclass -slotclass ::nx::doc::PartAttribute
:attribute @author -slotclass ::nx::doc::PartAttribute
:attribute @method -slotclass ::nx::doc::PartAttribute {
set :part_class @method
@@ -360,7 +489,21 @@
:attribute @param -slotclass ::nx::doc::PartAttribute {
set :part_class @param
}
-
+
+ :method inherited {member} {
+ if {[${:name} info is class]} {
+ set inherited [dict create]
+ foreach c [lreverse [${:name} info heritage]] {
+ set entity [[::nx::core::current class] id $c]
+ if {![::nx::core::is $entity object]} continue;
+ if {[$entity exists :${member}]} {
+ dict set inherited $entity [$entity $member]
+ }
+ }
+ return $inherited
+ }
+ }
+
:method process {
{-initial_section:optional "context"}
-entity:optional
@@ -407,8 +550,9 @@
:attribute part_attribute
}
+ # @object ::nx::doc::@method
#
- # @method is a named entity, which is part of some other
+ # "@method" is a named entity, which is part of some other
# docEntity (a class or an object). We might be able to use the
# "use" parameter for registered aliases to be able to refer to the
# documentation of the original method.
@@ -420,20 +564,34 @@
set :part_class @param
}
:attribute @return -slotclass ::nx::doc::PartAttribute {
- set :part_class @param
- }
- :method signature {} {
+
#
- # TODO: What was the original intention of introducing arguments?!
+ # TODO: @return spec fragments should be nameless,
+ # conceptually. They represent "out" parameters with each
+ # @method being allowed to have one only. For now, we fix
+ # this by injecting a dummy name "__out__" which should not
+ # be displayed. I shall fix this later and refactor it to a
+ # shared place between @method and @command.
#
- if {[info exists :arguments]} {
- set arguments ${:arguments}
- } else {
- set arguments [list]
- foreach p [:@param] {lappend arguments [$p name]}
+ :method require_part {domain prop value} {
+ set value [expr {![string match ":*" $value] ? "__out__: $value": "__out__$value"}]
+ next $domain $prop $value
}
- set result "method ${:name} $arguments"
+ set :part_class @param
}
+ :method parameters {} {
+ set params [list]
+ if {[info exists :@param]} {
+ foreach p [:@param] {
+ set value [$p name]
+ if {[$p exists default] || [$p name] eq "args" } {
+ set value "?[$p name]?"
+ }
+ lappend params $value
+ }
+ }
+ return $params
+ }
:method process {
{-initial_section:optional "context"}
comment_block
@@ -445,21 +603,40 @@
}; # @method
- #
- # TODO: retrofit @command::Variant
- #
- Class create @variant -superclass Part
+ PartClass 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
+ # @superclass ::nx::doc::entities::object::nx::doc::Part
PartClass create @param \
-superclass Part {
: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
+
set partof_fragment [:get_unqualified_name ${partof}]
return [:root_namespace]::${:tag}::${partof_fragment}::${name}
}
+ # @object-method new
+ #
+ # The per-object method refinement indirects entity creation
+ # to feed the necessary ingredients to the name generator
+ #
+ # @param -part_attribute
+ # @param -partof
+ # @param -name
+ # @param args
:object method new {
-part_attribute
{-partof:substdefault {[[MissingPartofEntity new \
@@ -470,29 +647,39 @@
-name
args
} {
- :createOrConfigure [:id $partof $name] {*}[self args]
+
+ lassign $name name def
+ set spec ""
+ regexp {^(.*):(.*)$} $name _ name spec
+ :createOrConfigure [:id $partof $name] \
+ -spec $spec \
+ -name $name \
+ -partof $partof \
+ {*}[expr {$def ne "" ? "-default $def" : ""}] \
+ -part_attribute $part_attribute {*}$args
+
}
}
namespace export EntityClass @command @object @method @param \
@param @package @ Exception StyleViolation InvalidTag \
- MissingPartofEntity
+ MissingPartofEntity ExceptionClass
}
namespace eval ::nx::doc {
Class create TemplateData {
+ # This mixin class realises a rudimentary templating language to
+ # be used in next::doc templates. It realises language expressions
+ # to verify the existence of variables and simple loop constructs
:method render {
{-initscript ""}
template
{entity:substdefault "[self]"}
} {
- #
- # Here, we assume the -nonleaf mode being
- # active for [eval].
- #
+ # Here, we assume the -nonleaf mode being active for {{{[eval]}}}.
set tmplscript [list subst [[::nx::core::current class] read_tmpl $template]]
$entity eval [subst -nocommands {
$initscript
@@ -552,12 +739,39 @@
:method include {template} {
uplevel 1 [list subst [[::nx::core::current class] read_tmpl $template]]
}
+
+ #
+ # TODO: This should make turn into a hook, the output
+ # specificities should move in a refinement of TemplateData, e.g.,
+ # DefaultHtmlTemplateData or the like.
+ #
+ :method code {{-inline true} script} {
+ return [expr {$inline?"
$script":"
$script
"}]
+ }
+
+ :method text {} {
+ # Provide \n replacements for empty lines according to the
+ # rendering frontend (e.g., in HTML ->
) ...
+ if {[info exists :@doc]} {
+ set doc [next -as_list]
+ foreach idx [lsearch -all -exact $doc ""] {
+ lset doc $idx "
"
+ }
+ return [subst [join $doc " "]]
+ }
+ }
+
+
#
#
#
:object method find_asset_path {{-subdir lib/doc-assets}} {
+ # This helper tries to identify the file system path of the
+ # asset ressources.
+ #
+ # @param -subdir Denotes the name of the sub-directory to look for
foreach dir $::auto_path {
set assets [file normalize [file join $dir $subdir]]
if {[file exists $assets]} {
@@ -700,7 +914,7 @@
# b. intrinsic: 'thing' is a arbitrary string block describing
# a script.
#
- :method process {thing} {
+ :method process {thing args} {
# 1) in-situ processing: a class object
if {[::nx::core::objectproperty $thing object]} {
if {[$thing exists __initcmd]} {
@@ -715,22 +929,25 @@
namespace import -force ::nx::*;
::nx::Class create SourcingTracker {
:method create args {
- [::nx::core::current class] eval {
- if {[info exists :scripts]} {
- set :scripts [dict create]
- }
- }
- [::nx::core::current class] eval [list dict set :scripts [info script] _];
- next;
+ set obj [next];
+ #[::nx::core::current class] eval {
+ # if {![info exists :scripts([info script])]} {
+ #dict create :scripts
+ #dict set :scripts [info script] objects
+ # }
+ #}
+ #puts stderr "dict lappend :scripts([info script]) objects [self]"
+ [::nx::core::current class] eval [list dict set :scripts [info script] objects \$obj _]
+ return \$obj
}
}
::nx::Object mixin add SourcingTracker
package forget $thing;
package req $thing
::nx::Object mixin delete SourcingTracker
- set sourced_scripts [SourcingTracker eval {dict keys \${:scripts}}]
- foreach script \$sourced_scripts {
- doc process \$script
+ puts stderr sourced_scripts=[SourcingTracker eval {dict keys \${:scripts}}]
+ dict for {script entities} [SourcingTracker eval {set :scripts}] {
+ doc process \$script \$entities
}
}]
@@ -745,7 +962,7 @@
:log "error reading the file '$thing', i.e.: '$msg'"
}
close $fh
- doc analyze $script
+ doc analyze $script {*}$args
} else {
:log "file '$thing' not readable"
}
@@ -763,14 +980,18 @@
}
}
- :method analyze {script} {
+ :method analyze {script additions:optional} {
# NOTE: This method is to be executed in a child/ slave
# interpreter.
- set pre_commands [:list_commands]
uplevel #0 [list namespace import -force ::nx::doc::*]
+ set pre_commands [:list_commands]
uplevel #0 [list eval $script]
set post_commands [:list_commands]
- set additions [dict keys [dict remove [dict create {*}"[join $post_commands " _ "] _"] {*}$pre_commands]]
+ if {![info exists additions]} {
+ set additions [dict keys [dict remove [dict create {*}"[join $post_commands " _ "] _"] {*}$pre_commands]]
+ } else {
+ set additions [dict keys [dict get $additions objects]]
+ }
puts stderr ADDITIONS=$additions
set blocks [:comment_blocks $script]
# :log "blocks: '$blocks'"
@@ -783,7 +1004,7 @@
# not qualified, so they are set to fail. however, record the
# failing ones for the time being
if {[catch {::nx::doc::EntityClass process $block} msg]} {
- if {![StyleViolation behind? $msg] && ![MissingPartofEntity behind? $msg]} {
+ if {![InvalidTag behind? $msg] && ![StyleViolation behind? $msg] && ![MissingPartofEntity behind? $msg]} {
if {[Exception behind? $msg]} {
error [$msg info class]->[$msg message]
}
@@ -800,7 +1021,7 @@
}
}
- :method list_commands {{parent ::}} {
+ :method list_commands {{parent ""}} {
set cmds [info commands ${parent}::*]
foreach nsp [namespace children $parent] {
lappend cmds {*}[:list_commands ${nsp}]
@@ -809,9 +1030,9 @@
}
:method analyze_line {line} {
- set regex {^\s*#+[#\s]*(.*)$}
+ set regex {^[\s#]*#+(.*)$}
if {[regexp -- $regex $line --> comment]} {
- return [list 1 [string trim $comment]]
+ return [list 1 [string trimright $comment]]
} else {
return [list 0 $line]
}
@@ -832,9 +1053,9 @@
# of code. This avoids "unmatched open brace" failures when
# feeding each physical line to a list command (later, in
# the parsing machinery)
- lappend comment_block [split $text]}
+ lappend comment_block $text}
1,0 {lappend comment_blocks $line_offset $comment_block}
- 1,1 {lappend comment_block [split $text]}
+ 1,1 {lappend comment_block $text}
0,0 {}
}
array set do $spec
@@ -1007,6 +1228,7 @@
set :comment_block $block
# initialise the context object
+ #puts stderr "--- [self callingproc] -> :partof_entity $partof_entity :processed_section $initial_section block $block"
set :processed_section $initial_section
set :partof_entity $partof_entity
@@ -1059,21 +1281,21 @@
# a) unqualified: attr1
# b) qualified: Bar#attr1
if {[regexp -- {([^\s#]*)#([^\s#]*)} $name _ qualifier nq_name]} {
- # TODO: Currently, I only foresee @object as possible
- # qualifier; however, this should be fixed asap, as soon as
- # the variety of entities has been decided upon!
- set partof_entity [@object id $qualifier]
- # TODO: Also, we expect the qualifier to resolve against an
- # already existing entity object? Is this intended?
- if {[::nx::core::is $partof_entity object]} {
- return [list $nq_name $partof_entity]
- } else {
- return [list $nq_name ${:partof_entity}]
+ # TODO: Currently, I only foresee @object and @command as
+ # possible qualifiers; however, this should be fixed asap, as
+ # soon as the variety of entities has been decided upon!
+ foreach entity_type {@object @command} {
+ set partof_entity [$entity_type id $qualifier]
+ # TODO: Also, we expect the qualifier to resolve against an
+ # already existing entity object? Is this intended?
+ if {[::nx::core::is $partof_entity object]} {
+ return [list $nq_name $partof_entity]
+ }
}
+ return [list $nq_name ${:partof_entity}]
} else {
return [list $name ${:partof_entity}]
}
-
}
:object method dispatch {tag args} {
@@ -1104,13 +1326,22 @@
set :current_entity [$partof_entity $tag $nq_name {*}$args]
} else {
+ #
+ # TODO: @object-method raises some issues (at least when
+ # 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
+ # now, we just ignore and bypass this issue by allowing
+ # InvalidTag exceptions in analyze()
+ #
set qualified_tag [namespace qualifiers [self]]::$tag
if {[EntityClass info instances -closure $qualified_tag] eq ""} {
[InvalidTag new -message [subst {
The entity type '$tag' is not available
}]] throw
}
- # puts stderr "$tag new -name $nq_name {*}$args"
+ puts stderr "$tag new -name $nq_name {*}$args"
set :current_entity [$tag new -name $nq_name {*}$args]
}
} else {
@@ -1184,30 +1415,94 @@
CommentLine create tag {
:method match {line} {
- set tag [lindex $line 0]
- return [expr {[string first @ $tag] == 0}]
+ return [regexp -- {^\s*@[^[:space:]@]+} $line]
}
:method event=process {line} {
+ set line [string trimleft $line]
set tag [lindex $line 0]
[:context] dispatch $tag [lrange $line 1 end]
}
}
CommentLine create text {
+ set :is_code_block 0
+ array set :parse {
+ 0,1 {
+ # BEGIN of a code block. Insert the code start marker, a newline and the current line.
+ set l "\[:code \{\n"
+ append l $line \n
+ set line $l
+ set :is_code_block 1
+ }
+ 1,0 {
+ # END of a code block. Insert the code stop marker.
+ set l "\}\]\n"
+ append l $line
+ set line $l
+ set :is_code_block 0
+ }
+ 1,1 {
+ # WITHIN a code block. Add the line + a newline
+ append line \n
+ }
+ 0,0 {
+ # NOP
+ set line [string trimleft $line]
+ }
+ }
+
:method match {line} {
- return [regexp -- {\s*[^[:space:]@]+} $line]
+ return [regexp -- {^\s*([^[:space:]@]+|@[[:space:]@]+)} $line]
}
+
:method event=process {line} {
+ set is_intended [expr {[string first "\t" $line] != -1}]
+ eval [set :parse(${:is_code_block},$is_intended)]
[:context] dispatch @doc add $line end
}
+
+ set :markup_map(sub) {
+ "{{{" "\[:code \{"
+ "}}}" "\}\]"
+ }
+ set :markup_map(unescape) {
+ "\\{" "{"
+ "\\}" "}"
+ "\\#" "#"
+ }
+ :method event=process {line} {
+ if {[regsub -- {^\s*(\{\{\{)\s*$} $line "\[:code -inline false \{" line] || \
+ (${:is_code_block} && [regsub -- {^\s*(\}\}\})\s*$} $line "\}\]" line])} {
+ set :is_code_block [expr {!${:is_code_block}}]
+ append line \n
+ } elseif {${:is_code_block}} {
+ set line [string map ${:markup_map(unescape)} $line]
+ append line \n
+ } else {
+ set line [string map ${:markup_map(sub)} $line]
+ set line [string map ${:markup_map(unescape)} $line]
+ set line [string trimleft $line]
+ }
+ [:context] dispatch @doc add $line end
+ }
+
+ :method toggle_code_block {is_indented} {
+ set :is_code_block [expr {}]
+ }
}
CommentLine create space {
:method match {line} {
return [expr {$line eq {}}]
}
+ :method event=process {line} {
+ if {[:comment_section] eq "::nx::doc::description"} {
+ [:context] dispatch @doc add "" end
+ }
+ next
+ }
}
@@ -1236,7 +1531,7 @@
set src ${:current_comment_line}
set tgt [$src is? $line]
}
-
+ #puts stderr "---- line $line src $src tgt $tgt"
#
# TODO: realise the initial state nodes as NULL OBJECTs, this
# helps avoid conditional branching all over the place!
Index: tests/doc.xotcl
===================================================================
diff -u -rcda7278a163020684b886f41aec71c90a2c39535 -r29239ea82b8a38f1100335b3fa8ad7798872d2e3
--- tests/doc.xotcl (.../doc.xotcl) (revision cda7278a163020684b886f41aec71c90a2c39535)
+++ tests/doc.xotcl (.../doc.xotcl) (revision 29239ea82b8a38f1100335b3fa8ad7798872d2e3)
@@ -65,6 +65,7 @@
set lines {
"# @package o" 1
+ "#@package o" 1
"bla" 0
"# @object o" 1
"# 1 2 3" 1
@@ -107,15 +108,15 @@
### # # # # @object o # ####
- # 1 2 3
+ # 1 2 3
#
# # # # # 345
# # # @tag1 part1
# @tag2 part2
bla; # # # # # no comment
}
- set blocks {1 {{@package o} {1 2 3}} 5 {{@object o} {1 2 3} {} 345 {@tag1 part1} {@tag2 part2}} 17 {{@object o # ####} {1 2 3} {} 345 {@tag1 part1} {@tag2 part2}}}
+ set blocks {1 {{ @package o} { 1 2 3}} 5 {{ @object o} { 1 2 3} {} { 345} { @tag1 part1} { @tag2 part2}} 17 {{ @object o # ####} { 1 2 3} {} { 345} { @tag1 part1} { @tag2 part2}}}
? [list ::lcompare [doc comment_blocks $script] $blocks] 1
}
@@ -363,7 +364,6 @@
? [list $entity info is type ::nx::doc::@object] 1
? [list $entity text] "The class Foo defines the behaviour for all Foo objects";
? [list $entity @author] "gneumann@wu.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]
@@ -382,7 +382,6 @@
"Provides a first value"
"Provides a second value"
} {
- puts stderr PARAM=$p
? [list expr [list [$p text] eq $expected]] 1;
}