#!/bin/sh
# line following backslash ended comment line is still comment for tclsh \
if [ ! -n "${PIST_WISH:=}" ] ; then          # \
    export PIST_WISH;                      # \
    PIST_WISH="wish8.4";                      # \
fi                                          # \
case "$#" in                                # \
        0) exec ${PIST_WISH} "$0"      ;;  # \
        *) exec ${PIST_WISH} "$0" "$@" ;;  # \
esac                                        # \

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


########################################################################
# 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 centralise
# dans ce fichier !
#
# But : doit etre aussi indpendant de l'appli que possible
#
proc pist:setup {} {
    global pist

    global tk_library env auto_path argv

    if {[string equal $::tcl_platform(platform) "windows" ]} {
        set pist(user) ""
    } else {
        set pist(user) $::tcl_platform(user)
    }

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


    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 pist(interpName) [winfo name .]

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

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

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

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

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

    # on met les librairies de pist en premier :
    set auto_path [concat $pist_auto_path $auto_path]

    # On s'assure que les package de tcllib sont bien accessible
    # 
    if { ![catch {package require base64}] } {
    
        # rien  faire : la tcllib est dja connu par cette distrib tcl
        # 
        set pist(tcllib) [info lib]
        
    } elseif { [info exists ::env(TCLLIB)] } {
    
        # L'utilisateur a prcis la tcllib   utiliser 
        lappend auto_path $env(TCLLIB)
        set pist(tcllib) $env(TCLLIB)
        
    } else {
    
        # tcllib n'est pas installe en standard dans cette distrib de tcl.
        # On va donc essayer de la trouver au voisinage de pist.
        # Les packages de la tcllib peuvent tre rangs soit directement sous
        # le nom "tcllib/" soit dans un sous-rpertoire du style
        # "tclib/modules/"
        # pist accepte choisira une librairie de la forme 
        #   .../tcllib-1.2a/modules/
        # de prfrence  
        #   .../tcllib-1.1/modules/
        # 
        # 
        # 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 ???)
        foreach dir  [ list                                         \
                            [file dir [info lib] ]                  \
                            [file join $pist(install) lib]         \
                            $pist(install)                         \
                            [file dir $pist(install)]              \
                            [file dir [file dir $pist(install)]]   \
        ] {             
            # 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 base64 pkgIndex.tcl]
                # puts "    x1  pkgFile=$pkgFile isfile=[file isfile $pkgFile]" 
                if { [file isfile $pkgFile] } {
                    set pist(tcllib) [file dir [file dir $pkgFile]]
                    break
                } 
                # On teste si les package sont dans le sous-rp modules
                set pkgFile [file join $tcllib modules base64 pkgIndex.tcl]
                # puts "    x2  pkgFile=$pkgFile isfile=[file isfile $pkgFile]" 
                if { [file isfile $pkgFile] } {
                    set pist(tcllib) [file dir [file dir $pkgFile]]
                    break
                } 
            }
            if { [info exists pist(tcllib)] } {
                break
            }
        }
        if { ![info exists pist(tcllib)] } {
            set msg      "Impossible de trouver la librairie tcllib \n"
            append msg   "   - ni dans la distribution de pist "
            append msg                              "($pist(install)),\n"
            append msg   "   - ni au voisinage de pist,\n"
            append msg   "   - ni au voisinage de la librairie de [info lib],\n"
            xtk_displayMsgThenExit \n$msg\n
        }
        lappend auto_path $pist(tcllib)
        # Pour gagner du temps par les process suivant :
        set ::env(TCLLIB) $pist(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 pistRequirePackages { stead xtext xentry }

    # Les packages de pist (conception ENSTA plus ventuellement
    # quelques contrib externe telle que Comm)
    #
    # 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 pistRequirePackages \
        hparse parsarg pref prompt shell xtcl xtk

    # Les packages disponibles dans tcllib-1.0 (distrib tcl) sont :
    #
    #    base64 cmdline counter csv 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
    #
    lappend pistRequirePackages \
        base64 cmdline csv fileutil ftp html htmlparse \
        log math ncgi profiler report \
        sha1 struct textutil fileutil uri


    foreach package $pistRequirePackages {
        # puts "Adding Package $package"
        if { [catch {package require $package} ] } {
            set     msg "Problme d'installation de PIST,\
                             dsol !\n"
            append  msg "\n  Package non trouv : \"$package\"\n"
            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      $pist(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
        }
    }
}


## file:normalName -- retourne le nom nomalis du fichier
#
# @param un nom de fichier ou rpertoir, existant ou nom
# @return un chemin absolu correspondant au nom rel du fichier
#     sans lien mme intermdiaires
#
# Si nom d eficheir en paramtre 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 syteme sunOS.
#
# name: file or directory (doesn't have to exist), absolute or relative,
#       could contain link.
#
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]]
        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
}


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