Requires TclOO.  Run tclsh8.5 server.tcl and open your browser to http://localhost:9001


I've recently started putting together a Tk-over-jQuery routine I'm calling web Tk (wtk). The idea is having full Tcl running on a server, with a Tk-like layer that sends commands to code running in a browser.

For those of you who remember it, this is conceptually similar to ProxyTk (see http://www.markroseman.com/pubs/proxytk.pdf).

An important thing is that its not tied into any particular web server or other communication channel; in fact, it just assumes there is a communication channel of some sort. This might be an AJAX connection pair, WebSockets, socket.io, etc. Or it might not even be a remote communication. You could well have a desktop/iPad app whose UI is a web view, and the "communication" between "server" and "client" might be just a procedure call.

The implementation is based on TclOO, and the demo uses simple Ajax communication over a generic minihttpd.tcl-derived web server. TclOO translates the "tk-like" commands into Javascript/jQuery calls with fairly minimal code. This is important as I want to make this very easy for people to extend, wrap other jQuery widgets, etc.

It's still at what I'd consider the proof of concept stage, but it feels very promising.


Notes:

Starting the wtk app server:

            return  -code error  -level 1  -errorcode [list WTKNOTIMPYET bind query_for_events]  {[bind window] not yet implemented}
        }
        1 {
            return  -code error  -level 1  -errorcode [list WTKNOTIMPYET bind query_for_script]  {[bind window pattern] not yet implemented}
        }
        2 {
            lassign $args ev script
            return [$w action_bind $ev $script]
        }
        default {
            return  -code error  -level 1  {wrong # args: should be "bind window ?pattern? ?command?"}

        }
    }
    return [$w action_bind $ev $script]
}

##
## Partial implementation of focus
##
proc ::wtk::focus {args} {
    if {![llength $args]} {
        set args [list  -displayof .]
    } elseif {[llength $args] > 2} {
        return \
            -code error \
            [format {bad option "%1$s": must be -displayof, -force, or -lastfor} [lindex $arg 0]]
    } elseif {[llength $args] == 1} {
        _VerifyWindowExists $args
        $args event_focus
        return;
    }
    switch -exact -- [lindex $args 0] {
        -displayof {
            return  -code error  -level 1  -errorcode [list WTKNOTIMPYET focus -displayof]  {[focus -displayof] not yet implemented}
        }
        -force {

namespace eval ::wtk::wm:: {
  namespace ensemble create  -map {
    aspect Aspect attributes Attributes client Client colormapwindows Colormapwindows command Command deiconify Deiconify focusmodel Focusmodel frame Frame geometry Geometry grid Grid group Group iconbitmap Iconbitmap iconify Iconify iconmask Iconmask iconname Iconname iconphoto Iconphoto iconposition Iconposition iconwindow Iconwindow maxsize Maxsize minsize Minsize overrideredirect Overrideredirect positionfrom Positionfrom protocol Protocol resizable Resizable sizefrom Sizefrom stackorder Stackorder state State title Title transient Transient withdraw Withdraw
  }
}

proc ::wtk::wm::_VerifyWindowExists {window} {
  parray ::wtk::widgets
  if {![info exists ::wtk::widgets([string trimleft $window])]} {
    return \
      -code error \
      -level 2 \
      [format {bad window path name "%1$s"} $window]
  } elseif {![string equal $window {.}]} {
    return \
      -code error \
      -level 2 \
      [format {window "%1$s" isn't a top-level window} $window]
  }
  return;
}

foreach file [glob -- [file join [file dirname [info script]] wm *.tcl]] {
  source $file
}

proc render {} {
  puts RENDER
  ::wtk::wm title . "Feet to Meters"
  
  ::wtk::grid [::wtk::frame .c -padding "3 3 12 12"] -column 0 -row 0 -sticky nwes
  ::wtk::grid columnconfigure .c 0 -weight 1; ::wtk::grid rowconfigure .c 0 -weight 1
  ::wtk::grid [::wtk::button .c.calc -text "Calculate" -radius 7 -bg #ffccff -fg darkgreen -command calculate] -column 0 -row 1 -sticky w
  ::wtk::grid [::wtk::entry .c.feet -width 7 -textvariable feet -bg GreenYellow -fg Red] -column 1 -row 1 -sticky we
  ::wtk::grid [::wtk::label .c.flbl -text "feet" -bg yellow] -column 2 -row 1 -sticky w
  ::wtk::grid [::wtk::label .c.islbl -text "is equivalent to"] -column 0 -row 2 -sticky e
  ::wtk::grid [::wtk::label .c.meters -textvariable meters] -column 1 -row 2 -sticky we
  ::wtk::grid [::wtk::label .c.mlbl -text "meters"] -column 2 -row 2 -sticky w
  #foreach w [::wtk::winfo children .c] {::wtk::grid configure $w -padx 50 -pady 50}; #not working yet
  
  ::wtk::grid [::wtk::text .text -rows 4 -cols 40 -bg GreenYellow -fg Red -textvariable textval] -column 0 -row 2 -sticky ew
  
  ::wtk::grid [::wtk::frame .d -padding "3 3 12 12"] -column 0 -row 3 -sticky nwes
  ::wtk::grid columnconfigure .d 0 -weight 1; ::wtk::grid rowconfigure .d 0 -weight 1
  ::wtk::grid rowconfigure . 3 -weight 1
  ::wtk::grid [::wtk::button .d.ib  -text "" -src /images/logo.png -width 63 -height 63 -command swapimages]  -column 0 -row 0 -sticky e
  ::wtk::grid [::wtk::label .d.iblbl -text "<-- Click Me"] -column 1 -row 0 -sticky w
  ::wtk::grid [::wtk::combobox .d.cb  -text "ComboBox" -options "zero one two three" -variable textval -command selectimg]  -column 2 -row 0 -sticky w
  ::wtk::grid [::wtk::checkbutton .d.ck  -bg violet -fg Red -variable checkval -command docheck] -column 3 -row 0 -sticky w
  ::wtk::grid [::wtk::label .d.cklbl  -textvariable ckstatus] -column 4 -row 0 -sticky w
  #foreach w [::wtk::winfo children .d] {::wtk::grid configure $w -padx 150 -pady 150}; #not working yet
  
  ::wtk::grid [::wtk::frame .e -padding "3 3 12 12"] -column 0 -row 4 -sticky nwes
  ::wtk::grid columnconfigure .e 0 -weight 1; ::wtk::grid rowconfigure .e 0 -weight 1	
  set html "<a href=\"http://www.google.com\">Link To Google<a/>"
  ::wtk::grid [::wtk::misc .e.misclink -type div -text "$html" -attr "innerHTML" -command nop] -column 0 -row 0
  
  ::wtk::grid [::wtk::label .e.spacer -text "&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp"] -column 1 -row 0 -sticky w
  
  set html "<a href=\"http://dev.sr-tech.com:8100/wtk/timeline?n=200\">   Link To Wtk Repo<a/>"
  ::wtk::grid [::wtk::misc .e.misclinkwtk -type div -text "$html" -attr "innerHTML" -command nop] -column 2 -row 0
  
  
  set html "<form action=\"demo.tcl\" method=\"post\" enctype=\"multipart/form-data\">"
  append html "<input type=\"file\" name=\"upfile\" id=\"file\">"
  append html "<input type=\"submit\" name=\"submit\" value=\"Submit\">"
  append html "</form>"
  ::wtk::grid [::wtk::misc .up -type div -text "$html" -attr "innerHTML" -command nop] -column 0 -row 5
}
  
proc nop {args} {}
  
proc docheck {} {
  if {$::checkval} {
        set ::ckstatus "checked"
        ::wtk::focus .c.feet
  } else {
        set ::ckstatus ""
  }
}
  
proc calculate {} {
  if {[catch {
                set ::meters [expr {round($::feet*0.3048*10000.0)/10000.0}]
                set ::textval "hey!"
        }]!=0} {
        set ::meters ""
  }
}
  
proc swapimages {} {
  switch -- $::image {
    0 {
      set ::image 1; set ::textval "one"
      .d.ib configure -src /images/cameralens1.jpg
    }
    
    1 {
      set ::image 2; set ::textval "two"
      .d.ib configure -src /images/rainbow.gif
    }
    
    2 {
      set ::image 3; set ::textval "three"
      .d.ib configure -src /images/cameralens2.jpg
    }
    
    3 {
      set ::image 0; set ::textval "zero"
      .d.ib configure -src /images/logo.png
    }
  }
}
  
proc selectimg {} {
  switch -- $::textval {
    zero  {
      set ::image 0
      .d.ib configure -src /images/logo.png
    }
    
    one   {
      set ::image 1
      .d.ib configure -src /images/cameralens1.jpg
    }
    
    two   {
      set ::image 2
      .d.ib configure -src /images/rainbow.gif
    }
    
    three {
      set ::image 3
      .d.ib configure -src /images/cameralens2.jpg
    }    
  }
}

set ::image 0

render

::wtk::focus .c.feet
::wtk::bind . <Return> {calculate}

proc ::wtk::grid::Configure {window args} {
    variable ::wtk::widgets

    set w [namespace tail $window]
    ::wtk::_VerifyWindowExists $w
    set parent [join [lrange [split $w .] 0 end-1] .]
    if {$parent eq ""} {set parent "."}
    if {![info exists widgets($parent)]} {error "no parent widget found"}
    if {![$w was_created]} {$w do_create}
    if {[dict keys $args -column]==""} {dict set args -column 0}; # TODO - proper defaults
    if {[dict keys $args -row]==""} {dict set args -row 0}
    ###::wtk::toclient "wtk.griditup('[$parent id]','[$w id]');"
    [::wtk::GridState for $parent] addSlave $w {*}$args
    return;
}

proc ::wtk::grid::Configure2 {cmd window args} {
    variable ::wtk::widgets

    set w [namespace tail $window]
    ::wtk::_VerifyWindowExists $w
    set parent [join [lrange [split $w .] 0 end-1] .]
    if {$parent eq ""} {set parent "."}
    if {![info exists widgets($parent)]} {error "no parent widget found"}
    if {![$w was_created]} {$w do_create}
    if {[dict keys $args -column]==""} {dict set args -column 0}; # TODO - proper defaults
    if {[dict keys $args -row]==""} {dict set args -row 0}
    ###::wtk::toclient "wtk.griditup('[$parent id]','[$w id]');"
    [::wtk::GridState for $parent] addSlave $w {*}$args
    return;
}

namespace eval ::wtk {
    # Grid geometry manager and friends
    
    # Place a slave inside its master.  Right now this doesn't process any actual grid options. Or handle multiple widgets. Or etc.
    proc grid {w args} {
        variable widgets
        switch -exact -- $w {
            "columnconfigure" {}        
            "rowconfigure" {}
            default {
              set w [namespace tail $w]
              set wobj ::$w
              
              puts [list grid $w [info object class $wobj]]
              
              set parent [join [lrange [split $w .] 0 end-1] .]
              if {$parent eq ""} {set parent "."}
              if {![info exists widgets($parent)]} {error "no parent widget found"}
              if {![$wobj was_created]} {$wobj do_create}
              if {[dict keys $args -column]==""} {dict set args -column 0}; # TODO - proper defaults
              if {[dict keys $args -row]==""} {dict set args -row 0}
              ###::wtk::toclient "wtk.griditup('[$parent id]','[$w id]');"     
              [::wtk::GridState for $parent] addSlave $w {*}$args
              return ""   
            }
        }
    }
    
    # internal state kept for each master
    odie::class ::wtk::GridState {

        class_method for {w} {
          my variable states
          set w [namespace tail $w]

          if {![info exists states($w)]} {
            set states($w) [my create ::wtk::${w}#grid $w]
          }
          return $states($w)
        }
        class_method _reset {} {
          my variable states
          foreach {w obj} [array get states] {
            $obj destroy
          }
          unset states
        }
        
        variable rows {}
        variable columns {}
        variable slaves ; # array
        variable tabledata {}
        variable master
        variable id

        constructor {w} {
          set master [namespace tail $w]
          my variable rows columns tabledata master id
          set rows {}
          set columns {}
          set tabledata {}

          set id [string map "obj grid" [$master id]]
        }
        
        method jqobj {} {return "\$('#$id')"}
        method jsobj {} {return "\$('#$id')\[0\]"}
        method _debug {} {
          my variable rows columns tabledata master id slaves
          return [list master $master rows $rows columns $columns slaves [array get slaves] tabledata $tabledata]
        }
        method addSlave {w args} {
          my variable rows columns tabledata master id slaves
          set w [namespace tail $w]
          if {[dict keys $args -column] eq "" || [dict keys $args -row] eq ""} {error "need to supply -column and -row"}; # NOTE: caller ensures we have a column and row
          set slaves($w) $args
          set colnum [dict get $args -column]; set rownum [dict get $args -row]
          #puts "\n        BEFORE: $tabledata  -> col=$colnum row=$rownum w=$w"
          if {$colnum ni $columns} {
            my _insertColumn $colnum
          }
          if {$rownum ni $rows} {
            my _insertRow $rownum
          }
          
          set colidx [lsearch $columns $colnum]; set rowidx [lsearch $rows $rownum]
          set row [lindex $tabledata $rowidx]
          #puts "             row=$row, colidx=$colidx"
          set tabledata [lreplace $tabledata $rowidx $rowidx [lreplace $row $colidx $colidx [lreplace [lindex $row $colidx] 2 2 $w]]]
          #puts "        AFTER: $tabledata\n"
          ::wtk::toclient "[my jsobj].rows\[$rowidx\].cells\[$colidx\].appendChild(wtk.widgets\['[$w id]'\]);"
          return ""
        }
        method _insertColumn {colnum} {
          my variable rows columns tabledata master id slaves
          
            set columns [lsort -integer [concat $columns $colnum]]; set colidx [lsearch $columns $colnum]
            set new ""; set rowidx 0
            foreach i $tabledata {
                lappend new [linsert $i $colidx [list $colidx 1 blank]]
                ::wtk::toclient "[my jsobj].rows\[$rowidx\].insertCell($colidx);"
                incr rowidx
            }
            set tabledata $new
        }
        method _insertRow {rownum} {
          my variable rows columns tabledata master id slaves

            if {$tabledata==""} {::wtk::toclient "wtk.newGrid('[$master id]','$id');"}
            set rows [lsort -integer [concat $rows $rownum]]; set rowidx [lsearch $rows $rownum];
            ::wtk::toclient "[my jsobj].insertRow($rowidx);"
            set row ""; for {set i 0} {$i<[llength $columns]} {incr i} {
                lappend row [list $i 1 blank]
                ::wtk::toclient "[my jsobj].rows\[$rowidx\].insertCell($i);"
            }
            lappend tabledata $row
        }
    }
    
}

#	set url $data(url)
	if {[catch {
#	    set timer [time {
		uplevel #0 $Httpd(responsehandler) handle $sock
#	    }]; puts stderr "-->$timer $url"
	} errmsg]!=0} {
          set einfo $::errorInfo
	    Httpd_Log $sock Respond completed error $errmsg
			if {$errmsg=="websocket"} {return}
	    unset -nocomplain data(inprogress)
	    if {$errmsg=="pending"} {
		Httpd_Log $sock Respond pending
		# we're waiting on something else to complete, so no sense having our
		# own HttpdRead keep getting called asking us to do something with this
		# socket
		fileevent $sock readable {}
	    } else {
		upvar #0 Httpd$sock data
		set url ""
		if {[info exists data(url)]} {
		    set url $data(url)
		}
		HttpdError $sock 500 "Error processing request"
		catch {bgerror "Error processing handler for $url:\n$einfo"}
	    }
	} else {
	    Httpd_Log $sock Respond completed ok
            if {[info exists data]  && (![info exists data(sendingfile)] || $data(sendingfile)!=1)} {
                Httpd_Log $sock "Return had not been called during request processing; closing connection.  data=[array names data]"
                HttpdSockDone $sock 1
            }

# This code is loaded into each application instance interpreter.  It maintains state
# for each widget, and then actually creates and manipulates widgets on the client side
# by sending Javascript commands.  It also receives callbacks from the client side which
# are interpreted and used to update internal widget state here, which often triggers
# callbacks or other event bindings.
#
# Communication with the client is solely via the "fromclient" and "toclient" routines
# (the latter of which is setup in the ::wtk::init call).

package require TclOO
package require log

source odie/index.tcl

###
# Add "option"
###
namespace eval ::wtk {
    variable widgets
    variable wobj
    variable _nextid -1
    variable _sender ""

    # Initialization and communication
    proc init {sender} {
      set ::wtk::_sender $sender
      ::wtk::Widget "."
      return ""
    }

    # for debugging
    proc _reset {} {
        variable wobj; variable widgets; variable _nextid; variable _sender
        foreach {id w} [array get wobj] {$w destroy}
        unset -nocomplain widgets
        unset -nocomplain wobj
        set _nextid -1
        ::wtk::GridState _reset
        init $_sender
        return ""
    }

    proc toclient {cmd} {uplevel #0 $::wtk::_sender [list $cmd]}

    proc fromclient {cmd} {
        switch -exact -- [lindex $cmd 0] {
            "EVENT" {
                [getwidget [lindex $cmd 1]] wtk_event {*}[lrange $cmd 2 end]
            }
            "LOG" {
                ::log::log [lindex $cmd 1] [lrange $cmd 2 end]
            }
        }
    }


    # 'Generic' widget object, which handles routines common to all widgets like
    # assigning it an id, keeping track of whether or not its been created, etc.
    # Purely for convenience, we also include some code here that manages widgets
    # that use -text or -textvariable, though not every widget will do so.

    ::odie::class ::wtk::Widget {
        variable id
        variable tkpath
        variable created
        variable wobj
        variable postcreatemsgs
        variable propertiesDict
        variable options

        constructor {new_tkpath args} {
          puts [list WIDGET [info object class [self]] $new_tkpath $args]
          my variable id tkpath postcreatemsgs created options
          set created 0
          set postcreatemsgs {}
          set tkpath $new_tkpath
          if { $tkpath eq "." } {
            # used for root window only

            dict set propertiesDict class Toplevel
          }
          set id obj[incr ::wtk::_nextid]
          set wobj [self]
          oo::objdefine [self] forward tkpath $tkpath
          #my graft tkpath $tkpath

          dict set ::wtk::widgets($tkpath) id $id
          set ::wtk::wobj($id) [self]
          foreach {var info} [my property options] {
            set options(-$var) [dictGet $info -default]
          }
          
          my configurelist {*}$args
          return $new_tkpath
        }
        

        class_method unknown {objname args} {
          if {[string index $objname 0] eq "."} {
            my create ::$objname $objname {*}$args
            return $objname
          }
          error "Unknown method $objname. Valid: [info class methods [info object class [self]]]"
        }

        class_method option args {
          puts $args
        }

        method property_set {propertyKey value} {
            dict set propertiesDict {*}$propertyKey value
            return $value;
        }
        method property_has {args} {
            return [dict exists $propertiesDict {*}$propertyKey]
        }
        method property_get {args} {
            return [dict get $propertiesDict {*}$propertyKey]
        }

        method was_created {} {
          my variable created
          return $created
        }
        method do_create {} {
            my variable postcreatemsgs
            set js [$wobj do_createjs]
            append js $postcreatemsgs
            set postcreatemsgs ""
            ::wtk::toclient $js
            set created 1
            return ""
        }
        method action_sendWhenCreated {msg} {
          if {[my was_created]} {
            ::wtk::toclient $msg
          } else {
            my variable postcreatemsgs
            append postcreatemsgs $msg
          }
        }
        
        method configure args {
          if {[llength $args] == 1} {
            my cget [lindex $args 0]
          } else {
            my configurelist {*}$args
          }
        }

        method configurelist args {
          my variable options
          set dat [my info options]
          
          foreach {var val} $args {
            set field  [string trimleft $var -]
            if {![dict exists $dat $field]} {
              error "Invalid option $var. Valid: [dict keys $dat]"
            }
            set info [dict get $dat $field]
            set options($var) $val
            if {[dict exists $info -configuremethod]} {
              my [dict get $info -configuremethod] $var $val
            }
          }
        }

        method cget field {
          my variable options
          set field [string trimleft $field -]

          if {![info exists options(-$field)]} {
            set dat [my info options]
            if {![dict exists $dat $field]} {
              error "Invalid option -$field. Valid: [dict keys $dat]"
            }
            set info [dict get $dat $field]
            set options(-$field) [dictGet $info -default]
          }
          return $options(-$field)
        }


        method id {} {return $id}
        method jqobj {} {return "\$('#[my id]')"}
        method jsobj {} {return "wtk.widgets\['[my id]'\]"}
        method event_focus {} {toclient "[my jsobj].focus();"}






























        # TODO - variable handling; only relevant if -variable option is delegated to us


        # bindings
        variable bindings
        method action_bind {ev script} {set bindings($ev) $script}
        method event_fire {ev subs} {if {[info exists bindings($ev)]} {uplevel #0 [string map $subs $bindings($ev)]}}
    }

    ::odie::class ::wtk::LabelWidget {
      superclass ::wtk::Widget
      
      
      # text variable handling; only relevant if the main types delegate these options to us
      option -text -configuremethod event_textchanged
      option -textvariable -configuremethod event_textvarset
      
      method event_textchanged {opt txt {fromwidget 0}} {
        my variable created options
        set options($opt) $txt
        if {$created && !$fromwidget} {
          ::wtk::toclient [my _textchangejs $txt]
        }
        
        if {$options(-textvariable)!=""} {
          uplevel #0 set $options(-textvariable) [list $txt]
        }
      }
      method event_textvariablechanged {args} {
        my variable options
        if {$options(-text) ne [uplevel #0 set $options(-textvariable)]} {
            my event_textchanged -text [uplevel #0 set $options(-textvariable)]
        }
      }
      method event_setuptextvar {} {
        my variable options
        if {$options(-textvariable)!=""} {
            if {![uplevel #0 info exists $options(-textvariable)]} {
                uplevel #0 set $options(-textvariable) [list $options(-text)]
            } else {
                set options(-text) [uplevel #0 set $options(-textvariable)]
            }
            uplevel #0 trace add variable $options(-textvariable) write [list [list [self] event_textvariablechanged]]
        }
      }
      method event_textvarset {opt var} {
        my variable options
        set options($opt) $var
        my event_setuptextvar
      }

    }

    proc getwidget {id} {return $::wtk::wobj($id)}

    proc _VerifyWindowExists {window} {
        variable widgets

        if {![info exists ::wtk::widgets([string trimleft $window])]} {
            return \
                -code error \
                -level 2 \
                [format {bad window path name "%1$s"} $window]
        }
        return;
    }

    proc focus {w} {$w event_focus; return ""}
    proc bind {w ev script} {return [$w action_bind $ev $script]}

    # Macro that can be used to simplify the definition of any widget
    ::odie::macro _wtkwidget {args} {
        component W; delegate method * to W; set extrainits ""
        if {"-usetextvar" in $args} {delegate option -textvariable to W; delegate option -text to W; set extrainits {$W event_setuptextvar}}
        constructor {args} "install W using Widget \$\{selfns\}::W \$self; \$self configurelist \$args; $extrainits"
    }


    # Macro used to define options which set their value and then send some Javascript command to the widget
    ::odie::macro _wtkoption {opt default msg} {
        option $opt -default $default -configuremethod _wtkoption$opt
        method _wtkoption$opt {opt val} "
        my variable options
        set opt [string trimleft $opt -]
        set options(\$opt) \$val
        set JS \[my jsobj\]
        set V \$val
        my action_sendWhenCreated \[subst [list $msg]\]
        "
    }

}


foreach file [glob -- commands/*.tcl] {
    source $file

###
# codebale.tcl
#
# This file defines routines used to bundle and manage Tcl and C
# code repositories
#
# Copyright (c) 2012 Sean Woods
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
###

::namespace eval ::codebale {}

::namespace eval ::codebale::parse {}

###
# topic: a5992c7f-8340-ba02-d40e-386aac95b1b8
# description: Records an alias for a Tcl keyword
###
proc ::codebale::alias {alias cname} {
  variable cnames
  set cnames($alias) $cname
}

###
# topic: 0e883f35-83c0-ccd3-eddc-6b297ac2ea77
###
proc ::codebale::buffer_append {varname args} {
  upvar 1 $varname result
  if {![info exists result]} {
    set result {}    
  }
  if {[string length $result]} {
    set result [string trimright $result \n]
    append result \n
  }
  set priorarg {}
  foreach arg $args {
    if {[string length [string trim $arg]]==0} continue
    #if {[string match $arg $priorarg]} continue
    set priorarg $arg
    append result \n [string trim $arg \n] \n
  }
  set result [string trim $result \n]
  append result \n
  return $result
}

###
# topic: 926c564a-a678-8498-6f74-89f37da3fb32
###
proc ::codebale::buffer_merge args {
  set result {}
  set priorarg {}
  foreach arg $args {
    if {[string length [string trim $arg]]==0} continue
    if {[string match $arg $priorarg]} continue
    set priorarg $arg
    append result [string trim $arg \n] \n
  }
  set result [string trim $result \n]
  return $result
}

###
# topic: c1e66f4a-20e3-97a5-d254-1714575c165f
###
proc ::codebale::buffer_puts {varname args} {
  upvar 1 $varname result
  if {![info exists result]} {
    set result {}    
  }
  set result [string trimright $result \n]
  #if {[string length $result]} {
  #  set result [string trimright $result \n]
  #}
  set priorarg {}
  foreach arg $args {
    #if {[string length [string trim $arg]]==0} continue
    #if {[string match $arg $priorarg]} continue
    #set priorarg $arg
    append result \n $arg
    #[string trim $arg \n]
  }
  #set result [string trim $result \n]
  #append result \n
  return $result
}

###
# topic: 951f31f2-cb24-992f-34d9-7e3deb16b43f
# description: Reports back the canonical name of a tcl keyword
###
proc ::codebale::canonical alias {
  variable cnames
  if {[info exists cnames($alias)]} {
    return $cnames($alias)
  }
  return $alias
}

###
# topic: b1e5e6ca-f0bf-9e78-695f-995a35af7c2f
# description: Provide a keyword handler to the autodoc parser
###
proc ::codebale::define {name info} {
  global cmdref
  foreach {var val} $info {
      dict set cmdref($name) $var $val
  }
}

###
# topic: 9cca11ca-4447-43a3-21d3-ad5ac85538b1
# description:
#    A simpler implementation of digest_comment, this proc
#    takes in the raw buffer and returns a dict of the annotations
#    it found
###
proc ::codebale::digest_comment {buffer {properties {}}} {
  set result(description) {}
  set appendto description
  
  foreach line [split $buffer \n] {
    set line [string trimleft [string range $line [string first # $line] end] #]
    set line [string trimright [string trim $line] -]
    if [catch {lindex $line 0} token] {
      append result($appendto) $line \n
      #set result($appendto) [buffer_merge $result($appendto) $line]
      continue
    }
    if {[string index $token end] ne ":"} {
      append result($appendto) $line \n
      #buffer_puts result($appendto) $line
    } else {
      set field [string tolower [string trimright $token :]]
      switch $field {
        topic {
          set result(topic) [lrange $line 1 end]
          append result(description) \n
          set appendto description
        }
        comment -
        desc -
        description {
          #append result(description) [lrange $line 1 end] \n
          set result(description) [buffer_merge $result(description) [lrange $line 1 end]]
          append result(description) \n
          set appendto description
        }
        title -
        headline {
          set result(title) [lrange $line 1 end]
          append result(description) \n
          set appendto description          
        }
        ensemble_method {
          set result(type) proc
          append result(description) \n
          set appendto description
        }
        ensemble -
        nspace -
        namespace -
        class -
        agent_class -
        task -
        subtask -
        method -
        class_function -
        class_method -
        phase -
        function -
        action {
          set result(type) $field
          set result(arglist) [lrange $field 1 end]
          append result(description) \n
          set appendto description
         }
        default {
          set result($field) [lrange $line 1 end]
          append result($field) \n
          set appendto $field
        }
      }
    }
  }
  foreach {field} [array names result] {
    set result($field) [string trim $result($field)]
  }
  return [array get result]
}

###
# topic: c0304a04-9be6-f312-06a0-2d15813720ce
###
proc ::codebale::meta_output outfile {
  set fout [open $outfile w]
  puts "SAVING TO $outfile"
  
  #puts $fout "array set filemd5 \x7b"
  #array set temp [array get ::filemd5]
  #foreach {file md5} [lsort -dictionary [array names temp]] {
  #  set md5 $temp($file)
  #  puts $fout "    [list $file $md5]"
  #}
  #array unset temp
  #puts $fout "\x7d"
  puts $fout "helpdoc eval {begin transaction}"
  helpdoc eval {
    select handle,localpath from repository
  } {
    puts $fout [list ::helpdoc repository_restore $handle [list localpath $localpath]]
  }
  helpdoc eval {
    select hash,fileid from file
  } {
    puts $fout [helpdoc file_serialize $fileid]
  }
  puts $fout [helpdoc node_serialize 0]
  helpdoc eval {
    select entryid from entry
    where class='section'
    order by name
  } {
    puts $fout [helpdoc node_serialize $entryid]
  }
  helpdoc eval {
    select entryid from entry
    where class!='section'
    order by parent,class,name
  } {
    puts $fout [helpdoc node_serialize $entryid]
  }
  puts $fout "helpdoc eval {commit}"
  close $fout
}

###
# topic: cd6e815c-2e68-b751-656a-4c9bbe8918dd
# description: Filters extranous fields from meta data
###
proc ::codebale::meta_scrub {aliases info} {
  foreach {c alist} $aliases {
    foreach a $alist {
      set canonical($a) $c
    }
  }

  set outfo {}
  foreach {field val} $info {
    if {[info exists canonical($field)]} {
      set cname $canonical($field)
    } else {
      set cname $field
    }
    if {$cname eq {}} continue
    if {[string length [string trim $val]]} {
      dict set outfo $cname $val
    }
  }
  return $outfo
}

###
# topic: ead7e6fe-5660-70cc-79f0-eb2f5182465e
###
proc ::codebale::normalize_tabbing {rawblock {newspace 0}} {
  set result {}
  ###
  # clean up spaces
  ###
  set block [string map [list \t "    "] $rawblock]
  
  set spaces -1
  while {[string index $block [incr spaces]] eq " " } {}
  if { $spaces < 0} {
    return $rawblock
  }
  set count 0
  foreach line [split $block \n] {
    if {[string first " " $line] > 0} {
      set spaces -1
      break
    }
    incr count
    set i [string last " " $line]
    if { ($i+1) < $spaces } {
      set spaces [expr $i + 1]
    }
  }
  if {$spaces <= 0} {
    return $rawblock
  }
  set head [string repeat " " $newspace]
  foreach line [split $block \n] {
    append result $head [string range $line $spaces end] \n
  }
  return $result
}

###
# topic: a6ee7ffd-7430-c9cc-d666-9addf08fd039
# description:
#    Parses a script, namespace body, or class
#    definition.
###
proc ::codebale::parse_body {meta body modvar} {
  
  upvar 1 $modvar match
  set match 0
  set patterns [parser_patterns [dictGet $meta scope]]
  foreach {pat info} $patterns {
    if {[regexp $pat $body]} {
      set match 1
      break
    }      
  }

  ###
  # Pass through if we don't see any patterns to match
  ###
  if {!$match} {
    return [list body $body]
  }
  
  set thisline {}
  set thiscomment {}
  set incomment 0
  set linecount 0
  set inheader 1

  array set result {
    namespace {}
    header    {}
    body      {}
    command   {}
    comment   {}
  }
  dict set meta comment {}

  foreach line [split $body \n] {
    append thisline \n $line
    if {![info complete $thisline]} continue
    
    set parseline [string range $thisline 1 end]
    set thisline {}

    if { $incomment } {
      if {[string index [string trimleft $parseline] 0] ne "#"} {
        set incomment 0
        set thiscomment [string trimright $thiscomment \n]
      } else {
        append thiscomment $parseline \n
        continue
      }
    } elseif {[string index [string trimleft $parseline] 0] eq "#"} {
      set incomment 1
      if {$inheader} {
        if {[string length $thiscomment]} {
          append result(header) $thiscomment \n
        }
      } else {
        if {[string length $thiscomment]} {
          append result(body) $thiscomment \n
        }
      }
      set thiscomment {}
      append thiscomment $parseline \n
      continue     
    }
    
    set cmd [pattern_match $patterns $parseline]
    if {$cmd eq {}} {
      set var body
      if {$inheader} {
        set var header
      } else {
        set var body
      }    
      if {[string length $thiscomment]} {
        append result($var) [string trimright $thiscomment \n] \n
        set thiscomment {}
      }
      append result($var) $parseline \n
    } else {
      set inheader 0
      set info $meta
      dict set info comment [string trim $thiscomment]
      if {[catch {{*}$cmd $info $parseline} lresult]} {
        puts "Error: [list {*}$cmd $info $parseline]"
        puts "$lresult"
        puts $::errorInfo
        exit
        error DIE
      }
      foreach {type info} $lresult {
        switch $type {
          header - body {
            #append result($type) $info \n
            buffer_append result($type) $info
          }
          command {
            foreach {pname pinfo} $info {
              dict set result($type) $pname $pinfo           
            }
          }
          namespace {
            logicset add result(namespace) {*}$info
          }
          default {
            append result($type) $info \n
          }
        }
      }
    }
    set thiscomment {}
  }
  return [array get result]
}

###
# topic: a18c5371-2559-4150-a50c-0a21013ba712
# description:
#    Parses a namespace and redeclares any procs as
#    glob procs pointing to the current namespace
###
proc ::codebale::parse_namespace {meta def} {
  global cmdref base block fileinfo
  set nspace [lindex $def end-1]
  set body [lindex $def end]

  set nspace [string trim $nspace :]
  if { $nspace eq {} } {
    set Nspace Global
  } else {
    set Nspace $nspace
  }
  set thisline {}
  array set result {
    command {}
    body    {}
    header  {}
  }
  
  dict set aliases {} [list topic subtopic proc namespace nspace class arglist method]
  set info [digest_comment [dict get $meta comment] $meta]
  set info [meta_scrub $aliases $info]
  dict set info type namespace
  
  helpdoc node_define namespace $Nspace $info nodeid
  set result(meta) [helpdoc node_properties $nodeid]

  set comment         [rewrite_comment 0 $nodeid $result(meta)]

  array set result [parse_body [list {*}$meta namespace $nspace parent $nodeid] $body mod]
  buffer_append newbody [get result(header)] [get result(body)]
  set result(header) {}

  if {[string length [string trim $newbody]]} {
    set result(body) [buffer_merge $comment "[list namespace eval ::$nspace] \{\n$newbody\}"]
  } else {
    logicset add result(namespace) $nspace
    set result(body) {}
    #[dict get $meta comment]
  }
  set result(comment) $comment
  return [array get result]
}

###
# topic: bab541dc-7ab2-5960-b7b3-75553ef388aa
###
proc ::codebale::parse_ooclass {meta def} {
  set nspace [lindex $def end-1]
  set body   [lindex $def end]

  set nspace [string trim $nspace :]
  
  set thisline {}
  array set result {
    command {}
    body    {}
    header  {}
  }
  
  set info [digest_comment [dict get $meta comment] $meta]
  dict set aliases {} [list topic subtopic proc namespace nspace class arglist method]
  set info [meta_scrub $aliases $info]
  dict set info type class
  helpdoc node_define class $nspace $info nodeid
  set result(meta)    [helpdoc node_properties $nodeid]
  set comment         [rewrite_comment 0 $nodeid $result(meta)]
  
  ###
  # Write in the results
  ###
  array set result [parse_body [list {*}$meta class $nspace parent $nodeid scope ooclass] $body mod]
  buffer_append newbody [get result(header)] [get result(body)]
  set result(header) {}
  foreach {mname} [lsort -dictionary [dict keys $result(command)]] {
    buffer_append newbody [dict get $result(command) $mname]
  }
  unset result(command)

  set result(body) [buffer_merge $comment "[list {*}[lrange $def 0 end-1]] \{\n$newbody\}"]
  set result(comment) $comment
  return [array get result]
}

###
# topic: 16fbb45b-8e9a-a13b-0b89-2270fd7537ff
# description:
#    This procedure reads in the definition of a method,
#    marks it up in the help documentation, and seeds the
#    re-writer so that this method is creates in sorted order
###
proc ::codebale::parse_oomethod {meta def} {
  set token    [lindex $def 0]
  if {[string range $token 0 5]=="class_"} {
    set cmd "class_method"
    set class class_method
  } else {
    set cmd "method"
    set class method
  }
  set def "  [list $cmd {*}[lrange $def 1 end-1]] \{[lindex $def end]\}"
  set def [normalize_tabbing $def 2]

  set token    [lindex $def 0]
  set procname [string trim [lindex $def 1] :]
  set fullname [string trimleft $class :]::$procname
  if {[llength $def] < 4} {
    set arglist dictargs
    set darglist dictargs
    set body [lindex $def 3]
  } else {
    set arglist [lindex $def 2]
    set body [lindex $def 4]
    ###
    # Clean up args
    ###
    set darglist {}
    foreach n $arglist {
      if [catch {
      if {[llength $n] > 1} {
        lappend darglist "?[lindex $n 0]?"
      } else {
        lappend darglist [lindex $n 0]
      }
      } err] {
        lappend darglist $n
      }
    }
  }
  
  ###
  # Document
  ###
  set info [digest_comment [dict get $meta comment] $meta]
  set type [dictGet $info type]

  if {$type eq {}} {
    set type [string trim $token :]
    if { $type ne "method" } {
      dict set info type $type
    }
  }
  
  dict set aliases returns {return yields}
  dict set aliases {} [list topic subtopic proc namespace nspace class arglist method $type]
  set info [meta_scrub $aliases $info]
  dict set info type $type
  dict set info arglist $darglist
  helpdoc node_define_child [dictGet $meta parent] $class $procname $info nodeid
  set result(meta)    [helpdoc node_properties $nodeid]
  set result(comment) [rewrite_comment 2 $nodeid $result(meta)]

  set result(command) $def
  return [list command [list ${class}::${procname} [buffer_merge $result(comment) $result(command)]]]
}

###
# topic: 2e9b9100-a28c-1d6d-d421-95779706ad24
# description:
#    This procedure reads in the definition of a method,
#    marks it up the ancestors for this object
###
proc ::codebale::parse_oosuperclass {meta def} {
  set parentid [dictGet $meta parent]
  foreach class [lrange $def 1 end] {
    set ancestor [helpdoc node_id [list class $class] 1]
    helpdoc link_create $parentid $ancestor class_ancestor
  }
  return [list header $def]
}

###
# topic: 0360b378-6857-5d30-2ab6-f15e88365266
###
proc ::codebale::parse_path {info base args} {
  set rewrite 0
  set repo    source
  dict with info {}

  set pathlist $args
  if {[llength $pathlist]==0} {
    set pathlist $base
  }
  
  set stack {}
  foreach path $pathlist {
    stack push stack $path
  }
  set filelist {}
  while {[stack pop stack stackpath]} {
    lappend filelist {*}[sniffPath $stackpath stack]
  }
  set meta [list repo $repo rewrite $rewrite base $base]
  if {![helpdoc exists {select localpath from repository where handle=:repo}]} {
    helpdoc eval {insert into repository (handle,localpath) VALUES (:repo,:base);}
  } else {
    helpdoc eval {update repository set localpath=:base where handle=:repo;}
  }
  foreach {type file} $filelist {
    switch $type {
      parent_name -
      source {
        if { [file tail $file] in {version_info.tcl packages.tcl lutils.tcl}} continue
        if {[catch {
          parse_tclsourcefile $meta $file $rewrite
        } err]} {
          puts [list $file $err]
          puts $::errorInfo
          if {[file exists $file.new]} {
            puts "X $file.new"
            file delete $file.new
          }
        }
      }
      csource {
        if {[catch {
          read_csourcefile $file
        } err]} {
          puts [list $file $err]
        }
      }
      index {
        continue
      }
    }
  }
}

###
# topic: 70a6c102-860a-d996-77f3-c4f2021a5308
# description:
#    This procedure reads in the definition of a procedures,
#    marks it up in the help documentation, and seeds the
#    re-writer so that this procedure is defined from the
#    global namespace
###
proc ::codebale::parse_procedure {meta def} {
  set def [normalize_tabbing $def]

  foreach {token procname arglist body} $def break;
  set rawproc $procname
  set proc [namespace tail $procname]
  set nspace [string trimleft [proc_nspace $rawproc] :]
  if { $nspace eq {} } {
    set nspace [dictGet $meta namespace]
  }
  if {$nspace in {{} ::}} {
    set fullname [string trim $proc :]
  } else {
    set fullname ${nspace}::${proc}
  }
  set result(namespace) $nspace
  set result(command) [list $token ::$fullname $arglist]
  append result(command) " \{$body\}"

  ###
  # Document
  ###
  set type [string trim $token :]
  dict set aliases yields return
  dict set aliases {} [list topic subtopic proc namespace nspace class arglist $type]

  set info [digest_comment [dict get $meta comment] $meta]
  set info [meta_scrub $aliases $info]
  
  dict set info type $type
  ###
  # Clean up args
  ###
  set darglist {}
  foreach n $arglist {
    if {[llength $n] > 1} {
      lappend darglist "?[lindex $n 0]?"
    } else {
      lappend darglist [lindex $n 0]
    }
  }
  dict set info arglist $darglist

  helpdoc node_define proc $fullname $info nodeid
  set result(meta) [helpdoc node_properties $nodeid]
  set result(comment) [rewrite_comment 0 $nodeid $result(meta)]

  return [list command [list $fullname [buffer_merge $result(comment) $result(command)]] namespace $result(namespace)]
}

###
# topic: 7c9f9cea-7829-7eef-903b-3f711033a993
###
proc ::codebale::parse_tclsourcefile {meta file {rewrite 0}} {
  global classes block filename fileinfo
  variable parser_patterns
  array unset filestore
  
  dict with meta {}

  set i [string length $base]

  set fname [file rootname [file tail $file]]
  set dir [string trimleft [string range [file dirname $file] $i end] /]
  set fpath $dir/[file tail $file]
  set filename $dir/[file tail $file]

  set repomd5 [helpdoc file_hash [list $repo $fpath]]
  set md5 [::md5::md5 -hex -file $file]
  
  if {!$::force_check} {
    if { $md5 eq $repomd5} { return 0 }
  }
  
  set info {}
  dict set info mtime [file mtime $file]
  dict set info hash  $md5
  dict set info path  $fpath
  dict set info filename [file tail $file]
  dict set info repo  $repo
  helpdoc file_restore [list $repo $fpath] $info
  
  #set ::filemd5($fpath) $md5
  
  set fin [open $file r]
  set dat [read $fin]
  close $fin
  
  puts "<< $fpath"
  set fileinfo {}
  set result [parse_body [list namespace {} file $file] $dat patmatch]
  if {!$rewrite || !$patmatch} {
    return $patmatch
  }
  ###
  # Rewrite the tcl sourcefile
  ###
  set buffer {}

  set ndefined {}
  set header {}
  set body {}
  set command {}
  set namespace {}
  set buffer {}
  dict with result {}
  buffer_append buffer $header
  foreach ns [lsort -dictionary $namespace] {
    if { $ns ne {} } {
      append buffer \n [list ::namespace eval ::$ns {}] \n
    }
  }  
  if {[llength $command]} {
    foreach {nsproc} [lsort -dictionary [dict keys $command]] {
      buffer_append buffer [dict get $command $nsproc]
    }
  }
  buffer_append buffer $body

  set oldlines [split $dat \n]
  set newlines [split $buffer \n]
  set idx -1
  set identical 1
  foreach oldline $oldlines {
    set newline [lindex $newlines [incr idx]]
    if {[string trim $oldline] ne [string trim $newline]} {
      set identical 0
      break
    }
  }
  if {$identical} {
    if {[file exists $file.new]} {
      puts "~ $file.new"
      file delete $file.new
    }
    return $patmatch
  }
  puts ">> $fpath.new"
  set fout [open $file.new w]
  fconfigure $fout -translation crlf
  puts $fout $buffer
  close $fout
  return $patmatch
}

###
# topic: 233756d1-a3b7-6fa9-3023-ccae156e0ec5
###
proc ::codebale::parser_addpattern args {
  variable parser_patterns
  dict set parser_patterns {*}$args
}

###
# topic: d086f779-79bd-e4d7-f60d-41af050c529d
###
proc ::codebale::parser_patterns scope {
  variable parser_patterns
  set result {}
  foreach {pat info} [dictGet $parser_patterns $scope] {
    dict set result $pat $info
  }
  return $result
}

###
# topic: 6fd968f4-2730-f701-c0fa-3ca32b8f7785
###
proc ::codebale::pattern_match {patterns parseline} {
  set parseline [string trimleft $parseline :]
  foreach {pat patinfo} $patterns {
    set idx -1
    set match 1
    foreach a $pat {
      incr idx
      if [catch {lindex $parseline $idx} token] {
        set match 0
        break
      }
      if {![string match $token $a] } {
        set match 0
        break
      }
    }
    if { $match } {
      return $patinfo
    }
  }
  return {}
}

###
# topic: 929629f0-ebaa-5547-10f6-6410dfa51f8a
###
proc ::codebale::pkgindex_path {base stackvar} {
  upvar 1 $stackvar stack

  set buffer {
set BASE [file dirname [file normalize [info script]]]
}
  set base [file normalize $base]
  set i    [string length  $base]
  
  set result {}
  while {[stack pop stack stackpath]} {
    foreach {type file} [::codebale::sniffPath $stackpath stack] {
      switch $type {
        parent_name {
          set file [file normalize $file]
          set fname [file rootname [file tail $file]]
          ###
          # Assume the package is correct in the filename
          ###
          set package [lindex [split $fname -] 0]
          set version [lindex [split $fname -] 1]
          set path [string trimleft [string range [file dirname $file] $i end] /]
          ###
          # Read the file, and override assumptions as needed
          ###
          set fin [open $file r]
          set dat [read $fin]
          close $fin
          foreach line [split $dat \n] {
            set line [string trim $line]
            if { [string range $line 0 9] != "# Package " } continue
            set package [lindex $line 2]
            set version [lindex $line 3]
            break
          }
          append buffer "package ifneeded $package $version \[list source \[file join \$BASE $path [file tail $file]\]\]"
          append buffer \n
        }
        source {
          set file [file normalize $file]
          if { $file == [file join $base packages.tcl] } continue
          if { $file == [file join $base main.tcl] } continue
          if { [file tail $file] == "version_info.tcl" } continue
          set fin [open $file r]
          set dat [read $fin]
          close $fin
          if {![regexp "package provide" $dat]} continue
          set fname [file rootname [file tail $file]]
          set dir [string trimleft [string range [file dirname $file] $i end] /]
          
          foreach line [split $dat \n] {
            set line [string trim $line]              
            if { [string range $line 0 14] != "package provide" } continue
            set package [lindex $line 2]
            set version [lindex $line 3]
            append buffer "package ifneeded $package $version \[list source \[file join \$BASE $dir [file tail $file]\]\]"
            append buffer \n
            break
          }
        }
        index {
          set dir [string trimleft [string range [file dirname $file] $i end] /]
          append buffer "set dir \[file join \$BASE $dir\] \; source \[file join \$BASE $dir pkgIndex.tcl\]"
          append buffer \n
        }
      }
    }
  }
  return $buffer
}

###
# topic: f9b3ce3a-afc9-72b5-5e33-0ac9b62c31db
###
proc ::codebale::proc_nspace procname {
  set rawproc $procname
  set proc [namespace tail $procname]
  set n [string last $proc $rawproc]
  if { $n == 0 } {
    set nspace {}
  } else {
    set nspace [string range $rawproc 0 [expr {$n - 1}]]
    set nspace [string trimleft $nspace :]
    set nspace [string trimright $nspace :]
  }
  return $nspace
}

###
# topic: 27a7f169-8a00-fb29-4f2c-700a8d8acb7e
###
proc ::codebale::read_csourcefile file {
  global classes base filename
  puts "Reading $file"
  ###
  # Skip the sqlite amalgamation file. It's huge and not marked
  # up the way we need anyway
  ###
  if {[file tail $file] eq "tclsqlite3.c"} {return 0}
  set i [string length $base]

  set fname [file rootname [file tail $file]]
  set dir [string trimleft [string range [file dirname $file] $i end] /]
  set fpath $dir/[file tail $file]
  set filename $dir/[file tail $file]
  set fin [open $file r]
  set dat [read $fin]
  close $fin
  set found 0

  set thisline {}
  set thiscomment {}
  set incomment 0
  set parentid tclcmd
  foreach line [split $dat \n] {
    set line [string trim $line]
    if {[string range $line 0 1] == "/*" } {
        set incomment 1
    }
    if { $incomment } {
      set pline [string trimleft $line "/"]
      set pline [string trimleft $pline "*"]
      set pline [string trimright $pline "/"]
      set pline [string trimright $pline "*"]
      append thiscomment $pline \n


      if {[string range $line end-1 end] eq "*/" } {
        set incomment 0
        #if {[file tail $filename] eq "wallset.c"} {
        #  puts "...COMMENT..."
        #  puts $thiscomment
        #}
        set info [digest_comment $thiscomment [list file $fpath]]
        set thiscomment {}
        set nodeid {}
        set found 0
        foreach {var val} $info {
          switch $var {
            topic {
              set nodeid $val
              dict unset info $var
            }
            tclcmd -
            tclmod {
              if { $nodeid eq {} } {
                set nodeid   [helpdoc node_id [list tclcmd [lindex $val 0]] 1]
              }
              set parentid $nodeid
              helpdoc node_property_set $nodeid usage $val
              dict unset info $var
            }
            tclmethod -
            tclsubcmd {
              if { $nodeid eq {} } {
                set nodeid [helpdoc node_id [list tclcmd [lindex $val 0] method [lindex $val 1]] 1]
              }
              dict unset info $var
              helpdoc node_property_set $nodeid usage   $val              
              helpdoc node_property_set $nodeid arglist [lrange $val 2 end]
            }
          }
        }
        if { $nodeid ne {} } {
          #puts [list $nodeid $info]
          helpdoc node_property_set $nodeid file $fpath

          dict set info file $fpath
          foreach {var val} $info {
            switch $var {
              topic -
              tclcmd -
              tclmod -
              tclmethod -
              tclsubcmd {}
              default {
                helpdoc node_property_set $nodeid $var $val
              }
            }
          }
        }
      }
    }
  }
  return 1
}

###
# topic: 7958a706-b48a-9bc4-4cbb-ef73813e0fb2
###
proc ::codebale::rewrite_comment {spaces topic info} {
  set result {}
  set head [string repeat " " $spaces]
  set class [helpdoc one {select class from entry where entryid=:topic}]
  if { $class eq [dictGet $info type] } {
    dict unset info type
  }

  set order [dict keys $info]
  logicset remove order type description arguments returns yields title
  set order [linsert order 0 title type]
  lappend order description arguments returns yields
  foreach {field} $order {
    set val [dictGet $info $field]
    ###
    # Fields to drop for meta-data
    ###
    set dtext [split [string trim $val] \n]
    if {![llength $dtext]} {
      continue
    }
    if {[llength $dtext] == 1} {
      append result \n "${head}# ${field}: [string trim [lindex $dtext 0]]"
    } else {
      append result \n "${head}# ${field}:"
      foreach dline $dtext {
        append result \n "${head}#    [string trim $dline]"
      }
    }
  }

  set result [buffer_merge "${head}###" "${head}# topic: $topic" $result "${head}###"]
}

###
# topic: d8ef9620-b068-3a82-3761-1725abc83192
# description:
#    Descends into a directory structure, returning
#    a list of items found in the form of:
#    type object
#    where type is one of: csource source parent_name
#    and object is the full path to the file
###
proc ::codebale::sniffPath {spath stackvar} {
  upvar 1 $stackvar stack    
  set result {}

  if { ![file isdirectory $spath] } {
    switch [file extension $spath] {
      .tm {
        return [list parent_name $spath]
      }
      .tcl {
        return [list source $spath]
      }
      .c {
        return [list csource $spath]
      }
    }
  }
  if { [string toupper [file tail $spath]] == "CVS" } return
  if {[file extension $spath] eq ".vfs"} return
  if {[file exists [file join $spath pkgIndex.tcl]]} {
    lappend result index [file join $spath pkgIndex.tcl]
  } else {
    foreach f [glob -nocomplain $spath/*.tcl] {
      lappend result source $f
    }
  }
  foreach f [glob -nocomplain $spath/*.tm] {
    lappend result parent_name $f
  }
  foreach f [glob -nocomplain $spath/*.c] {
    lappend result csource $f
  }
  foreach f [glob -nocomplain $spath/*] {
    while {[file type $f]=="link"} {
      set f [file readlink $f]
    }
    if [file isdirectory $f] {
      stack push stack $f
    }
  }
  return $result
}

set ::force_check 0

###
# topic: c790d2a5-043a-5f76-a476-143db91bd729
###
namespace eval ::codebale {
  alias nspace namespace

  parser_addpattern {}  {namespace eval}   ::codebale::parse_namespace
  parser_addpattern {}  proc               ::codebale::parse_procedure
  parser_addpattern {}  ensemble_method    ::codebale::parse_procedure
  parser_addpattern {}  odie::class        ::codebale::parse_ooclass  
  parser_addpattern {}  {oo::class create} ::codebale::parse_ooclass
  parser_addpattern ooclass method         ::codebale::parse_oomethod
  parser_addpattern ooclass proc           ::codebale::parse_oomethod
  parser_addpattern ooclass class_method   ::codebale::parse_oomethod
  parser_addpattern ooclass superclasses   ::codebale::parse_oosuperclass
}

###
# global.tcl
#
# This file defines Global functions that are genuinely useful
#
# Copyright (c) 2012 Sean Woods
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
###


###
# topic: 4dffef8f-9697-b8e7-e868-c3ad6cae2f00
# description: Export a namespace as an ensemble command
###
proc ::ensemble_build namespace {
  #if {[info command $namespace] ne {}} {
  #  return
  #}
  namespace eval $namespace {
    namespace export *
    namespace ensemble create
  }
}

###
# topic: 74aa80cd-d83e-751b-aa89-c413b6834b12
# description:
#    Provide an implementation in Tcl
#    for a function if none exists already in C
###
proc ::ensemble_method {name args body} {
  #puts [list ensemble_method $name [info script]]
  if {[info command $name] ne {}} return
  #proc $name $args "puts $name \n $body"
  proc $name $args $body
}

###
# topic: 87bd2757-7441-255a-f6fb-8781aacdb50d
# type: ensemble_method
###
ensemble_method ::dictGet {dictvar args} {
  if {[dict exists $dictvar {*}$args]} {
    return [dict get $dictvar {*}$args]
  }
  return {}
}

###
# topic: 58ef6deb-c315-edf9-c8ec-fe5ed710b07d
# type: ensemble_method
###
ensemble_method ::get varname {
  upvar 1 $varname var
  if {[info exists var]} {
    return [set var]
  }
  return {}
}

###
# topic: 84ff222d-9f57-4a40-5804-0b99485cd6ff
# type: ensemble_method
###
ensemble_method ::ladd {varname args} {
  upvar 1 $varname var
  if ![info exists var] {
    set var {}
  }
  foreach item $args {
    if { $item ni $var} {
      lappend var $item
    }
  }
  return $var
}

###
# topic: 9591fb2c-2d1d-be3e-b92d-6e993589a452
# type: ensemble_method
###
ensemble_method ::ladd_sorted {varname args} {
  upvar 1 $varname var
  if ![info exists var] {
    set var {}
  }
  foreach item $args {
    lappend var $item
  }
  set var [lsort -dictionary -unique $var]
  return $var
}

###
# topic: f0367444-a3ae-9186-1ee8-31f757fc4621
# type: ensemble_method
###
ensemble_method ::ldelete {varname args} {
  upvar 1 $varname var
  if ![info exists var] {
      return
  }
  foreach item [lsort -unique $args] {
    while {[set i [lsearch $var $item]]>=0} {
      set var [lreplace $var $i $i {}]
    }
  }
}

###
# index.tcl
#
# This file loads the rest of the odie package
#
# Copyright (c) 2012 Sean Woods
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
###

package provide odie 0.1

###
# topic: 8b8d3c47-197b-0abe-5005-b2a644ebcb7d
###
proc ::load_path {path {ordered_files {}}} {
  lappend loaded index.tcl pkgIndex.tcl
  if {[file exists [file join $path baseclass.tcl]]} {
    lappend loaded baseclass.tcl
    uplevel #0 [list source [file join $path baseclass.tcl]]
  }
  foreach file $ordered_files {
    lappend loaded $file
    uplevel #0 [list source [file join $path $file]]
  }
  foreach file [glob -nocomplain [file join $path *.tcl]] {
    if {[file tail $file] in $loaded} continue
    lappend loaded [file tail $file]
    uplevel #0 [list source $file]
  }
}

set loaded {pkgIndex.tcl index.tcl}

set odie_path [file dirname [info script]]

load_path $odie_path {
  global.tcl
  logicset.tcl
  stack.tcl
  ootools.tcl
  moac.tcl
}

This software is copyrighted by the Sean Woods.  The following terms apply
to all files associated with the software unless explicitly disclaimed in
individual files.

The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.

IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal 
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license. 

###
# logicset.tcl
#
# This file defines the method needed for the tcl inplementation
# of logical sets
#
# Copyright (c) 2012 Sean Woods
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
###

::namespace eval ::logicset {}

###
# topic: 08efb87d-9c9b-36e8-64f5-0a05ff0811f5
# type: ensemble_method
###
ensemble_method ::logicset::add {setvar args} {
  upvar 1 $setvar result
  if {![info exists result]} {
    set result {}
  }
  foreach arg $args {
    if { $args ni $result } {
      lappend result $arg
    }
  }
  return $result
}

###
# topic: bd1fdea7-e32f-113f-6b4b-b1fe7455d5fd
# type: ensemble_method
###
ensemble_method ::logicset::cartesian_product {A B} {
  set result {}
  foreach alement [sort $A] {
    foreach blement [sort $B] {
      lappend result $alement $blement
    }
  }
  return $result
}

###
# topic: d3032d6a-b1d1-656e-afab-a99bb80e09a9
# type: ensemble_method
###
ensemble_method ::logicset::contains {setval args} {
  foreach arg $args {
    if { $arg ni $setval } {
      return 0
    }
  }
  return 1
}

###
# topic: d642d345-9294-81a0-cd88-38b825966629
# type: ensemble_method
###
ensemble_method ::logicset::empty setval {
  if {[llength $setval] == 0} {
    return 1
  }
  return 0
}

###
# topic: aaf46124-7085-3353-aba3-88d113cd0e78
# type: ensemble_method
###
ensemble_method ::logicset::intersection {A B} {
  set result {}
  foreach element $B {
    if { $element in $A } {
      add result $element
    }
  }
  return $result
}

###
# topic: 5ff774e0-3ce3-fd96-38e0-3c83a0c7b1a4
# type: ensemble_method
###
ensemble_method ::logicset::remove {setvar args} {
  upvar 1 $setvar result
  if {![info exists result]} {
    set result {}
  }
  foreach arg $args {
    while { $arg in $result } {
      ldelete result $arg
    }
  }
  return $result
}

###
# topic: ca1ffbc9-d3ff-fbc4-4a2e-d63ed823573d
# type: ensemble_method
###
ensemble_method ::logicset::set_difference {U A} {
  set result {}
  foreach element $A {
    if { $element ni $U } {
      add result $element
    }
  }
  return $result
}

###
# topic: ddb93085-3ab4-a3b3-61e1-fc2133a7c79a
# type: ensemble_method
###
ensemble_method ::logicset::sort A {
  return [lsort -dictionary -unique $A]
}

###
# topic: 13e4ecbf-7e85-e27f-c293-a4b42ad48c30
# type: ensemble_method
###
ensemble_method ::logicset::symmetric_difference {A B} {
  set result {}
  foreach element $A {
    if { $element ni $B } {
      add result $element
    }
  }
  foreach element $B {
    if { $element ni $A } {
      add result $element
    }
  }
  return $result
}

###
# topic: 49074428-2a40-261f-0d63-192290657d9b
# type: ensemble_method
###
ensemble_method ::logicset::union {A B} {
  set result {}
  add result {*}$A
  add result {*}$B
  return $result
}

ensemble_build ::logicset

###
# topic: 5539066c-3e90-2cbd-b008-77a2eb4e7acd
# title: Mother of all Classes
# description:
#    Base class used to define a global
#    template of expected behaviors
###
odie::class moac {
  variable objectInfo
  

  ###
  # topic: 3c54cd52-e671-de60-2102-ebf9d5562a2d
  ###
  method debugOut string {}

  ###
  # topic: dfd570ca-bd5e-28af-f080-8fc28d36b54d
  # description: Bind an object to an event
  ###
  method event:bind {
    my variable event_map

    set event {}
    set script {}
    set idvar {}
    my event declare $dictargs
    dict with dictargs {}
    
    if { [string length $idvar] } { upvar $idvar id }

    if { ![info exists event_map($event)] } {
      return -code error -errorcode "LOGIC INVALID_ARGUMENT" \
        [format "unknown event \"%s\"" $event]
    }
  
    set id [incr event_map($event)]
    set event_map($event:$id) $script
    lappend event_map($event:list) $id
    return $id
  }

  ###
  # topic: 74d04ba1-8164-691a-91c9-e553c74f5cbe
  # description: Declares an oo event
  ###
  method event:declare {
    my variable event_map
    set event [dictGet $dictargs event]
    if { [string length $event] } {
      if {![info exists event_map($event)]} {
        set event_map($event)      -1
        set event_map($event:list) {}
        set event_map($event:subscribers) {}
      }
    } else {
      return -code error -errorcode "LOGIC INVALID_ARGUMENT" \
        "null event identifier"
    }
    return
  }

  ###
  # topic: a037c835-6d4c-767d-5104-78770a4b63ae
  # description: Detach an event from an object
  ###
  method event:detach {
    my variable event_map
    
    set event {}
    set id    {}
    dict with dictargs {}
    
    if { ! [info exists event_map($event)] } {
      return -code error -errorcode "LOGIC INVALID_ARGUMENT" \
        [format "unknown event \"%s\"" $event]
    }
    if { ! [info exists event_map($event:$id)] } {
      return -code error -errorcode "LOGIC INVALID_ARGUMENT" \
        [format "unknown script identifier \"%s\" for event \"%s\"" \
        $id $event]
    }
    
    unset event_map($event:$id)
    set idx [lsearch -sorted $event_map($event:list) $id]
    set event_map($event:list) [lreplace $event_map($event:list) $idx $idx]
  }

  ###
  # topic: 35db60ff-f0bb-e3df-3b41-126a38a49b2c
  # description: Forget an event
  ###
  method event:forget {
    my variable event_map

    set event {}
    dict with dictargs {}

    foreach key [array names event_map $event*] { unset event_map($key) }
    foreach event [lrange $args 1 end] {
      foreach key [array names event_map $event*] { unset event_map($key) }
    }
  }

  ###
  # topic: 401fbdb2-1e5b-47b0-ecbb-78c3f3ceaa71
  # description:
  #    Generate an event
  #    Adds a subscription mechanism for objects
  #    to see who has recieved this event and prevent
  #    spamming or infinite recursion
  ###
  method event:generate {
    my variable event_map

    set event {}
    set info $dictargs
    set strict 0
    set sender [self]
    dict with dictargs {}

    set self [self]

      dict set info id     event#[format %0.8x [incr ::odie::event_count]]
      dict set info origin $self
      dict set info event  $event
      dict set info sender $self
      dict set info rcpt   {}
    
    dict set info self $self
    set rcpt [dictGet $info rcpt]
    if {![info exists event_map($event)]} {
      if { $strict && $sender eq {} } {
        return -code error -errorcode "LOGIC INVALID_ARGUMENT" [format "unknown event \"%s\"" $event]
      }
      return
    }
    foreach pat [get event_map($event:subscribers)] {
      logicset add wholist {*}[info command $pat]
    }
    logicset remove wholist $self
    dict unset info self
    foreach who [lsort -dictionary -decreasing $wholist] {
      $who event notify $info
    }
    my event notify $info
  }

  ###
  # topic: 6056849a-7b71-f512-4f45-bc5d71c62cdf
  # description: Pass a subscribed event to this object
  ###
  method event:notify {
    my variable event_map
    set sender [self]
    dict with dictargs {}
    if {![info exists event_map]} return
    foreach {field value} $dictargs {
      lappend valuemap %${field} $value
    }
    dict set valuemap %sender [dictGet $dictargs $sender]
    dict set valuemap %self   [self]
    
    foreach id [get event_map($event:list)] {
      eval [string map $valuemap [list {*}$event_map($event:$id)]]
    }
  }

  ###
  # topic: 2955042c-8789-2c89-e4e1-eb55c1c35635
  # description:
  #    Subscribe calls for an ensemble to be
  #    passed on to another object
  ###
  method event:subscribe {
    my variable event_map

    set event {}
    set who   {}
    dict with dictargs {}
    
    my event declare event $event
    ::logicset add event_map($event:subscribers) $who
  }

  ###
  # topic: 1c0f43e0-e33d-bb2a-4923-4b7b79ea5252
  # description:
  #    Subscribe calls for an ensemble to be
  #    passed on to another object
  ###
  method event:unsubscribe {
    my variable event_map

    set event {}
    set who   {}
    dict with dictargs {}
    
    my event declare event $event
    ::logicset remove event_map($event:subscribers) $who
  }

  ###
  # topic: e04b7ac7-2d11-853d-e591-28469a01f1b8
  ###
  method forward {method args} {
    oo::objdefine [self] forward $method {*}$args
  }

  ###
  # topic: 92971042-7138-47f7-88b0-7704312df200
  ###
  method get {{field {}}} {
    my variable objectInfo
    if { $field == {} } {
      set result {}
      foreach f [::info object vars [self]] {
        my variable $f
        if {[array exists $f]} {
          dict set result @$f [::array get $f]
        } else {
          dict set result $f [set $f]
        }
      }
      return $result
    }
    my variable $field
    if {[array exists $field]} {
      return [::array get $field]
    }
    if {[info exists $field]} {
      return [set $field]
    }
    return {}
  }

  ###
  # topic: 7be7adbd-32da-8c19-909a-eab4d140fce4
  ###
  method getVarname field {
    return [my varname $field]
  }

  ###
  # topic: e1c1cccb-5201-997d-e0c5-4e04394b61e2
  ###
  method graft args {
    my variable organs
    foreach {stub object} $args {
      set stub [string trimleft $stub /]
      logicset add organs $stub
      my put [list $stub $object]
      my forward ${stub} $object
      # Provide a more standard "/->object" stub
      #my forward /${stub} $object
    }
  }

  ###
  # topic: df00845e-dcbf-6f93-65b9-ee824513102a
  ###
  method morph newclass {
    set class [string trimleft [info object class [self]]]
    set newclass [string trimleft $newclass :]
    if {[info command $newclass] eq {}} {
      error "Class $newclass does not exist"
    }
    if { $class ne $newclass } {
      oo::objdefine [self] class ::${newclass}
    }
  }

  ###
  # topic: 3826d482-8446-2b39-4590-1d02d1ba67e2
  ###
  method organsExport {} {
    my variable organs
    set result {}
    if {![info exists organs]} return
    foreach organ $organs {
      lappend result $organ [my get $organ]
    }
    return $result
  }

  ###
  # topic: 886b734b-f9a9-8aa7-82e8-f77b9a42c344
  ###
  method put args {
    if { [llength $args] == 1 } {
      set args [lindex $args 0]
    }
    foreach {key val} $args {
      string trimleft $key -
      my variable $key
      set $key $val
    }
  }

  ###
  # topic: 5b9a51d5-e327-84f0-8cb7-973e8f4115f0
  ###
  method sensai object {
    foreach {stub obj} [$object organsExport] {
      my graft $stub $obj
    }
  }
}

###
# topic: cceceb5d-a991-e07b-6eeb-21375178fa46
###
odie::class moac.sqliteDb {
  superclass moac
  property docentry {}

  ###
  # topic: 6e0d9dea-cbb3-7b09-98b4-d1b3f2fcc1e3
  ###
  method attach {alias filename} {
    set exists [file exists $filename]
    sqlite3 [self]::${alias} $filename
    my database_functions [self]::${alias}
    my graft $alias [self]::${alias}
    my attach_sqlite_methods [self]::${alias}
    if {!$exists} {
      my database_create $alias
    }
  }

  ###
  # topic: 080a0a01-e018-a81c-9f3d-7a696a0698c9
  ###
  method attach_sqlite_methods sqlchan {
    my graft db $sqlchan
foreach func {
authorizer
backup
busy
cache
changes
close
collate
collation_needed
commit_hook
complete
copy
enable_load_extension
errorcode
eval
exists
function
incrblob
last_insert
last_insert_rowid
nullvalue
one
onecolumn
profile
progress
restore
rollback_hook
status
timeout
total_changes
trace
transaction
unlock_notify
update_hook
version
    } {
        my forward $func $sqlchan $func
    }
  }

  ###
  # topic: d4ac9357-de80-79b0-24a8-a48c07ceac06
  # title: Default implementation of change
  # description: Just a simple passthrough to eval
  ###
  method change args {
    uplevel 1 [list [self] eval {*}$args]
  }

  ###
  # topic: a8f26a9d-1cbd-4992-dfe3-3a4a25a065b0
  ###
  method database_create alias {
    
  }

  ###
  # topic: 76de1589-de3f-78c3-b38c-83502c65cc30
  ###
  method database_functions sqlchan {
  }

  ###
  # topic: af76cd3e-8d30-4841-95d5-99d44e4a00b3
  ###
  method native_tableget table {
    set info {}
    my one {select type,sql from sqlite_master where tbl_name=$table} {
      foreach {type field value} [::schema::createsql_to_dict $sql] {
        dict set info $type $field $value
      }
    }
    return $info
  }

  ###
  # topic: e1811960-ced8-4756-76b4-64def58a2a1c
  ###
  method native_tablelist {} {
      return [my eval {SELECT name FROM sqlite_master WHERE type ='table'}]
  }

  ###
  # topic: cac2e473-a72e-f1d2-180a-fdd417117b0d
  ###
  method schema_dump {} {
    set result {}
    foreach table [my schema_tablelist] {
      dict set result $table [my schema_get $table]
    }
    return $result
  }

  ###
  # topic: 60cc2296-f2e2-4a12-24b7-4dd459d8b49b
  ###
  method schema_fields table {
    set dentry [my property docentry]
    if {![::helpdoc node_exists [list schema $dentry sqltable $table] entryid]} {
      return {}
    }
    set result {}
    helpdoc eval {select name,entryid as fieldid from entry where parent=:entryid and class='field' order by name} {
      dict set result $name [helpdoc node_get $fieldid]
    }
    return $result
  }

  ###
  # topic: a601c2ea-28ad-4dc6-40b6-b6be22cd590e
  ###
  method schema_get table {
    set dentry [my property docentry]
    if {![::helpdoc node_exists [list schema $dentry sqltable $table] entryid]} {
      return {}
    }
    set info [::helpdoc node_get $entryid]
    dict set info fields [my schema_fields $table]
    return $info
  }

  ###
  # topic: ba74ec88-9d25-c62c-fcd0-a50d61c36a99
  ###
  method schema_sql {} {
    set result {}
    foreach table [my schema_tablelist] {
      set info [my schema_get $table]
      append result "-- BEGIN $table" \n
      append result [dict get $info create_sql] \n
      append result "-- END $table" \n
    }
    return $result
  }

  ###
  # topic: f8feb545-51d7-1c81-3ed8-1fb468cb0f6a
  ###
  method schema_tablelist {} {
    set dentry [my property docentry]
    if {![::helpdoc node_exists [list schema $dentry] did]} {
      return {}
    }
    return [helpdoc eval {select name from entry where parent=:did order by name}]
  }
}

package require TclOO

::namespace eval ::classDefine {}

::namespace eval ::odie {}

::namespace eval ::viewobj {}


###
# topic: 14474616-1674-47d6-673c-5059adc6bbb0
###
proc ::classDefine::class_method {name arglist body} {  
  method $name $arglist $body
  dict set ::class_property([peek]) class_methods $name [list arglist $arglist body $body]
}

proc ::classDefine::component args {
  
}

proc ::classDefine::delegate {keyword object args} {
  switch $keyword {
    method {}
    option {}
    typemethod -
    class_method {} 
  }
}

###
# topic: 0bde8c29-3e7d-a6b5-193b-a3c856f0ed0a
# title: Define an ensemble method for this agent
###
::proc ::classDefine::ensemble {ensemble ebody} {
  set class [peek]
  foreach {method body} $ebody {
    dict set ::class_ensemble($class) $ensemble:$method $body
  }
}

###
# topic: e4bf9a80-4e2e-49c9-5547-a1d17af9dfcc
# title: Define an ensemble method for this agent
###
::proc ::classDefine::ensemble_method {ensemble method body} {
  set class [peek]
  dict set ::class_ensemble($class) $ensemble:$method $body
}

###
# topic: 13591268-7a5e-0459-1d8a-467d4875b753
# title: Define an ensemble method for this agent
###
::proc ::classDefine::method {rawmethod args} {
  set class [peek]
  if {[string first : $rawmethod] < 0} {
    ::oo::define $class method $rawmethod {*}$args
    return
  }
  dict set ::class_ensemble($class) $rawmethod [lindex $args end]
}

proc ::classDefine::option {name args} {
  ::global class_property
  set class [peek]
  dict set class_property($class) [string trimleft $name -] [list option $args]
}

###
# topic: b6fb7bbf-f61b-cecb-d5a6-608bd3c59db9
###
proc ::classDefine::peek args {
  if {[llength $args] == 2} {
    upvar 1 [lindex $args 0] class
  }
  ::variable classStack
  set class   [lindex $classStack end]
  return ${class}
}

###
# topic: 0e4e2742-3217-5838-bd78-43374d6daf13
###
proc ::classDefine::pop {} {
  ::variable classStack
  set class      [lindex $classStack end]
  set classStack [lrange $classStack 0 end-1]
  return $class
}

###
# topic: 0968eef3-84f2-c6db-1d59-0abcd79680d4
# title: Define the properties for this agent
###
proc ::classDefine::properties info {
  ::global class_property
  set class [peek]
  foreach {var val} $info {
    dict set class_property($class) $var [list const $val]
  }
}

###
# topic: 8316d501-0155-f0e9-2d71-fb1d13f38b09
# title: Define the properties for this agent
###
proc ::classDefine::property {property type {value {}}} {
  ::global class_property
  set class [peek]
  if { $value eq {} } {
    dict set class_property($class) $property [list const $type]
    return
  }
  switch $type {
    {} - eval {
      dict set class_property($class) $property [list eval $value]
    }
    option {
      dict set class_property($class) $property [list option $value]      
    }
    subst {
      dict set class_property($class) $property [list subst $value]
    }
    const {
      dict set class_property($class) $property [list const $value]      
    }
  }
}

###
# topic: b89c6b36-37ef-4c22-8ee5-26a4b1723bba
# description:
#    Here is the guts of our machine
#    In a seperate namespace so a developer can't accidentally
#    overwrite an important function
###
proc ::classDefine::push type {
  ::variable classStack
  lappend classStack $type
}

###
# topic: e710754b-3fe2-f0f1-fd52-58e24bc0e5dc
# title: Closes all floating windows
###
proc ::closeAllWindows {} {
  namespace delete ::viewobj
  namespace eval ::viewobj {}
}

###
# topic: 9242436a-9453-4827-14ee-766ed8ae9b20
###
proc ::odie::class {name body} {
  set class ::[string trimleft $name :]
  logicset add ::odie::class_list $class
  if { [::info command $class] == {} } {
    oo::class create $class
  }
  ::classDefine::push $class
  namespace eval ::classDefine $body
  ::classDefine::pop
  ::odie::class_properties $class
}

###
# topic: 80b8b5f1-ec02-3ee6-cd3e-34be71d2ffa4
###
proc ::odie::class_ancestors {class {stackvar {}}} {
  if { $stackvar ne {} } {
    upvar 1 $stackvar stack
  } else {
    set stack {}
  }
  if { $class in $stack } {
    return {}
  }
  stack push stack $class
  if {![catch {::info class superclasses $class} ancestors]} {
    foreach ancestor $ancestors {
      class_ancestors $ancestor stack
    }
  }
  if {![catch {::info class mixins $class} ancestors]} {
    foreach ancestor $ancestors {
      class_ancestors $ancestor stack
    }
  }
  return $stack
}

###
# topic: 1c1ea49e-6292-f4e3-e530-9f8af9374810
###
proc ::odie::class_build_ensembles class {
  set info {}
  set ancestors [::odie::class_ancestors $class]
  foreach ancestor $ancestors {
    foreach {path body} [get ::class_ensemble($ancestor)] {
      set ensemble [lindex [split $path :] 0]
      set method   [join [lrange [split $path :] 1 end] :]
      if {![dict exists $info $ensemble $method]} {
        dict set info $ensemble $method $body
      }
    }
  }
  return $info
}

###
# topic: 5fa9aec3-7717-5ab6-413d-0e24ec6f008e
###
proc ::odie::class_build_properties class {
  set info {}
  set ancestors [::odie::class_ancestors $class]
  foreach ancestor $ancestors {
    foreach {var val} [get ::class_property($ancestor)] {
      if {![dict exists $info $var]} {
        dict set info $var $val
      }
    }
  }
  dict set info class [list const $class]
  dict set info ancestors [list const $ancestors]
  return $info
}

###
# topic: 6d31677b-47b0-d566-8d91-a86902573335
# description: Return a list of IRM classes
###
proc ::odie::class_choices {} {
  return [lsort -dictionary -unique $::odie::class_list]
}

###
# topic: 9364ad08-92de-9b3d-df4f-48cc4b31e711
###
proc ::odie::class_properties class {
  foreach {ensemble einfo} [class_build_ensembles $class] {
    set eswitch {}
    foreach {method} [lsort -dictionary [dict keys $einfo]] {
      append eswitch [list $method [dict get $einfo $method]] \n
    }
    if {![dict exists $eswitch default]} {
      set msg "error \"unknown method \[subst \$method\]. Valid: [dict keys $eswitch]\""
      append eswitch [list default $msg] \n
    }
    set body {
if {[llength $args] > 1} {
  set dictargs $args
} else {
  set dictargs [lindex $args 0]
}
  }
    append body \n "set code \[catch {switch \$method [list $eswitch]} result opts\]"
    
    #if { $ensemble == "action" } {
    #  append body \n {  if {$code == 0} { my event generate event $method {*}$dictargs}}
    #}
    append body \n {return -options $opts $result}
    oo::define $class method $ensemble {method args} $body
  }
  ###
  # Apply properties
  ###
  set info [class_build_properties $class]
  set body "my variable options
switch \$field \{"
  append body \n " [list list [list return [lsort -dictionary [dict keys $info]]]]"
  set optiondict {}
  foreach {var val} $info {
    if { $var eq "class_methods" } {
      append body \n " [list $var [dict keys $val]]"
    }
    switch [lindex $val 0] {
      eval {
        append body \n " [list $var [lindex $val 1]]"
      }
      subst {
        append body \n " [list $var [list return [subst [lindex $val 1]]]]"
      }
      const {
        append body \n " [list $var [list return [lindex $val 1]]]"        
      }
      option {
        dict set optiondict $var [lindex $val 1]
        append body \n " [list $var [list return [lindex $val 1]]]"
      }
      default {
        append body \n " [list $var [list return $val]]"
      }
    }
  }
  ###
  # Build options
  ###
  append body \n "  [list options [list return $optiondict]]"
  append body \n "\}"
  append body \n {return [my get $field]}
  oo::define $class method info field $body
  oo::define $class method property field $body

  set cmethods {}
  foreach {method methodinfo} [dictGet $info class_methods] {
    dict with methodinfo {
      logicset add cmethods $method
      ::oo::objdefine $class method $method [get arglist] [get body]
    }
  }
  foreach anc [class_ancestors $class] {
    set ainfo [class_build_properties $anc]

    foreach {method methodinfo} [dictGet $ainfo class_methods] {
      if {$method in $cmethods} continue
      dict with methodinfo {
        logicset add cmethods $method
        ::oo::objdefine $class method $method [get arglist] [get body]
      }
    }
  }
}

proc ::odie::macro {name arglist body} {
  proc ::classDefine::$name $arglist $body
}

###
# topic: bcb549b7-ddbc-16e1-aafe-14cf30ed039a
# description: Work space for the IRM class parser
###
namespace eval ::classDefine {
foreach keyword {
    constructor deletemethod destructor export filter forward  renamemethod
    self superclass unexport unknown variable
  } {
    proc $keyword args "::oo::define \[peek\] $keyword {*}\$args"
  }
  namespace export *
}

###
# topic: ffd7dfab-3eb2-649f-4f78-349603275682
###
namespace eval ::odie {
  namespace export *
}

###
# queue.tcl
#
# This file defines the method needed for the tcl inplementation
# of queues
#
# Copyright (c) 2012 Sean Woods
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
###

::namespace eval ::queue {}

###
# topic: faf2fff4-8cce-65a9-1aa9-aebbd88abb93
# type: ensemble_method
###
ensemble_method ::queue::add {queuevar value} {
  upvar 1 $queuevar queue
  lappend queue $value
}

###
# topic: efe3829e-7435-57ee-356a-2e454a035da1
# type: ensemble_method
###
ensemble_method ::queue::head_insert {queuevar value} {
  upvar 1 $queuevar queue
  set queue [linsert $queue 0 $value]
}

###
# topic: 19078eef-4bc4-b494-9b90-eabf7e88ac1d
# type: ensemble_method
###
ensemble_method ::queue::next {queuevar resultvar} {
  upvar 1 $queuevar queue 
  upvar 1 $resultvar result
  if { [set len [llength $queue]] == 0 } { 
       set result {}
       return 0
  }
  set result [lindex $queue 0]
  if { $len == 1 } { 
       set queue {}
  } else {
    set queue [lrange $queue 1 end]
  }
  return 1 
}

ensemble_build ::queue

###
# queue.tcl
#
# This file defines the method needed for the tcl inplementation
# of stacks
#
# Copyright (c) 2012 Sean Woods
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
###

::namespace eval ::stack {}

###
# topic: 31fdcfe6-70eb-f454-2963-201fa6d15d70
# type: ensemble_method
###
ensemble_method ::stack::head_insert {stackvar value} {
  upvar 1 $stackvar stack
  set stack [linsert $stack 0 $value]
}

###
# topic: dc304faa-b514-d4ba-c7a5-f14287c4a710
# type: ensemble_method
###
ensemble_method ::stack::peek stackvar {
  upvar 1 $stackvar stack
  if {[info exists stack]} {
    return [lindex $stack end]
  }
  return {}
}

###
# topic: 79827956-1a8b-edda-397c-f9d076b9d8a9
# type: ensemble_method
###
ensemble_method ::stack::pop {stackvar resultvar} {
  upvar 1 $stackvar stack 
  upvar 1 $resultvar result
  if { [set len [llength $stack]] == 0 } { 
       set result {}
       return 0
  }
  set result [lindex $stack end]
  if { $len == 1 } { 
       set stack {}
  } else {
    set stack [lrange $stack 0 end-1]
  }
  return 1 
}

###
# topic: de540806-071f-5e11-d270-34e040a4b46c
# type: ensemble_method
###
ensemble_method ::stack::push {stackvar args} {
  upvar 1 $stackvar stack
  lappend stack {*}$args
}

ensemble_build ::stack

###
# Structure that manages an interactive help system
###
package provide ::odie::helpdoc 0.1

###
# topic: 57343680-c66e-0427-ac2c-217bff50a365
###
odie::class odie.yggdrasil {
  superclass moac.sqliteDb
  property create_sql {
    create table if not exists entry (
      entryid string default (uuid_generate()),
      indexed integer default 0,
      parent integer references entry (entryid),
      class string,
      name string,
      mtime integer,
      primary key (entryid)
    );
    create table if not exists property (
      entryid    string references entry (entryid),
      field      string,
      value      string,
      primary key (entryid,field)
    );
    create table if not exists link (
      linktype string,
      entry integer references entry (entryid),
      refentry integer references entry (entryid)
    );
    create table if not exists idset (
      class string,
      id    integer,
      name  string,
      primary key (class,id)
    );
    create table if not exists aliases (
      class string,
      alias string,
      cname string references entry (name),
      primary key (class,alias)
    );
    create table if not exists repository (
      handle string,
      localpath string,
      primary key (handle)
    );
    create table if not exists file (
      fileid         string default (uuid_generate()),
      repo           string references repository (handle),
      path           string,  --path relative to repo
      localpath      string,  --cached path to local file
      filename       string,  --filename
      content_type   string,  --Content/Type of file
      package        string,  --Name of any packages provided,
      size           integer, --File size in bytes
      mtime          integer, --mtime in unix time
      hash           string,   --md5 hash of file
      primary key (fileid)
    );
    create table if not exists filelink (
      linktype string,
      entryid integer references entry (entryid),
      fileid integer references file   (fileid)
    )
  }
  property create_index_sql {
    create index if not exists nameidx on entry (entryid,name);
    create index if not exists parentidx on entry (parent,entryid);
  }
  constructor filename {
    package require sqlite3
    my variable tcllib_md5

    if {[info command ::md5] eq {} } {
      set tcllib_md5 1
      package require md5
    } else {
      set tcllib_md5 0
    }

    catch {rename [self].db [self].db.old}
    if [catch {
      my attach db $filename
      ###
      # Allow up to 2 seconds of
      # slack time for another process to
      # write to the database
      ###
      my db timeout 2000
  
      my put [list filename $filename]
      my put [list initdir [file dir $filename]]
    }] {
      puts "Falling back to temporary storage"
      my attach db {}
      my put [list filename {}]
      my put [list initdir ~]
    }
    
    catch {rename [self].db.old {}}
    return 0
  }

  ###
  # topic: bf756514-f69b-697b-eb91-22dd9b9bf699
  ###
  method alias_list class {
    return [my db eval {select alias,cname from aliases where class=:class order by cname,alias}]
  }

  ###
  # topic: bd5398c9-a66d-c9f4-e692-4eb220fec800
  ###
  method canonical {class name} {
    set name [string tolower $name]
    if { $class in {{} * any}} {
      return [my db eval {select distinct class from aliases order by class}]
    }
    if { $name in {{} * any}} {
      return [my db eval {select alias,cname from aliases where class=:class order by cname,alias}]
    }
    set rows [my db eval {select entryid from entry where class=:class and name=:name}]
    if {[llength $rows] == 1} {
      return $name
    }
    if {[my db exists {select cname from aliases where class=:class and (alias=:name or cname=:name)}]} {
      return [my db one {select cname from aliases where class=:class and (alias=:name or cname=:name) limit 1}]
    }
  }

  ###
  # topic: 093a6db9-b548-c37f-eb65-8c6f4d465dcd
  ###
  method canonical_aliases {class name} {
    set name [string tolower $name]
    return [my db eval {select distinct alias from aliases where class=:class and cname=:name and alias!=:name}]
  }

  ###
  # topic: d6ac748e-6dff-ce69-fbd6-6cea74252a02
  ###
  method canonical_id {class name} {
    return [my db eval {select id from idset where class=:class and name=:name}]
  }

  ###
  # topic: 7150f504-e786-fa88-0bfa-7771b344c442
  ###
  method canonical_set {type name cname} {
    set class [string tolower $type]
    set name [string tolower $name]
    set cname [string tolower $cname] 
    variable canonical_name
    dict set canonical_name $class $name $cname
    set address $type/$name
    my db eval {replace into aliases (class,alias,cname) VALUES ($class,$name,$cname)}
  }

  ###
  # topic: c4c5d5bf-0980-7644-9f1f-8b8ac2a42f4c
  ###
  method class_list class {
    return [lsort -dictionary [my db eval {select name from entry where class=:class}]]
  }

  ###
  # topic: c521688b-4ca8-9bf0-d46e-a724c1b7ae4f
  ###
  method class_nodes class {
    set result {}
    foreach {entryid name} [my db eval {select entryid,name from entry where class=:class order by name}] {
      lappend result $name [my node_properties $entryid]
    }
    return $result
  }

  ###
  # topic: 10518da5-9ca8-ea62-c047-6ed05a6dbc96
  ###
  method database_create alias {
    my $alias eval [my property create_sql]
  }

  ###
  # topic: 5adf83a8-668b-157b-e6fa-72716a3998de
  ###
  method database_functions alias {
    package require uuid
    $alias function uuid_generate [list [self] uuid_generate]
  }

  ###
  # topic: 4c04478b-06d5-9bd5-8ae1-a6df2170d2e9
  ###
  method enum_dump class {
    return [my eval {select id,name from idset where class=:class order by id}]
  }

  ###
  # topic: a1250c93-e5cd-53c1-93df-d7832c47357c
  ###
  method enum_id {class name} {
    set arr ::irm::${class}_name_to_idx
    if {![info exists $arr]} {
      my db eval {select name as aname,id as aid from idset where class=:class} {
        set ${arr}($aname) $aid
      }
    }
    set cname [my canonical $class $name]
    if {![info exists ${arr}($cname)]} {
      error "Invalid $class $name"
    }
    return [set ${arr}($cname)]
  }

  ###
  # topic: ded135de-4cb9-003c-7bb4-70b7943052b1
  ###
  method enum_name {class id} {
    return [my db one {select name from idset where class=:class and id=:id}]
  }

  ###
  # topic: 76cfb43e-2bfd-986c-3316-d3706061dba6
  ###
  method enum_set {class name id} {
    set class [string tolower $class]
    set name [string tolower $name]
    set ::irm::${class}_name_to_idx($name) $id
    set ::irm::${class}_idx_to_name($id) $name
    my db eval {insert or replace into idset (class,id,name) VALUES ($class,$id,$name)}
  }

  ###
  # topic: 1c6106a6-8bf6-9dcc-021d-b31cbb561d4d
  ###
  method file_hash {fileid {newhash {}}} {
    set fileid [my file_id $fileid]
    if {$fileid ne {}} {
      return [my db one {select hash from file where fileid=:fileid}]
    }
    return {}
  }

  ###
  # topic: 9a2b2f20-ada2-155c-8a72-5917435ac127
  ###
  method file_id {addr {create 0}} {
    if {[string is integer $addr]} {
      return $addr
    }
    if {[my db exists {select fileid from file where hash=:addr}]} {
      return [my db one {select fileid from file where hash=:addr}]
    }
    if {[llength $addr]==2} {
      set repo [lindex $addr 0]
      set path [lindex $addr 1]
      if {[my db exists {select fileid from file where repo=:repo and path=:path}]} {
        return [my db one {select fileid from file where repo=:repo and path=:path}]
      }
    }
    if {[my db exists {select fileid from file where path=:addr}]} {
      return [my db one {select fileid from file where path=:addr}]
    }
    if {[my db exists {select fileid from file where localpath=:addr}]} {
      return [my db one {select fileid from file where localpath=:addr}]
    }
    return {}
  }

  ###
  # topic: 78c6fca8-3198-1b80-cc69-3b3ed59334b0
  ###
  method file_restore {nodeid info} {
    set stmtl {}
    dict with info {}
    if {[string is integer $nodeid]} {
      set _fileid $nodeid
    } else {
      set _fileid [my file_id $nodeid]
      if {$_fileid eq {}} {
        set _fileid {}
      }
    }
    if {$_fileid ne {}} {
      set fields fileid
      set values "\$_fileid"
    } else {
      set fields {}
      set values {}
    }
    foreach {field value} $info {
      switch $field {
        repo -
        path -
        localpath -
        filename -
        content_type -
        package -
        size -
        mtime -
        hash {
          if { $value ne {} } {
            lappend fields $field
            lappend values :_$field
            set _$field $value
          }
        }
      }
    }
    my db eval "insert or replace into file ([join $fields ,]) VALUES ([join $values ,]);"
  }

  ###
  # topic: 2d990f66-5ca7-6ad2-e5ef-05e364399b49
  ###
  method file_serialize nodeid {
    set result {}
    my db eval {
      select * from file
      where fileid=$nodeid
    } record {
      set fileid $record(fileid)
      append result "[list [self] file_restore [list $record(repo) $record(path)]] \{" \n
      
      foreach {field value} [array get record] {
        if { $field in {* fileid indexed export} } continue
        append result "  [list $field $value]" \n
      }
      append result "\}"
    }
    return $result
  }

  ###
  # topic: 2514ca1a-6e9c-1af1-275c-1ea253706daa
  ###
  method link_create {entryid to {type {}}} {
    if { $type eq {} } {
      set exists [my one {select count(entry) from link where entry=$entryid and refentry=$to}]
      if {!$exists} {
        my db eval {insert or replace into link (entry,refentry) VALUES ($entryid,$to)}
      }
    } else {
      set exists [my one {select count(entry) from link where entry=$entryid and refentry=$to and linktype=$type}]
      if {!$exists} {
        my db eval {insert or replace into link (entry,refentry,linktype) VALUES ($entryid,$to,$type)}
      } 
    }
  }

  ###
  # topic: f9685bcf-fb03-9e78-3938-4898c01a59c5
  ###
  method link_detect_address args {
    if {[my node_exists $args entryid]} {
      return [my eval {select entryid from entry where entryid=$entryid}]
    }
    ###
    # If the link contains a / we know it is a hard
    # path
    ###
    if {[my node_exists $args entryid]} {
      return $entryid
    }
    if {[llength $args] > 1} {
      set rootentries [my eval {select name from entry where class='section'}]
      
      if {[lindex $args 0] in $rootentries} {
        set type [lindex $args 0]
        set name [my canonical $type [lindex $args 1]]
        if {[my node_exists [list $type $name] entryid]} {
          return $entryid
        }
      }
      if {[lindex $args 1] in $rootentries} {
        set type [lindex $args 1]
        set name [my canonical $type [lindex $args 0]]
        if {[my node_exists [list $type $name] entryid]} {
          return $entryid
        }
      }
    }
    set addr [lindex $args 0]
    set cnames [my eval {select class,cname from aliases where alias=$addr}]
  
    if {[llength $cnames] == 2} {
      if {[my node_exists $cnames entryid]} {
        return $entryid
      }
    }
    #if {[string first / $addr] > 0 } {
    #  return $addr
    #}
    set candidates [my eval {select entryid,name from entry where name like '%$addr%'}]
    foreach address $candidates {
      if {[regexp simnode $address]} {
        return $address
      }
    }
    #puts [list CAN'T RESOLVE $args]
    return $args
  }

  ###
  # topic: 612a2335-0b20-ae08-c159-97a025d11390
  ###
  method node_alloc_child {parent entry {class {}}} {
    if { $parent eq $class } {
      set row [my one {select entryid from entry where parent is null and class=$class and name=$entry}]
    } elseif { $class ne {} } {
      set row [my one {select entryid from entry where parent=$parent and class=$class and name=$entry}]    
    } else {
      set row [my one {select entryid from entry where parent=$parent and name=$entry}]    
    }
    if { [llength $row] && $row != $parent } {
      return $row
    }
    set row [my uuid_generate $parent $class $entry]
    if { $class eq $parent } {
      set row $parent/$entry
      my db eval {insert into entry (entryid,class,name) VALUES ($row,$parent,$entry)}
    } elseif { $class ne {} } {
      my db eval {insert into entry (entryid,parent,class,name) VALUES ($row,$parent,$class,$entry)}
    } else {
      my db eval {insert into entry (entryid,parent,name) VALUES ($row,$parent,$entry)}
    }
    return $row
  }

  ###
  # topic: 522463d0-c361-0c5e-1e00-06469359750b
  # description:
  #    Return a list of all children of node,
  #    Filter is a key/value list that understands
  #    the following:
  #    type - Limit children to type
  #    dump - Output the contents of the child node, not their id
  ###
  method node_children {nodeid class} {
    set dump 1
    set entryid [my node_id $nodeid]
    if { $class eq {} } {
      set nodes [my eval {select name,entryid from entry where parent=$entryid}]
    } else {
      set nodes [my eval {select name,entryid from entry where parent=$entryid and class=$class}]
    }
    if {!$dump} {
      return $nodes
    }
    set result {}
    foreach {cname cid} $nodes {
      dict set result $cname [my eval {select field,value from property where entryid=$cid order by field}]
    }
    return $result
  }

  ###
  # topic: b4954836-f396-6f2c-92cc-4c8251572bd8
  ###
  method node_define {class name info {nodeidvar {}}} {
    if {$nodeidvar ne {}} {
      upvar 1 $nodeidvar nodeid
    }
    
    if { $class eq {} || $class eq "section" } {
      set nodeid $name
    } else {
      set nodeid {}
      if {[dict exists $info topic]} {
        set nodeid [dict get $info topic]
        dict unset info topic
      }
    }    
    if { $nodeid eq {} } {
      if {![my node_exists [list $class $name] nodeid]} {
        set nodeid [helpdoc node_id [list $class $name] 1]
        foreach {var val} [my node_empty $class] {
          my node_property_set $nodeid $var $val        
        }
      }
    } elseif {![my node_exists $nodeid]} {
      my canonical_set $class $name $name
      my eval {insert into entry (entryid,class,name) VALUES (:nodeid,:class,:name)}
      foreach {var val} [my node_empty $class] {
        my node_property_set $nodeid $var $val        
      }
    }
  
    foreach {var val} $info {
      my node_property_set $nodeid $var $val
    }
  }

  ###
  # topic: 07210b77-287a-e0a4-b5e5-d877a5aadb15
  ###
  method node_define_child {parent class name info {nodeidvar {}}} {
    if {$nodeidvar ne {}} {
      upvar 1 $nodeidvar nodeid
    }
    ###
    # Return an already registered node with this address
    ###
    if {[my db exists {select entryid from entry where parent=:parent and class=:class and name=:name}]} {
      set nodeid [my db one {select entryid from entry where parent=:parent and class=:class and name=:name}]
    } else {
      set nodeid {}
  
      if {[dict exists $info topic]} {
        set topicid [dict get $info topic]
        dict unset info topic
        if {![my db exists {select entryid from entry where entryid=:topicid}]} {
          # If we are recycling an unused UUID re-create the entry in the table
          my eval {insert into entry (entryid,parent,class,name) VALUES (:topicid,:parent,:class,:name)}
          set nodeid $topicid
        }
      }
      if { $nodeid eq {} } {
        set nodeid [my uuid_generate $parent $class $name]
      }
      if {[my db exists {select entryid from entry where entryid=:nodeid and class=:class and name=:name}]} {
        ###
        # Correct a misfiled node
        ###
        my db eval {update entry set parent=:parent where entryid=:nodeid}
      } else {
        my eval {insert into entry (entryid,parent,class,name) VALUES (:nodeid,:parent,:class,:name)}
      }
      foreach {var val} [my node_empty $class] {
        if {![dict exists $info $var]} {
          dict set info $var $val
        }
      }
    }
    foreach {var val} $info {
      my node_property_set $nodeid $var $val        
    }
    return $nodeid
  }

  ###
  # topic: ea04bf60-c884-5477-a841-87bb3d571e16
  ###
  method node_empty class {
    set id [my db one {select entryid from entry where name=:class and class='section'}]
    return [my db one {select value from property where entryid=:id and field='template'}]
  }

  ###
  # topic: c7b902b4-c9de-98dc-8230-c099b75a2067
  ###
  method node_exists {node {resultvar {}}} {
    set parent 0
    if { $resultvar != {} } {
      upvar 1 $resultvar row
    }
    if {[llength $node]==1} {
      set name [lindex $node 0]
      if {[my db exists {select entryid from entry where name=:name or entryid=:name}]} {
        set row [my db one {select entryid from entry where name=:name or entryid=:name}]
        return 1
      }
    } elseif {[llength $node]==2} {
      set class [lindex $node 0]
      set name [lindex $node 1]
      if {[my db exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
        set row [my db one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
        return 1
      }
    }
    set class [lindex $node 0]
    set name [lindex $node 1]
    if {[my db exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
      set parent [my db one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
    } else {
      return 0
    }
    foreach {eclass ename} [lrange $node 2 end] {
      set row {}
      if {$eclass eq {}} {
        if {[my db exists {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]} {
          set row [my db one {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]
        }
      } else {
        if {[my db exists {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]} {
          set row [my db one {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]
        }
      }
      if { $row eq {} } {
        return 0
      }
      set parent $row
    }
    return 1
  }

  ###
  # topic: 7f77641d-fbdf-50bc-acfe-1513f2d0a267
  ###
  method node_get {nodeid {field {}}} {
    set result {}
    if {[my node_exists $nodeid entryid]} {
      set result [helpdoc node_properties $entryid]
    } else {
      if {[llength $nodeid] > 1} {
        set type [lindex $nodeid 0]
        set result [my node_empty $type]
      }
    }
    if { $field eq {} } {
      return $result    
    }
    return [dictGet $result $field]
  }

  ###
  # topic: b2ab54e8-34d9-7dbe-cfa9-21066fc20d4e
  ###
  method node_id {node {create 0}} {
    if {[my db exists {select entryid from entry where entryid=:node;}]} {
      return [my db one {select entryid from entry where entryid=:node;}]
    }
    if {[llength $node]==1} {
      set name [lindex $node 0]
      if {[my db exists {select entryid from entry where name=:name or entryid=:name}]} {
        return [my db one {select entryid from entry where name=:name or entryid=:name}]
      }
      if { $create } {
        my db eval {insert into entry (class,name) VALUES ('section',:name)}
        return $name
      } else {
        error "Node $node does not exist"
      }
    } elseif {[llength $node]==2} {
      set class [lindex $node 0]
      set name [lindex $node 1]

      if {[my db exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
        set row [my db one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
        return $row
      }
    }
    set class [lindex $node 0]
    set name [lindex $node 1]
    if {[my db exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
      set parent [my db one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
    } else {
      if {!$create} {
        error "Node $node does not exist"
      }

      ###
      # If the name contains no spaces, dots, slashes, or ::
      ###
      set row [my uuid_generate $class $name]
      my db eval {insert into entry (entryid,class,name) VALUES (:row,:class,:name)}
      set parent $row
    }
    if { $create } {
      set classes [my db eval {select distinct class from entry}]
    }
    set eclass {}
    foreach token [lrange $node 2 end] {
      set ename $token
      set row {}
      if {$eclass eq {}} {
        if {[my db exists {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]} {
          set row [my db one {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]
        }
      } else {
        if {[my db exists {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]} {
          set row [my db one {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]
        }
      }
      if { $row eq {} } {
        if { $create } {
          if { $ename in $classes } {
            set eclass $token
            continue            
          } else {
            set eclass {}
            set row [my node_alloc_child $parent $ename $eclass]
          }          
        } else {
          error "Node $node does not exist"
        }
      }
      set parent $row
    }
    return $row
  }

  ###
  # topic: eb137c42-eacd-7016-7a91-7056ba96ed70
  ###
  method node_properties entryid {
    return [my eval {select field,value from property where entryid=$entryid}]
  }

  ###
  # topic: 8d72229b-f33b-acd0-cd41-b4584fa240eb
  ###
  method node_property_append {nodeid field text} {
    set buffer [my one {select value from property where entryid=:nodeid and field=:field}]
    append buffer " " [string trim $text]
    my db eval {insert or replace into property (entryid,field,value) VALUES (:nodeid,:field,:buffer)}
  }

  ###
  # topic: e1a3da3c-7005-1c92-0aed-5bde26228ee1
  ###
  method node_property_get {nodeid field} {
    return [my db one {select value from property where entryid=:nodeid and field=:field}]
  }

  ###
  # topic: c4e91fb2-44d0-aee6-8454-1effc7012081
  # description: nodeid is any value acceptable to {[my node_alloc]}
  ###
  method node_property_lappend {entryid field args} {
    if {![llength $args]} return
    set dbvalue [my eval {select value from property where entryid=$entryid and field=$field}]
    foreach value $args {
      if { $value eq {} } continue
      logicset add dbvalue $value
    }
    my db eval {update property set value=$dbvalue where entryid=$entryid and field=$field}
  }

  ###
  # topic: 89d208ff-7b88-3985-1167-8c025f82d4d6
  ###
  method node_property_set {entryid args} {
    my variable property_info property_cname
    if {[llength $args]==1} {
      set arglist [lindex $args 0]
    } else {
      set arglist $args
    }
    foreach {field value} $arglist {
      if {[info exists property_cname($field)]} {
        set cname $property_cname($field)
        set rawvalue $value
        eval [dictGet $property_info $cname script]
      } else {
        set cname $field
      }
      if {![my db exists {select value from property where entryid=:entryid and field=:cname and value=:value}]} {
        my db eval {insert or replace into property (entryid,field,value) VALUES (:entryid,:cname,:value)}
      }
    }
  }

  ###
  # topic: f7de1b2d-7c51-6c15-abfa-5a2a2f4d4b22
  ###
  method node_restore {nodeid info} {
    set stmtl {}
    dict with info {}
    set fields entryid
    set _entryid $nodeid
    set values "\$_entryid"
    
    foreach {field value} $info {
      switch $field {
        properties {
          foreach {var val} $value {
            my node_property_set $_entryid $var $val
          }
        }
        references {
          foreach {refid reftype} $references {
            my link_create $_entryid $refid $reftype
          }
        }
        enumid {
          my enum_set [lindex $value 0] [dict get $info name] [lindex $value 1]
        }
        aliases {
          foreach a $value {
            my canonical_set $_class $a $_name
          }
        }
        parent {
          if {![string is integer $value]} {
            set value [my node_id $value 1]
          }
          lappend fields $field
          lappend values "\$_$field"
          set _$field $value            
        }
        class -
        address -
        name {
          if { $value ne {} } {
            lappend fields $field
            lappend values "\$_$field"
            set _$field $value
          }
        }
      }
    }
    my db eval "insert or replace into entry ([join $fields ,]) VALUES ([join $values ,]);"
  }

  ###
  # topic: 478123c9-d7df-a4ed-e50f-4b6ae0778ae0
  ###
  method node_serialize nodeid {
    set result {}
    my db eval {
      select * from entry
      where entryid=$nodeid
    } record {
      set entryid $record(entryid)
      append result "[list [self] node_restore $entryid] \{" \n
      
      foreach {field value} [array get record] {
        if { $field in {* entryid indexed export} } continue
        append result "  [list $field $value]" \n
      }
      set class $record(class)
  
      set id [my canonical_id $class $record(name)]
      if { $id ne {} } {
          append result "  [list enumid [list $class $id]]" \n
      }
      
      append result "  properties \{" \n
      set info [my node_empty $record(class)]
      foreach {var val} [my node_properties $entryid] {
        dict set info $var $val
      }

      foreach {var} [lsort -dictionary [dict keys $info]] {
        if { $var in {aliases field method fields methods references id} } continue
        append result "    [list $var [string trim [dict get $info $var]]]" \n
      }
      
      append result "  \}" \n
      set references [my db eval {select refentry,linktype from link where entry=$entryid}]
      if {[llength $references]} {
        append result "  [list references $references]" \n
      }
      set aliases [my canonical_aliases $record(class) $record(name)]
      if {[llength $aliases]} {
        append result "  [list aliases $aliases]" \n
      }
      set attachments [my db eval {select file.hash,filelink.linktype from file,filelink where filelink.entryid=$entryid and filelink.fileid=file.fileid}]
      if {[llength $attachments]} {
        append result "  [list attachments $attachments]" \n
      }
      append result "\}"
    }
    return $result
  }

  ###
  # topic: e2cc4f04-58df-6611-55d2-1e0861a67299
  ###
  method property_define {property info} {
    my variable property_info property_cname
    foreach {f v} $info {
      dict set property_info $property $f $v
    }
    foreach alias [dictGet $property_info $property aliases] {
      set property_cname($alias) $property
    }
    set property_cname($property) $property
  }

  ###
  # topic: 540bbeb4-3def-889d-5c48-72bebf9ace6a
  ###
  method reindex {} {
    my variable canonical_name
    my db eval {select class,alias,cname from aliases order by class,cname,alias} {
      dict set canonical_name $class $alias $cname
    }
  }

  ###
  # topic: 0301bbb1-0f67-8314-b81d-f4a3d30b3123
  ###
  method repository_restore {handle info} {
    set stmtl {}
    dict with info {}
    set fields handle
    set _handle $handle
    set values "\$_handle"
    foreach {field value} $info {
      switch $field {
        localpath {
          if { $value ne {} } {
            lappend fields $field
            lappend values "\$_$field"
            set _$field $value
          }
        }
      }
    }
    my db eval "insert or replace into repository ([join $fields ,]) VALUES ([join $values ,]);"
  }

  ###
  # topic: e89c52fc-d941-f3a3-f2ef-9957ddbb63f2
  # description:
  #    Because the tcllib version of uuid generate requires
  #    network port access (which can be slow), here's a fast
  #    and dirty rendition
  ###
  method uuid_generate args {
    my variable tcllib_md5
    if {![llength $args]} {
      set block [list [info hostname] [get env(USER)] [get env(user)] [clock seconds] [clock microseconds]]
    } else {
      set block $args
    }
    if {$tcllib_md5} {
      set tok [md5::MD5Init]  
      foreach item $block {
        md5::MD5Update $tok $item
      }
      set uuid [md5::MD5Final $tok]
    } else {
      set uuid [md5 [join $block ""]]
    }
    binary scan $uuid H* s
    foreach {a b} {0 7 8 11 12 15 16 19 20 end} {
        append r [string range $s $a $b] -
    }
    return [string tolower [string trimright $r -]]

  }
}

		#$handler message $sock $msg
		#puts "ws receive $sock $msg"
		set sessionid [dict get $::sock($sock) sessionid]

		set cmd $msg
		if {$::events_on_stdout} {puts "WSCLIENT: $cmd"}
		[dict get $::session($sessionid) interp] eval ::wtk::fromclient [list $cmd]
	}
}


proc ws_upgrade {sock data} {
	fileevent $sock readable {}

	if {$isnewsess} {
		set interp [interp create]
		dict set ::session($sessionid) interp $interp
		dict set ::session($sessionid) sock $sock
		dict set ::session($sessionid) wsock 0
		if {[catch {$interp eval source lib/wtk-base.tcl}]!=0} {puts $::errorInfo}
		$interp alias sendto toclient $sessionid
		$interp eval ::wtk::init sendto
	} else {
		dict set ::session($sessionid) wsock 0
		set interp [dict get $::session($sessionid) interp]
		$interp eval namespace delete ::wtk
		if {[catch {$interp eval source lib/wtk-base.tcl}]!=0} {puts $::errorInfo}
		$interp eval ::wtk::init sendto
	}

	#update the clients cookie, todo: should do this periodically
	set msgq "(function () { document.cookie= 'wtksess=${sessionid};expires=0;path=/;' })();"
	dict set ::session($sessionid) msgq $msgq

	#pass in the server header vars first

}


# fromclient -- Receive a message from a web client and route it to the correct app instance
#
# This is called when the client wants to send its application instance a message (via
# the /wtkcb.html callback in this case), typically an event like a button press.
# We invoke the '::wtk::fromclient' routine in the instance's interpreter to process it.
proc fromclient {sessionid cmd} {puts "CLIENT: $cmd"; [dict get $::session($sessionid) interp] eval ::wtk::fromclient [list $cmd]}


# toclient -- Send Javascript commands from an app instance to the web client
#
# This is called when the application instance wants to send its client a message,
# in the form of a Javascript command.  The message is queued and the actual
# sending is taken care of by the next routine.

set color black
::wtk::grid [::wtk::canvas .c -width 400 -height 400 -background #eeeeee] -column 0 -row 0
::wtk::bind .c <1> "set x %x; set y %y"
::wtk::bind .c <B1-Motion> { 
   .c create line $x $y %x %y -fill $color
   set x %x; set y %y
}

set colors "black blue red green yellow orange brown"
::wtk::grid [::wtk::canvas .palette -background #cccccc -width 400 -height 30] -column 0 -row 2
set x 25
foreach i $colors {
    .palette bind [.palette create rectangle $x 5 [expr {$x+25}] 25 -fill $i] <1> "set color $i"
    incr x 28
}

# Button widgets
odie::class ::wtk::button {
  superclass wtk::LabelWidget
  
  _wtkoption -src "" {$JS.style.background='url($V)';}
  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  _wtkoption -width "" {$JS.style.width=$V;}
  _wtkoption -height "" {$JS.style.height=$V;}
  _wtkoption -radius "" {$JS.style.borderRadius=$V;}
  
  option -command -default {}
  
  method do_createjs {} {return "wtk.createButton('[my id]','[my cget -text]');"}
  
  method _textchangejs {txt} {return "[my jqobj].html('$txt');"}
  
  method wtk_event {which} {
    if {$which eq "pressed"} {
      variable options
      uplevel #0 $options(-command)
    }
  }
}

# Canvas
odie::class ::wtk::canvas {
  superclass wtk::Widget

  property itemtypes "line rectangle"
  property opts.line {-fill strokeStyle -width lineWidth}
  property opts.rectangle {-fill fillStyle -width lineWidth -outline strokeStyle}

  _wtkoption -width 100 {$JS.width=$V;$JS.style.width='${V}px';}
  _wtkoption -height 100 {$JS.height=$V;$JS.style.height='${V}px';}
  _wtkoption -background "#ffffff" {$JS.style.background='$V';}

  variable mousedown 0
  variable nextid 1
  variable items
  
  method do_createjs {} {return "wtk.createCanvas('[my id]');"}
  
  method create {itemtype args} {
      if {$itemtype ni [my property itemtypes]} {error "bad item type"}
      lassign [_parseCoordsAndOptions $args [my property opts.$itemtype]] coords opts
      set cid $nextid; incr nextid
      set items($cid) [list type $itemtype coords $coords]
      ::wtk::toclient "wtk.objs\['[my id]'\].createItem($cid,'$itemtype',\[[join $coords ,]\],$opts);"
      return $cid
  }
  
  method wtk_event {which args} {; # todo - make generic
      if {$which=="mousedown"} {set mousedown 1; set subs [list %x [lindex $args 0] %y [lindex $args 1]]; $W event_fire "<1>" $subs; if {[lindex $args 3]!=""} {$self event_fire [lindex $args 3] "<1>" $subs}}
      if {$which=="mousemove"} {if {$mousedown} {set ev "<B1-Motion>"} else {set ev "<Motion>"}; $W event_fire $ev [list %x [lindex $args 0] %y [lindex $args 1]]}
      if {$which=="mouseup"} {set mousedown 0; $W event_fire "<B1-Release>" [list %x [lindex $args 0] %y [lindex $args 1]]}
  }
  
  method _parseCoordsAndOptions {s optmap} {
      set coords ""; set inopts 0; set opts ""
      foreach {x y} [split $s] {
          if {!$inopts && [string is integer $x]} {
              if {![string is integer $y]} {error "odd number of coordinates"}
              lappend coords $x $y
          } else {
              set inopts 1
              if {![dict exists $optmap $x]} {error "bad option"}
              lappend opts "[dict get $optmap $x]:\"$y\""
          }
      }
      return [list $coords "\{[join $opts ,]\}"]
  }

  variable bindings
  
  method bind {id ev script} {set bindings(${id},$ev) $script}
  
  method event_fire {id ev subs} {
    if {[info exists bindings(${id},$ev)]} {
      uplevel #0 [string map $subs $bindings(${id},$ev)]
    }
  }
}

# Checkbutton
::odie::class ::wtk::checkbutton {
  superclass wtk::LabelWidget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  variable currentvalue 0
  option -command
  option -onvalue -default 1 -configuremethod _onoffchanged
  option -offvalue -default 0 -configuremethod _onoffchanged
  option -variable -configuremethod _varnameset

  # TODO : move -variable handling into generic widget base
  method do_createjs {} {set r "wtk.createCheckButton('[my id]','[my cget -text]');"; if {$currentvalue==$options(-onvalue)} {append r "[my jsobj].childNodes\[0\].checked=true;"}; return $r}
  method _textchangejs {txt} {return "[my jqobj].children(':last').html('$txt');"}
  method wtk_event {which} {
    if {$which in "checked unchecked"} {
      variable options
      if {$which=="checked"} {
        set val $options(-onvalue)
      } else {
        set val $options(-offvalue)
      }
      my _changevalue $val 1; uplevel #0 $options(-command)
    }
  }
  method _varnameset {opt var} {
    my variable options
    set options($opt) $var;
    if {$var!=""} {
      if {![uplevel #0 info exists $var]} {
        uplevel #0 set $var $currentvalue
      } else {
        set currentvalue [uplevel #0 set $var]
      }
      uplevel #0 trace add variable $var write [list [list $self _varchanged]]
    }
  }
  method _onoffchanged {opt val} {if {$currentvalue==$options($opt)} {set options($opt) $val; $self _changevalue $val} else {set options($opt) $val}}
  method _varchanged {args} {if {$currentvalue ne [uplevel #0 set $options(-variable)]} {$self _changevalue [uplevel #0 set $options(-variable)]}}; # trace callback
  method _changevalue {newval {fromwidget 0}} {
    if {[my was_created] && !$fromwidget} {
      if {$newval eq $options(-onvalue) && $options(-onvalue) ne $currentvalue} {
        ::wtk::toclient "[my jsobj].childNodes\[0\].checked=true;"
      } elseif {$newval ne $options(-onvalue) && $options(-onvalue) eq $currentvalue} {
        ::wtk::toclient "[my jsobj].childNodes\[0\].checked=false;"
      }
    }
    set currentvalue $newval
    if {$options(-variable) ne ""} {uplevel #0 set $options(-variable) [list $newval]}
  }

}

# Combobox widgets
::odie::class ::wtk::combobox {
  superclass wtk::Widget
  
  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  _wtkoption -width "" {$JS.style.width=$V;}
  _wtkoption -height "" {$JS.style.height=$V;}
  _wtkoption -radius "" {$JS.style.borderRadius=$V;}
  variable optionsvalue ""
  variable currentvalue ""
  
  option -text -configuremethod event_textchanged
  option -options  -configuremethod _setoptions 
  option -variable -configuremethod _varnameset
  option -command
  
  method do_createjs {} {
    my variable optionsvalue
    set r "wtk.createCombobox('[my id]','[my cget -text]');"
    foreach e [get optionsvalue] {
      append r "[my jsobj].innerHTML+='<option>$e</option>';"
    }
    return $r
  }
  method _textchangejs {txt} {return "[my jqobj].html('$txt');"}
  method wtk_event {which value} {
              if {$which eq "value"} {
                       $self _changevalue $value 1;
                       uplevel #0 $options(-command)
              }
  }    
  method _varnameset {opt var} {set options($opt) $var;
      if {$var!=""} {
          if {![uplevel #0 info exists $var]} {uplevel #0 set $var $currentvalue} else {set currentvalue [uplevel #0 set $var]}
          uplevel #0 trace add variable $var write [list [list $self _varchanged]]
      }
  }
  method _varchanged {args} {
    if {$currentvalue ne [uplevel #0 set $options(-variable)]} {
      my _changevalue [uplevel #0 set $options(-variable)]
    }
  }
  
  method _changevalue {newval {fromwidget 0}} {
    if {[my was_created] } {
      if {$newval ne $currentvalue} {
        ::wtk::toclient "[my jsobj].value = '$newval';"
      }
    }
    set currentvalue $newval
    if {$options(-variable) ne ""} {
      uplevel #0 set $options(-variable) [list $newval]
    }
  }

  method _setoptions {op values} {
    my variable optionsvalue
    set optionsvalue $values
    if {$options(-options) ne ""} {uplevel #0 set $options(-options) [list $values]}
    if {[my was_created]} {
      foreach e $values {
        ::wtk::toclient "[my jsobj].innerHTML+='<option>$e</option>';"
      }
    }
  }
}

# Entry widgets
::odie::class ::wtk::entry {
  superclass wtk::LabelWidget
  
  _wtkoption -width "" {$JS.size=$V;}
  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createEntry('[my id]','[my cget -text]');"}
  method _textchangejs {txt} {return "[my jqobj].val('$txt');"}
  method wtk_event {which args} {
    if {$which eq "value"} {
      my event_textchanged -text $args 1
    }
  }
}

# Frame
::odie::class ::wtk::frame {
  superclass wtk::Widget

  option -padding
  method do_createjs {} {return "wtk.createFrame('[my id]');"}
}

# Label widgets
::odie::class ::wtk::label {
  superclass wtk::LabelWidget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','[my cget -text]');"}
  method _textchangejs {txt} {return "[my jqobj].html('$txt');"}
}

# labelframe widgets
odie::class Labelframe {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','labelframe');"}
}

# listbox widgets
::odie::class ::wtk::Listbox {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','listbox');"}
}

# menu widgets
::odie::class ::wtk::Menu {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','menu');"}
}

# menubutton widgets
::odie::class ::wtk::Menubutton {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','menubutton');"}
}

# message widgets
::odie::class ::wtk::Message {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','message');"}
}

# Label widgets
::odie::class ::wtk::misc {
  superclass wtk::LabelWidget
  
  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  variable typevalue ""
  variable attrvalue ""
  variable currentvalue ""

  option -type  -configuremethod _setoption
  option -attr  -configuremethod _setoption
  option -variable -configuremethod _varnameset
  option -command
  
  method do_createjs {} {
      set r "wtk.createMisc('[my id]','[my cget -type]','[my cget -text]','[my cget -attr]');"
      return $r
  }
  method _textchangejs {txt} {return "[my jqobj].html('$txt');"}   
  
  method _setoption {opt var} {
    set options($opt) $var
    if {$var!=""} {
      if {![uplevel #0 info exists $options($opt)]} {
        uplevel #0 set $options($opt) [list $var]
      } else {
        set typevalue [uplevel #0 set $options($opt)]
      }
      #uplevel #0 trace add variable $options($opt) write [list [list $self _varchanged]]
    }
  }
  
  method wtk_event {which args} {
    uplevel #0 $options(-command) $args
  }
  
  method _varnameset {opt var} {
    set options($opt) $var
    if {$var!=""} {
      if {![uplevel #0 info exists $var]} {
        uplevel #0 set $var $currentvalue
      } else {
        set currentvalue [uplevel #0 set $var]
      }
      uplevel #0 trace add variable $var write [list [list $self _varchanged]]
    }
  }
  
  method _varchanged {args} {
    if {$currentvalue ne [uplevel #0 set $options(-variable)]} {
            $self _changevalue [uplevel #0 set $options(-variable)]
    }
  }
              
  method _changevalue {newval {fromwidget 0}} {
    if {[my was_created] } {
      if {$newval ne $currentvalue} {
          ::wtk::toclient "[my jsobj].value = '$newval';"
      }
    }
    set currentvalue $newval
    if {$options(-variable) ne ""} {uplevel #0 set $options(-variable) [list $newval]}
  }



}

# panedwindow widgets
::odie::class ::wtk::Panedwindow {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','panedwindow');"}
}

# radiobutton widgets
::odie::class ::wtk::Radiobutton {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','radiobutton');"}
}

# scale widgets
::odie::class ::wtk::Scale {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','scale');"}
}

# scrollbar widgets
::odie::class ::wtk::Scrollbar {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','scrollbar');"}
}

# spinbox widgets
::odie::class ::wtk::Spinbox {
  superclass wtk::Widget

  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','spinbox');"}
}

# TextArea widgets
::odie::class ::wtk::text {
  superclass wtk::LabelWidget
    
  #_wtkwidget -usetextvar
  _wtkoption -cols "" {$JS.cols=$V;}
  _wtkoption -rows "" {$JS.rows=$V;}
  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  method do_createjs {} {return "wtk.createText('[my id]','[my cget -text]');"}
  method _textchangejs {txt} {return "[my jqobj].val('$txt');"}
  method wtk_event {which args} {
    if {$which eq "value"} {
      my event_textchanged -text $args 1
    }
  }
}

# tk_optionmenu widgets
::odie::class ::wtk::Tk_optionmenu {
  superclass wtk::Widget
  
  _wtkoption -bg "" {$JS.style.background='$V';}
  _wtkoption -fg "" {$JS.style.color='$V';}
  
  method do_createjs {} {return "wtk.createLabel('[my id]','tk_optionmenu');"}
}