#!/bin/sh
# the next line restarts using wish \
exec tclsh "$0" ${1+"$@"}


# Exemple d'utilisation en batch 
# ATTENTION   -recursif -nobackup
# 
# ra -r .  -nb  jedit:pre_returnkey_hook    stead:returnkey_pre_hook
# ra -r .  -nb  jedit:post_returnkey_hook   stead:returnkey_post_hook
# ra -r .  -nb  jedit:mode_returnkey_proc   stead:returnkey_inside_hook

## help:historique - construction des variables d'aides
# 
proc help:historique {} {
return  [subst -nobackslashes  {
###########################################################################
Mises à jour par Maurice DIAMANTINI (diam@ensta.fr) : 

05/01/2005 (v 2.3) (diam) : 
    - correction bug avec option -dos2unix
    - amélioration de -dos2unix  pour y intégrer l'équivalent -mac2unix
29/04/04 (v 2.2) (diam) : 
    - modif mineur : affichage des fichiers à modifier
21/11/01 (v 2.1) (diam) : 
    -intégration des options -mode <regexp|glob..> et -subst
10/10/01 (v 2.0) (diam) : 
    - intégration à pist et à stead
    - début de refonte
... (skip)    
14/08/96 (version 1.0) : 
  - création par Maurice Diamantini (diam@ensta.fr) 
} ]
} ;# end proc help:historique




## main -- 
# 
# 
proc main { args } { 
    global app

    pist_requireAll app
    lappend ::auto_path [pist:guess_tcllibPath $app(pistsetup)]
    
    package require fileutil
    package require textutil
    
    # ligne de commande originale complète
    set app(commandLine) "[file tail [info script]] $args"
    

    set app(version) 2.3
    eval app_parsargs $args

    ########################################################################
    ########################################################################
    # Confirmation des parametres :
    ########################################################################
    ########################################################################
    
    if {$app(-confirm)} {
        puts "\nVoici les parametres qui seront utilisés :\n"
        puts "Ligne de commande originale :\n$app(commandLine)\n"
        # puts "tableau des parametre exploités (parray app) => \n"
        # parray app
        puts "tableau des parametre exploités (report -v app) => \n"
        report -v app
    
        puts "\nDétail des fichier à traiter:"
        foreach file [lsort $app(-files)]   {
            puts "    $file"
        }
        
        
        if {![confirm "\nVoulez-vous continuer ? "]} {
            puts stderr "interruption par l'utilisateur"
            exit
        }
    }
    
    puts stderr "remplacement de \"$app(-pat1)\" par \"$app(-pat2)\"\
                 dans les fichiers : \n"
    
    foreach file $app(-files) {
       
        # REMARQUE !!!  Si $file comme par "/" alors  $app(-backupdir) 
        # est ignoré par la commande "file join"
        # 
        # ***= pour  -exact mais plante à la compilation !
        # set tmp [textutil::trimleft $file "***=[pwd]/"]
        # 
        set tmp [textutil::trimleft $file "[pwd]/"]
        
        if {$app(-nobackup)} {
            set fileBak ""
        } else {
            set fileBak [file join $app(-backupdir) $tmp]
        }
        # 
        # report -v app(-backupdir) file fileBak
        
        # la commande tclCmd recevra un parametre supplémentaire : la chaine
        # à traiter
        if {$app(-tab2space)} {
            set tclCmd string_untabify
        } else {
            set tclCmd [list string_replace -mode $app(-mode)]
            
            if {$app(-subst)} {
                lappend tclCmd -subst
            }
            
            lappend tclCmd -- $app(-pat1) $app(-pat2)
        }                 
    
        if {!$app(-dry)} {
            set fullCmd [list file_applyTclCmd \
                    -backname $fileBak  $tclCmd $file]
            if {[string length $fileBak]} {
                set doneTxt "modifié : \"$file\"\
                        \n   (sauvegardé sous \"$fileBak\")."
            } else {
                set doneTxt "modifié : \"$file\" sans sauvegarde."
            }
        } else {
            set fullCmd [list file_applyTclCmd \
                    -dry -backname $fileBak  $tclCmd $file]
            if {[string length $fileBak]} {
                set doneTxt "à modifier :\"$file\"\
                        \n   (à sauvegarder sous \"$fileBak\")."
            } else {
                set doneTxt "à modifier : \"$file\" sans sauvegarde."
            }
        }
        
        set fileHasBeenModified [eval $fullCmd]
      
        if {$fileHasBeenModified} {
            puts "$doneTxt"
        }
    }
}


proc help:syntaxe {} {
global app

return  [subst -nobackslashes  {Version $app(version) - syntaxe :
----------------------- 
    [file tail [info script]] ?option? <pat1> <pat2> ?<file_patterns>?

arguments :
-----------
    <pat1> : chaine a rechercher (obligatoire)
    <pat2> : chaine de remplacement (obligatoire, meme si vide)
    <file_patterns> : liste de fichier (ou de patterne si recursif)
          (tous par défaut)
    
options :
---------
    -backupdir <dir>  : repertoire de sauvegarde des fichiers non modifiés
         sous un nom de la forme <fichier>.replacebak-13.08.96-10h03mn14s
         (par défaut, vaut le répertoire "./$app(-backupdir)")
    -nb
    -nobackup : pas de backup
    -dry : Essai à sec (sans exécuter réellement les commandes )
    -dos2unix : jeux predefini d'option permettant de remplacer les fins de
         ligne DOS (CR-LF = 0x0d 0x0a) ou mac (CR) par des fins de ligne UNIX\
         (LF = 0x0a)
         équivalent à pat1='\r\n?' pat2="\n"
         
    -tab2space : jeux predefini d'option permettant de remplacer 
         les tabulations par un à huit espaces 
    -r <dir>
    -recursivedir <dir> : traite recursivement le répertoire passé en parametre.
          Les arguments résiduels <file_patterns> sont considérés comme
          des patternes, et non plus comme des fichiers comme une liste
          de patternes et non plus un liste de fichiers 
    -h -help      : syntaxe et documentation de cette commande
    -nc  -noconfirm         : ne pas faire confirmer
    -edit         : pour éditer ce script
    --            : fin des options

Exemples :
----------

} ]
} ;# end proc help:syntaxe

proc help:exemples {} {
global app

# return  [subst -nobackslashes -nocommand {exemples : XXXXXXXXXXXX}
return  {exemples :
----------

Remplacement des fin de ligne DOS par des fin de ligne UNIX :

    replaceall   "\r\n"    "\n"     *exo
    replaceall   "\x0d0a"  "\n\n"   *exo
    
Remplacement des plus de deux lignes ne contenant que des espaces
par une seule ligne vide :

    replaceall   "\n([ \t]*\n)+"  "\n"   *exo

Remplacement des liens absolus en liens relatifs pour tous les fichiers
fichiers .html  de tous les sous-répertoires du répertoire courant :

    replaceall -c \
                "http://www.w3.org/StyleSheets" \
                "../LOCAL/w3/StyleSheets" \
                */*.html

Remplacement récursif de fichiers html depuis le répertoire courant :
(attention de bien protéger le liste des patternes pour qu'elle ne soient
pas interpeter par le shell unix)
pas de demande de confirmation ni backup des fichier modifiés

Essai à sec (sans exécuter réellement les commandes )
    replaceall -dry  -r . -nc -nb  xxx  yyy  "*.html *.htm"
    
Essai réelle :
    replaceall       -r . -nc -nb  xxx  yyy  "*.html *.htm"

Modif récursive de chaines xtext_BuildUid en xtext_buildUid :
    ra -r . -dry -subst 'xtext_([A-D])(a-m)' 'XTEXT_[string lower \1]\2'

remplacement récursif exact sans confirmation ni sauvegarde :
    ra -r . -nc -nb -dry stead:removeMode stead:modeRemove
    ra -r . -nc -nb      stead:removeMode stead:modeRemove
} 
} ;# end proc help:syntaxe

proc help:all {} {
global app

    set text  [subst -nobackslashes  {
    
    Script :         [info script]
    commande tapée : $app(commandLine)
    
    [help:historique]
    
    [help:syntaxe]
    
    [help:exemples]
    
    } ]
    
    append text {
    à faire :  Rajouter  options :
    ---------
    
     -mode <mode> : 
             regexpGlobal, = regexp = r
             regexpLine  = line = l ou 
             exact = e
          précise si la chaine de recherche doit s'appliquer au fichier
          complet (global) ou a chacune des lignes prises séparemenent
          (byline).
     -subst (flag)
         si positionné, une substitution est effectuée sur chaque remplacement
         
         exemple :
         ra -r . -dry -subst 'xtext_([a-d])(a-m)' 'XTEXT_[string toupper \1]\2'
    } ]
    return $text
};# proc help:all



## app_parsargs -- extraction des arguments de cette appli
# 
# 
proc app_parsargs { args } {
    global app
    set app(-backupdir) "@BACKUPDIR_[now %Y%m%d-%H%M%S]"
    puts "#####################"
    puts "avant Parsarg_fullSpec app {...}"
    puts "args=$args"
    parray app
    puts "#####################"
    Parsarg_fullSpec app {

        b               -
        backupdir       =
        
        tab2space       {
            -type flag
            -eval {
                set app(-pat1) "NON UNTILISÉ"
                set app(-pat2) "NON UNTILISÉ"
            }
        }

        dos2unix        {
            -type flag
            -eval {
                set ::app(-pat1) {\r\n?}
                set ::app(-pat2) "\n"
            }
        }
        
        r               -
        recursivedir    {
            -default    ""
            -label   "Repertoire de recherche si recursif (vide sinon)"
        }
        
        
        dry             {
            -type    flag
            -label  "test sans modifier les fichiers"
        }
                
        subst             {
            -type    flag
            -label  "Pour effectuer un substitution tcl apres le remplacement."
        }
                
        mode             {
            -type    flagenum
            -values {regexpGlobal regexp r   regexpLine line l  exact e}
            -label "Mode de fonctionnement da la patterne (regexp, exact, ...)"
        }
                
        nc              -
        noconfirm       {
            -type     flag 
            -variable app(-confirm) 
            -default  1 
            -value    0 
        }
        
        nb              -
        nobackup       {
            -type     flag 
            -default  0 
            -value    1 
        }
        
        h               -
        help            {
            -type  flag
            -eval {
                puts stderr "help - syntaxe :"
                puts stderr [help:all]
                exit 0
            }
        }
        v               -
        verbose         flag
        
        edit            { 
            -type flag
            -eval {
                uplevel #0 exec stead [info script] &
                exit 0
            }
        }
    }
    puts "#####################"
    puts "apres Parsarg_fullSpec app {...}"
    puts "args=$args"
    parray app
    puts "#####################"
    # Juste une petite vérif pour normaliser l'option -mode
    switch -exact -- $app(-mode) {
        r -
        regexp -
        regexpGlobal {
            set app(-mode) "regexpGlobal"
        }
        l -
        line -
        regexpLine {
            set app(-mode) "regexpLine"
        }
        e -
        exact {
            set app(-mode) "exact"
        }
        default {
            set msg "\noption -mode incorrecte : $app(-mode)"
            append msg "\nVérifier la procédure Parsarg_fullSpec qui "
            append msg "\naurait du détecté cette anomalie !\n\n"
            error $msg
        }
    }
    
    
    # 
    # Extraction des arguments obligatoires
    # les patterne pat1 et pat2 peuvent avoir été affecté par les jeux d'options
    # du style -dos2unix, ... 
    # Donc si la variable app(-pat1) est définie, on ne touche ni à app(-pat1) 
    # ni à app(-pat2)
    # 
    # 1 - La patterne de recherche (qui doit etre correcte)
    # 
    if ![info exists app(-pat1)] {
        set app(-pat1) [lindex $args 0]
        if {![string length $app(-pat1)]} {
           puts stderr "\nManque la patterne à rechercher\n[help:syntaxe]"
           exit
        }
        if {[catch {regexp -- $app(-pat1) ""}]} {
           puts stderr "\nPatterne à rechercher incorrecte\n[help:syntaxe]"
           exit
        }
        # 2 - La patterne de remplacement
        set app(-pat2) [lindex $args 1]
        set args [lrange  $args 2 end]
    }
    
    
    report -v app args

    # Le dernier argument (optionnel) forme une liste de patternes
    set filePats $args
    

    # 3 - La liste des fichiers a modifier :
    # 
    if {[string length $app(-recursivedir)]} {
        if {![string length $filePats]} {
            set filePats {* .*}
        }
        
        # Probleme avec fileutil::findByPattern car retourne des chemin
        # absolu !!
        set cmd [list ::fileutil::findByPattern  $app(-recursivedir)  $filePats]
        # set cmd [list recursive_glob  [list $app(-recursivedir)]  $filePats]
        set files [eval $cmd ]
        # puts "filePats=$filePats"
        # puts "cmd=$cmd"
        # puts "files=$files"
        # exit
    } else {
        if {![string length $filePats]} {
            set filePats [glob -nocomplain * .*]
        }
        set files $filePats
    }
    
    # Examen des fichiers à traiter
    # 
    set msg ""
    set app(-files) {}
    foreach file $files {
        if {$app(-verbose)} {
            report -v file
        }
        if {![file isfile $file]} {
           append msg "fichier non standard :   \"$file\" (ignoré)\n"
           continue
        }
        if {![file readable $file]} {
           append msg "fichier non lisible :    \"$file\" (ignoré)\n"
           continue
        }
        if {![lsearch -exact  $app(-files) $file]} {
           append msg "fichier déja mémorisé :  \"$file\" (ignoré)\n"
           continue
        }
        
        lappend app(-files) $file
    }
    # 
    # La liste des fichiers est créée

    if {$app(-verbose)} {
        if {[string length $msg]} {puts stderr $msg}
        report -v app
    }
    
    
    if {![llength $app(-files)]} {
       puts stderr "\nAucun de fichier a modifier :\n[help:syntaxe]"
       exit
    }
} ;# proc app_parsargs


# pist_requireAll -- cherche et installe la librairie pist 
# 
# Argument : 
# 
#  - appliName : nom du tableau à initialiser (i.e gred, stead, ...).
#    Par défaut ce tableau est "pist"
# 
# Description :
# 
#  Le fonction principale de cette procédure est de mémoriser le répertoire 
#  d'installation de la librairie PIST utilisée et de la rendre utilisable
#  par une appli.
#  Si la variable d'environnement PIST_SETUP est positionnée, elle est 
#  utilisée.
#  
#  Sinon, la librairie pist est recherchée successivement dans les 
#  répertopoires suivants :
#   ./pist ./lib/pist ../pist ../lib/pist ../../pist ../../lib/pist ...
#  
#  Il est possible de créer un lien "pist" dans un des répertoire recherché
#  La variable d'environnement PIST_SETUP est alors positionnée pour 
#  les process fils éventuels
# 
# Hypothese :
#  
#  Chaque répertoire contenant un package pist **doit** avoir le même nom que
#  le package lui-meme :
#  Le package "Comm" doit etre dans le répertoire "Comm/", et nom par 
#  "comm/" ni "Comm-3.7/"
#  
# 
# sortie : 
# 
#  positionnement des variables suivantes (pist ou appliName si spécifié) :
#   - pist(exe) : nom absolu (normalisé) de cet exécutable
#   - pist(pistsetup) et env(PIST_SETUP) : installation de PIST
#   - auto_path : insertion de pist(pistsetup) **devant** cette globale
# 
# 
proc pist_requireAll { {appliName pist} } {

global env auto_path
upvar #0 $appliName appli
   
    array set appli {
        exe         UNKNOWN
        pistsetup   UNKNOWN
    }
    
    # On normalise le nom de ce script en suivant les liens ...
    # extrait de la proc "file:normalName"
    set name [info script]
    if {[file pathtype $name] == "relative"} {
       set name [file join [pwd] $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
    }
    # 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
    
    # Enfin, on mémorise le nom canonnique de ce script :
    set appli(exe) $name
    
    
    # Recherche de la librairie PIST
    if {[info exists env(PIST_SETUP)]} {
        set appli(pistsetup) $env(PIST_SETUP)
    } else {
        set direxe [file dir $appli(exe)]
        set dirsToScan [list                                      \
           $direxe                                                \
           [file dir $direxe]                                     \
           [file dir [file dir $direxe]]                          \
           [file dir [file dir [file dir $direxe]]]               \
           [file dir [file dir [file dir [file dir $direxe]]]]    \
        ]
        
        # On cherche dans ce répertoire s'il y a un un plusieurs noms
        # de répertoire, (mais aussi lien !) commençant par pist...
        foreach dir $dirsToScan {
           
           set pistDirs [glob -nocomplain [file join $dir pist]* ]
           if {[llength $pistDirs] == 0} {
               # avant de hurler, on cherche dans un sous répertoire "lib/"
               set pistDirs [glob -nocomplain [file join $dir lib pist]* ]
               if {[llength $pistDirs] == 0} {
                   continue
               }
           } 
           
           # S'il existe plusieurs lib potentielle au même niveau, 
           # (pist-1.9.a et pist-1.10.a), on doit sélectionner 
           # pist-1.10 (la plus ancienne)
           # 
           foreach name [lsort -decreasing -dictionary $pistDirs] {
              set pkgIndexes [glob -nocomplain  \
                            [file join $name * pkgIndex.tcl]]
              if {[llength $pkgIndexes]} {
                 set pistSetup $name
                 break
              }
           }

           if {[info exists pistSetup]} break
         }
        
         if {![info exists pistSetup]} {
           error "Librairie PIST introuvable à partir de $appli(pistsetup) "
           exit
         }
        
         set appli(pistsetup) $pistSetup
         set env(PIST_SETUP) $appli(pistsetup)
    }
    # On ajout la librairie pist à l'auto_path
    set auto_path [concat [list $appli(pistsetup)]  $auto_path]
    
    # On demande chaque package (sous-répertoire contenant un fichier 
    # pkgIndex.tcl)
    set pkFiles [glob -nocomplain  \
            [file join $appli(pistsetup) * pkgIndex.tcl] ]

    foreach pkFile $pkFiles   {
        set pk [file tail [file dir $pkFile]]
        package require $pk
    }
    # parray appli
}


## 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
}


eval main $argv
exit 0 
# ./
