#!/Library/Frameworks/Tk.framework/Resources/Wish\ Shell.app "$0"  --  ${1+"$@"}


#!/usr/bin/env /Applications/Utilities/Launcher.app/Contents/MacOS/Launcher 
# /Volumes/big/unix/diam/work/tcl/stead/bin/aquaStead


## Lancement de stead sous MacOSX :
# cd /Library/Frameworks/Tk.framework/Versions/8.4/Resources/Wish Shell.app/Contents/MacOS
setenv STEAD_WISH "/Library/Frameworks/Tk.framework/Versions/8.4/Resources/Wish Shell.app/Contents/MacOS/Wish Shell"
setenv stead /Volumes/big/unix/diam/work/tcl/stead/bin/aquaStead.tk
#!/bin/sh
# if you havn't tclkit installed, you can use wish or wish8.4... \
# if [ ! -n "${STEAD_WISH:=}" ] ; then          # \
#     export STEAD_WISH;                        # \
#     STEAD_WISH="tclkit";                      # \
# fi                                            # \
# case "$#" in                                  # \
#         0) exec ${STEAD_WISH} "$0"      ;;    # \
#         *) exec ${STEAD_WISH} "$0" "$@" ;;    # \
# esac                                          # \
                                            
# # line following backslash ended comment line is still comment for tclsh \
# if [ ! -n "${STEAD_WISH:=}" ] ; then          # \
#     export STEAD_WISH;                        # \
#     STEAD_WISH="wish";                        # \
# fi                                            # \
# case "$#" in                                  # \
#         0) exec ${STEAD_WISH} "$0"      ;;    # \
#         *) exec ${STEAD_WISH} "$0" "$@" ;;    # \
# esac                                          # \
                                            
# 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
# 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

########################################################################
# Toutes info cvs pour ce fichier seulement
#
# $Id:  $
# $Date:  $
# $Revision: $
# $Name:  $
# $Source:  $
# $State:  $
# $Log: $
#
########################################################################

## 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 centralisée
# dans ce fichier !
#
# But : doit etre aussi indépendant de l'appli que possible
#
proc stead:setup {} {
    global stead

    global tk_library env auto_path argv

    xtk_displayMsgThenExit "popo popo"
    
    # En principe $::tcl_platform(user) et définie sur toute platefome
    # dans les version récentes de TCL
    # 
    # # # if {[string equal $::tcl_platform(platform) "windows" ]} {
    # # #     set stead(user) ""
    # # # } else {
    # # #     set stead(user) $::tcl_platform(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 défini sur toutes les plateformes
    # dans les version récentes 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 .]

    # Détermination automatique du répertoire 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 répertoires 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 déja connu par cette distrib tcl
        # 
        set stead(tcllib) [info lib]
        
    } elseif { [info exists ::env(STEAD_TCLLIB)] } {
    
        # L'utilisateur a précisé 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 installée en standard, ni de tcllib
        # imposée 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-répertoire
    #   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 possiblilités récentes 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
    # hésiter à compléter en cas de besoin
    #
    # ATTENTION : 
    #   MAINTENIR RIGOUREUSEMENT la liste des package de pist
    #   réellement utilisés
    # 
    #   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 "Problème d'installation de STEAD,\
                             désolé !\n"
            append  msg "\n  Problème au chargement de package : \"$package\"\n"
            append  msg "\n"
            append  msg "\n  $errMsg"
            append  msg "\n"
            append  msg "\n  Nom logique de l'exécutable :"
            append  msg "\n      [info script]"
            append  msg "\n"
            append  msg "\n  Nom physique de l'exécutable : "
            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 trouvée
#  
#   Les packages de la tcllib peuvent être rangés soit directement sous
#   le nom "tcllibXXX/" soit dans un sous-répertoire du style
#   "tclibXXXX/modules/"
#   Stead accepte choisira une librairie de la forme 
#     .../tcllib-1.2a/modules/
#   de préférence à 
#     .../tcllib-1.1/modules/
#   
# Principe :
# 
#   recherche le fichier ".../fileutil/pkgIndex.tcl" dans un répertoire
#   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-rép 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 répertoire, existant ou nom
# @return un chemin absolu correspondant au nom réel du fichier
#     sans lien même intermédiaires
#
# Si le nom du fichier en parametre n'existe pas, cette procédure
# s'assure que le parent est un nom normalisé (absolu et sans lien)
# d'un manière récursive
#
# Cette procédure est une version simplifiée de file:realName.
# car elle fait l'impasse sur le bug d'autodémontage 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 nécessite 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 -- créer 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 (nécessite 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
# supplémentaire
#
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
# ./

