#!/usr/bin/env tclsh

# 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: moodss.tcl,v 1.96 2006/10/07 09:47:47 jfontain Exp $


regexp {^[\d\.]+} $tcl_patchLevel version                                               ;# ignore extra characters, such as in 8.5a2
if {[package vcompare $version 8.4] < 0} {
    puts stderr "error: Tcl/Tk version 8.4 or above, not $tcl_patchLevel, is required"
    exit 1
}
if {($tcl_platform(wordSize) == 8) && ([package vcompare $version 8.4.8] < 0)} {
    puts stderr "error: Tcl/Tk version 8.4.8 or above, not $tcl_patchLevel, is required on 64 bit machines"
    exit 1
}

proc printUsage {} {
    puts stderr [format [mc {Usage: %s [OPTION]... [MODULE] [OPTION]... [MODULE]...}] $::argv0]
    puts stderr [mc {  --debug          module errors verbose reporting}]
    puts stderr [mc {  -display         display (and screen) on which to display application}]
    puts stderr [mc {  -f, --file       dashboard file name}]
    puts stderr [mc {  -h, --help       display this help and exit}]
    puts stderr [mc {  -p, --poll-time  poll time in seconds}]
    puts stderr [mc {  -r, --read-only  disable viewer creation, editing, ...}]
    puts stderr [mc {  --record         start recording cells data history in database}]
    puts stderr [mc {  -S, --static     disable internal window manager sizing and moving}]
    puts stderr [mc {  --show-modules   try to find available moodss modules}]
    puts stderr [mc {  --version        output version information and exit}]
}

source getopt.tcl

if {[catch\
    {\
        set argv [parseCommandLineArguments\
            {
                -display 1 -f 1 --file 1 --debug 0 -h 0 --help 0 --norpath 0 -p 1 --poll-time 1 -r 0 --read-only 0 --record 0 -S 0
                --static 0 --show-modules 0 --version 0
            } $argv arguments\
        ]\
    } message\
]} {
    puts stderr $message
    if {[catch {package require internationalization}]} {                          ;# may be too soon for availability at this point
        proc ::mc {string} {return $string}                                                                         ;# so compensate
    }
    printUsage                                                                                   ;# note: needs internationalization
    exit 1
}
foreach {short long} {-f --file -h --help -p --poll-time -r --read-only -S --static} {
    catch {set arguments($short) $arguments($long)}                                          ;# long version if present has priority
}

set list $argv
set argv {}; catch {lappend argv -display $arguments(-display)}  ;# sole argument needed by Tk layer, which would process the others
if {[catch {package require Tk} message]} {                         ;# catch any X window problem (such as display related problems)
    puts stderr "fatal graphical interface error: $message"
    exit 1
}
set argv $list
unset list

catch {rename ::send {}}                                                      ;# for safety reasons (send is available on UNIX only)
option add *BorderWidth 1                                                        ;# reduce all widgets border width to improve looks
option add *Canvas.BorderWidth 0                                                               ;# restore original values for canvas
option add *Frame.BorderWidth 0                                                                                             ;# frame
option add *Toplevel.BorderWidth 0                                                                                   ;# and toplevel
option add *ScrollbarWidth 12
option add *Listbox.Background white                                                                    ;# also necessary on windows
if {$tcl_platform(platform) eq "unix"} {                                     ;# the following are already correctly white on windows
    option add *Entry.Background white
    option add *Entry.disabledBackground white
    option add *Entry.readonlyBackground white
    option add *Spinbox.Background white
    option add *Spinbox.disabledBackground white
    option add *Spinbox.readonlyBackground white
}

# note: the following sources should not contain immediate Tk code as Tk may not be loaded at this point
source packlibs/misc.tcl
source global.tcl
source utility.tcl
startGatheringPackageDirectories

set global::debug [info exists arguments(--debug)]
set global::noRPath [info exists arguments(--norpath)]                                ;# only used in standalone binary distribution

setupGlobalMouseWheelBindings
source procs.tcl
source entrychk.tcl
# include XML and DOM libraries:
source tcllib/uri.tcl                                                                                       ;# needed by XML library
package provide xml 2.6
package provide dom 2.6
package provide dom::tcl 2.6
package provide dom::tclgeneric 2.6
namespace eval ::xml {}
source tclxmldom/sgml-8.1.tcl
source tclxmldom/xml-8.1.tcl
source tclxmldom/sgmlparser.tcl
source tclxmldom/xml__tcl.tcl
source tclxmldom/tclparser-8.1.tcl
source tclxmldom/xpath.tcl
namespace eval ::dom {variable strictDOM 0}
source tclxmldom/domimpl.tcl
source tclxmldom/dom.tcl
source tclxmldom/dommap.tcl
# bypass switch/eval code to try to improve performance when loading big dashboards:
proc dom::selectNode {node path} {return [dom::tcl::XPath:SelectNode $node $path]}

source preferen.tcl
source config.tcl
source tcllib/base64.tcl                                                                                   ;# needed by MIME package
source tcllib/md5.tcl
source tcllib/mime.tcl                                                                          ;# allow thresholds email capability
source tcllib/smtp.tcl

configuration::load [preferences::read]                                               ;# initialize from rc file as soon as possible
if {$tcl_platform(platform) eq "windows"} {
    menu .temporary                            ;# use menubar font as reference since that reflects control panel global user choice
    set global::fontFamily [font actual [.temporary cget -font] -family]
    set global::fontSize [font actual [.temporary cget -font] -size]
    destroy .temporary
}
option add *Font [list $global::fontFamily $global::fontSize]                               ;# use application font from preferences
option add *Button*Font [list $global::fontFamily $global::fontSize bold]                                 ;# buttons need bold style

package require Tktable 2.7
package require BLT 2.4
package require msgcat
namespace import msgcat::*

# search in current directory sub-directories for development and Tcl package moodss sub-directory
# (after packages above are loaded for better startup performance):
if {$tcl_platform(platform) eq "unix"} {
    # ATTENTION: do not change single-spaced line below without updating replacement code in makefile
    lappend auto_path $::tcl_library/moodss                                           ;# usually where moodss packages are installed
}
if {[info exists package(directory,internationalization)]} {             ;# application library installed in a Tcl package directory
    package require internationalization
} else {
    lappend auto_path [pwd]              ;# load relative to current directory, used for example in development stage and on windows
    if {[catch {package require internationalization} message]} {
        puts stderr $message:
        puts stderr "either moodss is not properly installed or you need to run\nmoodss directly from its installation directory"
        exit 1
    }
}

if {[info exists arguments(-h)]} {
    printUsage
    exit 1
}
if {[info exists arguments(--version)]} {
    puts [format [mc {moodss (Modular Object Oriented Dynamic SpreadSheet) version %s}] $global::applicationVersion]
    exit
}

if {[catch {package require stooop 4.1}]} {
    source stooop.tcl                                                                     ;# in case stooop package is not installed
}
namespace import stooop::*
if {[catch {package require switched 2.2}]} {                                           ;# in case switched package is not installed
    source switched.tcl
}

source module.tcl
source modperl.tcl
source modpython.tcl
source modules.tcl

if {[info exists arguments(--show-modules)]} {
    modules::printAvailable
    exit                                                                                                                     ;# done
}

if {[catch {package require scwoop 4.1}]} {
    source scwoutil.tcl
    source scwoop.tcl                                                                     ;# in case scwoop package is not installed
    source bindings.tcl
    source widgetip.tcl
    source arrowbut.tcl
    source panner.tcl
    source scroll.tcl
    source combobut.tcl
    source scrolist.tcl
    source comboent.tcl
    source optimenu.tcl
}
if {[catch {package require tkpiechart 6.4}]} {                                       ;# in case tkpiechart package is not installed
    source pielabel.tcl
    source boxlabel.tcl
    source relirect.tcl
    source canlabel.tcl
    source labarray.tcl
    source perilabel.tcl
    source slice.tcl
    source selector.tcl
    source objselec.tcl
    source pie.tcl
}
source font.tcl
source scrollbl.tcl
source xifo.tcl
source lifolbl.tcl
source dialog.tcl
source listentry.tcl
source bgchoose.tcl
source datatrace.tcl
source tktable.tcl
source viewer.tcl
source history.tcl
source help.tcl
source selectab.tcl
source threshold.tcl
source imbutton.tcl
source calendar.tcl
source gui.tcl
source canvhand.tcl
source canvicon.tcl
source canvaswm.tcl
source imagelab.tcl
source colorlab.tcl
source blt2d.tcl
source databar.tcl
source graph.tcl
source datagraf.tcl
source stagraph.tcl
source linetask.tcl
source progbar.tcl
source predtime.tcl
source predictor.tcl
source predtask.tcl
source predwork.tcl
source datapie.tcl
source viewtab.tcl
source sumtable.tcl
source valuetab.tcl
source formutab.tcl
source formudlg.tcl
source freetext.tcl
source images.tcl
source canvview.tcl
source highlght.tcl
source drag.tcl
source drop.tcl
source menuhelp.tcl
source printcap.tcl
source prntview.tcl
source print.tcl
source scroller.tcl
source modgui.tcl
source tablesel.tcl
source datatab.tcl
source lastwish.tcl
source htmllib.tcl                                                ;# Tcl HTML library from Sun, used for viewing HTML help documents
source htmlview.tcl
source html.tcl                                            ;# must be sourced after HTML library since some procedures are redefined
if {[catch {package require BWidget 1.7}]} {
    source bwidget/utils.tcl
    source bwidget/widget.tcl
    source bwidget/dynhelp.tcl
    source bwidget/arrow.tcl
    source bwidget/notebook.tcl
    namespace eval BWIDGET {set LIBRARY {}}                                                    ;# needed by dropsite code but unused
    source bwidget/dragsite.tcl
    source bwidget/dropsite.tcl
    source bwidget/tree.tcl
}
class tree {                                           ;# cannot use Tree name since it conflicts with BWidget Tree widget namespace
    proc tree {this parentPath args} widget {[eval ::Tree $parentPath.$this $args]} {}
    proc ~tree {this} {destroy $widget::($this,path)}
}
source threshman.tcl
source repeater.tcl
source sequencer.tcl
source threshlbl.tcl
source pages.tcl
source database.tcl
source dbgui.tcl
source store.tcl
source dbview.tcl
source hashes.tcl
source peerdlg.tcl
source peertab.tcl

# intercept closing from window manager so that exit can be effectively used when renamed
# and that shutting down when hung initializing a remote capable module is possible
wm protocol . WM_DELETE_WINDOW exit
wm command . [concat [info nameofexecutable] $argv]                  ;# for proper window manager (windowmaker for example) behavior
wm client . [info hostname]
wm group . .

# frame used as a common parent, for example to configuration and general help windows, so user can interact with both but not other
frame .grabber                                                                                      ;# windows, such as the main one
place .grabber -x -1 -y -1                     ;# needs to be mapped, otherwise Tk dialog boxes code does not restore grabs properly

grid columnconfigure . 0 -weight 1
set path [createMessageWidget .]
grid $path -row 3 -column 0 -sticky we                                         ;# so that modules can display informational messages
update

wm title . [mc {moodss: Loading modules...}]              ;# load uninitialized modules 1st so that their tables are placed properly

source contain.tcl
source record.tcl

# obviously, one cannot save dashboard if it came from standard input:
set global::readOnly [expr {[info exists arguments(-r)] || ([info exists arguments(-f)] && ($arguments(-f) eq "-"))}]
set global::static [info exists arguments(-S)]
if {[info exists arguments(-f)]} {                                                              ;# configuration file name specified
    # modules from save file must be loaded before any command line module to preserve data namespace indices (see modules code)
    set initializer [loadFromFile $arguments(-f)]
} else {
    set global::saveFile {}
}

database::initializeSamples $global::showSampleDatasets
modules::loadResidentTraceModule
residentTraceModule 0     ;# create resident trace viewer as soon as possible so traces in modules initialization phase are not lost

if {[catch {modules::parse 0 $argv} message]} {                                                       ;# recursive; validate modules
    puts stderr $message
    exit 1
}

wm title . [mc {moodss: Initializing modules...}]
modules::initialize 0 initializationErrorMessageBox

rename exit _exit                                     ;# from now on, application is considered running so only the user can exit it
proc exit {{code 0}} {                                                             ;# intercept exit in case of unsaved changes, ...
    predictor::terminate                                                                ;# kill all statistical engine sub-processes
    if {$code == 0 && !$global::readOnly && [needsSaving]} {                             ;# note: exit immediately in case of errors
        switch [inquireSaving] {
            yes {
                save
                if {[needsSaving]} return                                                                      ;# data was not saved
            }
            no {}
            default return
        }
    }
    modules::terminate
    _exit $code
}

set global::scroll [new scroll canvas . -viewthreshold 0.01]
set global::canvas $composite::($global::scroll,scrolled,path)
$global::canvas configure -highlightthickness 0 -background $global::canvasBackground\
    -scrollregion [list 0 0 $global::canvasWidth $global::canvasHeight]                       ;# note: sizes can come from save file
updateCanvasImage $global::canvasImageFile 1                                                              ;# may come from save file
bind $global::canvas <Configure> "updateCanvasImagesPosition; pages::updateScrollRegion $global::canvas"
if {!$global::readOnly} createBackgroundMenu

set global::windowManager [new canvasWindowManager $global::canvas]
# enable tab circulation between displayed tables and viewers:
bind . <Shift-Tab> "canvasWindowManager::raise $global::windowManager 0"
if {$tcl_platform(platform) eq "unix"} {
    bind . <ISO_Left_Tab> "canvasWindowManager::raise $global::windowManager 0"
}
bind . <KP_Tab> "canvasWindowManager::raise $global::windowManager 1"
bind . <Tab> "canvasWindowManager::raise $global::windowManager 1"

if {[info exists ::geometry]} {                                                               ;# command line geometry was specified
    wm geometry . $::geometry
} elseif {[info exists initializer]} {
    foreach {width height} [record::sizes $initializer] {}                                   ;# used stored geometry for scroll area
    composite::configure $global::scroll -width $width -height $height
} else {
    wm geometry . 600x550                                                          ;# big enough for a predictor to be fully visible
}

image create photo applicationIcon -data [dataGraph::iconData]                                ;# use data graph icon for application
if {$tcl_platform(platform) eq "unix"} {
    wm iconwindow . [toplevel .icon]
    pack [label .icon.image -image applicationIcon]
}

if {!$global::readOnly} {
    grid [updateDragAndDropZone] -row 1 -column 0 -sticky we
}
grid rowconfigure . 2 -weight 1                                                                ;# scrolled canvas area should expand

set draggable [expr {!$global::readOnly}]

if {[info exists arguments(-p)]} {                                                     ;# command line argument has highest priority
    modules::setPollTimes $arguments(-p)
} elseif {[info exists initializer]} {                                                                  ;# then stored configuration
    modules::setPollTimes [record::pollTime $initializer]
} else {                                                                                                       ;# use modules values
    modules::setPollTimes
}

updateTitle                                                                              ;# now that modules and poll time are known
updateMenuWidget

manageToolBar 0                                                                             ;# useless to save identical preferences
if {!$global::readOnly} {                                                                          ;# if save menus or buttons exist
    updateFileSaveHelp $global::saveFile                                             ;# now that menu and tool bar icons are created
}

set modules::(synchronous) {}                                                                    ;# save list of synchronous modules

::update                                        ;# required with big dashboards, otherwise menu bar and icons are incompletely drawn
# display all modules using their namespace name (which may be indexed or set in the module code itself)
foreach instance $modules::(instances) {
    displayModule $instance $draggable
}
if {[info exists initializer]} {                  ;# stored configuration, now that modules data is initialized, create some viewers
    lifoLabel::push $global::messenger [mc {initializing viewers and finalizing display...}]
    ::update idletasks
    createSavedImages $initializer
    createSavedViewers $initializer
    updateMenuWidget                                               ;# since store viewer, just created, may contain recordable cells
    updateToolBar
    lifoLabel::pop $global::messenger
}

if {[pages::current] == 0} {                                                                                             ;# no pages
    manageScrolledCanvas 1
} else {
    pages::manageScrolledCanvas 1
}
updateViewObjectsMenu
refresh                                                                                                ;# initialize refresh process
update                                                   ;# required so that table and viewer windows sizes are correct for snapshot
record::snapshot                                  ;# take a snap shot of initial configuration so any future changes can be detected

if {[info exists arguments(--record)] && [store::anyActiveCells $store::singleton]} {
    databaseRecording 1
}

list             ;# so that nothing is printed (such as the result of the last invoked command) when sourced interactively from wish
