#!/usr/bin/wish
# or #!/opt/tcltk/bin/wish8.x
# lappend auto_path /usr/lib

# copyright (C) 1997-2005 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.69 2005/01/02 00:45:07 jfontain Exp $


if {![catch {package present Tk}]} {    ;# to avoid invalid command error when -h option is used (handled internally by interpreter)
    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 {[string equal $tcl_platform(platform) unix]} {                       ;# the following are already correctly white on windows
        option add *Entry.Background white
        option add *Entry.disabledBackground white                                                                     ;# for Tk 8.4
        if {[package vcompare $::tcl_version 8.4] >= 0} {
            option add *Entry.readonlyBackground white
            option add *Spinbox.Background white
            option add *Spinbox.disabledBackground white
            option add *Spinbox.readonlyBackground white
        }
        option add *Entry.selectForeground black
        option add *Listbox.selectForeground black
    }
}

# 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
source getopt.tcl

if {[catch\
    {\
        set argv [parseCommandLineArguments\
            {
                -f 1 --file 1 --debug 0 -h 0 -he 0 -hel 0 -help 0 --help 0 -p 1 --poll-time 1 -r 0 --read-only 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 1                                                                                 ;# note: needs internationalization
}
foreach {short long} {-f --file -h -he -h -hel -h -help -h --help -p --poll-time -r --read-only -S --static} {
    catch {set arguments($short) $arguments($long)}                                          ;# long version if present has priority
}

if {[catch {package present Tk}]} {exit 1}                          ;# catch any X window problem (such as display related problems)
setupGlobalMouseWheelBindings

set global::debug [info exists arguments(--debug)]

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
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 {[string equal $tcl_platform(platform) unix]} {
    option add *Font -*-$global::fontFamily-medium-r-*-*-$global::fontSize-*                ;# use application font from preferences
    option add *Button*Font -*-$global::fontFamily-bold-r-*-*-$global::fontSize-*                         ;# 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 {[string equal $tcl_platform(platform) unix]} {
    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 1
}
if {[info exists arguments(--version)]} {
    printVersion
    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
    if {[package vcompare $tcl_version 8.4] < 0} {
        source spinent.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 help.tcl
source selectab.tcl
source threshold.tcl
source imbutton.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 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

# 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

set global::readOnly [info exists arguments(-r)]
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 {}
}

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 $argv} message]} {                                                                           ;# recursive
    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, ...
    if {$code != 0} {                                                                          ;# exit immediately in case of errors
        _exit $code
    }
    if {$global::readOnly || ![needsSaving]} _exit                                                             ;# no changes to save
    switch [inquireSaving] {
        yes {
            save
            if {![needsSaving]} _exit                                                                              ;# data was saved
        }
        no _exit
    }
}

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 {[string equal $::tcl_platform(platform) 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 . 500x400                                                             ;# wide enough for all the icons to be visible
}

image create photo applicationIcon -data [dataGraph::iconData]                                ;# use data graph icon for application
if {[string equal $tcl_platform(platform) 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

# 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
    createSavedImages $initializer
    createSavedViewers $initializer
    updateMenuWidget                                               ;# since store viewer, just created, may contain recordable cells
    updateToolBar
}

if {[pages::current] == 0} {                                                                                             ;# no pages
    manageScrolledCanvas 1
} else {
    pages::manageScrolledCanvas 1
}
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

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