#!/bin/sh
# if you havn't tclkit installed, you can use wish or wish8.4... \
if [ ! -n "${STEAD_WISH:=}" ] ; then                           # \
    export STEAD_WISH;                                         # \
    interp=`which wish`                                        # \
    if test '\expr "$interp" : '.*/wish$'' != 0                # \
    then                                                       # \
        STEAD_WISH="$interp";                                  # \
    else                                                       # \
        interp=`which tclkit`                                  # \
        if test '\expr "$interp" : '.*/tclkit$'' != 0          # \
        then                                                   # \
            STEAD_WISH="$interp";                              # \
        else                                                   # \
            # STEAD_WISH="tclkit";                             # \
            echo "no suitable tcl interpreter found !"         # \
            exit 1                                             # \
        fi                                                     # \
    fi                                                         # \
fi                                                             # \
case "$#" in                                                   # \
        0) exec "${STEAD_WISH}" "$0"      ;;                   # \
        *) exec "${STEAD_WISH}" "$0" "$@" ;;                   # \
esac                                                           # \


## Pour lancer stead sous OSX (n'est pas encore oprationnel)
# setenv STEAD_WISH "/Library/Frameworks/Tk.framework/Versions/8.4/Resources/Wish Shell.app/Contents/MacOS/Wish Shell"
                                        



# Ce qui suit marche sous MacOSX mais pose certain pb sous linux
# exec ${STEAD_WISH} "$0" "$@" 

# Ce qui suit marche sous linux mais pas MacOSX (avec zsh, pas essay avec bash)
# exec ${STEAD_WISH} "$0" ${1+"$@"}

# mode tcl pour stead et emacs : -*-Tcl-*-


########################################################################
# COMPLEMENT A CONSERVER EN ATTENDANT DE TOUT VERIFIER
#
# This doesn-t work on solaris :-(  )
#     exec ${STEAD_WISH:=wish3.6 -f} "$0" ${1+"$@"}
#
# Autre lignes de lancement possibles :
#     exec wish3.6 -f "$0" ${1+"$@"}
#     exec wish8.3 "$0" -- ${1+"$@"}
#
# Quand tout sera pass en tk8, on utilisera la ligne suivante
#     exec ${STEAD_WISH:=wish} "$0" ${1+"$@"}
#
# Quand tout tait simple, la premiere ligne tait la suivante :
#     #!/usr/local/bin/wish -f
########################################################################


# ## tk8 -- return true  iff tk_version >= 8.x, else return 0
# #
# # A VIRER DES QUE LES APPEL RESIDUELLE SONT SUPPRIMES !
# #
# proc tk8 {} {
#    global stead
#    set stead(tk8)
# }
# proc tk8_init {} {
#    global tk_version stead
#    if {[set tk_version] >= 8 } {
#       set stead(tk8) 1
#    } else {
#       set stead(tk8) 0
#    }
# }


## stead:setup -- initialise librairies
#
# Toute variable pointant sur un fichier de stead83 doit etre centralise
# dans ce fichier !
#
# But : doit etre aussi indpendant de l'appli que possible
#
proc stead:setup {} {
    global stead

    global tk_library env auto_path argv

    # Au cas o stead est lancer depuis un outils externe (i.e. sans utiliser
    # le shell unix), on doit s'assurer que la variable STEAD_WISH est bien
    # positionne
    if {![info exists ::env(STEAD_WISH)]} {
        set ::env(STEAD_WISH) "[info name]"
    }
    
    
    # En principe $::tcl_platform(user) et dfinie sur toute platefome
    # dans les version rcentes de TCL
    # 
    # # # if {[string equal $::tcl_platform(platform) "windows" ]} {
    # # #     set stead(user) ""
    # # # } else {
    # # #     set stead(user) $::tcl_platform(user)
    # # # }
    # 
    if {[catch {set stead(user) $::tcl_platform(user)}]} {
        set ::tcl_platform(user) NO_USER
    }
    
    set stead(user) $::tcl_platform(user)

    # A DEPLACER PLUS TARD
    #
    set superusers {diam commeau}
    if { [lsearch $superusers $stead(user) ] != -1 } {
        set stead(superuser) 1
    } else {
        set stead(superuser) 0
    }


    # Je suppose que env(HOME) est dfini sur toutes les plateformes
    # dans les version rcentes de TCL
    # # 
    # # # if {![info exists env(HOME)]} {
    # # #     # Penser  [file nativename ~toto/popo.tmp] qui marche meme si le 
    # # #     # fichier n'existe pas encore
    # # #     set env(HOME) [glob ~]
    # # # }
    # 
    set stead(interpName) [winfo name .]

    # Dtermination automatique du rpertoire principal de stead
    #
    # RAJOUTER AUTODOCUMENTATION DES GLOBALES
    #
    set stead(exe_logical)    [info script]
    set stead(exe)            [file:normalName [info script]]
    set stead(install)        [file dirname [file dirname $stead(exe)]]

    # VOIR GRED POUR LES FICHIERS DEPENDANTS DE LA PLATEFORME
    # (preferences, fichiers tampons..)

    # TODO : CHANGER CONVENTION DE NOMMAGE : userlib --> userLib
    #
    set stead(userlib)        $env(HOME)/.stead_alpha

    set stead(userfile)       $stead(userlib)/steadrc
    set stead(clipFile)       $stead(userlib)/clipFile
    set stead(localfile)      $stead(install)/etc/steadrc.local
    set stead(userfile_proto) $stead(install)/etc/steadrc.user.example
    set stead(install_modes)  $stead(install)/lib/modes

    # Attention : les rpertoires d'installation peuvent contenir des espaces !
    set stead_auto_path [list                    \
        $stead(userlib)                          \
        [file join $stead(install) lib stead]    \
        [file join $stead(install) lib pist]     \
    ]

    # on met les librairies de stead en premier :
    set auto_path [concat $stead_auto_path $auto_path]

    # On s'assure que les package de tcllib sont bien accessible
    # Ne pas tester sur la package comm plutot que fileutil qui peut
    # exister dans une ancienne version de la tcllib
    # 
    if { ![catch {package require comm}] } {
    
        # rien  faire : la tcllib est dja connu par cette distrib tcl
        # 
        set stead(tcllib) [info lib]
        
    } elseif { [info exists ::env(STEAD_TCLLIB)] } {
    
        # L'utilisateur a prcis la tcllib   utiliser 
        lappend auto_path $env(STEAD_TCLLIB)
        set stead(tcllib) $env(STEAD_TCLLIB)
        
    } elseif { [file isdir [file join $stead(install) lib tcllib_EXTRAIT]] } {
    
        set stead(tcllib) [file join $stead(install) lib tcllib_EXTRAIT]
        lappend auto_path $stead(tcllib)

    } else {
    
        
        # Pas le tcllib installe en standard, ni de tcllib
        # impose par la variable d'environnement STEAD_TCLLIB.
        # De plus tcllib_EXTRAIT n'est plus inclue dans la distribution
        # de stead => avant de hurler, on recherche la tcllib au voisinage 
        # de stead
        
        set stead(tcllib) [pist:guess_tcllibPath $stead(install)]

        if { ![string length $stead(tcllib)] } {
        
            set msg      "Impossible de trouver la librairie tcllib \n"
            append msg   "   - ni dans la distribution de stead "
            append msg                              "($stead(install)),\n"
            append msg   "   - ni au voisinage de stead,\n"
            append msg   "   - ni au voisinage de la librairie de [info lib],\n"
            xtk_displayMsgThenExit \n$msg\n
        }
        lappend auto_path $stead(tcllib)
        
        # Pour gagner du temps par les process suivant en vitant 
        # cette recherche:
        set ::env(STEAD_TCLLIB) $stead(tcllib)
        
    }
    

    # Les packages propres  stead (xtext en sortira plus tard)
    # Nota :
    #   Le package "core" est contenu dans un sous-rpertoire
    #   nomm "core" et non pas "stead"
    set steadRequirePackages { stead xtext xentry }

    # Les packages de pist (conception ENSTA plus ventuellement
    # quelques contrib externes)
    #
    # Une bonne partie de ces packages est  refondre pour exploiter
    #  la fois les possiblilits rcentes de TCL, et pour viter
    # la redondance avec tcllib
    lappend steadRequirePackages \
        hparse parsarg pref prompt shell xtcl xtk

    # Les packages disponibles dans tcllib-1.0 (distrib tcl) sont :
    #
    #    base64 cmdline comm control counter csv fileinput fileutil ftp
    #    ftpd html htmlparse javascript log math md5 mime ncgi nntp pop3
    #    profiler report sha1 stats struct textutil uri 
    #   
    # Mais on n'adopte pour l'instant que les suivants, mais ne pas
    # hsiter  complter en cas de besoin
    #
    # ATTENTION : 
    #   MAINTENIR RIGOUREUSEMENT la liste des package de pist
    #   rellement utiliss
    # 
    #   base64
    #   cmdline     utilis par fileutil !
    #   comm        bientot  la place de send
    #   control
    #   counter
    #   csv
    #   fileinput
    #   fileutil    pist/shell/find.tcl
    #   ftp
    #   ftpd
    #   html        bientot pour la doc
    #   htmlparse   bientot pour la doc
    #   javascript
    #   log
    #   math
    #   md5
    #   mime
    #   ncgi
    #   nntp
    #   pop3
    #   profiler    stead/core/main.tcl
    #   report
    #   sha1
    #   stats
    #   struct      utilis par htmlparse !
    #   textutil    bientot, partout (expander, ...)
    #   uri
    #   
    lappend steadRequirePackages \
        comm fileutil profiler textutil
      

    foreach package $steadRequirePackages {
        # puts "Adding Package $package"
        if { [catch {package require $package} errMsg] } {
            set     msg "Problme d'installation de STEAD,\
                             dsol !\n"
            append  msg "\n  Problme au chargement de package : \"$package\"\n"
            append  msg "\n"
            append  msg "\n  $errMsg"
            append  msg "\n"
            append  msg "\n  Nom logique de l'excutable :"
            append  msg "\n      [info script]"
            append  msg "\n"
            append  msg "\n  Nom physique de l'excutable : "
            append  msg "\n      $stead(exe)\n"
            append  msg "\n"
            append  msg "\n  auto_path :"
            foreach dir $auto_path {
                append  msg "\n     $dir"
            }
            append  msg "\n"
            append  msg "\n"
            append  msg "Vous pouvez transmettre ces informations par mail  :"
            append  msg "\n\n"
            append  msg "        Maurice.Diamantini@ensta.fr"


            # text .t -width 100 -height 7 -font {lucida 14 bold}
            # .t insert 0.0 $msg
            # button .b -command {destroy .} \
            #           -text {Au revoir...} \
            #           -font {time 14 bold}
            # pack .t .b
            # bind . <Return> exit
            # bind . <Escape> exit
            # tkwait window .
            # exit
            xtk_displayMsgThenExit \n$msg\n
        }
    }
}

## pist:guess_tcllibPath -- recherche la tcllib au voisinage d'un chemin
# 
#   retourne le chemin contenant les modules de la tcllib
#   ou une chaine vide si aucune tcllib trouve
#  
#   Les packages de la tcllib peuvent tre rangs soit directement sous
#   le nom "tcllibXXX/" soit dans un sous-rpertoire du style
#   "tclibXXXX/modules/"
#   Stead accepte choisira une librairie de la forme 
#     .../tcllib-1.2a/modules/
#   de prfrence  
#     .../tcllib-1.1/modules/
#   
# Principe :
# 
#   recherche le fichier ".../fileutil/pkgIndex.tcl" dans un rpertoire
#   suivant xx/tcllib*/ ou xx/tcllib*/modules/  situ soit dans :
#      - le parent de la librairie tcl d'installation
#      - $setupDir/lib, 
#      - $setupDir
#      - le parent de $setupDir
#      - le grand parent de $setupDir
#   
proc pist:guess_tcllibPath { setupDir } {
    
    
    
    # Remarque bug tk8.4 vs tk8.3.2 ?
    #   [glob -nocomplain -join $dir tcllib*]         => OK
    #   [glob -nocomplain -join $dir tcllib* modules] => MAUVAIS
    #   car le * de tcllib* n'est pas pris en compte ???)

    set tcllibPath ""
    
    foreach dir  [ list                                   \
                        [file dir [info lib] ]            \
                        [file join $setupDir lib]         \
                        $setupDir                         \
                        [file dir $setupDir]              \
                        [file dir [file dir $setupDir]]   \
    ] {             
        # puts "xxx dir=$dir"
        # puts "glob1=[glob -nocomplain -join $dir tcllib* modules]"
        # puts "glob2=[glob -nocomplain -join $dir tcllib*]"
        foreach tcllib  [lsort -dictionary -decreasing      \
            [glob -nocomplain -join $dir tcllib*]           \
        ]  {
            # puts "  xxx tcllib=$tcllib"
            set pkgFile [file join $tcllib fileutil pkgIndex.tcl]
            # puts "    x1  pkgFile=$pkgFile isfile=[file isfile $pkgFile]" 
            if { [file isfile $pkgFile] } {
                set tcllibPath [file dir [file dir $pkgFile]]
                break
            } 
            # On teste si les package sont dans le sous-rp modules
            set pkgFile [file join $tcllib modules fileutil pkgIndex.tcl]
            # puts "    x2  pkgFile=$pkgFile isfile=[file isfile $pkgFile]" 
            if { [file isfile $pkgFile] } {
                set tcllibPath [file dir [file dir $pkgFile]]
                break
            } 
        }
        if { [info exists stead(tcllib)] } {
            break
        }
    }

    return $tcllibPath
}


## file:normalName -- retourne le nom nomalis du fichier
#
# @param un nom de fichier ou rpertoire, existant ou nom
# @return un chemin absolu correspondant au nom rel du fichier
#     sans lien mme intermdiaires
#
# Si le nom du fichier en parametre n'existe pas, cette procdure
# s'assure que le parent est un nom normalis (absolu et sans lien)
# d'un manire rcursive
#
# Cette procdure est une version simplifie de file:realName.
# car elle fait l'impasse sur le bug d'autodmontage qui est
# suppos corrig dans les versions actuelles du systeme sunOS.
#
# name: file or directory (doesn't have to exist), absolute or relative,
#       could contain link.
# 
# TODO a refondre en utiolisant tk8.4 
#   - file link, 
#   - file nativename, 
#   - file normalize
#   - file normalize [file link $name]
# 
# ATTENTION : EN COURS
#        Refonte de la procedure file:normalName pour quelle 
#        fonctionne sous window (vite pb lors de l'ouverture de fichiers 
#        avec des lien)
#        => EN TEST CAR NECESSITE TK-8.4 !!
#        (il y a des problemes pour utiliser stead sous cygwin avec un
#        wish compil sous windows) 
#        
proc file:normalName_NEW_TEST {name} {
    set nameOri $name
    set name [file normalize $name]
    
    if {[file exists $name]} {
        while {[string match "link" [file type $name] ]} {
           set name [file normalize [file link $name]]
        }
    }
    puts "nameOri=$nameOri"
    puts "file:normalName_BAK_GOOD=>[file:normalName_BAK_GOOD $nameOri] "
    puts "file:normalName         =>$name"
    return $name
}
proc file:normalName {name} {

    # # puts "file:normalName: name=$name"

    # If the name is relative: one make it absolute
    if {[file pathtype $name] == "relative"} {
       set name [file join [pwd] $name]
    }

    global tcl_platform
    switch -exact -- $tcl_platform(platform) {
      macintosh  -
      windows {
          return $name
      }
    }

    if {[file exists $name]} {
        # One follows a possible link (which can be absolute or relative)
        while {[string match "link" [file type $name] ]} {
           set followName [file readlink $name]
           # If the name is relative: one make it absolute
           if {[file pathtype $followName] == "relative"} {
              set followName \
                   [file join [file dirname $name] $followName]
           }
           set name $followName
        }
    } else {
        # not existing file or directory : normalise the parent
        set name [file join [file:normalName [file dir $name]] \
                            [file tail $name]]
        # Pour utilisation sous windows, mais ncessite tk8.4+
        catch {set name [file nativename $name] }
        return $name
    }


    # parent itself could be a link !
    set pwd_ori [pwd]
    cd [file dirname $name]
    set theDir [pwd]
    set name [file join $theDir [file tail $name]]
    cd $pwd_ori
    return $name

} ;# endproc file:normalName

## xtk_error_exit -- crer une fenetre, affiche l'erreur et exit
# 
# 
proc xtk_displayMsgThenExit { msg } {
    set width 40
    set height 7
    set lines [split $msg \n]
    foreach line $lines {
        if {[string length $line] > $width} {
            set width [string length $line]
        }
    }
    if {[llength $lines] > $height} {
        set height [llength $lines]
    } 
    text .t \
            -width $width \
            -height $height \
            -font {lucida 14 bold}
    .t insert 0.0 $msg
    .t configure -state disable
    button .b -command {destroy .} \
              -text {Au revoir...} \
              -font {time 14 bold}
    pack .t  -expand 1 -fill both
    pack .b 
    bind . <Return> exit
    bind . <Escape> exit
    tkwait window .
    exit
}

# Permet de charger Tk depuis tclsh (ncessite tcl version >= 8.3.xx ?)
# => fonctionne avec le "tclkit" !!! TTTTB !
catch {package require Tk}

# Ceci sera PEUT-ETRE utilis pour que des scripts auxiliaires puisse
# profiter du positionnement des librairie de ce script sans lancer
# stead
# On pourrait immaginer faire un source pour viter in process
# supplmentaire
#
if {![info exist stead(exe) ]} {
    # # tk8_init
    stead:setup
    # ::profiler::init
}
# Maintenant que l'on sait o on habite : au boulot !
#
eval stead:new $argv
# ./

