** 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 writting RenderTk. So, RenderTk was inspired by WubTk, and to some extend 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 use the same Tk code. So, I desided 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 fasted 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 {} \n foreach r [lsort -integer [dict keys $table]] { append html \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 \n } append html \n } append html {
1} {append html " colspan=\"$numCols\""} if {$numRows > 1} {append html " rowspan=\"$numRows\""} append html > append html [[dict get $slave tkwin] render {*}$args] append html
} \n } ## foreach child $_children { ## append html [$child render {*}$args] ## } if {$_tag ne ""} {append html \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] - [entry .x.e1] [entry .x.e2] \ [button .x.b1] [button .x.b2] grid [label .x.l2] - - - ^ ^ -padx 2 -pady 2 ## Render the toplevel... puts [.x render] ## Destroy the toplevel... destroy .x ===== <> Internet