#***
# [manpage_begin threads tclircc 0.0.1]
# [titledesc {Component threads.tcl}]
# [description]

namespace eval threads {
  variable threads [list main [thread::id]]
  variable log [logger::init tclircc::threads]

  variable t_ns_script {
    namespace eval ::t {
      variable ns
      variable self
      proc update {} {
        variable ns
        thread::send -head [set ns(main)] threads::update
      }
      proc ns {name} {
        variable ns
        set ns($name)
      }
      proc debug {} {
        variable log
        parray t::ns
      }
      proc util_pctsub {script} {
        set new_script {}
        set idx 0
        while {[set subst_start [string first "%" $script $idx]] != -1} {
          append new_script [string range $script $idx $subst_start-1]
          if {[string index $script $subst_start+1] == "%"} {
            append new_script %
            set idx [expr {$subst_start + 2}]
            continue
          }
          regexp -start [expr {$subst_start + 1}] -indices {[^A-Za-z0-9_:]} $script match
          if {[llength $match]} {
            lassign $match subst_end
            set subst_end $subst_end-1
          } else {
            set subst_end [string length $script]
          }
          upvar [string range $script $subst_start+1 $subst_end] subst_data
          append new_script $subst_data
          set idx [expr $subst_end + 1]
        }
        append new_script [string range $script $idx end]

        return $new_script
      }
      proc exec {name script {followup {}}} {
        variable ns
        variable self

        set script [uplevel [list ::t::util_pctsub $script]]
        set followup [uplevel [list ::t::util_pctsub $followup]]

        if [string length $followup] {
          set realscript {
            set result [eval %script]
            set script [concat [list set result $result] ";" %followup]
            thread::send -async [t::ns %self] $script
          }
          regsub %self $realscript [list $self] realscript
          regsub %followup $realscript [list $followup] realscript
          regsub %script $realscript [list $script] script
        }

        thread::send -async [set ns($name)] $script
      }
    }
  }
  eval $t_ns_script
  set ::t::self "main"

  proc manage {tid name} {
    variable threads
    variable log
    variable t_ns_script
    dict set threads $name $tid
    ${log}::debug "managing thread $tid as \"$name\""

    thread::send -head $tid [concat $t_ns_script ";" [list set ::t::self $name]]

    ::threads::update
  }
  proc unmanage {name} {
    variable threads
    variable log
    dict unset threads $name
    ${log}::debug "unmanaging thread $tid (\"$name\")"
    ::threads::update
  }
  proc update {} {
    variable threads
    dict for {name tid} $threads {
      if ![thread::exists $tid] {dict unset $threads $name}
    }
    dict for {name tid} $threads {
      set payload {array unset t::ns; }
      dict for {n t} $threads {
        append payload {set t::ns(} $n {) } $t {; }
      }
      append payload {
        if {"on_threads_update" in [info procs on_threads_update]} \
          on_threads_update
      }
      thread::send -head $tid $payload
    }
    ::update
  }
}

#***
# [manpage_end]