Updated 2011-10-12 12:14:39 by dkf

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>&nbsp;
          <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 "" ' {&nbsp;} } ;# non breakable space
      proc obrace   {} { _gener "" ' {&#123;} } ;# open brace    -> {
      proc pipe     {} { _gener "" ' {&#124;} } ;# pipe          -> |
      proc cbrace   {} { _gener "" ' {&#125;} } ;# close brace   -> }
      proc obracket {} { _gener "" ' {&#91;}  } ;# open bracket  -> [
      proc bslash   {} { _gener "" ' {&#92;}  } ;# back slash    -> \ 
      proc cbracket {} { _gener "" ' {&#93;}  } ;# close bracket -> ]
      proc squote   {} { _gener "" ' {&#39;}  } ;# single quote
      proc dquote   {} { _gener "" ' {&#34;}  } ;# double quote
      proc dollar   {} { _gener "" ' {&#36;}  } ;# 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" &