** 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: petasis@iit.demokritos.gr                                       ##
##          petasisg@yahoo.gr                                               ##
##          petasisg@gmail.com                                              ##
##                                                                          ##
##  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. Everyting 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 is supported.

<<categories>> Internet | Web