#init.tcl
# Copyright (c) 2001-2004 Digi International Inc., All Rights Reserved
# 
# This software contains proprietary and confidential information of Digi
# International Inc.  By accepting transfer of this copy, Recipient agrees
# to retain this software in confidence, to prevent disclosure to others,
# and to make no use of this software other than that for which it was
# delivered.  This is an unpublished copyrighted work of Digi International
# Inc.  Except as permitted by federal law, 17 USC 117, copying is strictly
# prohibited.
# 
# Restricted Rights Legend
#
# Use, duplication, or disclosure by the Government is subject to
# restrictions set forth in sub-paragraph (c)(1)(ii) of The Rights in
# Technical Data and Computer Software clause at DFARS 252.227-7031 or
# subparagraphs (c)(1) and (2) of the Commercial Computer Software -
# Restricted Rights at 48 CFR 52.227-19, as applicable.
#
# Digi International Inc. 11001 Bren Road East, Minnetonka, MN 55343
#
# ***************************************************************************
if { $tcl_platform(platform) == "windows" } {
    set hand hand5
} else {
    set hand hand2
}
namespace eval dg {
    variable argOS [lindex $::argv 0]
    
    variable strUnknown "unknown"
    
    variable strProcessor $strUnknown
    variable strPlatform $strUnknown
    variable strOS $strUnknown
    variable strOSHuman $strUnknown
    variable strInstance $strUnknown
    variable strOSVersion $strUnknown
    variable strUser $strUnknown
    variable strIssue $strUnknown
    variable strOSorIssue $strUnknown
    variable strServicePack $strUnknown
    variable strIEVersion $strUnknown
    variable pathBrowser $strUnknown
    variable dirRoot [pwd]
}

proc dg::_Instance {strOS strPlatform} {
    return [format "%s_%s" $strOS $strPlatform]
}

proc dg::_SetIssue {strIssueName strOSHumanName} {
    variable strIssue
    variable strOSHuman
    variable strUnknown
    upvar $strIssueName strIssue
    upvar $strOSHumanName strOSHuman
    
        set ch [open /etc/issue r]
        set issue [read $ch]
        close $ch
        switch -regexp -- $issue {
            ".*Red Hat.*" {
                set strIssue "Red Hat"
                set strOSHuman "Linux -- Red Hat"
            }
            ".*Debian.*" {
                set strIssue "Debian"
                set strOSHuman "Linux -- Debian"
            }
            ".*Mandrake.*" {
                set strIssue "Mandrake"
                set strOSHuman "Linux -- Mandrake"
            }
            ".*SuSE.*" {
                set strIssue "SuSE"
                set strOSHuman "Linux -- SuSE"
            }
            ".*Conectiva.*" {
                set strIssue "Conectiva"
                set strOSHuman "Linux -- Conectiva"
            }
            ".*TurboLinux.*" {
                set strIssue "TurboLinux"
                set strOSHuman "Linux -- TurboLinux"
            }
            default {
                set strIssue $strUnknown
                set strOSHuman "Linux"
            }
        } 
}

proc dg::GetMachineInfo {} {
    variable argOS 
    variable strUnknown
    variable strProcessor
    variable strPlatform
    variable strOS
    variable strOSHuman
    variable strInstance
    variable strOSVersion
    variable strUser
    variable strOSorIssue
    variable strIssue
    variable strIEVersion
    variable strServicePack
    
    if {[info exists ::tcl_platform(machine)]} {
          switch -glob -- $::tcl_platform(machine) {
              sun* -
              sparc { set strProcessor sparc }
              i?86 -
              i86* -
              x86* -
              intel { set strProcessor intel }
              alpha { set strProcessor alpha }
          default { set strProcessor $::tcl_platform(machine) }
        }
    }
    
    if {[info exists ::tcl_platform(platform)]} {
        set strPlatform $::tcl_platform(platform)
    }
    
    set strOS $argOS
    switch -exact -- $argOS {
        "aix" { 
            set strOSHuman "AIX"
            if {[info exists ::tcl_platform(osVersion)]} {
                if {$::tcl_platform(osVersion) < 5.0 } {
                    set strOS aix4x
                } else {
                    set strOS aix5x
                }
            } else {
                # default to 4.x if we can't detect the version
                set strOS aix4x
            }
        }
        "hpux" { set strOSHuman "HP-UX" }
        "irix" { set strOSHuman "IRIX" }
        "linux-intel" { 
            set strOS "linux"
            _SetIssue strIssue strOSHuman
        }
        "linux-alpha" { 
            set strOS "linux"
            _SetIssue strIssue strOSHuman
        }
        "osr5" { 
            set strOSHuman "OpenServer" 
            set strOS "openserver"
        }
        "solaris-intel" { 
            set strOSHuman "Solaris (Intel)" 
            set strOS solarisintel
        }
        "solaris-sparc" { 
            set strOSHuman "Solaris (SPARC)" 
            set strOS solarissparc
        }
        "uw" { 
            set strOSHuman "UnixWare"
            set strOS unixware
        }
        "svr4" { set strOSHuman "SVR4"}
        "windows" {
            catch {set strServicePack [registry get \
             {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion} CSDVersion]}

            if {[catch {set strIEVersion [registry get \
             {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer} Version]}]} {
                if {![catch {set strIEVersion [registry get \
                 {HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer} IVer]}]} {
                    switch $strIEVersion {
                        100 { set strIEVersion 1.0 }
                        101 { set strIEVersion 2.0 }
                        102 { set strIEVersion 2.0 }
                        103 { set strIEVersion 3.0 }
                        default {}
                    }
                }               
            }
            set strNetware "compatable"
            if {[string equal $::tcl_platform(os) "Windows NT"]} {
                if {$::tcl_platform(osVersion) <= 4.0 } {
                    set strOS winnt
                    set strOSHuman "Windows NT"
                } elseif {$::tcl_platform(osVersion) >= 5.2} {
                    set strOS win03
                    set strOSHuman "Windows Server 2003"
                } elseif {$::tcl_platform(osVersion) >= 5.1} {
                    set strOS winxp
                    set strOSHuman "Windows XP"
                } else {
                    set strOS win2k
                    set strOSHuman "Windows 2000"
                }
            } else {            
                set strOSHuman "Windows 95"
                set strOS win9598
                if {$::tcl_platform(osVersion) > 4.0 } {
                    set strOSHuman "Windows 98"
                }
                if {$::tcl_platform(osVersion) == 4.90 } {
                    set strOSHuman "Windows Me"
                }
            }
        }
        "tru64" { set strOSHuman "Compaq Tru64 UNIX"}
    }
    
    if {[string equal $strOS linux]} {
            set strOSorIssue $strIssue
        } else {
            set strOSorIssue $strOS
    }
    
    set strInstance [_Instance $strOS $strProcessor]
    if {[info exists ::tcl_platform(osVersion)]} {
        set strOSVersion $::tcl_platform(osVersion)
    }
    if { [string first solaris $strOS ] >= 0 } {
        switch -exact -- $strOSVersion {
            5.3 { set strOSVersion 2.3 }
            5.4 { set strOSVersion 2.4 }
            5.5 { set strOSVersion 2.5 }
            5.5.1 { set strOSVersion 2.5.1 }
            5.6 { set strOSVersion 2.6 }
            5.7 { set strOSVersion 7 }
            5.8 { set strOSVersion 8 }
        }
    }
    
    if {[info exists ::tcl_platform(user)]} {
        set strUser $::tcl_platform(user)
    }
}

proc dg::SourceScripts {} {
    variable dirRoot
    set lstScripts [glob -nocomplain -- [file join $dirRoot frontend common support *.tcl]]
    lappend lstScripts [file join $dirRoot frontend specific command.tcl]
    foreach script $lstScripts {                                   
            source $script
    }
}

## Look for a lang specific images folder
proc dg::ImgLocale {} {
    ## en is the default locale
    variable strImgLang en
    variable dirRoot

    foreach loc [mcpreferences] {
        set dir [file join $dirRoot frontend specific images $loc]
        if {[file isdirectory $dir]} {
            set strImgLang $loc
            break
        }
    }
}

proc dg::LoadMsgcat {} {
    variable dirRoot
    if {![msgcat::mcload [file join $dirRoot frontend specific msgs]]} {
        ## No .msg file for users Local(LANG). Just use en
        mclocale en
        msgcat::mcload [file join $dirRoot frontend specific msgs]
    }                                 

    # This proc is needed for the msgcat setup
    proc ::msgcat::mcunknown {locale strSrc args}  {
        ## This mirrors the original definition.  It's repeated here for debug purposes
        if {[llength $args]} {
            return [eval [list format $strSrc] $args]
        } else {
            return $strSrc
        }
        ## End of mirror
    }
}

proc dg::InitMain {} {
    variable pathBrowser
    variable strOS
    variable strIssue
    GetMachineInfo
    LoadMsgcat
    ImgLocale
    SourceScripts

    if { $strOS == "linux" && $strIssue == "Debian" } {
        set pathBrowser "$env(TERM) -e [file join $dirRoot lynx/linux/lynx] -cfg=[file join $dirRoot lynx/lynx.cfg] -show_cursor"
    } else {
        set pathBrowser [browser::Path]
    }
}

dg::InitMain

