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:
<cmd>:
' multiline string
<key> * ?<opts>?... ?--? ?script?
<key> ' ?<opts>?... ?--? ?multiline string?
<text cmd>
<text cmd>:
' monoline string
"" <text>
<key> ?<opts>?... ?--? ?<text>?
<text>: ??monoline string?...?[<text cmd>]?...?...
<key>:
key -> generate <KEY OPTs><text></KEY>
!key -> generate <KEY OPTs><text>
<opts>:
-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
<HTML>
<HEAD>
<TITLE>feathers</TITLE>
<STYLE>H2 {text-align: center; padding: 1em}</STYLE>
</HEAD>
<BODY BGCOLOR="#f0f0ff">
<H2>this is an example</H2>
<BR>
<BR>of the use of <B>feathers</B>
</BODY>
</HTML>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 (<KEY OPTs><text></KEY>)
# ------------
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</$KEY>\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 </$KEY> }
}
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 </$KEY> }
}
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 {' {<!-- %s -->}} $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" &