########################################################################
#f fichier parsarg_pop.tcl 
# 
# Maurice DIAMANTINI diam@ensta.fr
# 
# Version initiale de Frank Mangin mangin@sophia.inria.fr
# 
# xx/12/95 (diam@ensta.fr) : réorganisation
# 06/09/95 (diam@ensta.fr) : modifs pour supporter les tableaux
# 05/05/97 (diam@ensta.fr) : modifs mineurs (présentation, ...)
# 24/09/01 (diam@ensta.fr) : réorganisation (intégration au package
#                            parsarg...)
#
# A FAIRE : 
#
# - gérer la méta-option "--"
# - rajouter une proc "popargvEndSwitch" pour s'assurer qu'il
#   ne reste plus d'option, et pour virer le "--" éventuel
# - (? si besoin ?) envisager d'interdire les switch collées aux valeurs 
#   pour alléger les procédures (analyse manuelle toujours possible 
#   pour ces cas là)
#   
# BUG : popargv ne met pas à jour la globale argc.
########################################################################

package provide parsarg 1.0


## Parsarg_Pop -- extrait **une** option de la liste argv ou args
# 
# popargv switch varName1 varName2 ...  
#          
#   - Analyse la liste d'arguments (argv ou args) et en extrait "switch"
#          
#   - retourne 1 si une extraction a été faite, 0 sinon.
#          
#   - affecte éventuellement chaque vari able dont le nom est spécifié.
#          
#   - supprime les éléments exploités de la liste analysée.
#          
#   - l'option peut être ou non accolée au switch : imprimer -Pmiel
#     Mais attention : ceci nécessite d'extraire l'option -POPO avant
#     l'option -P !!
#          
#   - on peut extraire plusieurs arguments à l'aide d'un même switch :
#           Parsarg_Pop -bbox x1 y1 x2 x2
#     Affecte les 4 variable x1 .. y2 si l'option -bbox est présente.
#          
#   - retourne une erreur s'il y a moins de valeurs que prévu
#          
#   - on peut extraire des valeur simples, sans switch
#           if {[popargv {} outPath]} {
#             ... 
#           }
#          
# 
# BUG et limitation :
# 
#   - ne tient pas compte de la méta-option "--"
#          
#   - ne met pas à jour la globale argc
#          
#   - risque de perturbation dans les cas ou une donnée a la même valeur
#     qu'une clé comme dans le cas ou on voudrait éditer un fichier
#     nommé "-opt1" si -opt1 est un flag reconnu par stead.
#           stead  fichier1 -opt1 fichier3
#     Dans ce cas, les deux fichiers "-opt1" et "fichier3" sont ignorés
#     et l'option "-opt1" est par erreur affectée la valeur "fichier3"
# 
# Exemples d'utilisation :
# 
#   set DEBUG [popargv {-debug}]   
#   =>  DEBUG recoit 1 ou 0 suivant que $argv contient "-debug" ou non
#   
#   set VERBOSE [expr [popargv {-verbose}] || [popargv {-debug}] ]
#   => VERBOSE recoit 1 su on a passé "-verbose" ou "-debug" :
#   
#   if {[popargv {-\?}] || [popargv {-help}]} { PrintUsage ; exit }
#   => détection du flag d'aide (Attention au méta-caractère style glob !)
#   
#   if {![popargv {-P} Printer]} {set Printer $env(PRINTER)}
#   => détection du flag collé
#   
#   if {![popargv {-coords} x1 y1 x2 y2]} { error }
#   => extraction de plusieurs arguments à l'aide d'un même switch.
#   
#   if {[popargv {} outPath]} {
#     ... 
#   }
#   => extraire une valeur simple (sans le tiret) : myscript myfile
#   
# 
proc Parsarg_Pop {opt args } {
    
    # La liste à analyser :
    #    Attention : on veut détecter "[info level] == 0" du **parent** !
    if {[info level] == 1} {
        upvar argv argl
    } else {
        upvar args argl
    }
    
    # Chaque élément de args est associé à une variable du même nom
    # dans le contexte de la procédure appelante.
    # Attention cet élément peut-etre un élément de tableau, et on ne peut
    # pas faire simplement 
    #      upvar #0 tab(element) tab(element) ;# INCORRECT
    # 
    foreach fullVar $args {
        regexp {^([^\(]+)} $fullVar match tabOrVar
        upvar 1 $tabOrVar $tabOrVar
    }
    
    
    if {$opt == {}} then {
        #  value alone  #
        foreach var $args {
            if {[set i [lsearch -regexp $argl {^[^-]} ]] < 0} {
                return 0
            } else {
                set $var [lindex $argl $i]
                set argl [lreplace $argl $i $i]
            }
        }
        return 1
    } elseif {[set i [lsearch $argl "$opt*"]] >= 0} then {
    
        # TODO : 
        # Il faudrait interdire la recherche au dela de la méta-option "--" !!
    
        ## found switch ##
        set re [format "%s%s" $opt {([^ ]+)}]
        if {[regexp -- $re [lindex $argl $i] foo value]} {
            # collated switch and value #
            set [lindex $args 0] $value
            set argl [lreplace $argl $i $i]
            return 1
        } else {
            # separate value #
            if {[expr "[llength $argl] - $i - 1"] < [llength $args]} {
                # not enough values for the switch #
                return 0
            } else {
                # everything's ok #
                set argl [lreplace $argl $i $i]
                foreach var $args {
                    set $var [lindex $argl $i]
                    set argl [lreplace $argl $i $i]
                }
                if {$args==""} then {
                } else {
                    # ??? ET LA : IL Y A QUOI (voir script imprimer)
                }
                return 1
            }
        }
    } else {
        return 0
    }
} ;# end Parsarg_Pop

# ./
