feathers

''Not to be confused with the C extension set [Feather]...'' ---- One might also look at [Expand] or the textutil::expander module of [TclLib] -- [WHD] ---- ulis: One day I was tired to write the hand-made documentation of my OOlib. So I wondered about a tool which will help me. The result is a tiny language for generating documents. I named it "feathers" and for now it generates HTML documents. But it is easy to modify it to generate nroff or rtf documents. This is great for making and displaying dynamic documents without Tk. I'm still wondering: what magic could be done with feathers and the Tcl plug-in? (feathers is free and you can do what you want with it) feathers syntax: : ' multiline string * ??... ?--? ?script? ' ??... ?--? ?multiline string? : ' monoline string "" ??... ?--? ?? : ??monoline string?...?[]?...?... : key -> generate !key -> generate : -opt val -> generate OPT="val" feathers example: # the helper feathers eval \ { proc page {page title text} \ { uplevel 1 [format \ { html * \ { head * { title {%s}; style ' {H2 {text-align: center; padding: 1em}} } body * -bgcolor #f0f0ff { h2 {%s}; !br; !br {%s} } } } $page $title $text] } } # the work puts [feathers eval {page feathers {this is an example} {of the use of [b feathers]}}] # the result feathers

this is an example

of the use of feathers ---- The package. ====== package provide feathers namespace eval ::feathers \ { # this package exports nothing but the feathers interpreter interp create feathers feathers eval \ { # ------------------------ # # HTML mechanism # # ------------------------ set ::text 0 set ::uniq 0 # ------------ # learn from keys # ------------ proc unknown {key args} \ { set KEY [string toupper $key] eval [format {interp alias {} %s {} _gener %s} $key $KEY] uplevel 1 _gener $KEY $args } # ------------ # basic generator () # ------------ interp alias {} "" {} _gener "" interp alias {} ' {} _gener "" ' proc _gener {KEY args} \ { if {[string index $KEY 0] == "!"} \ { incr ::uniq set KEY [string range $KEY 1 end] } foreach {opts s eval str uniq} [eval _tokenz $args] break while { [string index $s 0] == "\{" && [string index $s end] == "\}"} \ { set s [string range $s 1 end-1] } set level [info level] if {$::text} \ { # ------------ # inside text # result is returned if {$str} { set res [_str $uniq $KEY $opts $s] } \ else { set res [_txt $uniq $KEY $opts $s] } } \ else \ { # ------------ # command # intermediate result goes to ::eval([info level]) # final result is returned set pfx [_pfx] if {$eval} \ { set res $pfx<${KEY}$opts>\n set lvl2 [expr {$level + 1}] set ::eval($lvl2) "" eval $s append res $::eval($lvl2) unset ::eval($lvl2) append res $pfx\n } \ elseif {$str} { set res [_str $uniq $KEY $opts $s] } \ else { set res [_txt $uniq $KEY $opts $s] } append ::eval($level) $res set ::eval($level) } } # ------------ # tokenizer (?*? ?-opt val?... ?--? ?text?) # ------------ proc _tokenz {args} \ { foreach v {str eval uniq skip n} { set $v 0 } set opts "" foreach item $args \ { if {$skip} { set skip 0; continue } \ elseif {$item == "--"} \ { # end of options incr n break } \ elseif {$item == "*"} \ { # eval flag set eval 1 incr n } \ elseif {$item == "'"} \ { # string flag set str 1 incr n } \ elseif {[string index $item 0] == "-"} \ { # option set KEY [string toupper [string range $item 1 end]] incr n set value [lindex $args $n] incr n append opts " $KEY=\"$value\"" set skip 1 } \ else { break } } set max [llength $args] if {[incr n] < $max} \ { error "bad expression: $args\n" } if {$n == $max } { set s [lindex $args end] } \ else { set s "" } if {$::uniq} {set uniq 1; incr ::uniq -1 } return [list $opts $s $eval $str $uniq] } # ------------ # level prefix (HTML beautifier) # ------------ proc _pfx {{i 0}} \ { if {$::text} { return "" } set n [info level] incr n $i incr n -2 string repeat " " $n } # ------------ # text line (with embedded commands) # ------------ proc _txt {uniq KEY opts txt} \ { set beg ""; set end "" if {$KEY != ""} \ { set beg <$KEY$opts> if {!$uniq} { set end } } set res [_pfx -1]$beg incr ::text set level [info level] set ::eval([expr {$level + 2}]) "" set txt [eval concat "$txt"] append res $txt incr ::text -1 if {$end != ""} { append res $end } if {$::text < 1} { append res \n } set res } # ------------ # multiline string # ------------ proc _str {uniq KEY opts text} \ { set beg ""; set end "" if {$KEY != ""} \ { set beg <$KEY$opts> if {!$uniq} { set end } } set lines {} set p 0 while {[set n [string first \n $text $p]] > -1} \ { lappend lines [string range $text $p [incr n -1]] set p [incr n 2] } if {[incr p] < [string length $text]} \ { lappend lines [string range $text [incr p -1] end] } if {[lindex $lines 0] == ""} { set lines [lreplace $lines 0 0] } if {[lindex $lines end] == ""} { set lines [lreplace $lines end end] } set max [llength $lines] set res "" if {$beg != ""} { append res [_pfx -1]$beg } append res [lindex $lines 0] for {set i 1} {$i < $max} {incr i} \ { append res \n[lindex $lines $i] } if {$end != ""} { append res $end } if {$::text < 1} { append res \n } set res } # ------------ # some helpers # ------------ interp alias {} br {} !br interp alias {} BR {} !br interp alias {} !BR {} !br proc !br {args} \ { if {$args == ""} { uplevel 1 _gener !BR ' {[sp]} } \ else { uplevel 1 _gener !BR $args } } proc sp {} { _gener "" ' { } } ;# non breakable space proc obrace {} { _gener "" ' {{} } ;# open brace -> { proc pipe {} { _gener "" ' {|} } ;# pipe -> | proc cbrace {} { _gener "" ' {}} } ;# close brace -> } proc obracket {} { _gener "" ' {[} } ;# open bracket -> [ proc bslash {} { _gener "" ' {\} } ;# back slash -> \ proc cbracket {} { _gener "" ' {]} } ;# close bracket -> ] proc squote {} { _gener "" ' {'} } ;# single quote proc dquote {} { _gener "" ' {"} } ;# double quote proc dollar {} { _gener "" ' {$} } ;# dollar } # end of feathers namespace eval } ====== ---- Now a more elaborate example: one page of the OOlib man. First, the helpers. ====== # ============================================== # # usage # # ============================================== # ------------------------ # OOlib man extension # ------------------------ feathers eval \ { # the page disposition proc page {title body} \ { set cmd [format \ { copyright {ulis (C) 2002} html * \ { header {%s} body * \ { h2 {%s} %s } } } $title $title $body] uplevel 1 $cmd } # a copyright notice proc copyright {text} \ { uplevel 1 [format {' {}} $text] } # the header component proc header {args} \ { set cmd [format \ { head * \ { title {%s} style ' \ { BODY { background: #FFFAFC } H2 { color: gold; background-color: #F0F0F0; text-align: center; padding: 1em } H3 { color: brown } A { color: green; text-decoration: none } UL { display: inline; margin-left: +10mm } DIV { display: block; margin-left: 10mm } PRE, CODE { color: blue } } } } $args] uplevel 1 $cmd } # a division component proc division {name args} \ { if {[llength $args] > 1} \ { set pre [lindex $args 0] set body [lrange $args 1 end] } \ else \ { set pre "" set body $args } set cmd [format \ { h3 {%s} if {{%s} != ""} { pre ' -style margin-left:1cm {%s} } div * {%s} } $name $pre $pre $body] uplevel 1 $cmd } # a list division proc divli {title args} \ { if {[llength $args] > 1} \ { set type [lindex $args 0] set body [lrange $args 1 end] } \ else \ { set type "" set body $args } set cmd [format \ { !br {[!li {%s}]} div %s {%s} } $title $type $body] uplevel 1 $cmd } # a reference to the glossary proc v {pattern {text ""}} \ { if {$text == ""} { set text $pattern } eval [format {a -href "Vocabulaire.html#$pattern" {%s}} $text] } # an index pointer proc left {target text} \ { set cmd [format \ { a -href %s {[sp][!img -src left.gif -border 0][sp] %s} } $target $text] uplevel 1 $cmd } } ---- Second, making the page. # ------------------------ # OOlib man example : the "aliases directive" page # ------------------------ set res [ \ feathers eval \ { page {aliases directive} \ { division NOM \ { "" {aliases - déclare des alias pour une méthode} } division SYNOPSIS \ { "" {[b aliases] [i method] [b ?][i alias][b ?...]} } division DESCRIPTION \ { "" {Cette directive permet de déclarer des alias (synonymes) pour les méthodes.} !br {Un nom d'alias est redéfinissable (par une méthode ou un alias).} !br divli {Au moment de la déclaration} * \ { "" {[i alias] doit être un nom [v redéfinissable] (par une méthode ou un alias).} !br {Il ne peut pas commencer par le caractère _ (souligné).} } divli {Au moment de l'exécution} * \ { "" {[i method] doit être [v définition définie].}} } division EXAMPLE \ { methods config aliases config co conf configure } \ { "" {La méthode [b config] pourra aussi être appelée par [b co], [b conf] ou [b configure].} } division {VOIR AUSSI} \ { "" {[left rename.htm {renames directive}],} "" {[left Directives.htm {Directives}]} } } } ] ====== ---- Third, showing the result. ====== set fn /tmp/feathers_result.html set h [open $fn w] puts $h $res close $h eval exec [auto_execok start] "file:$fn" & ====== <> Documentation