#f Procédures de gestion des styles (couleur) pour les widgets xtext

package provide xtext 2.0

# A FAIRE :
#   
#   
#   xtext_style_$sheet($style,-type)    => xtext_style($w,$sheet,$style,-type)
#   xtext_style_$sheet($style,-pat)     => xtext_style($w,$sheet,$style,-pat)
#   xtext_style_$sheet($style,-prePat)  => xtext_style($w,$sheet,$style,-prePat)
#   xtext_style_$sheet($style,-postPat) => xtext_style($w,$sheet,$style,-postPat)
#   xtext_style_$sheet($style,-values)  => xtext_style($w,$sheet,$style,-values)
#   xtext_style_$sheet($style,-tag)     => xtext_style($w,$sheet,$style,-tag)
#   xtext_style_$sheet($style,-config)  => xtext_style($w,$sheet,$style,-config)
#                                      
#   = $styles($style,-tag)
#   
#   xtext_style_$sheet(names)  : liste des styles d'une feuille
#   
#   xtext_style($w,updatePeriode)#         
#   
#   # Quelques alias
#   upvar 0 xtext_style($w,allSheet)           allSheet
#   upvar 0 xtext_style($w,enabledSheet)       enabledSheet
#   upvar 0 xtext_style($w,$sheet,styles)      styles
#   upvar 0 xtext_style($w,$sheet,$style,-tag) tag
#   
#   xtext_style($w,isRefreshingAll) 0
#   xtext_style($w,isRefreshingScreen) 0
#   xtext_style($w,allSheets)        [list]
#   xtext_style($w,enabledSheets)    [list]
#   xtext_style($w,nextRequestCmd)   [list]
#   xtext_style($w,prevStartRefreshedScreen) 1.0 
#   xtext_style($w,prevEndRefreshedScreen)   1.0
#        
# 



########################################################################
# DEBUT de Manuel de xtext_style
########################################################################
# 
# Procédures de gestion des styles (couleur) pour les widgets xtext
# 
# 
# historique :
# 13/11/01 (diam) création, cassure, modification ...
# 
# 
# Stead permet de définir et d'appliquer des feuilles de styles (sheets) à 
# un widget texte. 
# (ANCIENNEMENT : ensembles de styles (<styleSet>) 
# 
# On peut définir autant de feuilles que nécessaire, et leur donner
# des noms arbitraires, bien qu'on utilise généralement le nom du 
# mode (e.g "tcl")
# 
# Une feuille de style est associée à un widget texte, et est caractérisée par
# - un nom <sheet>
# - plusieurs spécification de style <styleSpec>
# 
# Chaque spécification de style est entièrement défini par :
# 
# - son nom <style> 
#   Par exemple "comment", "mainKeywords", ...
#   
# - sa définition <styleDef>
#   La définition d'un style est une liste paire de la forme 
#    {-type <type> -key2 value2 ...}
# 
# La principale clé "-type" est le type du style, et caractérise la manière
# dont ce style est recherché dans le widget. 
# Par exemple :
#   -type wordList
#   -type regexpGlobal
#   -type regexpLine
#   -type ...
#   
# Les autres clés dépendent du type, par exemple, pour un type "wordList" :
#   -values {if the else while...}
#   
# pour un type "wordList", ou pour un type "regexpGlobal"
#   -pat {(/\*).*?(/\*)}
# 
# Une autre clé de style indipensable permet de décrire la configuration
# du widget pour ce style :
# 
#   -config {-foreground red}
#   -config {-foreground blue  -font bold }
#   ...
# 
# Uns seule commande permet de gérer entièrement les feuilles de styles.
# Sa syntaxe générale est la suivante :
# 
#   xtext_style $w <fonction> ?sheet? ?options? ?arguments ...?
#   
# Des fonctions permettent de créer (define), supprimer (delete), 
# appliquer (apply), effacer (remove) des styles d'une feuille donnée.
# Il est également possible d'interroger la liste des feuilles 
# définies, ainsi que la liste des styles définis pour une feuille
# donnée.
# 
########################################################################
# 
# Les fonctions disponibles sont les suivantes
# 
########################################################################
# xtext_style__get (get)
# 
# xtext_style $w get
# xtext_style $w get -all
# xtext_style $w get  $sheet
# xtext_style $w get  $sheet $style
# xtext_style $w get  $sheet $style $key
#   
# Retourne suivant le cas :
# - la liste des feuilles de style active (sans -all)
# - la liste des feuilles de style définie, même si non active (avec -all)
# - la liste des styles de la feuille $sheet 
#   e.g. {comment mainKeywords ...}
# - la définition $styleDef du style $style
#   e.g. {-type keywordsLight -pat {if then else} -config { ...} ...
# - la valeur de la clé $key du style $style 
#   (e.g si $key = -type, on peut obtenir "regexpLine"
#   
# A FAIRE : 
# 
#   - prévoir pattern de filtrage (glob)
#   
#   - prévoir la possibilté de modifier une valeur particulier en faisant :
#   
#        xtext_style $w get  tcl comment -config 
#           =>  {background green}
#        xtext_style $w get  tcl comment -config {background red}
#           =>  {background red}
# 
########################################################################
# xtext_style__enable (enable ou en)
# 
# Syntaxe :
# 
#   xtext_style $w enable ?options?  ?sheets? ?sheets? ..
# 
# Rend actives les feuilles de style spécifiées en argument.
# 
# Options :
# 
#   Aucune options pour l'instant
# 
# Si une des feuilles précisées en argument n'est pas définie : une
# erreur est générée.
# Les dernières feuilles validées par cette fonction sont ajoutée en fin
# de liste, et leur effet et donc prioritaire sur les autres feuilles
# (par écrasement)
# 
########################################################################
# xtext_style__disable (disable ou dis)
# 
# xtext_style $w disable  ?options?  ?sheets? ?sheets? ..
# 
# Rend inactives les feuilles de style spécifiées en argument
# 
# Options :
# 
#   Aucune options pour l'instant
#   
# Si une des feuilles précisées en argument n'est pas définie ou était
# déja inactive : cette fonction est sans effet (ce n'est pas une erreur)
# 
# 
########################################################################
# xtext_style__define (define ou def)
# 
# Définit ou redéfinit un style
# 
# Syntaxe
# -------
# xtext_style $w define sheet ?options? styleSpec  ?styleSpec?  ...
# ou 
# xtext_style $w define sheet ?options?  styleSpecList 
# 
#   Rajoute une ou plusieurs spécifications de style à la feuille sheet 
#   attachée au widget texte $x
# 
#  
# Spécification des styles :
# --------------------------
# 
# Chaque style est spécifié par une paire :
# 
#   {<style> <styleDef>}
#   
# Une définition de style est une liste paire de la forme :
# 
#   {-type theType -pat thePat -config theConfig ...}
# 
# Le type permet de spécifier certaines expressions particulières 
# d'une maniere simple :
# 
#   -type regexp    (alias de...)
#   -type regexpLight  : expression régulière simple sensible au ligne
#       Le type ***le plus efficace*** car il se contente d'exploiter la 
#       recherche intégré au widget text, mais ne permet pas d'exploiter
#       des sous-chaine non capturée : le tag est appliqué à la chaine
#       compléte. 
#       Nota : pour l'instant, le type "regexp" est synonyme de "regexpLight"
#   
#   -type regexpLine  : expression régulière sensible aux lignes
#       C'est un type de recherche intermédiaire par ligne qui accepte la
#       définition de sous-chaines.
#       La recherche intégrée au widget texte est exploitée pour rechercher
#       la chaine complète (qui est donc localisée à une ligne), puis
#       le résultat est exploitée par une regexp pour en extraire la sous-chaine
#       à colorier.
#           
#   -type wordList : une patterne de type regexpLine est contruite à partir 
#       d'une liste de mots.
#       Par défaut, ces mots sont délimiter par les contraintes régulières
#       \m et \M. Mais ces valeur peuvent être remplacée grâce aux clés
#       de style -prePat et -postPat. Les paternes de délimitation doivent
#       être inserées dans des parenthèses non capturables (?:xxx)
#       
#               -values {if while for ...}  
#               -prePat {(?:^|[\[;])(?:\s)}     ;# \]
#               -posPat {[^a-z]}
# 
#   -type wordListLight : une patterne de type regexpLight est contruite 
#       à partir  d'une liste de mots.
#       La seule limitation par rapport au type wordList est que le style
#       est appliquer également aux délimiteurs (prePat et postPat) definis 
#       par les patternes -prePat et -postPat (ce qui n'a aucun effet si les 
#       valeurs par défaut sont utilisées cat \n et \M sont des contrainte 
#       et ont une taille nulle) 
#       
#       
#   -type regexpPair  : (NON IMPLÉMENTÉ) deux regexp simple sont à préciser 
#               -prePat {/\*}
#               -postPat {\*/}
#         ou bien synonyme qui écrase les définition de -prePat et -postPar
#               -pats { {/\*} {\*/} }
#         (permet  d'utiliser $w search en multiline)
# 
#   -type regexpGlobal  : expression régulière multiligne
#   
#       Le type ***le plus puissant***, mais le plus lent car nécessite 
#       l'extraction du texte pour analyse par la commande regexp. 
#       Le tag n'est appliqué qu'à la première sous-chaine parenthésée.
#       On peut donc préciser une sous-patterne servant de préfixe à
#       la chaine à colorier en l'encardant par une parenthèse non 
#       capturante par la syntaxe  "(?:xxxxx)"  (c.f. manuel re-syntax de tcl)
#       Par contre il ne faut ***PAS OUBLIER*** d'encadrer la partie de
#       la patterne à colorier par des parenthèses normales.
#           
#        
#  IDEE D'EXTENSION : 
#   
#   - Le type regexpPair pourrait etre complété pour permettre la colorisation
#     de n'importe quelle combinaison des trois sous-chaines suivant :
#     
#            $prePat$betweenPat$postPat
#       
#     Ceci permettrait de généraliser (et donc de supprimer) les types 
#     regexpLine et regexpPair
#           
# Exemples d'utilisation de l'options range :
# -------------------------------------------
# 
# Voir le mode tcl.
# 
#   A FAIRE : ajouter quelques petits exemples commentés !
# 
# 
########################################################################
# xtext_style__delete (delete ou del)
# 
# 
# Syntaxe
# -------
# xtext_style $w delete ?options? ?sheets? ?<styles>? ?<styles>?  ...
# 
# 
# arguments :
# -----------
#  <sheets> : liste des feuille de style à traiter (toutes si vide) 
#  <styles> ... : les listes des styles à détruire pour chaque 
#           feuille précisée
# 
# options :
# ---------
#   Aucune option pour l'instant
# 
# 
# Cette fonction supprime la définition des styles spécifiée. 
# Plus précisément, elle supprime la configuration et les informations 
# concernant les styles indiqués des feuilles de style indiquées.
# 
# Si la liste des feuilles de style est vide : toutes les feuilles
# (actives ou non) sont considérées
# Si aucun style n'est précisé : tous les styles de chaque feuille de style
# en argument sont supprimés.
# 
# Si une feuille de style n'existe n'existe pas : cette procédure n'a 
# aucun effet.
# 
# Si un des styles spécifés pour la destruction n'existe pas, il est ignoré.
# 
# 
########################################################################
# xtext_style__apply (apply ou ap)
# 
# Syntaxe
# -------
#  xtext_style $w apply  ?options <sheets> <styles> ?<styles>?
# 
# Applique les styles précisées de la feuille <sheets> au texte
# 
# Exemples :
# 
#   xtext_style $w apply
#       => rafraichi l'écran visible (pour toutes les feuilles actives)
#       
#   xtext_style $w apply -all
#       => rafraichi tout le texte
#   
#   xtext_style $w apply -range {127.9 end} tcl comment_style 
#       applique le style "comment_style" de la feuille tcl sur l'intervale
#       de 127.9 à end
#
# Options reconnues :
# -------------------
#  -range <rangeSpec>
#    Un intervale (range) peut être spécifié de différentes manières
#    
#       -range {<index1> <index2>} : 
#              l'intervale à traiter va de <index1> à <index2>
#       
#       -range {<index>} : 
#          la ligne complète contenant l'index <index> est traitée
#       
#       -range currentLine  
#          la ligne complète contenant l'insert est traitée
#       
#       -range previousLine  
#          la ligne précédent celle contenant l'insert est traitée
#       
#       -range screen : 
#          traite tout l'intervale visible sur l'écran
#          
#       -range all :  equivalent à  -range 1.0 end
#     
#  Les flags suivants sont des abbréviations pour l'option précédente :
#       -currentLine
#       -previousLine
#       -screen
#       -all
#       
#  A FAIRE : 
#   - flag -long permettant de faire une longue colorisation sans blocage
#     (nombreux update)
#   - l'option -nocase est inutiles car elle est remplaçable par le préfixe
#   (?i) dans la regexp 
#   
########################################################################
# xtext_style__remove (remove ou rem)
# 
# Syntaxe
# -------
#  xtext_style $w remove  ?options?  ?<sheets>? ?<styles>? ?<styles>?
# 
# <sheets> est la liste des feuilles de style à considérer
#       Si <sheets> est vide alors tous les jeux de styles connus sont 
#       considérés.
#       on peut spécifier une liste vide de feuille de style tout en 
#       ajoutant des noms de style à effacer : cela permet de traiter 
#       sélectivement certains noms de style pour TOUS les jeux 
#       (e.g n'effacer que les styles communs à toutes les feuilles de styles)
# 
# Option :
# --------
#   Les mêmes que pour la fonction "define" (-range xxx)
# 
# Concatène les listes des noms de style et les "désapplique".
# Les styles à effacer **doivent** exister sinon erreur
# 
########################################################################
# 
# Implémentation (sera modifiée)
# 
# Toutes les info relatives à la getsion des style sont entierement contenes
# dans le tableau global "xtext_style"
# En cours d'utilisation, certaines variables de ce tableau sont associées
# à un alias pour en alléger l'acces.
# 
# TODO : détailler un peu l'organisation
# 
########################################################################
# 
# Bug et remarques :
# ------------------
# 
# - Il semble que la colorisation d'un ecran soit de plus en plus long 
#   au fur et a mesure qu'on approche de la fin d'un gros fichier 
#   (PAS CERTAIN)
#  
# - Attention aux lookhead positif dans les patternes : (?=xxx)
#   car ne fait fait pas partie de la chaines extraite : dont la sous 
#   patterne n'est pas trouvée !
#   
# 
########################################################################
# FIN de Manuel de xtext_style
########################################################################



## xtext_style -- gère les spécifications de style (defini, applique, ...)
# 
# Syntaxe
# -------
#  xtext_style $w  <key>  ?options?  ?args? 
# 
# 
#  xtext_style est la seule procédure nécessaire pour l'utilisateur.
#  
#  Cette procédure se contente en gros de :
#  
#  1 - "consommer" le parametre "key" qui précise la sous-commande à réaliser 
#      (define, apply, ...)
#  
#  2 - appeler des procédures de plus bas niveau en leur passant les
#      arguments non traités
# 
proc xtext_style {w args} {

# report "==> xtext_style $w  [string range $args 0 30]..."

    global xtext_style
    
    set key         [lindex $args 0]
    set args        [lrange $args 1 end]


    # On dispatch le travail en fonction de la sous commande key
    # 
    switch -exact -- $key {
        ap -
        apply { 
            eval xtext_style__apply   $w $args
        }
        def -
        define {
            eval xtext_style__define   $w $args
        }
        en -
        enable {
            eval xtext_style__enable   $w $args 
        }  
        dis -
        disable {
            eval xtext_style__disable  $w $args 
        }  
        del -
        delete {
            eval xtext_style__delete   $w $args 
        }  
        rem -
        remove {
            eval xtext_style__remove   $w  $args
        }
        get {
            eval xtext_style__get      $w  $args
        }
        init {
            if {[llength $args]} {
                set msg "Aucun argument supplémentaire n'est accepté pour :\n"
                append msg "    xtext_style \$w init !\n"
                append msg "    \nargs=$args"
                error "\n\n$msg\n\n"
            }
            
            eval xtext_style__init     $w  $args
        }
        deb -
        debug {
            foreach var {
                xtext_style($w,allSheets)                 
                xtext_style($w,enabledSheets)             
                xtext_style($w,isRefreshingAll)         
                xtext_style($w,isRefreshingScreen)      
                xtext_style($w,nextRequestCmd)          
                xtext_style($w,prevEndRefreshedScreen)  
                xtext_style($w,prevStartRefreshedScreen)
                xtext_style($w,updatePeriode)   
            } { 
                puts "set $var [set [subst $var]]"
            }
            set allMarks [lsort [$w mark names]]
            puts "Nombre total de marque : [llength $allMarks]"
            puts -nonewline  "dont la dernière marque temporaire est :"
            puts "[lindex $allMarks end]"
            return
        }
        h -
        help -
        default {
            set msg    "\nClé \"$key\" pour args=\"$args\" incorrecte."
            append msg "\nClés autorisées :"
            append msg "\ndefine, delete, apply, remove, enable, disable,\n"
            append msg "\n, get, init\n\n"
        }
    }
}


## xtext_style__init -- 
# 
# Syntaxe  
# -------
#   xtext_style__init $w 
#                          
# Options :
# ---------
#   Aucune option !
# 
# Voir manuel séparé
# 
proc xtext_style__init { w args } {
 
    global xtext_style

    # Vrai quand la colorisation est en train de se faire
    set xtext_style($w,isRefreshingAll) 0
    set xtext_style($w,isRefreshingScreen) 0
    
        
    # Listes des feuilles de styles 
    set xtext_style($w,allSheets)        [list]
    set xtext_style($w,enabledSheets)    [list]
    
    # Initialisation de quelques mark
    $w mark set old_screenStart 1.0
    $w mark set old_screenEnd   1.0
    $w mark set screenStart 1.0
    $w mark set screenEnd   1.0
    
    
    # Contient la commande de colorisation lorsqu'une colorisation est déla
    # en cours
    set xtext_style($w,nextRequestCmd) [list]
    
    # En test : mémo du dernier screen rafrechi
    set xtext_style($w,prevStartRefreshedScreen) 1.0 
    set xtext_style($w,prevEndRefreshedScreen)   1.0

    # periode de rafrechissement par update (nbre d'itération par boucle)
    # 1000 est  OK pour petits fichier, 
    # mais il faut passer à 10 pour gros fichier !?
    # set xtext_style($w,updatePeriode) 1000
    set xtext_style($w,updatePeriode) 100
    
    # Création de quelques marque (globale !) pour la gestion des styles
    # Attention : ces marques sont succeptibles de varier entre deux updates !
    # 
    $w mark set startMark 1.0   ;# debut pour apply
    $w mark set endMark   1.0   ;# fin pour apply
    $w mark set startRemMark 1.0   ;# debut pour remove
    $w mark set endRemMark   1.0   ;# fin pour remove
    $w mark set S1 1.0
    $w mark set S2 1.0
    $w mark set S3 1.0
    $w mark set S4 1.0
    $w mark set S1sub 1.0
    $w mark set S2sub 1.0
    $w mark set R 1.0

}
## xtext_style__get -- 
# 
# Syntaxe  
# -------
#   xtext_style__get $w ?options?  ?<sheet>? ?<style>?
#                          
# Options :
# ---------
#   Aucune option pous l'instant !
# 
# Voir manuel séparé
# 
proc xtext_style__get { w args } {
 
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets
    
    # 
    # 1 - analyse des options
    # 
    Parsarg_fullSpec opt {
        all          flag
    }

    if { $opt(-all) } {
        if {[string length $args]} {
            set    msg "\nL'option -all doit etre le seul argument\n"
            append msg "\n ignoré : args=$args\n\n"
            error $msg
        } else {
            # On retourne la liste des ensembles de styles connus
            return $allSheets
        }
    }

    # Extraction des arguments résiduels.
    # Suivant les cas certains de ces arguments devront etre vide
    set sheet [lindex $args 0]
    set style [lindex $args 1]
    
    # Sera soit une interrogation clé (e.g. -config), soit une affectation 
    # de clé (e.g. -config {-backgroung red} )
    set args [lrange $args 2 end]
    
    if { ![string length $sheet] } {
        # On retourne la liste des ensembles des styles **actifs**
        return $enabledSheets
    } 
    
    # on vérifie que la feuille de style spécifiée existe bien
    if { [lsearch -exact $allSheets $sheet] == -1} {
        error  "\nAucune feuille de styles de nom $sheet.\n"
    } 
    
    # Si pas de style spécifié on retourne la liste des styles de cette feuille
    if { ![string length $style] } {
        # On retourne la liste des styles connus pour cette feuille
        return $xtext_style($w,$sheet,styles)
    } 
    
    
    upvar #0 xtext_style($w,$sheet,styles) styles
    

    # Un style est proposé : on vérifie qu'il existe
    if {[lsearch -exact $styles $style] == -1} {
        error "style \"$style\" inexistant dans la feuille \"$sheet\""
    }
      
    # Le style existe.
    # Si aucune clé n'est indiquée pour ce style on retourne sa définition
    if { ! [llength $args] } {
        set keyValues [list]
        
        # A FAIRE : une option pour choisir le formatage de sortie :
        # - soit le définition stricte comme ici
        # - soit la spécif (style + styleDef) formatée d'une maniere
        #   plus lisible pour l'utilisateur
        # 
        set allKeys {type pat prePat postPat values tag config}
        foreach key $allKeys {
            lappend keyValues -$key $xtext_style($w,$sheet,$style,-$key)
        }
        return $keyValues
    }

    # Il y a au moins une clé en argument.
    # 
    # Si args contient un seul élément : c'est une clé dont on doit retourner 
    # la valeur
    # Le clé éventuelles est de la forme -type (**avec** le signe moins)
    # 
    if { [llength $args] == 1} {
        set key $args
        if { ![info exists xtext_style($w,$sheet,$style,$key)] } {
            set msg    "\nClé $key inconnue pour le style \"$style\""
            append msg "(au lieu de -tag, -type, -pat...)"
            error $msg
        }
        return $xtext_style($w,$sheet,$style,$key)
    }
    
    # S'il y a plusieurs éléments, ce doit etre une liste pair de la forme
    #    -key1 value1 -key2 value2...
    if { [llength $args] % 2 } {
        error "$args doit etre une liste paire"
    } 
    foreach {key val} $args {
        if { ![info exists xtext_style($w,$sheet,$style,$key)] } {
            set msg    "\nClé $key inconnue pour le style \"$style\""
            append msg "(au lieu de -tag, -type, -pat...)"
            error $msg
        }
        set xtext_style($w,$sheet,$style,$key) $val
        if {[string equal $key "-config"]} {
            set tagName  [xtext_style__get $w $sheet $style -tag]
            eval $w tag configure $tagName $val
        }
    }
    
    # A FAIRE : IL FAUDRAIT VERIFIER LES VALEUR (cf. fonction define)
}
## xtext_style__enable -- 
# 
# Syntaxe  
# -------
#   xtext_style__enable $w ?options?  ?<sheets>? ?<sheets>?
#                          
# Options :
# ---------
#   Aucune option pous l'instant !
# 
# Voir manuel séparé
# 
proc xtext_style__enable { w args } {
    
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets
    
    
    if { ![llength $args] } {
        set enabledSheets $allSheets
    } else {
        # on concatène les listes de feuilles de style
        set args [join $args " "]
        
        foreach sheet $args {
            if { [lsearch -exact $allSheets $sheet ] == -1} {
                error "\n$sheet : feuille de style non définie\n"
            } else {
                # On rend la feuille la plus récemment validée prioritaire en 
                # l'insérant en dernier
                set idx [lsearch -exact $enabledSheets $sheet]
                if {$idx != -1} {
                    set enabledSheets [lreplace $enabledSheets $idx $idx]
                }
                lappend  enabledSheets  $sheet
            }
        }
    }

}
## xtext_style__disable -- 
# 
# Syntaxe
# -------
#   xtext_style__disable $w  ?<sheets>? ?<sheets>?
#                          
# Options :
# ---------
#   Aucune option pous l'instant !
# 
proc xtext_style__disable { w args } {
    
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets
    
    
    if { ![llength $args] } {
        # on inactive **toutes** les feuilles de style
        set enabledSheets [list]
    } else {
        # on concatène les listes de feuille
        set args [join $args " "]
        
        foreach sheet $args {
        
            # On peut souhaiter générer une erreur si une feuille n'est pas 
            # définie. Pour l'instant on ignore.
            # if { [lsearch -exact $allSheets $sheet] == -1} {
            #     error "\n$sheet : feuille de style non définie\n"
            # }
             
            # On inactive **cette** feuille
            set idx [lsearch -exact $enabledSheets $sheet]
            if {$idx != -1} {
                set enabledSheets [lreplace $enabledSheets $idx $idx]
            }
        }
    }

}
## xtext_style__define -- 
# 
# Deux syntaxes possibles
# ------------------------
#   xtext_style__define $w  ?options?   <sheet> <styleSpec> ?<styleSpec>...?
#   xtext_style__define $w  ?options?   <sheet> <styleSpecs>
#                          
# Options :
# ---------
#   Aucune option pous l'instant !
# 
proc xtext_style__define { w args } {
    
    # report "xtext_style__define : $w $sheet [lindex $args 0]..."
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets
    

    set sheet [lindex $args 0]
    set args [lrange $args 1 end]
    
    # On crée un alias "specs" pour le tableau global de cette feuille
    upvar #0 xtext_style($w,$sheet,styles) styles
        
    if { [lsearch -exact $allSheets $sheet]  == -1} {
        # Si cette feuille n'existait pas encore : on la crée.
        # Attention : rien d'autre à faire ?
        lappend allSheets $sheet
        set styles [list]
    }

    if {[llength $args] == 1} {
        # Si args est un singleton : son seul élément constitue les styleSpecs
        # report "singleton : OUI"
        set styleSpecs [lindex $args 0]
    } else {
        # Si args n'est pas un singleton, args constitue les styleSpecs
        # report "singleton : NON : [llength $args]"
        set styleSpecs $args
    }
    if {[llength $styleSpecs] % 2} {
        set msg    "\nLa spécification de style doit etre une liste paire !"
        append msg "\n"
        append msg "\nstyleSpecs=\n$styleSpecs\n\n"
        error $msg
    }
    foreach {style styleDef} $styleSpecs {

        # On (ré)initialise **toutes** les clés pour etre sûr de la pas
        # conserver une ancienne valeur en cas de redéfinition avec un
        # type différent 
        foreach key {type pat prePat postPat values tag config} {
             upvar 0 xtext_style($w,$sheet,$style,-$key) $key
             set $key ""
        }
        
        # On mémorise le nom de ce style.,
        # mais si ce style existait deja on le déplace à la fin
        if {[set styleIdx [lsearch -exact $styles $style]] != -1} {
            set styles [lreplace $styles $styleIdx $styleIdx]
        }
        lappend styles $style
        
        # report "\n\nstyle=$style=> styleDef=\n$styleDef\n\n"

        # on lit la liste des couples -key val pour chaque définition de style
        # e.g :
        #   si on a :        ...  -type regexpPair ...
        #   on veut faire :  set type "regexpPair"
        foreach {key val} $styleDef   {
            set [string range $key 1 end] $val
        }
        
        # Si le type n'est pas spécifié : on impose une valeur par défaut
        if { ![string length $type] } {
            set type "regexpLight"
        }
        
        # 
        # On vérifie que le type en question est valide 
        # 
        set allowedTypes {
            regexp regexpLight regexpLine regexpGlobal
            wordList wordListLight  regexpPair
        }
        if { ![regexp -- "^[join $allowedTypes |]\$" $type] } {
            set msg    "\nType \"$type\" non accepté.\n"
            append msg "Valeurs actuellement autorisées : $allowedTypes\n\n"
            error $msg
        }
        if { $type == "regexp" } {
            set type regexpLight
        }
        
        
        # 
        # Si le type est wordList* : on construit la regexp en fonction
        # des séparateurs de ligne (prePat et postPat)
        # Par défaut, si -perPar et -postPat ne sont pas précisés par 
        # l'utilisateur, on utilise les cassures de mot standard.
        # 
        if { ( $type == "wordList" )   ||
             ( $type == "wordListLight" ) } {
            
            if { [string length $pat] } {
                set msg "\nLa clé de style \"-pat $pat\"ne doit pas etre"
                append msg "utilisée avec les types wordList* :\n"
                append msg "utilisez la clé -values\n\n"
                error $msg
            }
            if { ![string length $prePat] } {
                set prePat {\m}
            }
            if { ![string length $postPat] } {
                set postPat {\M}
            }
            if { ![string length $values] } {
                set msg "\nManque la liste des mots clés \"-values ???\" !\n"
                error $msg
            }
            
            set pat "${prePat}([join $values |])${postPat}"
            
            # Le type "wordList" et "wordListLight" deviennent des types
            # standard "regexpLight" ou "regexpLight"
            # 
            switch -exact -- $type {
                wordListLight {set type "regexpLight"}
                wordList      {set type "regexpLine"}
            }
        }
        # 
        # Suivant le type : on vérifie l'existence, valide et précompile 
        # les expressions régulières
        # 
        switch -exact --  $type {
            regexpLine -
            regexpLight -
            regexpGlobal   {
                # report "\n\n style=$style"
                # report -v  type pat prePat postPat values tag config 
                
                # Il est IMPORTANT de détecter une patterne vide car risque de
                # boucle infinie (regexp toujours vraie et longueur nulle !)
                if { ! [string length $pat] } {
                    error "La patterne du style $style est vide : -pat=\"\""
                }
                if {[catch {regexp -- $pat "foo"} ]} {
                    error "Expression régulière incorrecte : $pat"
                }
                
                # Dans le type "regexpLine" il faut en plus qu'il y ait au
                # moins une sous-patterne parenthésée "xxx(yyy)zzz"
                if {$type == "regexpLine"} {
                    set regexpAbout [regexp -about -- $pat]
                    if {[expr {[lindex $regexpAbout 0] < 1 } ]} {
                        set msg "style=$style  pat=$pat :"
                        append msg "\ntoute patterne d'un type \"regexpLine\""
                        append msg "\ndoit contenir au moins"
                        append msg "\nune sous-patterne parenthésée."
                        error "\n\n$msg\n\n"
                    }
                }
                
            }
            regexpPair   {
                if { [string length $pat] } {
                    set msg    "\nLa clé de style -pat (=\"$pat\") ne doit pas"
                    append msg "utilisée :\n"
                    append msg "utilisez les clés -prePat et/ou -postPat\n\n"
                    error $msg
                }
                if { [string equal "" $prePat] || [string equal "" $postPat] } {
                    set msg "\nUne des patternes -prePat ou -postPat de style "
                    append msg "$style est vide !\n\n"
                    error $msg
                }
                
                if {[catch {regexp -- $prePat "foo"} ]} {
                    error "Expression régulière incorrecte : $prePat"
                }
                if {[catch {regexp -- $postPat "foo"} ]} {
                    error "Expression régulière incorrecte :  $postPat"
                }
            }
        }
        
        # NOTA : on autorise les configurations vide : cela peut servir pour 
        # marquer des intervales pour y appliquer un menu contextuel, ou 
        # une filtre

        
        # On construit et on mémorise le nom de ce tag
        # set tag [xtext_style__getTagName $w $sheet $style];# Supprimé !
        set tag "xtext_style_${sheet}_${style}"
                
        set cmd [concat [list $w tag configure $tag]  $config]
        if {[catch $cmd msg]} {
            append msg "\n\nERREUR dans la configuration du tag $style.\n"
            error $msg
        }        
    }
    # report "xtext_style__define : FIN"
} ;# xtext_style__define

## xtext_style__delete -- 
# 
# Syntaxe
# -------
#  xtext_style__delete $w  ?options?  <sheets> <styles> ?<stylees>?
# 
# arguments :
# -----------
#   liste de liste de noms de style.
# 
# options :
# ---------
#   Aucune option pour l'instant
# 
# Voir manuel séparé.
# 
proc xtext_style__delete { w args } {

    # report "xtext_style__delete : $w $sheet $args"
    # report -v w sheet args
    # 
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets
    
    # Si pas de feuilles de style spécfiée : on les considère toutes.
    # (et pas seulement celles qui sont actives !)
    set sheets [lindex $args 0]
    if { ![llength $sheets] } {
        set sheets $allSheets
    }
    
    set args [lrange $args 1 end]
    
    # On transforme la liste de liste de style en une liste simple.
    # Tous les styles en argument doivent exister. S'il n'y a pas d'argument :
    # on prendra tous les styles **de chaque feuille en cours de traitement**
    set args [join [lrange $args 1 end] " "]

    # report -v enabledSheets allSheets sheets stylesToDelete
    foreach sheet $sheets {
    
        upvar #0 xtext_style($w,$sheet,styles) styles
        
        if { ! [info exists styles] } {
            # rien à detruire
            return
        }

        # On commence par déactiver cette feuille de style
        xtext_style__disable $w $sheet

        # Si aucun style n'est précisé, on les détruit tous !
        set stylesToDelete $args
        if { ![llength $stylesToDelete] } {
            set stylesToDelete $styles
        }
        
        # On examine chaque style 
        foreach style $stylesToDelete {
            set nameIdx [lsearch -exact $styles $style]
    
            # Si un style n'existe pas : on l'ignore
            if {$nameIdx == -1} {
                continue
            }
                        
            # Suppression des infos concernant ce style
            set styles [lreplace $styles $nameIdx $nameIdx]
            # Suppression de la configuration du widget
            $w tag delete $xtext_style($w,$sheet,$style,-tag)
            
            # suppression des élements du tableau associés à ce style,
            array unset xtext_style $w,$sheet,$style,*
            
        }
        
        # Si on a supprimé le dernier style : on supprime la feuille elle-même.
        # 
        # Question : et pourquoi ne pas garder de feuille de style vide ??
        # 
        if { ![llength $styles] } {
            
            # On supprime cette feuille (déja désactivée) de la liste principale
            set idx [lsearch -exact $allSheets $sheet]
            # ASSERT : {$idx != -1}
            set allSheets [lreplace $allSheets $idx $idx]
        
            # suppression des élements du tableau associés à cette feuille,
            # et on fini par détruire le tableau des données de ce
            # 
            array unset xtext_style $w,$sheet,* 
        }
    }
    # report "/xtext_style__delete : FIN"
}

proc xtext_style__apply { w  args } {
    # 
    # report "DANS xtext_style__apply $w $args"
    # 
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets
    
    # 
    # 1 - analyse des options
    # 
    Parsarg_fullSpec opt {
        range        {screen}
        currentLine  { -type flag  -eval {set opt(-range) currentLine}  } 
        previousLine { -type flag  -eval {set opt(-range) previousLine} }
        screen       { -type flag  -eval {set opt(-range) screen}       }
        all          { -type flag  -eval {set opt(-range) all}          }
    }
        
    # On définit des **noms** de marque uniques, pour éviter les conflits
    # en cas de réentrance
    # et on y mémorise les extrémité de l'intervale à traiter
    # 
    set limitMarks [xtext_style__normaliseRange $w $opt(-range)]         
    set startMark "M[xtcl_uid]"; $w mark set $startMark [lindex $limitMarks 0]
    set endMark   "M[xtcl_uid]"; $w mark set $endMark   [lindex $limitMarks 1]
    set linesNumber [expr {int ([$w index $startMark] - [$w index $endMark])}]
    
    if {$linesNumber > 102} {
        set opt(isLong) 1
    } else {
        set opt(isLong) 0
    }
    
    
    # Traitement des cas particuliers destinés à limiter la réentrance.
    # 
    # PROVISOIRE ET EN COURS DE MISE AU POINT
    # 
    # 1 - Une colorisation complète peut etre **tres longue** dans certaines 
    #     condition, alors si on souhaite **tout** recolorié et qu'une 
    #     colorisation complète  est déja en cours : on se contente de 
    #     rafraichir la partie visible de l'écran (en se restreignant aux 
    #     feuilles et styles initialement demandées !).
    # 2 - Un rafraichissement peut etre démandé **tres fréquemment**, plusieurs
    #     demandes de rafraichissement de l'écran peuvent survenir pendant un 
    #     rafraichessement d'écran : on se contentera d'exécuter la dernière
    #     demande en oubliant les précédentes (on interdit la réentrance)
    # 
    switch -exact $opt(isLong) {
        1 { 
            
            # report -nn "REQUEST apply all .. range=$opt(-range) args=$args"
            if { $xtext_style($w,isRefreshingAll) } {
                # report " On lance screen"
                # report " => xtext_style__apply  $w -screen $args"
                eval xtext_style__apply  $w -screen $args
                # update
                # **NE PAS OUBLIER** la suppression des marques temporaires !
                $w mark unset $startMark $endMark
                return
            } else {
                # report " On lance all"
                set xtext_style($w,isRefreshingAll) 1
            }
        } 
        0 {
            # report  -c "REQUEST apply screen .. range=$opt(-range) args=$args"
            if { $xtext_style($w,isRefreshingScreen) } {
                
                # On mémorise la commande **avec les argument** car on
                # peut avoir demande un apply pour certain style seulement !"
                # report " On mémorise !"
                set xtext_style($w,nextRequestCmd) \
                            [concat {xtext_style__apply $w -screen} $args]
                $w mark unset $startMark $endMark
                return
            } else {
                # report " On lance screen"
                set xtext_style($w,isRefreshingScreen) 1
            }
        }
    }    
    # report " EXECUT apply opt(-range)=$opt(-range) $args"
    

    # Si aucune feuille de style précisée : on les prend toutes
    set sheets [lindex $args 0]
    if { ! [llength $sheets] } {
        set sheets $enabledSheets
    }
    
    # Tous les styles en argument doivent exister. S'il n'y a pas d'argument :
    # on prendra tous les styles **de la feuille en cours de traitement**
    set stylesToApply [lrange $args 1 end]
                
    foreach sheet $sheets {
        
        upvar #0 xtext_style($w,$sheet,styles) styles
        
        # Si la variable styles n'existe pas : erreur
        if { ! [info exists styles] } {
            set msg "\nVous devez d'abords définir des styles dans le jeu :"
            append msg "$specsArrayName\n\n"
            error $msg
        }

        if { ![llength $stylesToApply] } {
            set stylesToApply $styles
        }
                
        # On examine chaque style 
        foreach style $stylesToApply {

            # On vérifie que ce style est bien prédéfini
            if { [lsearch -exact $styles  $style] == -1 } {
                set msg "\nstyle non défini : \"$style\" ; style connu :\n"
                append msg "   \{$styles\}"
                append msg "\nUtiliser d'abord : xtext_style $w define"
                error $msg
            }

            # report "TRAITEMENT DE $style  $startMark $endMark"
            # A FAIRE :
            # Tenir compte de fileSize et de rangeSize pour adapter le nbre
            # de update à réaliser
            switch -exact -- $xtext_style($w,$sheet,$style,-type) {
                regexpPair  {
                    xtext_style__apply_regexpPair $w \
                            $sheet $style  $startMark $endMark 
                }
                regexpGlobal  {
                    
                    # A FAIRE : Il faut traiter différemment les cas
                    # où on rafraichit une page max, ou tout le texte !
                    # On peut gérer plus finement les limites de coloration
                    set from  "$startMark-10lines"
                    set to    "$endMark+10lines"
                    
                    # ASSERT : les marques $startMark et $endMark sont à jour
                    xtext_style__apply_regexpGlobalShort $w \
                                        $sheet $style  $from $to 
                }
                regexpLight  -
                regexpLine  {
                    xtext_style__apply_regexpLine $w \
                            $sheet $style  $startMark $endMark 
               }
                default {
                    error "\nType de style inconnu : $type !\n"
                }
            } ;# end switch
            update
        } ;# end foreach style
        # update    
    } ;# enf foreach sheet

    # report -nn "FIN de apply :"

    # Traitement des cas particuliers destinés à limiter la réentrance.
    # report "FIN de range=$opt(-range)"
    switch -exact $opt(isLong) {
        1 { 
            # report "FIN de all"
            # On libère le verrou
            set xtext_style($w,isRefreshingAll) 0
        } 
        0 {
            # report "FIN de screen"
            
            # update
            # # On traite les éventuelles demandes en attente
            while {[llength $xtext_style($w,nextRequestCmd)]} {
                # report "apply MEMO : $xtext_style($w,nextRequestCmd)"
                set xtext_style($w,nextRequestCmd) [list]
                eval  $xtext_style($w,nextRequestCmd)
            } 
            # et on libère le verrou
            set xtext_style($w,isRefreshingScreen) 0

            # Mémo du dernier écran refrechi (pour eviter refraichissements
            # inutiles lors des scroll)
            # 
            # Ces variables sont exploitées par xtext_updateScreenMarks pour
            # décider ou non de la génération de <<screenChange>>
            # 
            set xtext_style($w,prevStartRefreshedScreen) [$w index $startMark] 
            set xtext_style($w,prevEndRefreshedScreen) [$w index $endMark]
        }
    }

    # Suppression des marques temporaires
    $w mark unset $startMark $endMark
    update

    # report "/xtext_style__apply : FIN"
}

## xtext_style__apply_regexpPair -- 
# 
# Syntaxe
# -------
#  xtext_style__apply_regexpPair $w  \
#         <sheet> <style>  from to 
# 
# 
proc xtext_style__apply_regexpPair { w  sheet style  from to } {

# report "xtext_style__apply_regexpPair DEBUT $from $to"
    
    upvar #0  xtext_style($w,$sheet,$style,-type)       type
    # upvar #0  xtext_style($w,$sheet,$style,-pat)        pat
    upvar #0  xtext_style($w,$sheet,$style,-prePat)     prePat
    upvar #0  xtext_style($w,$sheet,$style,-postPat)    postPat
    # upvar #0  xtext_style($w,$sheet,$style,-values)     values
    upvar #0  xtext_style($w,$sheet,$style,-tag)        tag
    upvar #0  xtext_style($w,$sheet,$style,-config)     config
    upvar #0  xtext_style($w,$sheet,styles)             styles

    # Création de marques temporaires de nom unique :
    # 
    set startMark M[xtcl_uid]  ;  $w mark set $startMark $from
    set endMark   M[xtcl_uid]  ;  $w mark set $endMark   $to  
                                 
    #  M1, M2 : limites du préfixe ;  
    #  M3, M4 : limite du suffixe
    #  R est le nouveau début de la zone de recherche (le M4 précédent)
    set M1        M[xtcl_uid]  ;  $w mark set $M1 $startMark
    set M2        M[xtcl_uid]  ;  $w mark set $M2 $startMark
    set M3        M[xtcl_uid]  ;  $w mark set $M3 $startMark
    set M4        M[xtcl_uid]  ;  $w mark set $M4 $startMark
    set R         M[xtcl_uid]  ;  $w mark set $R  $startMark
                          
    
    # On commence à cherche un suffix apres le début de zone, et on regarde
    # si le préfixe correspondant est dans, ou avant la zone.
    set postIdx [$w search -regexp  -count count2 -- $postPat $R end]
    if {[string length $postIdx]} {
        # On revient en arriére pour chercher le préfixe correspondant
        $w mark set $M3 $postIdx
        $w mark set $M4 $M3+${count2}c
        set preIdx [$w search -regexp -backwards -count count1 -- \
                                    $prePat $M3 1.0]
        if { ([string length $preIdx]) && ([$w compare $preIdx < $endMark])} {
            $w mark set $M1 $preIdx
            $w mark set $M2 $M1+${count1}c
            $w tag remove $tag $R  $M1
            $w tag add    $tag $M1 $M4
            $w mark set $R  $M4
        } else {
            # Soit parenthèse fermante orpheline,
            # Soit toute la chaine est apres le fin de zone => on ignore
            $w mark unset $startMark $endMark $M1 $M2 $M3 $M4 $R
            return
        }
    } else {
        # Rien à colorier
        $w mark unset $startMark $endMark $M1 $M2 $M3 $M4 $R
        return
    }


    # set i $xtext_style($w,updatePeriode)
    set preIdx_old end
    set preIdx [$w search -regexp  -count count1 -- $prePat $R $endMark]
    
    if {$::arga(-Tstyle)} {
        report "Type=$type $style prePat=$prePat postPat=$postPat"
    }
    while {[string length $preIdx]} {
       
        if {$::arga(-Tstyle)} {
            report "preIdx=$preIdx";# if {[regexp {2\d\d} $idx]} {error FIN} 
        }
        # Détecteur de boucle infinie (par erreur de patterne)
        if {[$w compare $preIdx_old == $preIdx]} {
            set    msg "Risque de boucle infinie "
            append msg "style=$style pat=$pat idx=$idx"
            error \n\n$msg\n\n
        } else {
            set preIdx_old $preIdx
        }

        $w mark set $M1 $preIdx
        $w mark set $M2 $preIdx+${count1}c
        
        # On vient de marquer le prefixe, on doit chercher la 
        # suffixe correspondant (éventuellement jusqu'à la fin 
        # du fichier)
        set postIdx [$w search -regexp -count count2 -- $postPat $M2 end]
        
        if { ![string length $postIdx] } {
            # On vient de trouver un prefixe orphelin
            # e.g. un "/*"   sans "*/"
            # Que doit-on faire ? Appliquer un tag d'erreur ?
            # Pour l'instant on ignore.
            $w mark unset $startMark $endMark $M1 $M2 $M3 $M4 $R
            return
        }
        
        $w mark set $M3 $postIdx
        $w mark set $M4 $postIdx+${count2}c
        

        # Suivant les options on pourra colorier ou non les 
        # préfixes, voir ne colorier que les prefixe et suffixe 
        # mais pas ce qu'il y a entre les deux !
        # 
        $w tag remove $tag $R  $M1
        $w tag add    $tag $M1 $M4

        $w mark set $R $M4

        # if { ![incr i -1 ] } {
        #     set i $xtext_style($w,updatePeriode)
        #     update
        # }
        set preIdx [$w search -regexp  -count count1 --  $prePat $R $endMark]
    }

    # Suppression des marques temporaires
    $w mark unset $startMark $endMark $M1 $M2 $M3 $M4 $R
    # report "xtext_style__apply_regexpPair FIN"
}

## xtext_style__apply_regexpLine -- 
# 
# Syntaxe
# -------
#  xtext_style__apply_regexpLine $w <sheet> <style>  from to 
# 
# 
proc xtext_style__apply_regexpLine { w  sheet style  from to } {
    
    # report "xtext_style__apply_regexpLine DEBUT $from $to"
    global xtext_style

    upvar #0  xtext_style($w,$sheet,$style,-type)       type
    upvar #0  xtext_style($w,$sheet,$style,-pat)        pat
    # upvar #0  xtext_style($w,$sheet,$style,-prePat)     prePat
    # upvar #0  xtext_style($w,$sheet,$style,-postPat)    postPat
    # upvar #0  xtext_style($w,$sheet,$style,-values)     values
    upvar #0  xtext_style($w,$sheet,$style,-tag)        tag
    # upvar #0  xtext_style($w,$sheet,$style,-config)     config
    upvar #0  xtext_style($w,$sheet,styles)              styles

    # Création de marques temporaires de nom unique :
    # 
    set startMark M[xtcl_uid]  ;  $w mark set $startMark $from
    set endMark   M[xtcl_uid]  ;  $w mark set $endMark   $to
    
    #  M1, M2 : limites de la chaine cherchée ;  
    #  M1sub, M2sub : limites de la sous-chaine à colorier ;  
    #  R est le nouveau début de la zone de recherche (le M2 ~ précédent)
    set M1        M[xtcl_uid]  ;  $w mark set $M1    $startMark
    set M2        M[xtcl_uid]  ;  $w mark set $M2    $startMark
    set M1sub     M[xtcl_uid]  ;  $w mark set $M1sub $startMark
    set M2sub     M[xtcl_uid]  ;  $w mark set $M2sub $startMark
    set R         M[xtcl_uid]  ;  $w mark set $R     $startMark
                                 
    # set i $xtext_style($w,updatePeriode)
    set idx_old end
    set idx [$w search -regexp  -count count -- $pat $R $endMark]
    if {$::arga(-Tstyle)} {
        report "Type=$type $style pat=$pat"
    }
    while {[string length $idx]} {
        if {$::arga(-Tstyle)} {
            report "idx=$idx";# if {[regexp {2\d\d} $idx]} {error FIN}
        }

        # Détecteur de boucle infinie (par erreur de patterne)
        if {[$w compare $idx_old == $idx]} {
            set    msg "Risque de boucle infinie "
            append msg "style=$style pat=$pat idx=$idx"
            error \n\n$msg\n\n
        } else {
            set idx_old $idx
        }

        $w mark set $M1 $idx
        $w mark set $M2 $idx+${count}c

        # Attention aux limites à droite des intervales
        # indice (+/- 1 suivant inclu ou non)
        #   - resultat d'une recherche  => bornes de droite incluses
        #   - $w tag add/remove  => borne de droite exclue
        #   
        switch -exact -- $type {
            "regexpLine" {
                regexp -indices --  $pat [$w get $M1 $M2]  wholePair subPair
                $w mark set $M1sub $M1+[lindex $subPair 0]c
                $w mark set $M2sub $M1+[lindex $subPair 1]c+1c
                $w tag remove $tag $R     $M1sub
                $w tag add    $tag $M1sub $M2sub
                $w mark set        $R     $M2sub
            }                     
            "regexpLight" {
                $w tag remove $tag $R  $M1
                $w tag add $tag    $M1 $M2
                $w mark set        $R  $M2
            }                         
            default {
                error "Ce type n'est pas accepté ici : $type"
            }
        }
                

        # if { ![incr i -1 ] } {
        #     set i $xtext_style($w,updatePeriode)
        #     update
        # }
        set idx [$w search -regexp  -count count -- $pat $R $endMark]
        # update
        
    }
    
    # Suppression des marques temporaires
    $w mark unset $startMark $endMark $M1 $M2 $M1sub $M2sub $R
    # report "xtext_style__apply_regexpLine FIN"

}
## xtext_style__apply_regexpGlobalShort -- 
# 
# Syntaxe
# -------
#  xtext_style__apply_regexpGlobalShort $w  <sheet> <style>  from to  
# 
# Version adaptée pour le traitement de petit blocs de text (peu de update)
# 
proc xtext_style__apply_regexpGlobalShort {w sheet style from to} {
        
    # report "xtext_style__apply_regexpGlobal DEBUT $from $to"
    global xtext_style

    # upvar #0  xtext_style($w,$sheet,$style,-type)       type
    upvar #0  xtext_style($w,$sheet,$style,-pat)        pat
    # upvar #0  xtext_style($w,$sheet,$style,-prePat)     prePat
    # upvar #0  xtext_style($w,$sheet,$style,-postPat)    postPat
    # upvar #0  xtext_style($w,$sheet,$style,-values)     values
    upvar #0  xtext_style($w,$sheet,$style,-tag)        tag
    # upvar #0  xtext_style($w,$sheet,$style,-config)     config
    upvar #0  xtext_style($w,$sheet,styles)              styles


    # Création de marques temporaires de nom unique :
    # 
    set startMark M[xtcl_uid]  ;  $w mark set $startMark $from
    set endMark   M[xtcl_uid]  ;  $w mark set $endMark   $to
    
    #  M1, M2 : limites de la chaine cherchée ;  
    # # #  R est le nouveau début de la zone de recherche (le M2 ~ précédent)
    set M1        M[xtcl_uid]  ;  $w mark set $M1    $startMark
    set M2        M[xtcl_uid]  ;  $w mark set $M2    $startMark
    set R         M[xtcl_uid]  ;  $w mark set $R     $startMark
    
    set text [$w get $startMark $endMark ]
    set indicesPairs [regexp -all -indices -inline -- $pat $text]
    
    # Probleme : 
    # chute d'efficacité si c'est une patterne rare !!
    # if {[llength $indicesPairs] < 10} {
    #     # Pas assez de tag : on risque de chevauchement 
    #     # d'écran. On traite alors tout le fichier.
    #     $w mark set $startMark "1.0"
    #     $w mark set $endMark "end"
    #     set text [$w get $startMark $endMark ]
    #     set indicesPairs \
    #             [regexp -all -indices -inline -- $pat $text]
    # }
    
    # report -t "      ...fait (indicesPairs: \
    #         \nde [$w index $startMark] à \
    #         [$w index $endMark] \
    #         [llength $indicesPairs] elem) \
    #         [lrange $indicesPairs 0 5]\n"

    # Principe : 
    # 
    # On obtient par regexp :
    #   {3 12} {5 7} {13 19} {15 17} ...
    # on veut extraire :
    #   {5 7} {15 17} ...
    # Pour colorier (si M == 10.0) :
    #   10.0+5c 10.0+7c+1c  10.0+15c 10.0+17c+1c
    # 
    
    # 
    # Extraction des index de sous-patterne :
    # 
    
    set indices [list]
    foreach {pair1 pair2} $indicesPairs {
        lappend indices [lindex $pair2 0] [lindex $pair2 1] 
    }
    # report -t "     FAIT ; indices = [llength $indices] elem.\
    #             \n [lrange $indices 0 7]"
    # On doit avoir {5 7 15 17 ...}
    
    
    # report -t "     création liste des  différences ..."
    # update
    # On doit avoir {5 7  15-5 17-7 ...} soit {5 7 10 7}
    # et on va faire évoluer deux marques M et N initialisées 
    # à 0.0
    # 
    set deltas [list]
    set last_ind1  0
    set last_ind2 -1
    # set i $xtext_style($w,updatePeriode)
    foreach {ind1 ind2} $indices {
        set d1 [expr {$ind1 - $last_ind1}]
        set d2 [expr {$ind2 - $last_ind2}]
        lappend deltas $d1 $d2
        set last_ind1 $ind1
        set last_ind2 $ind2
        # if { ![incr i -1 ] } {
        #     set i $xtext_style($w,updatePeriode)
        #     update
        # }
    }
    # report -t "     FAIT ; deltas = [llength $deltas] elem.\
    #             \n [lrange $deltas 0 7]"
    
    # On va appliquer progressivement tag pat tag en premachant
    # le travail pour éviter les [$w index nnn.m + N car]
    # qui sont couteux loin de nnn.m !
    
    # report -t "     application des tags ...\
    #          \n     indices : [llength $indices] elem"
    # set i $xtext_style($w,updatePeriode)
    foreach {d1 d2} $deltas {
        $w mark set  $M1 $M1+${d1}c
        $w mark set  $M2 $M2+${d2}c
        $w tag remove $tag  $R  $M1
        $w tag add    $tag  $M1 $M2
        $w mark set $R $M2+1c
        # if { ![incr i -1 ] } {
        #     set i $xtext_style($w,updatePeriode)
        #     update
        # }
    }
    # Suppression des marques temporaires
    $w mark unset $startMark $endMark $M1 $M2 $R
    # report "xtext_style__apply_regexpGlobal FIN"
}
## xtext_style__apply_regexpGlobalLong -- 
# 
# Syntaxe
# -------
#  xtext_style__apply_regexpGlobalLong $w  <sheet> <style>  from to  
# 
# Version adaptée pour le traitement de gros blocs de text (beaucoup de update)
# 
proc xtext_style__apply_regexpGlobalLong {w sheet style from to} { 
    
    error "\nxtext_style__apply_regexpGlobalLong est en cours de \
            développement : A FINIR\n\n"
    
}
## xtext_style__remove -- 
# 
# Syntaxe
# -------
#  xtext_style__remove $w  ?options?  ?<sheets>?  <styles> ?<styles>?
# 
# Les style à effacer **doivent** exister sinon erreur
# 
proc xtext_style__remove { w args } {
    
    # report "xtext_style__remove : $w $sheet $args"
    # 
    # 1 - analyse des options
    # 
    Parsarg_fullSpec opt {
        range {}
        currentLine  { -type flag  -eval {set opt(-range) currentLine}  } 
        previousLine { -type flag  -eval {set opt(-range) previousLine} }
        screen       { -type flag  -eval {set opt(-range) screen}       }
        all          { -type flag  -eval {set opt(-range) all}          }
    }
    
    global xtext_style
    upvar 0 xtext_style($w,enabledSheets)  enabledSheets
    upvar 0 xtext_style($w,allSheets)      allSheets

    # On détermine l'intervale à traiter et réation de marques temporaires 
    # de nom unique :
    # 
    set opt(-range) [xtext_style__normaliseRange $w $opt(-range)] 
    set startMark M[xtcl_uid] ; $w mark set $startMark [lindex $opt(-range) 0]
    set endMark   M[xtcl_uid] ; $w mark set $endMark   [lindex $opt(-range) 1]
    
    set sheets [lindex $args 0]
    # Si aucune feuille n'est précisée, on considère toutes les feuilles 
    # **actives**
    if { ![llength $sheets] } {
        set sheets $enabledSheets
    }
    
    # On transforme la liste de liste de styles en une liste simple.
    # Tous les styles en argument doivent exister. 
    # S'il n'y a pas d'argument : on prendra tous les styles **de la 
    # feuille en cours de traitement**
    set stylesToRemove [join [lrange $args 1 end] " "]
    
    foreach sheet $sheets {
        upvar #0  xtext_style($w,$sheet,styles)             styles
        
        # # # Si la variable styles n'existe pas : rien à faire
        # # if { ! [info exists styles] } {
        # #     return
        # # }
        
        if { ![llength $stylesToRemove] } {
            # On veux appliquer TOUS les styles
            set stylesToRemove $styles
        }
        
        # On examine chaque style 
        foreach style $stylesToRemove {
            # On vérifie que chaque style est bien prédéfini
            if { [lsearch -exact $styles  $style] == -1 } {
                set msg    "\nstyle non défini : \"$style\"\n"
                append msg "styles connus :\n  \{$styles\}"
                append msg "\nUtiliser d'abord : xtext_style $w define"
                error $msg
            }
            upvar #0  xtext_style($w,$sheet,$style,-tag)   tag
            $w tag remove $tag $startMark $endMark
        }
    }
    $w mark unset $startMark $endMark
    # report "/xtext_style__aremove : FIN"
}

## xtext_style__normaliseRange -- retourne un couple de marque
# 
# Syntaxe
# -------
#  xtext_style__normaliseRange $w <range>
# 
# Arguments :
# ----------
# w : widget 
# <range> : marque, paire de marque ou  symbole spécifiant un intervale
#   pouvant être :
#       - all
#       - preScreen
#       - screen
#       - postScreen
#       - currentLine
#       - previousLine
#       - {indx1 indx2}  => valeur des marques retournées
#       - {indx1}   => retourne la l'intervale de la ligne contenant cet index 
# 
# 
proc xtext_style__normaliseRange {w range} {
    switch -exact -- $range {
        ""  -
        all { 
            return [list 1.0 end]
        }
        preScreen { 
            xtext_updateScreenMarks $w
            return [list 1.0 screenStart]
        }                  
        screen { 
            xtext_updateScreenMarks $w
            return [list screenStart screenEnd]
        }                  
        postScreen { 
            xtext_updateScreenMarks $w
            return [list screenEnd end]
        }                  
        currentLine {
            return [list "insert linestart" "insert lineend+1c"]
        }
        previousLine {
            return [list "insert -1line linestart" "insert -1line lineend+1c"]
        }
        default {
            # L'intervale peut-etre soit un index, soit deux index
            if {[llength $range] == 1} {
                # on choisit la ligne spécifiée (complete)
                # Attention : meme avec un seul index, range $reste une liste !
                return [list \
                    "[lindex $range 0] linestart" \
                    "[lindex $range 0] lineend+1c" \
                ]
            } elseif {[llength $range] == 2} {
                # on choisit toutes les lignes entre ces deux lignes (incluses)
                return [list \
                    "[lindex $range 0] linestart" \
                    "[lindex $range 1] lineend+1c" \
                ]
            } else {
                set rangeSymbols {
                    all currentLine previousLine screen preScreen postScreen
                }
                error "option -range {index1 ?index2?}\
                        ou bien -range [join $rangeSymbols |]"
            }
        }
    } ;#endswitch
}


## testTclTagSpecs --
#        
# 
proc style_test {  } {
    upvar #0 ::stead(text) w

    report -t "Avant delete test"
    update
    xtext_style $w delete test
    
    report -t "Avant define test"
    update
    # xtext_style $w define test {
    #     style1 {
    #         -type regexpGlobal
    #         -pat {(?:\W)(\w{2})}
    #         -pat {(?:\W|\w\w\w)(\w{2})}
    #         -config {-foreground blue}
    #     }
    # }
    # xtext_style $w define test {
    #     style1 {
    #         -type regexpLine
    #         -pat {(?:\W)(\w{2})}
    #         -pat {(?:\W|\w\w\w)(\w{2})}
    #         -config {-foreground blue}
    #     }
    # }
    xtext_style $w define test {
        pair {
            -type regexpPair
            -prePat {<!--}
            -postPat {-->}
            -config {-background blue}
        }
    }
    
    report -t "Avant remove"
    update
    xtext_style $w remove

    report -t "Avant application du test"
    update
    xtext_style $w refresh test 
    # xtext_style $w ref test 

    report -t "APRES application du test"
    update
        
}
# ./
