RenderTk

RenderTk, version 0.000001 :-)

This page is about RenderTk, a package that tries to "emulate" a *tiny* part of Tk, and "render" it as HTML. Emphasis should be given to "tiny" (much of Tk is not supported), and "render". (The Tk UI is converted in HTML tags; the resulting HTML does not function as the original Tk code. It only "draws" the Tk UI.)

Why RenderTk?

I needed a way to "convert" a Tk UI into an HTML UI (using AngularJS). I would like very much to use WubTk, but I had the following limitations:

  • I was not using Wub, I was using Apache Rivet, inside the Apache 2 web server.
  • Tk was not available, I had no X Server the Apache 2 server could connect to.

Initially, I tried to modify WubTk, in order to remove dependencies to Wub and Tk, and I ended up writing RenderTk. So, RenderTk was inspired by WubTk, and to some extent it borrowed its implementation, as it started from the WubTk implementation.

What is new

RenderTk tries to mimic Tk as much as possible. This means that I didn't like the fact that WubTk used "grid" in a strange way, and you have to use cell coordinates to all widgets. This means that you can never re-use the same Tk code. So, I decided that the grid command must be emulated, and I did it: RenderTk has a (partial) implementation of grid in Tcl. I did this by translating the C code from Tk internals into Tcl. Maybe not the fastest approach, but for sure the most compatible... :-)

What is missing

Almost everything. As a start, interaction of any kind with the rendered UI.

The code

##############################################################################
##  RenderTk-1.0.tm:                                                        ##
## --------------------------------------------------                       ##
##  This package implements a simple Tk emulator, which converts a Tk UI    ##
##  into HTML.                                                              ##
##  This package has been inspired by WubTk.                                ##
##                                                                          ##
##  This file is part of the Ellogon Language Engineering Platform.         ##
##  Copyright 1998-2015 by:                                                 ##
##  Georgios Petasis,                                                       ##
##  Athens, Greece.                                                         ##
##  E-mail: [email protected]                                       ##
##          [email protected]                                               ##
##          [email protected]                                              ##
##                                                                          ##
##  For licensing information, please refer to the license conditions of    ##
##  "Ellogon" Language Engineering Platform.                                ##
##############################################################################
package require html

namespace eval RenderTk {
  namespace eval classes {
  };# namespace classes

  namespace eval grid {

    proc unknown {cmd opt args} {
      switch -exact -- [string range $opt 0 0] {
        . - x - ^ {
          return [list $cmd configure $opt]
        }
      }
      # The following will cause ensemble to check again, leading to an error.
      list
    };# unknown

    proc configure {args} {
      # puts "=>[join $args |]"
      ## The first argument is always a window...
      set w [lindex $args 0]
      if {[string range $w 0 0] ne "."} {
        error "bad argument \"$w\": must be name of window"
      }
      set prev .
      ## Is there any saved -in from a removed slave?
      ## If there is, it becomes default for -in.
      ## If the stored master does not exist, just ignore it.
      set master [GetGrid $w]
      if {[dict get $master in] ne ""} {
        set master [GetGrid [dict get $master in]]
      } else {
        set master [GetGrid [$w getparent]]
      }
      ## Count the number of windows, or window short-cuts.
      set numWindows 1
      foreach one [lrange $args 1 end] {
        switch -glob -- $one {
          .* {set prev .; incr numWindows}
          x  {set prev x; incr numWindows}
          ^  {set prev ^; incr numWindows}
          -  {
            if {$prev in {x ^}} {
              error "must specify window before shortcut '-'"
            }
            incr numWindows
          }
          -* {break}
          default {
            error "unexpected parameter \"$one\" in configure list:\
                   should be window name or option"
          }
        }
      }
      if {([llength $args]  - $numWindows) & 1} {
        error "extra option or option with no value"
      }
      set windows [lrange $args 0 $numWindows-1]
      set options [lrange $args $numWindows end]

      ##
      ## Go through all options looking for -in and -row, which are needed to be
      ## found first to handle the special case where ^ is used on a row without
      ## windows names, but with an -in option. Since all options are checked
      ## here, we do not need to handle the error case again later.
      ##
      foreach {opt val} $options {
        switch -exact -- $opt {
          -in  {set master [GetGrid $val]}
          -row {
            set defaultRow $val
            if {$defaultRow < 0} {
              error "bad row value \"$defaultRow\":\
                     must be a non-negative integer"
            }
          }
        }
      }

      if {![info exists defaultRow]} {
        SetGridSize master
        set defaultRow [dict get $master rowEnd]
      }

      ##
      ## Iterate over all of the slave windows and short-cuts, parsing options
      ## for each slave. It's a bit wasteful to re-parse the options for each
      ## slave, but things get too messy if we try to parse the arguments just
      ## once at the beginning. For example, if a slave already is managed we
      ## want to just change a few existing values without resetting everything.
      ## If there are multiple windows, the -in option only gets processed for
      ## the first window.
      ##
      set defaultColumn     0
      set defaultColumnSpan 1
      set positionGiven     0
      for {set j 0} {$j < $numWindows} {incr j} {
        set w [lindex $windows $j]
        ## '^' and 'x' cause us to skip a column. '-' is processed as part of
        ## its preceeding slave.
        switch -exact $w {
          ^ - x {incr defaultColumn; continue}
          -     {continue}
        }
        ## w is a window. Try to detect if we must increase column span...
        for {set defaultColumnSpan 1} {$j + $defaultColumnSpan < $numWindows} \
            {incr defaultColumnSpan} {
          if {[lindex $windows $j+$defaultColumnSpan] ne "-"} {break}
        }
        if {[$w istoplevel]} {
          error "can't manage \"$w\": it's a top-level window"
        }
        set slave [GetGrid $w]
        foreach {opt val} $options {
          switch -exact -- $opt {
            -column {
               if {$val < 0} {error "bad column value \"$val\": must be a non-negative integer"}
               if {$val > 10000} {error "column out of bounds"}
               dict set slave column $val
            }
            -columnspan {
               if {$val < 0} {error "bad columnspan value \"$val\": must be a positive integer"}
               if {$val > 10000} {error "column out of bounds"}
               dict set slave numCols $val
            }
            -in {
               if {$w eq $val} {"window can't be managed in itself"}
               set positionGiven 1
               set master [GetGrid $val]
            }
            -ipadx {
               if {$val < 0} {
                 error "bad ipadx value \"$val\": must be positive screen distance"
               }
               dict set slave iPadX [expr {$val*2}]
            }
            -ipady {
               if {$val < 0} {
                 error "bad ipady value \"$val\": must be positive screen distance"
               }
               dict set slave iPadY [expr {$val*2}]
            }
            -padx {
               switch -exact [llength $val] {
                 1 {
                   set firstInt [lindex $val 0]
                   dict set slave padLeft $firstInt
                   dict set slave padX    $firstInt
                 }
                 2 {
                   dict set slave padLeft [lindex $val 0]
                   dict set slave padX    [lindex $val 1]
                 }
                 default {
                   error "wrong number of parts to pad specification"
                 }
               }
            }
            -pady {
               switch -exact [llength $val] {
                 1 {
                   set firstInt [lindex $val 0]
                   dict set slave padTop  $firstInt
                   dict set slave padY    $firstInt
                 }
                 2 {
                   dict set slave padTop  [lindex $val 0]
                   dict set slave padY    [lindex $val 1]
                 }
                 default {
                   error "wrong number of parts to pad specification"
                 }
               }
            }
            -row {
               if {$val < 0} {error "bad row value \"$val\": must be a non-negative integer"}
               if {$val > 10000} {error "row out of bounds"}
               dict set slave row $val
            }
            -rowspan {
               if {$val < 0} {error "bad rowspan value \"$val\": must be a positive integer"}
               if {$val > 10000} {error "row out of bounds"}
               dict set slave numRows $val
            }
            -sticky {
               foreach c [split $val {}] {
                 switch -exact $c {
                   n - N - e - E - s - S - w - W - \  - , - \t - \r - \n {}
                   default {
                     error "bad stickyness value \"$val\": must be\
                            a string containing n, e, s, and/or w"
                   }
                 }
               }
               dict set slave sticky $val
            }
          }
        };# foreach {opt val} $options
        $w setgrid $slave
        ## If no position was specified via -in and the slave is already
        ## packed, then leave it in its current location.
        if {!$positionGiven && [dict get $slave masterPtr] ne ""} {
           set master [dict get $slave masterPtr]
        } elseif {$positionGiven &&
           [dict get $slave masterPtr] eq [dict get $master tkwin]} {
          ## If the same -in window is passed in again, then just leave it in
          ## its current location.
        } else {
          ## Make sure we have a geometry master. We look at:
          ##  1)   the -in flag
          ##  2)   the parent of the first slave.
          set parent [$w getparent]
          if {![info exists master]} {
            set master [GetGrid $parent]
          }
          set m [dict get $master tkwin]; set s [dict get $slave tkwin]
          set masterPtr [dict get $slave masterPtr]
          if {$masterPtr ne "" && $masterPtr ne $m} {
            Unlink slave
          }
          if {[dict get $slave masterPtr] eq ""} {
            set tempPtr [dict get $master slavePtr]
            dict set slave  masterPtr $m
            dict set master slavePtr  $s
            dict set slave  nextPtr   $tempPtr
            $m setgrid $master
            $s setgrid $slave
          }
          ## Make sure that the slave's parent is either the master or an
          ## ancestor of the master, and that the master and slave aren't the
          ## same.
          for {set ancestor $m} {1} {set ancestor [$m getparent]} {
            if {$ancestor eq $parent} {break}
            if {[$ancestor istoplevel]} {
              error "can't put $w inside $ancestor"
            }
          }
          ## Try to make sure our master isn't managed by us.
          if {[dict get $master masterPtr] eq $s} {
            Unlink slave
            error "can't put $w inside $s, would cause management loop"
          }
          ## Assign default position information.
          if {[dict get $slave column] == -1} {
            dict set slave column $defaultColumn
          }
          if {[dict get $slave row] == -1} {
            dict set slave row $defaultRow
          }
          dict incr slave numCols [expr {$defaultColumnSpan - 1}]
          incr defaultColumn [dict get $slave numCols]
          set defaultColumnSpan 1
          $s setgrid $slave
        }
      };# for {set j 0} {$j < $numWindows} {incr j}

      ##
      ## Now look for all the "^"'s.
      ##
      set lastWindow {}
      set numSkip     0
      for {set j 0} {$j < $numWindows} {incr j} {
        set w [lindex $windows $j]
        set firstChar [string range $w 0 0]
        if {$firstChar eq "."} {
          set lastWindow $w; set numSkip 0
        }
        if {$firstChar eq "x"} {incr numSkip}
        if {$firstChar ne "^"} {continue}
        if {$master eq ""} {
          error "can't use '^', cant find master"
        }
        ## Count the number of consecutive ^'s starting from this position.
        for {set width 1} {$j + $width < $numWindows} {incr width} {
          if {[lindex $windows $j+$width] ne "^"} {break}
        }
        ## Find the implied grid location of the ^
        if {$lastWindow eq ""} {
          set lastRow [expr {$defaultRow - 1}]
          set lastColumn 0
        } else {
          set other [GetGrid $lastWindow]
          set lastRow [expr {[dict get $other row] +
                             [dict get $other numRows] - 2}]
          set lastColumn [expr {[dict get $other column] +
                                [dict get $other numCols]}]
        }
        incr lastColumn $numSkip
        set match 0
        for {set slavePtr [dict get $master slavePtr]} {$slavePtr ne ""} \
            {set slavePtr [dict get $slave  nextPtr]} {
          set slave [GetGrid $slavePtr]
          if {[dict get $slave column] == $lastColumn &&
            (([dict get $slave row] + [dict get $slave numRows] - 1) == $lastRow)} {
            if {[dict get $slave numCols] <= $width} {
              dict incr slave numRows
              [dict get $slave tkwin] setgrid $slave
            }
            incr match
            incr j [dict get $slave numCols]
            incr j -1
            set lastWindow [dict get $slave tkwin]
            set numSkip 0
            break
          }
        }
        if {!$match} {
          error "can't find slave to extend with \"^\""
        }
      }
      if {$master eq ""} {
        error "can't determine master window"
      }
      SetGridSize master
      ## If we have emptied this master from slaves it means we are no longer
      ## handling it and should mark it as free.
      if {[dict get $master slavePtr] eq ""} {
        [dict get $master tkwin] setgrid {}
      }
    };# configure

    proc Unlink {s} {
      upvar $s slave
      set masterPtr [dict get $slave masterPtr]
      if {$masterPtr eq ""} return

      set master [GetGrid $masterPtr]
      set tkwin  [dict get $slave tkwin]
      if {[dict get $master slavePtr] eq $tkwin} {
        dict set master slavePtr [dict get $slave nextPtr]
      } else {
        for {set slavePtr2 [dict get $master slavePtr]} {1} \
            {set slavePtr2 [dict get [GetGrid $slavePtr2] nextPtr} {
          if {$slavePtr2 eq ""} {
            error "Unlink couldn't find previous window"
          }
          set gridder [GetGrid $slavePtr2]
          if {[dict get $gridder nextPtr] eq $tkwin} {
            dict set gridder nextPtr [dict get $slave nextPtr]
            $slavePtr2 setgrid $gridder
            break;
          }
        }
      }
      SetGridSize $master
      dict set slave masterPtr {}
      $tkwin setgrid $slave

      ##
      ## If we have emptied this master from slaves it means we are no longer
      ## handling it and should mark it as free.
      ##
      if {[dict get $master slavePtr] eq ""} {
        [dict get $master tkwin] setgrid {}
      }
    };# Unlink

    proc SetGridSize {m} {
      upvar $m master
      set maxX 0; set maxY 0
      set slavePtr [dict get $master slavePtr]
      while {$slavePtr ne ""} {
        set slave [GetGrid $slavePtr]
        set x [expr {[dict get $slave numCols] + [dict get $slave column]}]
        set y [expr {[dict get $slave numRows] + [dict get $slave row]}]
        if {$x > $maxX} {set maxX $x}
        if {$y > $maxY} {set maxY $y}
        set slavePtr [dict get $slave nextPtr]
      }
      dict set master columnEnd $maxX
      dict set master rowEnd    $maxY
      [dict get $master tkwin] setgrid $master
    };# SetGridSize

    proc GetGrid {w} {
      set Gridder [$w getgrid]
      if {![dict exists $Gridder tkwin]} {
        ## The structure is unitialised.
        dict set Gridder tkwin         $w
        dict set Gridder masterPtr     {}
        dict set Gridder nextPtr       {}
        dict set Gridder slavePtr      {}
        dict set Gridder masterDataPtr {}
        dict set Gridder in            {}
        dict set Gridder column        -1
        dict set Gridder row           -1
        dict set Gridder numCols        1
        dict set Gridder numRows        1
        dict set Gridder padX           0
        dict set Gridder padY           0
        dict set Gridder padLeft        0
        dict set Gridder padTop         0
        dict set Gridder iPadX          0
        dict set Gridder iPadY          0
        dict set Gridder sticky        {}
        dict set Gridder columnEnd      0
        dict set Gridder columnMax      0
        dict set Gridder columnSpace    0
        dict set Gridder rowEnd         0
        dict set Gridder rowMax         0
        dict set Gridder rowSpace       0
        $w setgrid $Gridder
      }
      return $Gridder
    };# GetGrid

    proc size {w} {
      set master [GetGrid $w]
      SetGridSize master
      set columnEnd [dict get $master columnEnd]
      set columnMax [dict get $master columnMax]
      set rowEnd    [dict get $master rowEnd]
      set rowMax    [dict get $master rowMax]
      if {$columnMax > $columnEnd} {set columnEnd $columnMax}
      if {$rowMax    > $rowEnd}    {set rowEnd    $rowMax}
      list $columnEnd $rowEnd
    };# size

    proc CheckSlotData {m slot slotType} {
      upvar $m master
      foreach f {minsize pad weight uniform} def {0 0 0 {}} {
        if {![dict exists $master masterDataPtr $slot $slotType $f]} {
          dict set master masterDataPtr $slot $slotType $f $def
        }
      }
    };# CheckSlotData

    proc RowColumnConfigure {what w index args} {
      set master [GetGrid $w]
      switch [llength $args] {
        0 {
          ## Return all of the options for this row or ${what}. If the request
          ## is out of range, return all 0's.
          if {[llength $index] != 1} {
            error "must specify a single element on retrieval"
          }
          set index [lindex $index 0]
          if {![string is integer $index]} {
            error "when retrieving options only integer indices are allowed"
          }
          CheckSlotData master $index ${what}Ptr
          return [list \
            -minsize [dict get $master masterDataPtr $index ${what}Ptr minsize]\
            -pad     [dict get $master masterDataPtr $index ${what}Ptr pad]    \
            -uniform [dict get $master masterDataPtr $index ${what}Ptr uniform]\
            -weight  [dict get $master masterDataPtr $index ${what}Ptr weight] \
          ]
        }
        1 {
          ## Return this option...
          if {[llength $index] != 1} {
            error "must specify a single element on retrieval"
          }
          set index [lindex $index 0]
          if {![string is integer $index]} {
            error "when retrieving options only integer indices are allowed"
          }
          CheckSlotData master $index ${what}Ptr
          switch -- [lindex $args 0] {
            -minsize {
              return [dict get $master masterDataPtr $index ${what}Ptr minsize]
            }
            -pad {
              return [dict get $master masterDataPtr $index ${what}Ptr pad]
            }
            -uniform {
              return [dict get $master masterDataPtr $index ${what}Ptr uniform]
            }
            -weight {
              return [dict get $master masterDataPtr $index ${what}Ptr weight]
            }
            default {
              error "invalid option \"[lindex $args 0]\""
            }
          }
        }
        default {
          ## Iterate over all indices
          set indices {}
          foreach slot $index {
            if {[string is integer $slot]} {
              lappend indices $slot
            } elseif {$slot eq "all"} {
              set slavePtr [dict get $master slavePtr]
              while {$slavePtr ne ""} {
                set slave [GetGrid $slavePtr]
                lappend indices [dict get $slave ${what}]
                set slavePtr [dict get $slave nextPtr]
              }
            } else {
              set slave [GetGrid $slot]
              if {[dict get $slave masterPtr] ne [dict get $master tkwin]} {
                error "the window \"$slot\" is not managed by \"$w\""
              }
              lappend indices [dict get $slave ${what}]
            }
          }
          foreach slot [lsort -integer -unique $indices] {
            CheckSlotData master $slot ${what}Ptr
            foreach {o v} $args {
              switch -- $o {
                -minsize {
                  dict set master masterDataPtr $slot ${what}Ptr minsize $v
                }
                -pad {
                  dict set master masterDataPtr $slot ${what}Ptr pad $v
                }
                -uniform {
                  dict set master masterDataPtr $slot ${what}Ptr uniform $v
                }
                -weight {
                  dict set master masterDataPtr $slot ${what}Ptr weight $v
                }
                default {
                  error "invalid option \"$o\""
                }
              }
            }
          }
          $w setgrid $master
        }
      }
    };# RowColumnConfigure

    proc columnconfigure {w index args} {
      RowColumnConfigure column $w $index {*}$args
    };# columnconfigure

    proc rowconfigure {w index args} {
      RowColumnConfigure row $w $index {*}$args
    };# rowconfigure

    proc Render2Table {w} {
      set master [GetGrid $w]
      SetGridSize master
      set table [dict create]
      set slavePtr [dict get $master slavePtr]
      while {$slavePtr ne ""} {
        set slave [GetGrid $slavePtr]
        ## Get the coordinates of the slave...
        set row      [dict get $slave row]
        set column   [dict get $slave column]
        dict set table $row $column $slave
        set slavePtr [dict get $slave nextPtr]
      }
      return $table
    };# Render2Table

    namespace export *
    namespace ensemble create -unknown [namespace which unknown]
  };# namespace grid
};# namespace RenderTk

oo::class create RenderTk::classes::widget {
  # cget - get a variable's value
  method cget {n} {
    set n [string trim $n -]
    my variable $n
    return [set $n]
  };# cget
  method cget? {n} {
    set n [string trim $n -]
    my variable $n
    if {[info exists $n]} {
      return [set $n]
    } else {
      return {}
    }
  };# cget?

  # configure - set variables to their values
  method configure {args} {
    if {$args eq {}} {
      set result {}
      foreach var [info object vars [self]] {
        if {![string match _* $var]} {
          my variable $var
          lappend result $var [set $var]
        }
      }
      return $result
    }
    # install variable values
    dict for {n v} $args {
      set n [string trimleft $n -]
      my variable $n
      switch -- $n {
        default {
          set $n $v
        }
      }
    }
  };# configure

  method state {{state {}}} {
    my variable _ttk_state
    if {$state eq ""} {
      return $_ttk_state
    } else {
      set _ttk_state $state
    }
    return $_ttk_state
  };# state

  method cexists {n} {
    set n [string trim $n -]
    my variable $n
    info exists $n
  };# cexists

  method setparent {parent} {
    my variable _parent
    set _parent ""
    if {$parent eq ""} {return}
    if {![info object isa object $parent] ||
        ![info object isa typeof $parent RenderTk::classes::widget]} {
      error "$parent is not a RenderTk widget"
    }
    set _parent $parent
    oo::objdefine [self] forward parent $parent
    my parent addchild [namespace tail [self]]
  };# setparent

  method getparent {} {
    my variable _parent
    return $_parent
  };# getparent

  method addchild {w} {
    my variable _children
    lappend _children $w
  };# addchild

  method delchild {w} {
    my variable _children
    set i [lsearch -exact $_children $w]
    if {$i != -1} {
      set _children [lreplace $_children $i $i]
    }
  };# delchild

  method getchildren {} {
    my variable _children
    return $_children
  };# getchildren

  method type {} {
    string range [namespace tail [info object class [self]]] 0 end-1
  };# type

  method wid {} {
    return [string map {. _} [string trim [namespace tail [self]] .]]
  }

  method widget {} {
    return [string trim [namespace tail [self]] .]
  }

  method istoplevel {} {
    my variable _is_toplevel
    if {[info exists _is_toplevel]} {return $_is_toplevel}
    return 0
  };# istoplevel

  # calculate name relative to widget's parent
  method relative {} {
    return [lindex [split [namespace tail [self]] .] end]
  }

  method gridname {} {
    return [join [lrange [split [namespace tail [self]] .] 0 end-1] .]
  }

  method getgrid {} {
    my variable _grid_manager_data
    return $_grid_manager_data
  };# getgrid

  method setgrid {data} {
    my variable _grid_manager_data
    set _grid_manager_data $data
  };# setgrid

  method update {args} {
    return [my render {*}$args]
  }

  method render {args} {
    my variable _tag _tag_attributes _tag_attributes_map \
                _children _tag_content_var
    foreach {_n _v} $args {
      my variable $_n
      set $_n $_v
    }
    set html {}
    if {$_tag ne ""} {
      set html "<$_tag id=\"[::html::html_entities [my wid]]\""
      if {[info exists _tag_attributes]} {
        append html { } $_tag_attributes
      }
      if {[info exists _tag_attributes_map]} {
        foreach {_n _v} $_tag_attributes_map {
          my variable $_v
          if {[info exists $_v] && [set $_v] ne ""} {
            set r [::html::html_entities [set $_v]]
            set j [join [::html::html_entities \
                           [string map {; \;} [set $_v]]] \;]
            append html { } [string map \
                  [list %V $r %JV $j] $_n]
          }
        }
      }
      append html >
    }
    if {[info exists _tag_content_var] && $_tag_content_var ne ""} {
      my variable $_tag_content_var
      if {[info exists $_tag_content_var]} {
        append html [::html::html_entities [set $_tag_content_var]]
      }
    }
    ##
    ## Render children, according to the geometry manager...
    ##
    set table [RenderTk::grid Render2Table [self]]
    if {[dict size $table]} {
      append html {<table class="table"><tbody>} \n
      foreach r [lsort -integer [dict keys $table]] {
        append html <tr>\n
        set row [dict get $table $r]
        foreach c [lsort -integer [dict keys $row]] {
          set slave   [dict get $row $c]
          set numCols [dict get $slave numCols]
          set numRows [dict get $slave numRows]
          append html <td
          if {$numCols > 1} {append html " colspan=\"$numCols\""}
          if {$numRows > 1} {append html " rowspan=\"$numRows\""}
          append html >
          append html [[dict get $slave tkwin] render {*}$args]
          append html </td>\n
        }
        append html </tr>\n
      } 
      append html {</tbody></table>} \n
    }
    ## foreach child $_children {
    ##   append html [$child render {*}$args]
    ## }
    if {$_tag ne ""} {append html </$_tag>\n}
    return $html
  };# render

  constructor {args} {
    my variable _children _grid_manager_data my _ttk_state
    set _children              {}
    set _grid_manager_data     {}
    set _ttk_state         normal
    ## Calculate widget's parent...
    my setparent [my gridname]
    my configure {*}$args
  };# constructor

  destructor {
    my variable _children _parent
    foreach child $_children {
      $child destroy
    }
    if {$_parent ne ""} {
      my parent delchild [namespace tail [self]]
    }
  };# destructor

};# class RenderTk::classes::widget

oo::class create RenderTk::classes::toplevel {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _is_toplevel          1
      _tag                  div
      _tag_attributes      {class="button-widget-wrapper"}
    } $args]
  }
};# class RenderTk::classes::toplevel

oo::class create RenderTk::classes::label {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  div
      _tag_attributes      {class="button-widget-header"}
      _tag_content_var     text
      _tag_attributes_map  {
        textvariable="%V"         textvariable
        bg-color="%V"             background
        fg-color="%V"             foreground
        title="%V"                text
      }
    } $args]
  }
};# class RenderTk::classes::label

oo::class create RenderTk::classes::labelframe {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  div
      _tag_attributes      {class="button-widget-header"}
      _tag_content_var     text
      _tag_attributes_map  {
        textvariable="%V"         textvariable
        bg-color="%V"             background
        fg-color="%V"             foreground
        title="%V"                text
      }
    } $args]
  }
};# class RenderTk::classes::labelframe

oo::class create RenderTk::classes::frame {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  div
      _tag_attributes      {class="button-widget-header"}
      _tag_content_var     text
      _tag_attributes_map  {
        textvariable="%V"         textvariable
        bg-color="%V"             background
        fg-color="%V"             foreground
        title="%V"                text
      }
    } $args]
  }
};# class RenderTk::classes::frame

oo::class create RenderTk::classes::button {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-button
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        label="%V"                text
        textvariable="%V"         textvariable
        button-tooltip="%V"       tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
      }
    } $args]
  }
};# class RenderTk::classes::button

oo::class create RenderTk::classes::checkbutton {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-checkbutton
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        label="%V"                text
        textvariable="%V"         textvariable
        variable="%V"             variable
        checkbutton-tooltip="%V"  tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
      }
    } $args]
  }
};# class RenderTk::classes::checkbutton

oo::class create RenderTk::classes::radiobutton {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-radiobutton
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        label="%V"                text
        textvariable="%V"         textvariable
        variable="%V"             variable
        radiobutton-tooltip="%V"  tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
        compound="%V"             compound
        image="%V"                image
        image-size="%V"           image-size
      }
    } $args]
  }
};# class RenderTk::classes::radiobutton

oo::class create RenderTk::classes::entry {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-entry
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        label="%V"                text
        textvariable="%V"         textvariable
        entry-tooltip="%V"        tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
        width="%V"                width
      }
    } $args]
  }
};# class RenderTk::classes::entry

oo::class create RenderTk::classes::dateentry {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-dateentry
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        dateentry-format="%V"     date_format
        label="%V"                text
        dateentry-tooltip="%V"    tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
      }
    } $args]
  }
};# class RenderTk::classes::dateentry

oo::class create RenderTk::classes::combobox {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-combobox
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        label="%V"                text
        textvariable="%V"         textvariable
        combobox-tooltip="%V"     tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
        values="%JV"              values
      }
    } $args]
  }
};# class RenderTk::classes::combobox

oo::class create RenderTk::classes::text {
  superclass RenderTk::classes::widget

  constructor {args} {
    next {*}[dict merge {
      _tag                  annotation-text
      _tag_attributes_map  {
        annotation-type="%V"      annotation-type
        annotation-attribute="%V" annotation-attribute
        annotation-value="%V"     value
        label="%V"                text
        text-tooltip="%V"         tooltip
        bg-color="%V"             background
        fg-color="%V"             foreground
        cols="%V"                 width
        rows="%V"                 height
      }
    } $args]
  }
};# class RenderTk::classes::text


namespace eval RenderTk {
  foreach class [info command classes::*] {
    proc [namespace tail $class] {w args} \
       "$class create ::\$w {*}\$args; return \$w"
  }
  unset class

  proc destroy {args} {
    foreach one $args {
      $one destroy
    }
  };# destroy

  namespace export *

};# namespace RenderTk

package provide CLARIN::RenderTk 1.0

# vim: syntax=tcl

How to use it

Although the use of the package is questionable, here is an example:

## Add current directory to paths searched for packages...
::tcl::tm::path add [file normalize [file dirname [info script]]]
## Load the RenderTk package...
package require RenderTk
## Import all RenderTk commands...
namespace import RenderTk::*

## Create a toplevel, and add some widgets with grid (the only supported
## manager)...
toplevel .x
grid [label .x.l -text "This is a label"]  - [entry .x.e1]  [entry .x.e2] \
     [button .x.b1 -text A] [button .x.b2]
grid [label .x.l2 -text "Another label"] - - - ^ ^ -padx 2 -pady 2

## Render the toplevel...
puts [.x render]

## Destroy the toplevel...
destroy .x

Sample output:

<div id="x" class="button-widget-wrapper"><table class="table"><tbody>
<tr>
<td colspan="2"><div id="x_l" class="button-widget-header" title="This is a label">This is a label</div>
</td>
<td><annotation-entry id="x_e1"></annotation-entry>
</td>
<td><annotation-entry id="x_e2"></annotation-entry>
</td>
<td rowspan="2"><annotation-button id="x_b1" label="A"></annotation-button>
</td>
<td rowspan="2"><annotation-button id="x_b2"></annotation-button>
</td>
</tr>
<tr>
<td colspan="4"><div id="x_l2" class="button-widget-header" title="Another label">Another label</div>
</td>
</tr>
</tbody></table>
</div>

How it works

Instead of creating Tk widgets, the package creates widgets using TclOO objects. Each widget is a TclOO class, but if you look more closely, all classes inherit RenderTk::classes::widget, with different instantiation. All options are kept inside each object (yes, even non-Tk ones), and during rendering, if an option is present, it is mapped to the output. Everything is managed by the _tag_attributes_map list, which maps options (minus the starting "-" character) to strings. For example, {bg-color="%V" background} maps the value of -background (if not empty) to {bg-color="<value>"}. %V stands for the value of the option.

Only grid has been implemented, thus only grid layout is supported.

MDD Inspired approach, and a great start!