Index: doc/index.html =================================================================== diff -u -r261afd3f6e91b27144e6614a535518bbec6d5cde -rdb31aba05701517b161d7633e64d5af925358ee0 --- doc/index.html (.../index.html) (revision 261afd3f6e91b27144e6614a535518bbec6d5cde) +++ doc/index.html (.../index.html) (revision db31aba05701517b161d7633e64d5af925358ee0) @@ -23,7 +23,7 @@

Index: doc/langRef2.xotcl =================================================================== diff -u --- doc/langRef2.xotcl (revision 0) +++ doc/langRef2.xotcl (revision db31aba05701517b161d7633e64d5af925358ee0) @@ -0,0 +1,138 @@ +package req xotcl::doc-tools + +namespace eval ::xodoc-tools { + + @ xotclCmd ::xotcl::self { + The command [:cmd ${:name}] returns callstack related information + } { + :variant self { + [:cmd ${:name}] returns the name of the object, which is currently executed. + If it is called from outside of an XOTcl method, it returns an error. + } + + :variant "self class" { + [:cmd ${:name}] returns the name of the class, which + holds the currently executing method. Note, that this may be + different to the class of the current object. If it is called from + an object specific method it returns an empty string. + } + + :variant "self method" { + [:cmd ${:name}] returns the name of the currently executing method. + } + + :variant "self callingclass" { + [:cmd ${:name}] returns the name of the class that has + called the executing method. + } + + :variant "self callingobject" { + [:cmd ${:name}] returns the name of the object that has + the object that has called the executing method. + } + + :variant "self callingmethod" { + [:cmd ${:name}] returns the name of the method + that has called the executing method. + } + + :variant "self calledclass" { + [:cmd ${:name}] returns the class name of the + class that holds the target method (in mixins and filters). + } + + :variant "self calledmethod" { + [:cmd ${:name}] returns the name of the target called + method (only applicable in a filter). + } + + :variant "self isnextcall" { + [:cmd ${:name}] returns 1 if this method + was invoked via next, otherwise 0. + } + + :variant "self next" { + [:cmd ${:name}] returns the "next" method on the precedence path. + } + + :variant "self filterreg" { + [:cmd ${:name}] returns the name + of the object/class on which the filter is registered. + } + + :variant "self callinglevel" { + [:cmd ${:name}] returns the calling level, from where + the actual method was called from. Intermediary next calls are ignored + in this computation. The level is returned in a form + that can be used as first argument in [:cmd uplevel] or [:cmd upvar]. + } + + :variant "self activelevel" { + [:cmd ${:name}] returns the level, from where + the actual method was invoked from. This might be the calling level or a next + call, whatever is higher in the stack. The level is returned in a form + that can be used as first argument in [:cmd uplevel] or [:cmd upvar]. + } + } + + + @ xotclCmd ::xotcl::alias -arguments { + object -per-object:switch methodName -nonleaf:switch -objscope:switch cmd + } { + The command [:cmd ${:name}] is used to register a Tcl command as method for + an object or class. + } { + :param object {is the object or class, on which the command + is registered as a method} + :param -per-object {if provided, the method is an per-object + method (not inheritable)} + :param methodName {the name for the method to be added} + :param -nonleaf:switch {if provided, the method will have a call + stack entry such it can call [:cmd next]} + :param -objscope:switch {if provided, the variables created during + the execution of the method will be instance variables} + :param cmd {is the Tcl command to be registered as method} + } + + + @ xotclClass ::xotcl2::Object { + This class holds the pre-defined methods available for all XOTcl 2 + objects. These methods are also available on XOTcl 2 classes. + } + + # + # alias + # + + @ xotclMethod alias -partof ::xotcl2::Object \ + -arguments {-nonleaf:switch -objscope:switch methodName cmd} \ + { + This method is used to register an existing Tcl command as + a method for a class or object. + } { + :param "-nonleaf:switch" {} -use ::xotcl::alias + :param "-objscope:switch" {} -use ::xotcl::alias + :param "methodName" {} -use ::xotcl::alias + :param "cmd" {} -use ::xotcl::alias + :returns "Fully qualified method name" + } + + # + # setter + # + + @ xotclMethod setter -partof ::xotcl2::Object \ + -arguments {methodName} { + Register a method as a setter for same-named instance variables + } { + :param methodName {the name for the method to be added} + :returns "Fully qualified method name" + } + + @ xotclClass ::xotcl2::Class { + } +} + + +::xodoc-tools::make all +::xodoc-tools::make doc Index: doc/sample-source.xotcl =================================================================== diff -u --- doc/sample-source.xotcl (revision 0) +++ doc/sample-source.xotcl (revision db31aba05701517b161d7633e64d5af925358ee0) @@ -0,0 +1,72 @@ +package require XOTcl 2 +::xotcl::use xotcl2 + +package require xotcl::doc-tools + +Class create Foo { + + # The class Foo defines the behaviour for all Foo objects + + # @attribute attr + # + # This attribute is wonderful + :attribute attr1 + + # @method m + # + # The method m is just a small class to demonstrate documentation of + # an method inside of an init block. + # + # @param a sample argument 1 + # @param b sample argument 2 + # @param c sample argument 3 + # + # @returns empty + :method m {a b c} { + puts hello + } + + :method m2 {a b c} { + puts hello + # an arbitrary comment + } + + :method setter {methodName} { + # Register a method as a setter for same-named instance variables + # + # @param methodName the name for the method to be added + # @returns Fully qualified method name + ..... + } + + :object method osetter {methodName} { + # Register an object method setter for same-named instance variables + # + # @param methodName the name for the method to be added + # @returns Fully qualified method name + + set x 1 + ..... + } + + # @object-method foo + # + # this is a method defined via alias + # + # @param name name of variable + # @param ?value? optional value + # @returns value of variable + :object alias foo ::set + + # @method bar + # + # is a method defined via forwarder + # + # @param x the input value1 + # @param y the input value2 + # @returns some other value + :forward bar ::o +} + +::xodoc-tools::make all +::xodoc-tools::make doc Index: library/lib/doc-tools.xotcl =================================================================== diff -u --- library/lib/doc-tools.xotcl (revision 0) +++ library/lib/doc-tools.xotcl (revision db31aba05701517b161d7633e64d5af925358ee0) @@ -0,0 +1,541 @@ +package provide xotcl::doc-tools 0.1 +package require XOTcl + +# +# Study for documentation classes for XOTcl2. +# +# Compared to the "old" @ docmentation effort, this is a rather +# light-weight structure based on xotcl 2 language features. The +# documentation classes build an (extensible) object structure which +# is used as a basis for some renderers. In general, the classes are +# defined in a way they can be used for +# +# a) building documentation outside the source code artefacts, or +# +# b) inside code artefacts (value added method definition commands +# providing extra arguments for the documentation). The +# documentation commands could reuse there names/arguments +# etc. directly from the method definition by issueing these +# commands inside the method definition methods. +# +# One could provide lint-like features to signal, whether the +# documentation is in sync with actually defined methods (when these +# are available). +# + +namespace eval ::xodoc {} +namespace eval ::xodoc-tools { + ::xotcl::use xotcl2 + + # + # A few helper commands: + # - "@" is a conveniant way for creating new objects with less syntactic overhead + # - "sorted" is used to sort instances by values of a specified attribute + # + proc @ {class name args} {$class new -name $name {*}$args} + + proc sorted {instances sortedBy} { + set order [list] + foreach v $instances {lappend order [list $v [$v eval [list set :$sortedBy]]]} + set result [list] + foreach pair [lsort -index 1 $order] {lappend result [lindex $pair 0]} + return $result + } + + Class create DocClass -superclass Class { + # + # DocClass is a meta class for named doc entities + # + :method createOrConfigure {id arguments} { + namespace eval $id {} + if {[::xotcl::objectproperty $id object]} { + $id configure {*}$arguments + } else { + :create $id {*}$arguments + } + } + } + + + Class create docEntity { + # + # docEntity is the base class for the documentation classes + # + + # every docEntity must be created with a "doc" value and can have + # an optional initcmd + :method objectparameter args {next {doc __initcmd:initcmd,optional}} + + :attribute doc + + #the following two cases (incremental multivalued) could be nicer + :attribute {variants:multivalued ""} {set :incremental 1} + :attribute {params:multivalued ""} {set :incremental 1} + + # @method _doc + # + # The method _doc can be use to obtain the value of the documentation + # from another doc entity. This should avoid redundant documentation pieces. + :method _doc {doc use what value} { + if {$doc ne ""} {return $doc} + if {$use ne ""} { + foreach thing {xotclCmd xotclClass} { + set docobj [$thing id $use] + if {[::xotcl::objectproperty $docobj object]} break + } + if {[::xotcl::objectproperty $docobj object]} { + if {![$docobj exists $what]} {error "no attribute $what in $docobj"} + set names [list] + foreach v [$docobj $what] { + if {[$v name] eq $value} {return [$v doc]} + lappend names [$v name] + } + error "can't use $use, no $what with name $value in $docobj (available: $names)" + } else { + error "can't use $use, no documentation object $docobj" + } + } + } + + # @method param + # + # The method param is currently used for documenting parameters of + # tcl-commands and xotcl methods. Most probably, it should cover + # object parameters as well. The parameters are identified by a + # name and ar part of another documentation entitiy + # + :method param {param doc {-use ""}} { + set flags [list -param $param] + if {[llength $param]>1} { + lappend flags -default [lindex $param 1] + set param [lindex $param 0] + } + set name $param + if {[regexp {^(.*):(.*)$} $param _ name spec]} { + lappend flags -spec $spec + } + lappend flags -fullname param + @ xotclCmdParam $name -partof [self] {*}$flags [:_doc $doc $use params $name] + } + + # @method variant + # + # variants are used in cases, where depending on a parameter, the + # semantics of a command (and therefore its documentation) is + # completely different. A typical case are subcommands in Tcl. + # + :method variant {name doc {-use ""}} { + @ xotclCmdVariant $name -partof [self] [:_doc $doc $use variants $name] + } + + # @method text + # + # text is used to access the content of doc of an docEntity, and + # performs substitution on it. The substitution is not essential, + # but looks for now convenient. + # + :method text {} {subst ${:doc}} + } + + # @class docPart + # + # An docPart is a part of the documentation, defined by a + # separate object. Every docPart is associated to another + # documentation entity and is identified by a name. + # + Class create docPart -superclass docEntity { + #:method objectparameter args {next {doc -use}} + :attribute name:required + :attribute partof:required + :attribute use + } + + # + # variant and param are docParts: + # + Class create xotclCmdVariant -superclass docPart { + :method init {} {${:partof} variants add [self] end} + } + Class create xotclCmdParam -superclass docPart { + :attribute param + :attribute fullname + :attribute spec + :attribute default + :method init {} {${:partof} params add [self] end} + } + + + # + # Now, define some kinds of docEntities. The toplevel docEntities + # are named objects in the ::xoDoc namespace to ease access to it. + # + # We define here the following toplevel docEntities (e.g. xotclObject will follow): + # - xotclCmd + # - xotclClass + # + # The xotcl methods are defined as docParts. + # - xotclMethod + # + + DocClass create xotclCmd -superclass docEntity { + :attribute name + :attribute arguments + :attribute {returns ""} + :object method id {name} {return ::xodoc::cmd::[string trimleft $name :]} + :object method new args { + foreach {att value} $args {if {$att eq "-name"} {set name $value}} + :createOrConfigure [:id $name] $args + } + } + + DocClass create xotclClass -superclass docEntity { + :attribute name + :attribute {methods:multivalued ""} {set :incremental 1} + :object method id {name} {return ::xodoc::object::[string trimleft $name :]} + :object method new args { + foreach {att value} $args {if {$att eq "-name"} {set name $value}} + :createOrConfigure [:id $name] $args + } + } + + # + # xotclMethod 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. + # + DocClass create xotclMethod -superclass docPart { + :attribute {scope class} + :attribute {modifier public} + :attribute arguments + :attribute {returns ""} + :object method id {partof scope name} { + return ::xodoc::method::[string trimleft $partof :]::${scope}::${name} + } + + :object method new args { + foreach {att value} $args { + if {$att eq "-partof"} {set partof $value} + if {$att eq "-name"} {set name $value} + if {$att eq "-scope"} {set scope $value} + } + if {![info exists scope]} { + if {[::xotcl::objectproperty $partof class]} { + set scope class + } elseif {[::xotcl::objectproperty $partof object]} { + set scope object + } else { + set scope class + } + } + :createOrConfigure [:id $partof $scope $name] $args + } + + :method init {} {[xotclClass id ${:partof}] methods add [self] end} + + :method signature {} { + if {[info exists :arguments]} { + set arguments ${:arguments} + } else { + set arguments [list] + foreach p [:params] {lappend arguments [$p param]} + } + set result "obj ${:name} $arguments" + } + } +} + + + +namespace eval ::xodoc-tools { + + # + # Provide a simple HTML renderer. For now, we make our life simple + # by defining for the different supported docEntities different methods. + # + # We could think about a java-doc style renderer... + # + + Class create HTMLrenderer { + # render command pieces in the text + :method cmd {text} {return <@TT>$text} + + # + # render xotcl commands + # + :method renderCmd {} { + puts "

  • [:cmd ${:name}]
    \n[:text]" + set variants [sorted [:variants] name] + if {$variants ne ""} { + puts " " + } + set params [:params] + if {$params ne ""} { + puts " " + } + puts "
  • \n" + } + + # + # render xotcl classes + # + :method renderClass {} { + puts "
  • [:cmd ${:name}]
    \n[:text]" + set methods [sorted [:methods] name] + if {$methods ne ""} { + puts "
    Methods of ${:name}:\n " + puts "
    Object Methods of ${:name}:\n " + } + puts "
  • \n" + } + + # + # render xotcl methods + # + :method renderMethod {} { + puts "
  • [:cmd [:signature]]
    \n[:text]" + set params [:params] + if {$params ne ""} { + puts " " + } + if {${:returns} ne ""} { + puts " Returns: ${:returns}" + } + puts "\n" + } + + } + +} + +# +# post processor for initcmds and method bodies +# +namespace eval ::xodoc-tools { + + Object create postprocessor { + + :method process {thing} { + if {[::xotcl::objectproperty $thing class]} { + if {[$thing exists __initcmd]} { + :analyze_initcmd xotclClass $thing [$thing eval {set :__initcmd}] + } + } elseif {[::xotcl::objectproperty $thing object]} { + puts "can't postprocess objects currently" + } else { + puts "no idea how to postprocess $thing" + } + } + + :method analyze_line {line} { + if {[regexp {^\s*$} $line]} { + return 1 + } elseif {[regexp {^\s*#} $line]} { + return 2 + } else { + return 3 + } + } + + :method remove_comment_markup {comment} { + regsub -all -line {^\s*#} $comment "" comment + return $comment + } + + :method analyze_comment_block {comment} { + set result [list] + set text "" + foreach line [split $comment \n] { + if {[regexp {^ *@(class|attribute|param|returns|method|object-method) (.*)$} $line _ kind value]} { + if {$kind eq "param"} { + if {[regexp {^\s*(\S+)\s+(.*)$} $value _ name desc]} { + set value [list $name $desc] + } else { + puts stderr "invialid param specification $value" + } + } + lappend result $kind $value + } else { + append text $line + } + } + lappend result text $text + #puts result=$result + return $result + } + + :method comment_blocks {{-mode all} source} { + set comment_blocks [list] + set lines [split $source \n] + + # states + # 1 empty line + # 2 (pseudo) comment + # 3 code + + set behaviour(all) { + 1,1 {} + 1,2 {set comment $line\n} + 1,3 {} + 2,1 {lappend comment_blocks [:remove_comment_markup $comment]} + 2,2 {append comment $line\n} + 2,3 {lappend comment_blocks [:remove_comment_markup $comment]} + 3,1 {} + 3,2 {set comment $line\n} + 3,3 {} + } + set behaviour(first) { + 1,1 {} + 1,2 {set comment $line\n} + 1,3 {set code 1} + 2,1 {if {!$code} {lappend comment_blocks [:remove_comment_markup $comment]}} + 2,2 {append comment $line\n} + 2,3 {if {!$code} {lappend comment_blocks [:remove_comment_markup $comment]}; set code 1} + 3,1 {} + 3,2 {set comment $line\n} + 3,3 {} + } + array set actions $behaviour($mode) + set state 1 + set code 0 + foreach line $lines { + set nextstate [:analyze_line $line] + eval $actions($state,$nextstate) + set state $nextstate + } + + return $comment_blocks + } + + :method analyze_method_block {-methodName -partof -scope -arguments analyzed_block} { + array set cb $analyzed_block + + @ xotclMethod $methodName -partof $partof -scope $scope $cb(text) + set m [xotclMethod id $partof $scope $methodName] + set docparams [list] + foreach {att value} $analyzed_block { + # we do not handle "use" yet + if {$att eq "param"} { + $m param [lindex $value 0] [lindex $value 1] + lappend docparams [lindex $value 0] + } elseif {$att eq "returns"} { + $m returns $value + } + } + if {$arguments eq ""} { + set arguments $docparams + } + $m arguments $arguments + } + + :method analyze_body {-partof -methodName -scope arguments body} { + set blocks [:comment_blocks -mode first $body] + if {[llength $blocks] > 0} { + :analyze_method_block -methodName $methodName -partof $partof -scope $scope \ + -arguments $arguments \ + [:analyze_comment_block [lindex $blocks 0]] + } + } + + :method analyze_initcmd {docKind name initcmd} { + set first_block 1 + foreach block [:comment_blocks $initcmd] { + set analyzed_block [:analyze_comment_block $block] + array unset cb + array set cb $analyzed_block + if {$first_block} { + set first_block 0 + if {[array size cb] == 1} { + # we got a comment for the doc kind + @ $docKind $name $cb(text) + continue + } + } + + if {[info exists cb(method)] || [info exists cb(object-method)]} { + set arguments "" + + if {[info exists cb(method)]} { + set methodName $cb(method) + set scope class + catch {set arguments [$name info method args $methodName]} + } else { + set methodName $cb(object-method) + set scope object + catch {set arguments [$name object info method args $methodName]} + } + + :analyze_method_block -methodName $methodName -partof $name -scope $scope \ + -arguments $arguments $analyzed_block + } + } + + foreach methodName [$name info methods -methodtype scripted] { + :analyze_body -partof $name -methodName $methodName -scope class \ + [$name info method args $methodName] \ + [$name info method body $methodName] + } + + foreach methodName [$name object info methods -methodtype scripted] { + :analyze_body -partof $name -methodName $methodName -scope object \ + [$name object info method args $methodName] \ + [$name object info method body $methodName] + } + + } + + # activate the recoding of initcmads + ::xotcl::configure keepinitcmd true + } +} + +# +# toplevel interface +# ::xodoc-tool::make all +# ::xodoc-tool::make doc +# +namespace eval ::xodoc-tools { + + Object create make { + + :method all {{-verbose:switch} {-class ::xotcl2::Class}} { + foreach c [$class info instances -closure] { + if {$verbose} {puts "postprocess $c"} + ::xodoc-tools::postprocessor process $c + } + } + + :method doc {{-renderer ::xodoc-tools::HTMLrenderer}} { + + # register the HTML renderer for all docEntities. + + docEntity mixin add $renderer + + puts "

    Primitive XOTcl framework commands

    \n\n\n" + + puts "

    XOTcl Classes

    \n\n\n" + + docEntity mixin delete $renderer + } + } + +} +puts stderr "Doc Tools loaded: [info command ::xotcl-tools]" \ No newline at end of file Index: library/lib/make.xotcl =================================================================== diff -u -rc0df808e0c4f79c4c2296174c22cfb331eb4c8f1 -rdb31aba05701517b161d7633e64d5af925358ee0 --- library/lib/make.xotcl (.../make.xotcl) (revision c0df808e0c4f79c4c2296174c22cfb331eb4c8f1) +++ library/lib/make.xotcl (.../make.xotcl) (revision db31aba05701517b161d7633e64d5af925358ee0) @@ -20,7 +20,7 @@ if {[string match "*package provide*" $c]} { lappend fls $f } } } - + set so [glob -nocomplain *[info sharedlibextension]] # loading libxotcl into xotclsh crashes on some systems foreach lib [list libxotcl$::xotcl::version[info sharedlibextension] \ @@ -39,8 +39,8 @@ file delete -force pkgIndex.tcl } #puts stderr "callinglevel <[self callinglevel]> $fls" - #puts stderr "[pwd]:\n\tcall eval pkg_mkIndex -direct . $fls" - if {[catch {pkg_mkIndex -direct . {*}$fls} errs]} { + #puts stderr "[pwd]:\n\tcall eval pkg_mkIndex -verbose -direct . $fls" + if {[catch {pkg_mkIndex -verbose -direct . {*}$fls} errs]} { puts stderr "!!! $errs" } #puts stderr "[pwd] done" Index: library/lib/pkgIndex.tcl =================================================================== diff -u -rc0df808e0c4f79c4c2296174c22cfb331eb4c8f1 -rdb31aba05701517b161d7633e64d5af925358ee0 --- library/lib/pkgIndex.tcl (.../pkgIndex.tcl) (revision c0df808e0c4f79c4c2296174c22cfb331eb4c8f1) +++ library/lib/pkgIndex.tcl (.../pkgIndex.tcl) (revision db31aba05701517b161d7633e64d5af925358ee0) @@ -9,6 +9,7 @@ # full path name of this file's directory. package ifneeded xotcl1 1.0 [list source [file join $dir xotcl1.xotcl]] +package ifneeded xotcl::doc-tools 0.1 [list source [file join $dir doc-tools.xotcl]] package ifneeded xotcl::htmllib 0.1 [list source [file join $dir htmllib.xotcl]] package ifneeded xotcl::metadataAnalyzer 0.84 [list source [file join $dir metadataAnalyzer.xotcl]] package ifneeded xotcl::mixinStrategy 0.9 [list source [file join $dir mixinStrategy.xotcl]]