#!/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
    - amlioration de -dos2unix  pour y intgrer l'quivalent -mac2unix
29/04/04 (v 2.2) (diam) : 
    - modif mineur : affichage des fichiers  modifier
21/11/01 (v 2.1) (diam) : 
    -intgration des options -mode <regexp|glob..> et -subst
10/10/01 (v 2.0) (diam) : 
    - intgration  pist et  stead
    - dbut de refonte
... (skip)    
14/08/96 (version 1.0) : 
  - cration 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 complte
    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 utiliss :\n"
        puts "Ligne de commande originale :\n$app(commandLine)\n"
        # puts "tableau des parametre exploits (parray app) => \n"
        # parray app
        puts "tableau des parametre exploits (report -v app) => \n"
        report -v app
    
        puts "\nDtail des fichiers  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 supplmentaire : 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 dfaut)
    
options :
---------
    -backupdir <dir>  : repertoire de sauvegarde des fichiers non modifis
         sous un nom de la forme <fichier>.replacebak-13.08.96-10h03mn14s
         (par dfaut, vaut le rpertoire "./$app(-backupdir)")
    -nb
    -nobackup : pas de backup
    -dry : Essai  sec (sans excuter rellement 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 rpertoire pass en parametre.
          Les arguments rsiduels <file_patterns> sont considrs 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-rpertoires du rpertoire courant :

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

Remplacement rcursif de fichiers html depuis le rpertoire courant :
(attention de bien protger le liste des patternes pour qu'elle ne soient
pas interpeter par le shell unix)
pas de demande de confirmation ni backup des fichier modifis

Essai  sec (sans excuter rellement les commandes )
    replaceall -dry  -r . -nc -nb  xxx  yyy  "*.html *.htm"
    
Essai relle :
    replaceall       -r . -nc -nb  xxx  yyy  "*.html *.htm"

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

remplacement rcursif 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 tape : $app(commandLine)
    
    [help:historique]
    
    [help:syntaxe]
    
    [help:exemples]
    
    } ]
    
    append text {
     faire :  Rajouter  options :
    ---------
    
     -mode <mode> : 
             regexpGlobal, = regexp = r
             regexpLine  = line = l ou 
             exact = e
          prcise si la chaine de recherche doit s'appliquer au fichier
          complet (global) ou a chacune des lignes prises sparemenent
          (byline).
     -subst (flag)
         si positionn, une substitution est effectue 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 vrif 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 "\nVrifier la procdure Parsarg_fullSpec qui "
            append msg "\naurait du dtect 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 dfinie, 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 dja mmoris :  \"$file\" (ignor)\n"
           continue
        }
        
        lappend app(-files) $file
    }
    # 
    # La liste des fichiers est cre

    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 dfaut ce tableau est "pist"
# 
# Description :
# 
#  Le fonction principale de cette procdure est de mmoriser le rpertoire 
#  d'installation de la librairie PIST utilise et de la rendre utilisable
#  par une appli.
#  Si la variable d'environnement PIST_SETUP est positionne, elle est 
#  utilise.
#  
#  Sinon, la librairie pist est recherche successivement dans les 
#  rpertopoires suivants :
#   ./pist ./lib/pist ../pist ../lib/pist ../../pist ../../lib/pist ...
#  
#  Il est possible de crer un lien "pist" dans un des rpertoire recherch
#  La variable d'environnement PIST_SETUP est alors positionne pour 
#  les process fils ventuels
# 
# Hypothese :
#  
#  Chaque rpertoire contenant un package pist **doit** avoir le mme nom que
#  le package lui-meme :
#  Le package "Comm" doit etre dans le rpertoire "Comm/", et nom par 
#  "comm/" ni "Comm-3.7/"
#  
# 
# sortie : 
# 
#  positionnement des variables suivantes (pist ou appliName si spcifi) :
#   - pist(exe) : nom absolu (normalis) de cet excutable
#   - 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 mmorise 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 rpertoire s'il y a un un plusieurs noms
        # de rpertoire, (mais aussi lien !) commenant 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 rpertoire "lib/"
               set pistDirs [glob -nocomplain [file join $dir lib pist]* ]
               if {[llength $pistDirs] == 0} {
                   continue
               }
           } 
           
           # S'il existe plusieurs lib potentielle au mme niveau, 
           # (pist-1.9.a et pist-1.10.a), on doit slectionner 
           # 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-rpertoire 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 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
}


eval main $argv
exit 0 
# ./
