# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: peertab.tcl,v 1.25 2006/01/28 19:16:59 jfontain Exp $


namespace eval peer {                                                                ;# note: based on formulas table implementation

    class table {

if {$global::withGUI} { ;# >8

        proc table {this parentPath args} composite {[new frame $parentPath] $args} viewer {} {
            composite::complete $this
            constructor $this $composite::($this,-port) $composite::($this,-source)
            # wait till after completion before creating table since some options are not dynamically settable
            set table [new dataTable $widget::($this,path)\
                -data $($this,dataName) -draggable $composite::($this,-draggable) -background $viewer::(background)\
            ]
            pack $widget::($table,path) -fill both -expand 1
            set tablePath $dataTable::($table,tablePath)
            # note: this viewer cannot be mutated
            set formats KILL
            if {$composite::($this,-source) eq ""} {                                        ;# import tables do not allow cells drop
                lappend formats DATACELLS
            }
            set ($this,drop) [new dropSite -path $tablePath -formats $formats -command "peer::table::handleDrop $this"]
            set ($this,table) $table
            if {$composite::($this,-draggable)} {
                set drag $dataTable::($table,drag)
                dragSite::provide $drag OBJECTS "peer::table::dragData $this"
                dragSite::provide $drag DATACELLS "peer::table::dragData $this"                ;# intercept original data cells drag
                set ($this,drag) $drag
            }
            preload $this $composite::($this,-configurations)
            updateMessage $this
        }

} else { ;# >8                       remove Tk dependant code since this class can be used by monitoring daemon in a Tcl environment

        proc table {this args} switched {$args} viewer {} {
            switched::complete $this
            constructor $this $switched::($this,-port) $switched::($this,-source)
            preload $this $switched::($this,-configurations)
        }

} ;# >8

        proc constructor {this port source} {
            variable object

            set dataName ::peer::table::$(nextDataIndex)data              ;# unique name based on index (available after completion)
            unset -nocomplain $dataName
            array set $dataName [list\
                updates 0\
                0,label [mc cell] 0,type ascii\
                1,label [mc value] 1,type dictionary\
                indexColumns 0\
                sort {0 increasing}\
            ]
            set ($this,dataName) $dataName
            set instance [modules::loadPeerModule $(nextDataIndex) $port $source message]
            set namespace $modules::instance::($instance,namespace)
            if {$message ne ""} {                                           ;# there was an error in the module initialization stage
if {$global::withGUI} { ;# >8
                tk_messageBox -title [mc {moodss: Error loading peer module}] -type ok -icon error -message $message
} ;# >8
                modules::flashMessage peer $namespace $message                                                      ;# leave a trace
            }
            set object($namespace) $this
            foreach [list ${dataName}(0,message) ${dataName}(1,message)] [${namespace}::messages] {}
            set ($this,namespace) $namespace
            set ($this,instance) $instance
            incr (nextDataIndex)
        }

        proc ~table {this} {
            variable ${this}cellRow
            variable object

if {$global::withGUI} { ;# >8
            if {$composite::($this,-source) eq ""} {                  ;# export case: delete remaining last wishes, one for each row
                foreach {name wish} [array get {} $this,rowLastWish,*] {
                    delete $wish                                                                        ;# which in turn deletes row
                }
                delete $($this,drop) $($this,table)
            } else {
                $($this,namespace)::clear                                      ;# so related viewers can show cells have disappeared
            }
} ;# >8                                                                 note: daemon case in not handled as tables are never deleted
            unset -nocomplain ${this}cellRow
            unset $($this,dataName)
            modules::unload $($this,instance)
            foreach {namespace identifier} [array get object] {
                if {$identifier == $this} {
                    unset object($namespace)
                    break
                }
            }
if {$global::withGUI} { ;# >8
            if {$composite::($this,-deletecommand) ne ""} {
                uplevel #0 $composite::($this,-deletecommand)                               ;# always invoke command at global level
            }
} else { ;# >8
            if {$switched::($this,-deletecommand) ne ""} {
                uplevel #0 $switched::($this,-deletecommand)
            }
} ;# >8
        }

        proc options {this} {                                       ;# data index must be forced so that initialization always occur
            return [list\
                [list -cellrows {} {}]\
                [list -configurations {} {}]\
                [list -dataindex {}]\
                [list -deletecommand {} {}]\
                [list -draggable 0 0]\
                [list -port 8008 8008]\
                [list -source {} {}]\
            ]
        }

        proc set-cellrows {this value} {                                             ;# restore cell to row mapping from a save file
if {$global::withGUI} { ;# >8
            set complete $composite::($this,complete)
} else { ;# >8
            set complete $switched::($this,complete)
} ;# >8
            if {$complete} {
                error {option -cellrows cannot be set dynamically}
            }
            set ($this,cellRows) $value
            set ($this,cellRowIndex) 0                                                  ;# initialize cell row index in list of rows
        }

        # for client table, restore data cells from dashboard file so that viewers monitoring such cells do not loose them at
        # initialization time
        proc set-configurations {this value} {
if {$global::withGUI} { ;# >8
            set complete $composite::($this,complete)
} else { ;# >8
            set complete $switched::($this,complete)
} ;# >8
            if {$complete} {
                error {option -configurations cannot be set dynamically}
            }
        }

        set (nextDataIndex) 0                        ;# used when data array index is not specified as an option when creating table
        proc reset {} {                              ;# reset generated counter (invoker must insure that there are no viewers left)
            set (nextDataIndex) 0
        }
        # data array name index must be specifiable so that data viewers depending on peer table data array name (through their
        # monitored cells) do not fail accessing that data (required when generating viewers from save file)
        proc set-dataindex {this value} {                                                     ;# always invoked at construction time
if {$global::withGUI} { ;# >8
            set complete $composite::($this,complete)
} else { ;# >8
            set complete $switched::($this,complete)
} ;# >8
            if {$complete} {
                error {option -dataindex cannot be set dynamically}
            }
            if {$value ne ""} {                                     ;# specified, else use internally generated next available index
                if {$value < $(nextDataIndex)} {
                    error "specified data index ($value) is lower than internal peer table index"
                }
                set (nextDataIndex) $value
            }
        }

        proc set-deletecommand {this value} {}

        foreach option {-draggable -port -source} {
            proc set$option {this value} "
if {$global::withGUI} { ;# >8
                set complete \$composite::(\$this,complete)
} else { ;# >8
                set complete \$switched::(\$this,complete)
} ;# >8
                if {\$complete} {
                    error {option \$option cannot be set dynamically}
                }
            "
        }

        proc supportedTypes {this} {
            return $global::dataTypes
        }

        proc preload {this lists} {                                 ;# comes from -configurations option, used for client table only
            foreach list $lists {
                array set option $list                                                  ;# array compatible list of name/value pairs
                $($this,namespace)::new $option(-row) $option(-type)
            }
        }

        proc monitorCell {this array row column} {                                                    ;# solely used by export table
            variable ${this}cellRow

            set cell ${array}($row,$column)
            if {[info exists ${this}cellRow($cell)]} return                                              ;# already displayed, abort
            foreach {label incomplete} [viewer::label $array $row $column] {}
            viewer::registerTrace $this $array
            if {[info exists ($this,cellRowIndex)]} {                                ;# restore cell row from recorded configuration
                set row [lindex $($this,cellRows) $($this,cellRowIndex)]
                if {$row eq ""} {                                ;# rows list exhausted: we are done initializing from recorded data
                    unset ($this,cellRowIndex) ($this,cellRows)
                    set row [hash64::string $cell]
                } else {
                    incr ($this,cellRowIndex)                                                         ;# get ready for upcoming cell
                }
            } else {   ;# use persistent row number so that for example other viewers recover monitoring deleted then recreated cell
                set row [hash64::string $cell]
            }
            set ${this}cellRow($cell) $row                                                                      ;# remember cell row
            set dataName $($this,dataName)
            set ${dataName}($row,0) $label
            set current ?
            catch {set current [set $cell]}                                                                    ;# cell may not exist
            set ${dataName}($row,1) $current
            viewer::parse $cell ignore ignore ignore type     ;# cannot fail as viewer layer insures cell array exists at this point
            $($this,namespace)::new $row $type
            $($this,namespace)::cell $row $label
            $($this,namespace)::value $row $current
if {$global::withGUI} { ;# >8
            # setup action when a row is deleted through a cell drop in eraser site
            set ($this,rowLastWish,$row) [new lastWish "peer::table::deleteRow $this $cell"]
} ;# >8
            if {$incomplete} {                                                                     ;# label cannot be determined yet
                set ($this,relabel,$row) {}
            }
            incr ${dataName}(updates)                   ;# let data table update itself (so colors can be set on cells, for example)
            $($this,namespace)::update
if {$global::withGUI} { ;# >8
            updateMessage $this
} ;# >8
        }

        proc update {this array} {       ;# note: invoked from viewer layer for exporter table when original cell(s) change(s) value
            variable ${this}cellRow

            set dataName $($this,dataName)
            set updated 0
            foreach {cell row} [array get ${this}cellRow] {
                if {[string first $array $cell] != 0} continue         ;# no need to update if cell does not belong to updated array
                if {[catch {set current [set $cell]}] || ($current eq "?")} {                      ;# cell does not exist or is void
                    set ${dataName}($row,1) ?                           ;# do not touch other columns as their content remains valid
                } else {                                                                                            ;# data is valid
                    set ${dataName}($row,1) $current
                }
                $($this,namespace)::value $row [set ${dataName}($row,1)]
                if {[info exists ($this,relabel,$row)] && [info exists $cell]} {           ;# if label is not yet defined, update it
                    viewer::parse $cell ignore cellRow cellColumn type
                    foreach [list ${dataName}($row,0) incomplete] [viewer::label $array $cellRow $cellColumn] {}
                    if {!$incomplete} {
                        unset ($this,relabel,$row)                                                   ;# label now completely defined
                        $($this,namespace)::cell $row [set ${dataName}($row,0)]
                    }
                }
                set updated 1
            }
            if {$updated} {
                incr ${dataName}(updates)                                                            ;# let data table update itself
                $($this,namespace)::update
            }
        }

        proc updated {namespace serialized} {                 ;# for client table only: invoked from asynchronous client peer module
            variable object

            set this $object($namespace)
            set dataName $($this,dataName)
            array unset $dataName {[0-9]*,[01]}                                                           ;# perform a brutal update
            array set $dataName $serialized
            if {[info exists ($this,drag)]} {
                if {[llength [array names $dataName {[0-9]*,0}]] == 0} {                        ;# empty table: allow drop in eraser
                    dragSite::provide $($this,drag) OBJECTS "peer::table::dragData $this"
                } else {                      ;# data cells cannot be deleted by user as they match the contents of the export table
                    dragSite::provide $($this,drag) OBJECTS {}
                }
            }
            incr ${dataName}(updates)                                         ;# let data table update itself to synchronize display
        }

        proc cells {this} {
            variable ${this}cellRow

            return [array names ${this}cellRow]
        }

if {$global::withGUI} { ;# >8

        proc handleDrop {this} {
            if {![catch {set data $dragSite::data(DATACELLS)}]} {
                set peer 0
                foreach cell $data {
                    viewer::parse $cell array ignore ignore ignore
                    if {[lindex [modules::decoded [modules::namespaceFromArray $array]] 0] eq "peer"} {
                        set peer 1
                    } else {
                        viewer::view $this $data
                    }
                }
                if {$peer} {
                    lifoLabel::flash $global::messenger [mc {peer tables cannot hold data from other peer tables}]
                }
            } elseif {[info exists dragSite::data(KILL)]} {
                delete $this                                                                                       ;# self destructs
                updateViewObjectsMenu
            }
        }

        proc dragData {this format} {
            variable ${this}cellRow

            set cells [dataTable::dragData $($this,table) DATACELLS]
            switch $format {
                OBJECTS {
                    set lastWishes {}
                    foreach cell $cells {
                        regexp {\(([^,]+)} $cell dummy row
                        lappend lastWishes $($this,rowLastWish,$row)
                    }
                    if {[llength $lastWishes] == 0} {                                                    ;# also used in import case
                        return $this                                                              ;# self destruct if no rows remain
                    } else {                                                                                  ;# only in export case
                        return $lastWishes
                    }
                }
                DATACELLS {
                    if {$composite::($this,-source) eq ""} {                                                         ;# export table
                        foreach {cell row} [array get ${this}cellRow] {                          ;# revert original cell/row mapping
                            set original($row) $cell
                        }
                    }                      ;# else import table: return data cells from the peer module, not the internal data array
                    set namespace $($this,namespace)
                    set list {}
                    foreach cell $cells {
                        viewer::parse $cell ignore row column ignore
                        if {($column == 1) && [info exists original]} {                             ;# current value in export table
                            lappend list $original($row)               ;# replace with original cell to propagate color, for example
                        } else {             ;# note: columns are identically numbered between the local and peer module data arrays
                            lappend list ${namespace}::data($row,$column)
                        }
                    }
                    return $list
                }
            }
        }

        proc title {this} {
            regsub {<0>$} $modules::instance::($($this,instance),identifier) {} title
            return $title                                      ;# with removed trailing namespace index for first instance of module
        }

        proc deleteRow {this cell} {                               ;# last wish object is deleted after completion of this procedure
            variable ${this}cellRow

            set dataName $($this,dataName)
            viewer::parse $cell array ignore ignore ignore
            viewer::unregisterTrace $this $array
            set row [set ${this}cellRow($cell)]
            unset ${this}cellRow($cell)
            unset ${dataName}($row,0) ${dataName}($row,1) ($this,rowLastWish,$row)
            dataTable::update $($this,table)
            $($this,namespace)::delete $row
            $($this,namespace)::update                                              ;# so that viewers immediately display void data
            updateMessage $this
        }

        proc initializationConfiguration {this} {
            variable ${this}cellRow

            set list [list -port $composite::($this,-port)]
            if {$composite::($this,-source) ne ""} {                                                       ;# this is a client table
                lappend list -source $composite::($this,-source)
                if {[set $($this,dataName)(updates)] == 0} {                                          ;# updated{} was never invoked
                    # there was never any communication achieved with server, so keep original configuration till valid one,
                    # otherwise user may be wrongly asked to save dashboard on exit if initial communication with server peer failed
                    set configurations $composite::($this,-configurations)
                    if {[llength $configurations] == 0} {unset configurations}
                } else {                                                                 ;# remember rows initiated from server peer
                    foreach name [array names $($this,dataName) {[0-9]*,0}] {
                        scan $name %lu row
                        lappend configurations [list -row $row -type [$($this,namespace)::type $row]]
                    }
                }
                if {[info exists configurations]} {
                    lappend list -configurations $configurations
                }
            }
            scan [namespace tail $($this,dataName)] %u index                                        ;# retrieve index from data name
            lappend list -dataindex $index
            foreach cell [cells $this] {                                                                        ;# in creation order
                lappend rows [set ${this}cellRow($cell)]
            }
            if {[info exists rows]} {
                lappend list -cellrows $rows
            }
            return $list
        }

        proc monitored {this cell} {
            variable ${this}cellRow

            if {[info exists ${this}cellRow($cell)]} {return 1}                                                  ;# an original cell
            set namespace $($this,namespace)
            if {([modules::moduleFromNamespace $namespace] == 0) || ([namespace qualifiers $cell] ne $namespace)} {
                return 0                           ;# note: companion module may have been unloaded (happens when viewer is deleted)
            }
            scan $cell {%*[^(](%lu,%u)} row column
            return [${namespace}::exists $row $column]                                    ;# whether cell exists in companion module
        }

        proc setCellColor {this source color} {
            variable ${this}cellRow

            if {$composite::($this,-source) eq ""} {                                                                 ;# export table
                foreach {cell row} [array get ${this}cellRow] {                           ;# look for original cell as current value
                    if {$cell eq $source} {
                        dataTable::setCellColor $($this,table) $row 1 $color
                        return                                                                                              ;# found
                    }
                }
            }                                      ;# else source cell always comes from peer module data: peer<N>::data(row,column)
            if {[namespace qualifiers $source] ne $($this,namespace)} return                                   ;# not for this table
            scan $source {%*[^(](%lu,%u)} row column
            # note: works because rows and columns are identically numbered between the local and peer module data arrays
            dataTable::setCellColor $($this,table) $row $column $color
        }

        proc updateMessage {this} {
            variable ${this}cellRow

            if {$composite::($this,-source) ne ""} return                                         ;# import tables do not allow drop
            if {[array size ${this}cellRow] == 0} {
                centerMessage $widget::($this,path)\
                    [mc "peer data table:\ndrop data cell(s)"] $viewer::(background) $global::viewerMessageColor
            } else {
                centerMessage $widget::($this,path) {}
            }
        }

} ;# >8

    }

}
