/binaries/theo/data

####################
# SCRIPTREE
# Copyright Š  2000-2008 Chevenet F. chevenet@ird.fr
# IRD SPIRALES
#
# This program is under the terms of the GNU General Public License
####################

####################
# INTERFACE
####################
namespace eval Interface {
    
    
    proc TreeDynInitialisation {} {
        global  tcl_platform S T db IMGshn IMGil1 B asedCon find
        #des preferences
        set S(ltoolboxusername) {}
        set S(toolboxType)  all
        set S(Preference_display_eu) 1
        set S(Preference_fgc) black
        set S(Preference_mainXY) +297+129
        set S(Preference_display_eu) 1
        set S(Preference_fgc) black
        set S(version) "TreeDyn (196.3)"
        set S(treedynpack) Marianne
        set S(patchnumber) 196
        set S(manual) 1.0
        set S(TreeDynUpdate) {Marianne 196 1.0}
        set S(loc) 1
        set S(history) ""
        set S(AutoReset) 0
        set S(illustration-tabulation) 0
        set S(TabulationAnnot) 5
        set S(-family) Arial
        set S(-weight) normal
        set S(-size)  10
        set S(-slant)  roman
        set S(-underline)  0
        set S(-overstrike) 0
        set S(gfo) [list -family $S(-family) \
                -weight $S(-weight) \
                -size $S(-size) \
                -slant $S(-slant) \
                -underline $S(-underline) \
                -overstrike $S(-overstrike)]
        set S(fontbase) [list -family Arial  -weight normal -size 10 -slant roman -underline 0 -overstrike 0]
        # Database
        set S(lastid) 0
        set S(nbobj) 0
        set S(database) ""
        set S(ldatabase) {}
        set asedCon [interp create treedyn]
        $asedCon alias db "Database::db"
        set S(topmessage) $S(version)
        set S(ghi) grey ;# couleur de hightlight
        set S(ilt) 0 ;# liste des identificateurs tree
        set S(ilw) 0 ;# liste des identificateurs windows
        set S(col) red
        set S(display_eu) normal
        set S(nodefilter) 0
        set S(tool) move
        set S(cp) "" ; # variable contenant les arguemnts pour les copy/paste
        set S(und) "?" ; # variable undo
        set S(Xfactor) 1.0
        set S(Yfactor) 1.0
        set S(collection) "" ;# liste des ID de collection (processus de copy / paste)
        set S(browserCP_width) 150
        set S(browserCP_height) 150
        ### variable package supertree
        set S(supertreeConsDisplayNewWindow) 1
        set S(supertreeConsDisplaySameWindow) 1
        set S(supertreeConsFile) 0
        ##### variable de reset graphique
        set S(OpResetLFgC) 0
        set S(OpResetLBgC) 0
        set S(OpResetLF) 0
        set S(OpResetNFgC) 0
        set S(OpResetNBgC) 0
        set S(OpResetNLW) 0
        set S(OpResetNLD) 0
        set S(OpResetNUS) 0
        set S(OpResetNUC) 0
        set S(OpResetAL) 0
        set S(OpResetAN) 0
        set S(OpResetAC) 0
        set S(AutoReset) 0 ;# variable de reset automatic du panel "Interface::Find"
        ##### variable/ valeur par defaut pour exportation HTML
        set S(url-prefix) "http://www.ncbi.nlm.nih.gov/entrez/viewer.fcgi?db=Nucleotide&cmd=search&val="
        set S(stipple) z.xbm
        # variable clavier virtuel (illustration)
        set S(ill-family) Wingdings
        set S(ill-size) 6
        set S(ill-weight) normal
        set S(ill-overstrike) 0
        set S(ill-underline) 0
        set S(ill-slant) roman
        # operation  l'identification
        set S(operation) leaffgcolor
        set S(operationName) "Leaf Foreground Color"
        set S(operationlabelisation) menu
        set S(operationdatabase) localisation
        set S(AnnotateNote) <text>
        set S(illustration-tabulation) 0
        set S(TabulationAnnot) 5
        set S(loc) 1
        set S(history) {}
        set find(case) 1
        set S(newW) 350 ;# Width et Height par defaut
        set S(newH) 350 ;# Width et Height par defaut
        set S(defaultshape) 1 ;# la forme par defaut des backgrounds
        set S(DisplayVOV) 1 ;# variable pour qLannC et qLannC360 pour differencie affichage variableValeur
        # variable MULTI IMPORT
        set S(MultiImportTDY) 0
        set S(MultiImportSFN) "0 File(s)"
        set S(MultiImportAFN) "0 File(s)"
        set S(MultiImportTRE) "0 Tree(s)"
        set S(MultiImportDII) {} ;# conservation des directories deja visitees
        set S(MultiImportTAR) new
        set S(MultiImportNBC) 3
        # fonte d'illustration par defaut
        set S(ill-fon) +
        set S(ill-car) +
        #variable SIMPLE IMPORT
        set S(SimpleImportTDY) 0
        set S(SimpleImportAFN) "0 File(s)"
        set S(SimpleImportTRE) "0 Tree(s)"
        set S(SimpleImportDII) {} ;# conservation des directories deja visitees
        # parametre par defaut Legend (identification query variable)
        set S(LegendLabels) 0
        set S(LegendVariable) 0
        set S(LegendOperator) 0
        set S(LegendOperation) 0
        set S(LegendBox) 1
        set S(LegendCadre) 0
        # variable BigImport
        set S(BIseuil) 5
        set S(ImportAUTOTAR) 1 ;# autotarget
        set S(alterTool) move
        set S(toolswitch) ""
    }
    
    
    
}
####################

####################
# REFLECTION
####################
namespace eval Reflection {
    
    ### Transition I / Transition Empirique Simple
    proc Transition-I {w} {
        global S T
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            foreach key [array names S *,tar]  {
                if {$S($key) == 1} {
                    set ti [string range $key 0 [expr [string first , $key] - 1]]
                    if {$ti != 0} {
                        set wi $S($ti,w)
                        #liste des codes
                        set SouCodLea [Tools::NodeNoToLe $t $n]
                        #liste de noms
                        set SouRefLea [Tools::NodeLeCoToRe $t $SouCodLea]
                        Operation::Operation $wi $ti $SouRefLea
                    }
                }
            }
        }
    }
    
    #
    proc ConnectionAction {w t n key} {
        global S T
        #liste des codes
        set SouCodLea [Tools::NodeNoToLe $t $n]
        #liste de noms
        set SouRefLea [Tools::NodeLeCoToRe $t $SouCodLea]
        if {$key != "nodenetwork"} {
            foreach ti $S($w,t) {
                switch $key {
                    nodefgcolor {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeColorFgTree $ti $ni $S(col)
                        }
                    }
                    leaffgcolor {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeColorFgLeaf $ti $ni $S(col)
                        }
                    }
                    shrink {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Abstraction::Shrink $w $ti $ni
                        }
                    }
                    unshrink {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Abstraction::ShrinkUn $w $ti $ni
                        }
                    }
                    nodebgcolor {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeColorBgSubTree $ti $ni
                        }
                    }
                    leafbgcolor {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeColorBgLeaf $ti $ni
                        }
                    }
                    leaffontglob {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::FontSetGlobal $ti $ni $S(gfo)
                        }
                    }
                    widthline+ {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeLineWidth $ti $ni +
                        }
                    }
                    widthline- {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeLineWidth $ti $ni -
                        }
                    }
                    nodedashOn {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeLineDash $ti $ni 1
                        }
                    }
                    nodedashOff {
                        set peres [FindFatherNode $ti $SouRefLea]
                        foreach ni $peres {
                            Figuration::NodeLineDash $ti $ni 0
                        }
                    }
                    leafhide {
                    }
                    leafdisplay {
                    }
                    collapse {
                    }
                    uncollapse {
                    }
                    anotationmatrix {
                        Annotation::LabelMatrix  $w $ti $SouRefLea User
                    }
                }
            }
        } else  {
            set lkv {}
            lappend lkv $t $n
            foreach ti $S($w,t) {
                set peres [FindFatherNode $ti $SouRefLea]
                foreach ni $peres {
                    lappend lkv $ti $ni
                }
            }
            Reflection::NodeNetworkBuild $w $lkv ""
        }
    }
    
    # des feuilles vers des feuilles
    proc Transition-IIIAction {w t n database variable} {
        global S T
        # liste feuilles sources
        set SouRefLea [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $n]]
        # liste records dont la valeur de la variable contient au moins une feuille de liste source
        set MatchingRecords {}
        foreach f $SouRefLea {
            # ceci ok si la variable a pour valeurs des feuilles
            set recordsOK [Database::dbQueryRecordsFromVarPatVal $database $variable $f]
            foreach r $recordsOK {
                if {[lsearch -exact $MatchingRecords $r] == -1} {lappend MatchingRecords $r}
            }
        }
        # traduction records vers leafs
        set leaves [Database::dbQueryEusFromRecords $database $MatchingRecords]
        # localisation multi-arbres
        # allumage
        foreach key [array names S *,tar]  {
            if {$S($key) == 1} {
                set ti [string range $key 0 [expr [string first , $key] - 1]]
                if {$ti != 0} {
                    set wi $S($ti,w)
                    # allumer les resultats
                    Operation::Operation $w $ti $leaves
                    # allumer la source et ses copies
                    Operation::Operation $w $ti $SouRefLea
                }
            }
        }
    }
    
    ###
    proc Transition-IIAction {w t n database variable} {
        global S T
        # liste feuilles sources
        set SouRefLea [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $n]]
        
        # liste records correspondant aux feuilles sources
        set MatchingRecords {}
        foreach f $SouRefLea {
            set recordsOK [Database::dbQueryRecordsFromVarPatVal $database EU $f]
            foreach r $recordsOK {
                lappend MatchingRecords $r
            }
        }
        # liste valeurs pour $variable sur les matching records
        upvar #0 $database X
        set MatchingValues {}
        foreach r $MatchingRecords {
            set t $X($r)
            if {!([set pos [lsearch $t $variable]]%2)} {
                set val [lindex $t [incr pos]]
                if {[lsearch -exact $MatchingValues $val] == -1} {lappend MatchingValues $val}
            }
        }
        # Records matchant les MatchingValues sur la $database
        set MatchingRecordsFinal {}
        foreach v $MatchingValues {
            set recordsOK [Database::dbQueryRecordsFromVarPatVal $database $variable $v]
            foreach r $recordsOK {
                if {[lsearch -exact $MatchingRecordsFinal $r] == -1} {lappend MatchingRecordsFinal $r}
            }
        }
        # traduction records vers leafs
        set leaves [Database::dbQueryEusFromRecords $database $MatchingRecordsFinal]
        # localisation multi-arbres
        
        foreach key [array names S *,tar]  {
            if {$S($key) == 1} {
                set ti [string range $key 0 [expr [string first , $key] - 1]]
                if {$ti != 0} {
                    set wi $S($ti,w)
                    Operation::Operation $w $ti $leaves
                }
            }
        }
    }
    ### OPTIMISATION : si un node est ok : ne pas tester ses nodes fils
    proc FindFatherNode {t SouRefLea} {
        global S T
        set L {}
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $T($t,all_cod)] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test inclusion des references leaf de TARGET avec SOURCE
                if {$S(nodefilter) == 0} {
                    set r [Tools::ListInclu $TarRefLea $SouRefLea]
                    if {$r == 1} {lappend L $TarCodNod}
                } else  {
                    set r [Tools::ListIncluSauf $TarRefLea $SouRefLea $S(nodefilter)]
                    if {$r == 1} {lappend L $TarCodNod}
                }
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {
            if {[lsearch -exact $T($t,ue_lab) $SouRefLea] != -1} {return $T($t,ltc,$SouRefLea)} else {return {}}
        }
    }
    ### allume fg leafs et nodes a partir d'un node select par user
    ### et compare les topologies, transmission aux tree de la meme fenetre
    ### selon resultats comparaison
    proc Congruence {w} {
        global S T
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            foreach ti $S($w,t) {
                congruenceTNs $t $n $ti
            }
        }
    }
    # cette proc applique la procedure congruenceTN a tous les nodes
    # issus de nsource issue de tsource
    proc congruenceTNs {tsource nsource ttarget} {
        global T S
        #
        set lresult {}
        # Figuration::NodeColorFgTree $tsource $nsource $S(col)
        set nodesfromsource [Tools::NodeNoCoFaToNoCoCh $tsource $nsource]
        # on ne prend pas en compte les codes des feuilles
        set latest [Tools::SousL $nodesfromsource $T($tsource,ue_cod)]
        foreach node $latest {
            lappend lresult [congruenceTN $tsource $node $ttarget]
        }
        #puts LRESULT$lresult
        if {[lsearch $lresult 0] == -1} {
            Figuration::NodeColorFgTree $ttarget [lindex $lresult 0] $S(col)
        }
    }
    # si il existe un et un seul node pere de ttarget commun
    # aux leafs names de tsource pour nsource, cette fonction
    # retourne ce node, sinon retourne 0
    proc congruenceTN {tsource nsource ttarget} {
        # liste des noms leafs de tsource pour nsource
        set SouCodLea [Tools::NodeNoToLe $tsource $nsource]
        set SouRefLea [Tools::NodeLeCoToRe $tsource $SouCodLea]
        # recherche d'un node pere a ces leafs sur ttarget
        set result [Tools::FatherSearch2 $ttarget $SouRefLea]
        #puts ===================
        #puts $SouRefLea
        #puts $result
        if {$result != "" && [llength $result] == 1} {
            return $result
        } else  {
            return 0
        }
    }
    
    # compl?Šter un reseau, cad ajouter des nodes
    # sachant l'id d'un node network, on reactive la descrition du reseau
    # avec en argument le dernier element de B($id,CONnod)
    proc ReStartNodeNetwork {w id} {
        global S B
        set lasttree [lindex $B(CONtre,$id) end]
        set S(tool) connect
        bindtags $w [list $S(tool) $w Canvas . all]
        bind connect <Button-1> "Reflection::Connection %W $id"
        bind connect <Double-Button-1> "Reflection::UpdateLinkStop %W $lasttree $id"
        bind connect <Motion> "Reflection::UpdateLink %W $lasttree $id %x %y"
    }
    # delete
    proc ConnectorDelete  {w id} {
        global B S
        # nettoyage canvas
        $w delete [format "%s%s%s" Connect ? $id]
        $w delete [format "%s%s%s" ConIconTag ? $id]
        # nettoyage array B
        unset B(CONtre,$id)
        unset B(CONnod,$id)
        unset B(CONnot,$id)
        # retrait
        set index [lsearch -exact $S($w,con) $id]
        set S($w,con) [concat [lrange $S($w,con) 0 [expr $index - 1]] \
                [lrange $S($w,con) [expr $index + 1] end]]
    }
    ### voir modifications pour network en etoile
    proc UpdateLink {w t id xmouse ymouse} {
        global B S
        set lcoords {}
        foreach n $B(CONnod,$id) {
            set co [$w coords $n]
            lappend lcoords [lindex $co 0] [lindex $co 1]
        }
        lappend lcoords [expr $xmouse - 5] [expr $ymouse - 5]
        # prise en compte figuration preexistante
        set j [format "%s%s%s"  Connect ? $id ]
        if {[$w find withtag $j] != ""} {
            set width_line [lindex [$w itemconfigure $j -width] end]
            set dash_line [lindex [$w itemconfigure $j -dash] end]
            set color_line [lindex [$w itemconfigure $j -fill] end]
        } else  {
            set width_line 1
            set dash_line {2 2}
            set color_line $S(col)
        }
        $w delete $j
        if {$lcoords != {} } {
            $w create line  $lcoords -width $width_line -fill $color_line -dash $dash_line \
                    -tags "Connect [format "%s%s%s"  Connect ? $id ]  "
        }
        $w lower Connect
    }
    #
    proc UpdateLinkStop {w t id} {
        global B
        set lcoords {}
        foreach n $B(CONnod,$id) {
            set co [$w coords $n]
            lappend lcoords [lindex $co 0] [lindex $co 1]
        }
        set j [format "%s%s%s"  Connect ? $id ]
        set width_line [lindex [$w itemconfigure $j -width] end]
        set dash_line [lindex [$w itemconfigure $j -dash] end]
        set color_line [lindex [$w itemconfigure $j -fill] end]
        $w delete $j
        if {[llength $lcoords] != 2 } {
            $w create line  $lcoords -fill $color_line -dash $dash_line -width $width_line \
                    -tags "Connect $j"
        }
        bind connect <Button-1> "Reflection::Connection %W"
        # mise a nil pour le reste
        bind connect <Motion> ""
        bind connect <Double-Button-1> ""
    }
    #
    proc UpdateAll {w} {
        global B S
        foreach id $S($w,con) {
            set lcoords {}
            foreach n $B(CONnod,$id) {
                set co [$w coords $n]
                lappend lcoords [lindex $co 0] [lindex $co 1]
            }
            set j [format "%s%s%s"  Connect ? $id ]
            set width_line [lindex [$w itemconfigure $j -width] end]
            set dash_line [lindex [$w itemconfigure $j -dash] end]
            set color_line [lindex [$w itemconfigure $j -fill] end]
            set state [lindex [$w itemconfigure $j -state] end]
            $w delete $j
            if {[llength $lcoords] != 2 } {
                $w create line  $lcoords -fill $color_line -dash $dash_line -width $width_line \
                        -tags "Connect $j" -state $state
            }
        }
        $w lower Connect
    }
    proc ConnectNoteOk {w id} {
        global B
        set B(CONnot,$id) [.connectnote.st get 1.0 end]
        destroy .connectnote
        Reflection::ConnectorIconifyUpdate $w $id
    }
    # network ON/OFF
    proc ConnectorIconifyONOFF  {w id} {
        set connector [format "%s%s%s" Connect ? $id ]
        set etat [$w itemcget $connector -state]
        if {$etat == "normal"} {
            $w itemconfigure $connector -state hidden
        } else  {
            $w itemconfigure $connector -state normal
        }
    }
    #
    proc ConnectorIconify {w id x y } {
        global B S
        set connector [format "%s%s%s" Connect ? $id ]
        set ConIconTag [format "%s%s%s" ConIconTag ? $id]
        # destruction de l'ancien si existe, mais on conserve x y
        set idtext  [$w find withtag [list $ConIconTag && text]]
        set idline  [$w find withtag [list $ConIconTag && line]]
        if {$idline != ""}  {
            set coords [$w coords $idline]
            set x [lindex $coords 0]
            set y [lindex $coords 1]
            $w delete $idtext
            $w delete $idline
        }
        # $w delete $idtext
        # on masque le reseau
        $w itemconfigure $connector -state hidden
        # on cree l'icon
        #set color [lindex [$w itemconfigure $connector -fill] end]
        set width_line [lindex [$w itemconfigure $connector -width] end]
        set dash_line [lindex [$w itemconfigure $connector -dash] end]
        set color_line [lindex [$w itemconfigure $connector -fill] end]
        $w create line $x $y [expr $x + 20] $y  -width $width_line -dash $dash_line -fill $color_line \
                -tag "ConnectIcon $id $ConIconTag line"
        if {$B(CONnot,$id) != "" } {
            $w create text $x [expr $y + 3] -text "$B(CONnot,$id)"  -anchor nw \
                    -tag "ConnectIcon $id $ConIconTag text" -fill $color_line -font $S(gfo)
        }  else  {
            $w create text $x [expr $y + 3] -text ""  -anchor nw \
                    -tag "ConnectIcon $id $ConIconTag text" -fill $color_line -font $S(gfo)
        }
    }
    # mise a jour icone node network apres annotation network (display ON)
    proc ConnectorIconifyUpdate {w id} {
        global B
        set ConIconTag [format "%s%s%s" ConIconTag ? $id]
        set idtext  [$w find withtag [list $ConIconTag && text]]
        $w itemconfigure $idtext -text $B(CONnot,$id) -anchor nw
    }
    #
    proc ConnectorIconRemove {w id} {
        set ConIconTag [format "%s%s%s" ConIconTag ? $id]
        $w delete $ConIconTag
        ConnectorIconifyONOFF $w $id
    }
    proc ConnectorMerge  {w idsource lid} {
        global B
        # fusion de node network
        # lid est soit un id de node network soit une liste d'id node network (selection de all)
        # mise a jour array
        foreach  id $lid {
            #tre
            foreach tid $B(CONtre,$id) {
                if {[lsearch $B(CONtre,$idsource) $tid] == -1}  {
                    lappend B(CONtre,$idsource) $tid
                }
            }
            #nod
            foreach nid $B(CONnod,$id) {
                if {[lsearch $B(CONnod,$idsource) $nid] == -1}  {
                    lappend B(CONnod,$idsource) $nid
                }
            }
            # mise en ordre
            set B(CONnod,$idsource) [lsort -dictionary $B(CONnod,$idsource)]
            # not
            foreach notid $B(CONnot,$id) {
                # on ne garde les note que si elle sont differente de id et pas deja referencees
                if {$notid != $id} {
                    if {[lsearch $B(CONnot,$idsource) $notid] == -1}  {
                        lappend B(CONnot,$idsource) $notid
                    }
                }
            }
            #deletion graphique
            Reflection::ConnectorDelete $w $id
        }
        # mise a jour graphic de idsource
        UpdateAll $w
    }
    proc NodeNetworkBuild {w lkv note} {
        global B S
        set id [Tools::GenId]
        if {$note == ""} {set note $id}
        # liste tree
        set B(CONtre,$id) {}
        # liste node
        set B(CONnod,$id) {}
        # note
        set B(CONnot,$id) [list $note]
        # liste id network / window
        lappend S($w,con) $id
        foreach {tree node} $lkv {
            lappend B(CONtre,$id) $tree
            lappend B(CONnod,$id) $node
        }
        # graphic
        set lcoords {}
        foreach n $B(CONnod,$id) {
            set co [$w coords $n]
            lappend lcoords [lindex $co 0] [lindex $co 1]
        }
        set j [format "%s%s%s"  Connect ? $id ]
        set width_line 1
        set dash_line {2 2}
        set color_line $S(col)
        $w delete $j
        if {[llength $lcoords] != 2 } {
            $w create line  $lcoords -fill $color_line -dash $dash_line -width $width_line \
                    -tags "Connect $j"
        }
    }
    
}
####################


####################
# FIGURATION
####################
namespace eval Figuration {
    ###
    proc FontSet {t w n variable value} {
        global T
        set f [lindex [$w itemconfigure [format "%s%s" $n EUL] -font] end]
        set fnew {}
        foreach {var val} $f {
            if {$var == $variable} {lappend fnew $var $value} {lappend fnew $var $val}
        }
        set T($t,gfo,$n) $fnew
        $w itemconfigure [format "%s%s" $n EUL] -font $fnew
    }
    ###
    proc LineSize {mode} {
        global T S
        RecLineSize $S(ict) $mode
        if {$S(com) != {}} {
            foreach t $S(com) {
                set current [string range $t 2 [expr [string first .c $t] -1]]
                if {$current != $S(ict)} {
                    RecLineSize $current $mode
                }
            }
        }
    }
    
    ###
    proc RecLineSize {t mode} {
        global T S
        set w [format "%s%s%s" .t $t .c]
        if {$mode == "+" || $mode == "-"} {
            if {$T($t,sel) == "*"} {
                foreach c $T($t,all_cod) {
                    set code [format "%s%s" $c L]
                    set width_line [lindex [$w itemconfigure $code -width] end]
                    set new_wl [expr  abs($width_line $mode 1)]
                    $w itemconfigure $code -width $new_wl
                    $w itemconfigure [format "%s%s" $code C] -width $new_wl
                    set T($t,gls,$code) $new_wl
                }
            }
            if {$T($t,sel) != "*"} {
                foreach c $T($t,sel) {
                    set code [format "%s%s" $c L]
                    set width_line [lindex [$w itemconfigure $code -width] end]
                    set new_wl [expr  abs($width_line $mode 1)]
                    $w itemconfigure $code -width $new_wl
                    set T($t,gls,$code) $new_wl
                }
            }
        } else {
            
            if {$T($t,sel) == "*"} {
                foreach c $T($t,all_cod) {
                    set code [format "%s%s" $c L]
                    set new_wl 1
                    $w itemconfigure $code -width $new_wl
                    $w itemconfigure [format "%s%s" $code C] -width $new_wl
                    set T($t,gls,$code) $new_wl
                }
            }
            if {$T($t,sel) != "*"} {
                foreach c $T($t,sel) {
                    set code [format "%s%s" $c L]
                    set new_wl 1
                    $w itemconfigure $code -width $new_wl
                    set T($t,gls,$code) $new_wl
                }
            }
        }
        if {$S(desel) == 1} {TBA::UnSelect $w}
    }
    ###
    proc PreLineStipple {mode} {
        global T S
        set t $S(ict)
        set w [format "%s%s%s" .t $t .c ]
        LineStipple $t $w $mode
        if {$S(com) != {}} {
            foreach w $S(com) {
                set t [string range $w 2 [expr [string first .c $w] -1]]
                if {$t != $S(ict)} {
                    LineStipple $t $w $mode
                }
            }
        }
    }
    ###
    proc LineStipple {t w mode} {
        global T S
        foreach c $T($t,sel) {
            set code [format "%s%s" $c L]
            set dash_line [lindex [$w itemconfigure $code -dash] end]
            if {$mode == "+" || $mode == "-"} {
                switch -exact $dash_line {
                    1 { if {$mode == "+"} {
                            set new_dl 2
                        } else {
                            set new_dl {}
                        }
                    }
                    15 { if {$mode == "+"} {
                            set new_dl {}
                        } else {
                            set new_dl 14
                        }
                    }
                    {} { if {$mode == "+"} {
                            set new_dl 1
                            
                        } else {
                            set new_dl 15
                        }
                    }
                    default {
                        set new_dl [expr abs($dash_line $mode 1)]
                    }
                }
            } else {set new_dl {}}
            set T($t,gld,$c) $new_dl
            $w itemconfigure $code -dash $new_dl
        }
        if {$S(desel) == 1} {TBA::UnSelect $w}
    }
    #
    proc RedrawT {w t} {
        $w delete T$t
        TDcom::PhyNJ $t $w
    }
    # restauration sur un arbre entier
    proc RestaureT {w t} {
        #restauration des variables graphiques
        # gfg lbg lfg bbg gfo gls gld
        NodeGraVarRest $t
        # 2 variables graphiques particulieres (items suplementaires)
        # les bg tree et leaf
        Figuration::RestaureBGSall $w $t
        Figuration::RestaureBGLall $w $t
        ### restauration des variables de dessin
        # DANS L'ORDRE  decomposition, bll , querynode, shrink
        #RestaureOVAall $w $t
        RestaureBLLall $w $t
        RestaureQYNall  $w $t
        RestaureShrinkAll $w $t
    }
    #
    proc RestaureShrinkAll {w t} {
        global T S B IMGshn
        # il faut reconstruire la structure hierarchique des shrink
        # les plus anciens shrink d'abord, ajout incr?Šmental du tag
        # si le tag est deja present on tag pas
        foreach id [lsort -increasing $B($t,shi)] {
            set TAG [format "%s%s%s" SHI ? $id]
            # dessin
            set c0 [$w coords $B(SHInod,$id)]
            set x0 [lindex $c0 2]
            set y0 [lindex $c0 3]
            # passer au bitmap set  $S(col)
            $w create text [expr $x0 +5] $y0 -text + \
                    -tags "SHRINK [format "%s%s%s" SHN ? $id]  T$t" -font $B(SHIfon,$id) -fill $B(SHIcol,$id)
            # bll associees a n et ses derives
            set pattern [format "%s%s" $B(SHInod,$id) *]
            foreach idbll $B($t,bll) {
                if {[string match $pattern $B(BLLnod,$idbll)] == 1 } {
                    if {[$w itemcget $B(BLLidt,$idbll) -state] != "hidden"} {
                        $w addtag $TAG withtag $B(BLLidt,$idbll)
                        $w addtag $TAG withtag $B(BLLidl,$idbll)
                        $w itemconfigure $B(BLLidt,$idbll) -state hidden
                        $w itemconfigure $B(BLLidl,$idbll) -state hidden
                    }
                }
            }
            # leaves
            set leafs [Tools::NodeNoToLe $t $B(SHInod,$id)]
            foreach i $leafs {
                set tagi [list [format "%s%s" EUL  $T($t,ctl,$i)] && T$t]
                if {[$w itemcget $tagi -state] != "hidden"} {
                    $w addtag  $TAG withtag $tagi
                    $w itemconfigure $tagi -state hidden
                }
            }
            # background leaves
            set pattern [format "%s%s" $B(SHInod,$id) *]
            foreach idi $B($t,bgl)  {
                if  {[string match $pattern $B(BGLnod,$idi)] == 1} {
                    if {[$w itemcget [format "%s%s%s" BGL ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s" BGL ? $idi]
                        $w itemconfigure [format "%s%s%s" BGL ? $idi] -state hidden
                    }
                }
            }
            # arretes terminales
            set Le [Tools::NodeNoToLe $t $B(SHInod,$id)]
            foreach e $Le {
                if {[$w itemcget $e -state] != "hidden"} {
                    $w addtag $TAG withtag $e
                    $w itemconfigure $e -state hidden
                }
            }
            # tree
            set lchild [Tools::NodeNoCoFaToNoCoCh $t $B(SHInod,$id)]
            foreach i $lchild {
                if {[$w itemcget $i -state] != "hidden"} {
                    $w addtag $TAG withtag [format "%s%s" $i C]
                    $w itemconfigure [format "%s%s" $i C] -state hidden
                }
            }
            # background tree
            set pattern [format "%s%s" $B(SHInod,$id) *]
            foreach idi $B($t,bgs)  {
                if  {[string match $pattern $B(BGSnod,$idi)] == 1} {
                    if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s" BGS ? $idi]
                        $w itemconfigure [format "%s%s%s" BGS ? $idi] -state hidden
                    }
                }
            }
            # sous shrink
            set pattern [format "%s%s" $B(SHInod,$id) *]
            foreach idi $B($t,shi)  {
                if  {[string match $pattern $B(SHInod,$idi)] == 1 && $id != $idi} {
                    if {[$w itemcget [format "%s%s%s" SHN ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s" SHN ? $idi]
                        $w itemconfigure [format "%s%s%s" SHN ? $idi] -state hidden
                        set B(SHIsta,$idi) hidden
                    }
                }
            }
        }
    }
    #
    proc RestaureBLLall {w t} {
        global B
        set l {}
        foreach id $B($t,bll) {
            $w create text $B(BLLxxx,$id) $B(BLLyyy,$id) \
                    -text $B(BLLtxt,$id) -font $B(BLLgfo,$id) -fill $B(BLLcol,$id) -anchor nw \
                    -tags "bullab T$B(BLLtre,$id) $B(BLLidt,$id)"
            set co_sou [$w coords $B(BLLnod,$id)]
            set x1 [lindex $co_sou 0]
            set y1 [lindex $co_sou 1]
            $w create line $x1 $y1 $B(BLLxxx,$id) $B(BLLyyy,$id) \
                    -width 1 -fill $B(BLLcol,$id) -tags "Link T$B(BLLtre,$id) $B(BLLidl,$id)"
        }
    }
    #
    proc RestaureQYNall {w t} {
        global B
        foreach id $B($t,qyn) {
            set idtext [format "%s%s%s" QYN ? $id]
            $w create text $B(QYNxxx,$id) $B(QYNyyy,$id) \
                    -text [lrange $B(QYNqry,$id) [expr [lsearch $B(QYNqry,$id) where] + 1] end] \
                    -font $B(QYNgfo,$id) -fill $B(QYNcol,$id) -anchor nw \
                    -tags "querynode T$t $B(QYNidt,$id)"
            $w raise Q$t
        }
    }
    #
    proc RestaureOVAall {w t} {
        global B
        set lnodlid {}
        foreach id $B($t,ova) {
            lappend lnodlid $B(OVAnod2,$id)
            set decomp($B(OVAnod2,$id)) $id
        }
        foreach n [lsort -increasing $lnodlid] {
            set id $decomp($n)
            set TAG [format "%s%s%s" TD ? $id]
            Decomposition::SubTreeDescendant $w $t $n $id $TAG
            
            $w move $TAG $B(OVAtrx,$id) $B(OVAtry,$id)
        }
        Decomposition::UpdateLink $w $t
        if [array exists decomp] {unset decomp}
    }
    #
    proc RestaureBGSall {w t} {
        global T S B
        set lnodes {}
        foreach idi $B($t,bgs) {
            $w delete [format "%s%s%s" BGS ? $idi]
            lappend lnodes $B(BGSnod,$idi)
            set transit($B(BGSnod,$idi)) $idi
        }
        foreach ni [lsort -increasing $lnodes] {
            # compatibilit?Š sauvegarde precedent la creation variable du type des contours et stipple
            if {[catch {set v $B(BGStyp,$transit($ni))} err]} then {set B(BGStyp,$transit($ni)) 1}
            if {[catch {set v $B(BGSsti,$transit($ni))} err]} then {set B(BGSsti,$transit($ni)) z.xbm}
            set lxy [Figuration::NodeColorBgSubTreeContourSwitch $w $t $ni $B(BGStyp,$transit($ni))]
            set idi $transit($ni)
            set tag [format "%s%s%s" BGS ? $idi]
            if {$B(BGSsti,$idi) == "z.xbm"} {
                $w create polygon $lxy -outline $B(BGScol,$idi) -fill $B(BGScol,$idi) -tags "bgtree T$t $tag"
            } else  {
                #$w create polygon $lxy -outline $B(BGScol,$idi) -fill $B(BGScol,$idi) -tags "bgtree T$t $tag" \
                #        -stipple @[file join [file dirname [info script]] +/stipple/ $B(BGSsti,$idi)]
                #
                # ATTENTION a rester sur un path relatif
                #$w create polygon $lxy -outline $B(BGScol,$idi) -fill $B(BGScol,$idi) -tags "bgtree T$t $tag" \
                #        -stipple @[file join $S(stidir) $B(BGSsti,$idi)]
                #        @[file join + stipple $S(stipple)]
                
                $w create polygon $lxy -outline $B(BGScol,$idi) -fill $B(BGScol,$idi) -tags "bgtree T$t $tag" \
                        -stipple @[file join $S(TheoPATH) + stipple $B(BGSsti,$idi)]
            }
        }
        $w lower bgtree
        if {[array exists transit] == 1} {unset transit}
    }
    #
    proc RestaureBGLall {w t} {
        global T S B
        set lnodes {}
        foreach idi $B($t,bgl) {
            $w delete [format "%s%s%s" BGL ? $idi]
            lappend lnodes $B(BGLnod,$idi)
            set transit($B(BGLnod,$idi)) $idi
        }
        foreach ni $lnodes {
            set lab $T($t,ctl,$ni)
            set coords [$w bbox [list [format "%s%s" EUL  $lab ] && T$t]]
            if {$coords != ""} {
                set x1 [lindex $coords 0]
                set y1 [expr [lindex $coords 1] -1]
                set x2 [lindex $coords 2]
                set y2 [lindex $coords 3]
                set idi $transit($ni)
                set tag [format "%s%s%s" BGL ? $idi]
                # dessin
                $w create rectangle $x1 $y1 $x2 $y2 \
                        -fill  $B(BGLcol,$idi) -outline  $B(BGLcol,$idi) \
                        -tags "bgleaf T$t $tag"
            }
        }
        $w lower bgleaf
        if {[array exists transit] == 1} {unset transit}
    }
    #
    proc RedrawBGLall {w t} {
        global T  B
        foreach idi $B($t,bgl) {
            set lab $T($t,ctl,$B(BGLnod,$idi))
            set coords [$w bbox [list [format "%s%s" EUL  $lab ] && T$t]]
            if {$coords != ""} {
                $w coords [format "%s%s%s" BGL ? $idi] $coords
            }
        }
    }
    ### Procedure de restauration des variables graphiques sur tout l'arbre
    proc NodeGraVarRest {t} {
        global S T
        set w $S($t,w)
        ###
        # T($t,gfg,$n) restauration des foreground color tree
        # on classe les codes pour fg les subtree de la racine vers les feuilles
        set li [lsort -dictionary [array names T $t,gfg,*]]
        foreach key $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach e $Le {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    Figuration::NodeColorFgItem $w $j $T($key)
                }
            }
        }
        ###
        # T($t,lfg,$n) restauration des foreground color leaf
        foreach key [array names T $t,lfg,*] {
            set n [string range $key [expr [string last , $key] + 1] end]
            set lab $T($t,ctl,$n)
            $w itemconfigure [list [format "%s%s" EUL  $lab ] && T$t] -fill $T($key)
        }
        ###
        # T($t,gld,$n) restauration des line dash
        set li [lsort -dictionary [array names T $t,gld,*]]
        foreach key  $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach e $Le {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    $w itemconfigure $j -dash $T($key)
                }
            }
        }
        ###
        # set T($t,gls,$i)  restauration des line width
        set li [lsort -dictionary [array names T $t,gls,*]]
        foreach key $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach e $Le {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    $w itemconfigure $j -width $T($key)
                }
            }
        }
        ###
        # set T($t,gfo,$i)  restauration des font
        foreach key [array names T $t,gfo,*] {
            set n [string range $key [expr [string last , $key] + 1] end]
            set lab $T($t,ctl,$n)
            set i [$w find withtag [list [format "%s%s" EUL  $lab ] && T$t]]
            $w itemconfigure $i -font $T($key)
        }
    }
    #Procedure de restauration des variables graphiques a partir de N
    #independance de l'existence de variable
    proc NodeGraVarRestLOCAL {t n} {
        global S T
        set w $S($t,w)
        set p [format "%s%s" $n *]
        ###
        # T($t,gfg,$n) restauration des foreground color tree
        # on classe les codes pour fg les subtree de la racine vers les feuilles
        set li [lsort -dictionary [array names T $t,gfg,$p]]
        foreach key $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach e $Le {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    Figuration::NodeColorFgItem $w $j $T($key)
                }
            }
        }
        ###
        # T($t,lfg,$n) restauration des foreground color leaf
        foreach key [array names T $t,lfg,$p] {
            set n [string range $key [expr [string last , $key] + 1] end]
            set lab $T($t,ctl,$n)
            $w itemconfigure [list [format "%s%s" EUL  $lab ] && T$t] -fill $T($key)
        }
        ###
        # T($t,gld,$n) restauration des line dash
        set li [lsort -dictionary [array names T $t,gld,$p]]
        foreach key  $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach e $Le {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    $w itemconfigure $j -dash $T($key)
                }
            }
        }
        ###
        # set T($t,gls,$i)  restauration des line width
        set li [lsort -dictionary [array names T $t,gls,$p]]
        foreach key $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach e $Le {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    $w itemconfigure $j -width $T($key)
                }
            }
        }
        ###
        # set T($t,gfo,$i)  restauration des font
        foreach key [array names T $t,gfo,$p] {
            set n [string range $key [expr [string last , $key] + 1] end]
            set lab $T($t,ctl,$n)
            set i [$w find withtag [list [format "%s%s" EUL  $lab ] && T$t]]
            $w itemconfigure $i -font $T($key)
        }
    }
    
    
    # T($t,gfg,$n) init des foreground color tree
    # a l'appel n* = les desceandants aussi
    # par defaut l'arbre entier
    proc GraVarInitFgTree {w t {n *}} {
        global T S
        # liste key soit une si n soit peut etre liste si n*, fonction de l'appel
        set li [lsort -dictionary [array names T $t,gfg,$n]]
        foreach key $li {
            # destruction variable
            unset T($key)
            # coloration back to default
            # set node [string range $key [expr [string last , $key] + 1] end]
            set p [format "%s%s" $n *]
            foreach e $T($t,all_cod) {
                if {[string match $p $e] == 1} {
                    foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                        Figuration::NodeColorFgItem $w $j $S(Preference_fgc)
                    }
                }
            }
        }
        # si que n restauration locale sur d'eventuelle variable
        # si n* on a tout detruit donc pas besoin de restauration
        if {[string range $n end end] != "*"} {
            #restauration locale et specifique variable
            set p [format "%s%s" $n *]
            set li [lsort -dictionary [array names T $t,gfg,$p]]
            foreach key $li {
                set n [string range $key [expr [string last , $key] + 1] end]
                set Le [Tools::NodeNoCoFaToNoCoCh $t $n]
                foreach e $Le {
                    foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                        Figuration::NodeColorFgItem $w $j $T($key)
                    }
                }
            }
        }
    }
    #  init des background color tree
    proc GraVarInitBgSubTree {w t {n *}} {
        if {[string range $n end end] == "*"} {
            NodeColorBgSubTreeRemoveAll $t $n
        } else {
            NodeColorBgSubTreeRemove $t $n
        }
    }
    #  init des background color tree
    #proc GraVarInitBgSubTree {w t} {
    #    foreach j [$w find withtag [list bgtree && T$t]] {
    #        Figuration::NodeColorBgSubTreeDelete $w $j
    #    }
    #}
    # T($t,lfg,$n) init des foreground color leaf
    proc GraVarInitFgLeaf {w t {n *}} {
        global T S
        if {$n != "*"} {set pattern [format "%s%s" $n *]} {set pattern *}
        foreach key [array names T $t,lfg,$pattern] {
            set n [string range $key [expr [string last , $key] + 1] end]
            set lab $T($t,ctl,$n)
            $w itemconfigure [list [format "%s%s" EUL  $lab ] && T$t] -fill $S(Preference_fgc)
            unset T($key)
        }
    }
    #  init des background color leaf
    proc GraVarInitBgLeaf {w t {n *}} {
        global T S B
        set listid {}
        
        if {$n != "*"} {set p [format "%s%s" $n *]} {set p *}
        foreach {k v} [array get B BGLnod,*] {
            if {[string match $p $v] == 1} {
                lappend listid [string trimleft $k "BGLnod," ]
            }
        }
        foreach id $listid {
            $w delete [format "%s%s%s" BGL ? $id]
            set w $S($t,w)
            set t $B(BGLtre,$id)
            foreach key [array names B *,$id] {
                unset B($key)
            }
            set index [lsearch -exact $B($t,bgl) $id]
            set B($t,bgl) [concat [lrange $B($t,bgl) 0 [expr $index - 1]] \
                    [lrange $B($t,bgl) [expr $index + 1] end]]
        }
    }
    
    # set T($t,gfo,$i)  init des font
    proc GraVarInitFont {w t {n *}} {
        global T S
        foreach key [array names T $t,gfo,$n] {
            set n [string range $key [expr [string last , $key] + 1] end]
            set lab $T($t,ctl,$n)
            $w itemconfigure [list [format "%s%s" EUL  $lab] && T$t] -font $S(fontbase)
            unset T($key)
        }
    }
    # T($t,gls,$c) la taille du trait
    proc GraVarInitLineWidth {w t {n *}} {
        global T
        set li [lsort -dictionary [array names T $t,gls,$n]]
        foreach key $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set p [format "%s%s" $n *]
            set listeitems {}
            foreach e $T($t,all_cod) {
                if {[string match $p $e] == 1} {
                    foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                        lappend listeitems $j
                    }
                }
            }
            foreach i $listeitems {
                $w itemconfigure $i -width 1
            }
            unset T($key)
        }
    }
    # T($t,gld,$c) le pointille du trait
    proc GraVarInitLineDash {w t {n *}} {
        global T
        set li [lsort -dictionary [array names T $t,gld,$n]]
        foreach key  $li {
            set n [string range $key [expr [string last , $key] + 1] end]
            set p [format "%s%s" $n *]
            set listeitems {}
            foreach e $T($t,all_cod) {
                if {[string match $p $e] == 1} {
                    foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                        lappend listeitems $j
                    }
                }
            }
            foreach i $listeitems {
                $w itemconfigure $i -dash {}
            }
            unset T($key)
        }
    }
    # reset general de tous les arbres de toutes les fenetres
    proc ResetGlob {} {
        global S
        set l {}
        foreach key [array names S *,w] {
            foreach t $S($S($key),t) {
                if {[lsearch -exact $l $t] == -1} {lappend l $t}
            }
        }
        foreach t $l  {
            Figuration::NodeGraVarInit $t
        }
    }
    
    # procedure de suppression de toutes les variables graphiques
    proc NodeGraVarInit  {t} {
        global S T
        set w $S($t,w)
        # init des foreground color tree
        GraVarInitFgTree $w $t
        #  init des background color tree
        GraVarInitBgSubTree $w $t
        #  init des background color leaf
        GraVarInitBgLeaf $w $t
        # T($t,lfg,$n) init des foreground color leaf
        GraVarInitFgLeaf $w $t
        # set T($t,gfo,$i)  init des font
        GraVarInitFont $w $t
        # T($t,gls,$c) la taille du trait
        GraVarInitLineWidth $w $t
        # T($t,gld,$c) le pointille du trait
        GraVarInitLineDash $w $t
    }
    proc GraVarInitAllN {w t n} {
        GraVarInitFgTree $w $t $n
        GraVarInitBgSubTree $w $t $n
        GraVarInitBgLeaf $w $t $n
        GraVarInitFgLeaf $w $t $n
        GraVarInitFont $w $t $n
        GraVarInitLineWidth $w $t $n
        GraVarInitLineDash $w $t $n
    }
    # fonction de copy des variables graphiques d'un arbre vers un autre
    ## c un peu magique mais ca marche, il y a corespondance
    ## exacte entre les codes tsource/ttarget, cela vient de la procedure NodeNoCoFaToNoCoCh
    proc TransitionVG {w tsource npere ttarget}   {
        global T S B
        set lnodesFrom [Tools::NodeNoCoFaToNoCoCh $tsource $npere]
        set lnodesTo [Tools::NodeNoCoFaToNoCoCh $ttarget $ttarget]
        foreach nf $lnodesFrom nt $lnodesTo {
            set transition($nf) $nt
        }
        set lnodesFrom2 [lsort -dictionary [Tools::NodeFathers $tsource $npere]]
        foreach nf $lnodesFrom2  {
            set transition2($nf) $ttarget
        }
        # GROUPE 1, on prend en compte les nodes ascendants
        # variables T
        set lvar {gfg lfg gld gls gfo}
        foreach nf $lnodesFrom2  {
            foreach var $lvar {
                if {[catch {set v $T($tsource,$var,$nf)} err]} then {
                    #rien
                } else {
                    set T($ttarget,$var,$transition2($nf)) $v
                }
            }
        }
        # BGL bg leaves
        foreach idbgl $B($tsource,bgl) {
            if {[lsearch -exact $lnodesFrom2 $B(BGLnod,$idbgl)] != -1} {
                Figuration::NodeColorBgLeaf2 $ttarget $transition2($B(BGLnod,$idbgl)) $B(BGLcol,$idbgl)
            }
        }
        # BGS bg subtree
        foreach idbgs $B($tsource,bgs) {
            if {[lsearch -exact $lnodesFrom2 $B(BGSnod,$idbgs)] != -1} {
                Figuration::NodeColorBgSubTree2 $ttarget $transition2($B(BGSnod,$idbgs)) $B(BGScol,$idbgs) $B(BGSsti,$idbgs)
            }
        }
        # GROUPE 2 on ne prend pas en compte les ascendants
        # variables graphiques
        set lvar {gfg lfg gld gls gfo}
        foreach nf $lnodesFrom  {
            foreach var $lvar {
                if {[catch {set v $T($tsource,$var,$nf)} err]} then {
                    #rien
                } else {
                    set T($ttarget,$var,$transition($nf)) $v
                }
            }
        }
        # BGL bg leaves
        foreach idbgl $B($tsource,bgl) {
            if {[lsearch -exact $lnodesFrom $B(BGLnod,$idbgl)] != -1} {
                Figuration::NodeColorBgLeaf2 $ttarget $transition($B(BGLnod,$idbgl)) $B(BGLcol,$idbgl)
            }
        }
        # BGS bg subtree
        foreach idbgs $B($tsource,bgs) {
            if {[lsearch -exact $lnodesFrom $B(BGSnod,$idbgs)] != -1} {
                Figuration::NodeColorBgSubTree2 $ttarget $transition($B(BGSnod,$idbgs)) $B(BGScol,$idbgs) $B(BGSsti,$idbgs)
            }
        }
        # variables B : shi bll ova
        # construction des items (mais array seuleument, pas graphique)
        # BLL
        # on prend les nodes des bll on regarde si ils sont dans la liste des nodes copies
        foreach bi $B($tsource,bll) {
            if {[lsearch -exact $lnodesFrom $B(BLLnod,$bi)] != -1} {
                set co [$w coords $transition($B(BLLnod,$bi))]
                set x [lindex $co 0]
                set y [lindex $co 1]
                set titx  [string first "\n"  $B(BLLtxt,$bi)]
                set titre [string range $B(BLLtxt,$bi) 0 [expr $titx - 1]]
                set text  [string range $B(BLLtxt,$bi) [expr $titx + 1] end]
                # BLLmake2 ne construit que les array
                Annotation::BLLmake2 $w $ttarget $x $y $titre $text $transition($B(BLLnod,$bi)) $B(BLLcol,$bi) $B(BLLgfo,$bi)
            }
        }
        ### OVA
        # on prend les nodes sous decomposition et on regarde si ils sont dans la liste des nodes copies
        foreach idc $B($tsource,ova) {
            if {[lsearch -exact $lnodesFrom $B(OVAnod2,$idc)] != -1} {
                Decomposition::SubTree2 $ttarget $B(OVAtrx,$idc) $B(OVAtry,$idc) $transition($B(OVAnod2,$idc))
            }
        }
        # SHI en dernier
        # il suffit de reconstruire les shrink en partant des plus bas
        # afin d'appliquer le state/tag de visiblite au fur et a mesure
        set lni {}
        # on prend les nodes qui sont shrink et on regarde si ils sont dans la liste des nodes copies
        foreach si $B($tsource,shi) {
            if {[lsearch -exact $lnodesFrom $B(SHInod,$si)] != -1} {lappend lni $B(SHInod,$si)}
        }
        # on ordonne ensuite les codes nodes, les plus profons d'abord, la fct shrink
        # reconstruit la strucutre imbriqu?Še des shrink
        foreach ni [lsort -decreasing $lni] {
            Abstraction::Shrink2 $w $ttarget $transition($ni)  $S(col)
        }
        unset transition
    }
    
    
    ###set S(contour2mode) c ; set S(contour2mode) d ;
    proc NodeColorBgSubTreeToolbox {w command} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            switch -exact $command {
                add1 {NodeColorBgSubTree $t $n}
                remove {NodeColorBgSubTreeRemove $t $n}
                removeall {NodeColorBgSubTreeRemoveAll $t $n}
                menushape {SetDefaultShape $w}
            }
            Figuration::RestaureBGSall $w $t
        }
    }
    
    ### Background color of Subtree
    # on calcule le pourtour du sous-arbre
    # pour etre independant des orientations des arbres et des items
    # on compare les normes des vecteurs entre chaque extremites et
    #une des coordonn?Šes du node pere
    proc NodeColorBgSubTree {t n} {
        global T S B
        
        set w $S($t,w)
        set id [format "%s%s"  $t [Tools::GenId]]
        # MEM
        set B(BGStre,$id) $t
        set B(BGSnod,$id) $n
        set B(BGScol,$id) $S(col)
        set B(BGSsti,$id) $S(stipple)
        set B(BGStyp,$id) $S(defaultshape)
        # Liste des BGS par tree
        lappend B($t,bgs) $id
        # RestaureBGSall est place ailleurs car trop long en identification
        #Figuration::RestaureBGSall $w $t
    }
    proc NodeColorBgSubTreeSwitch {w i type} {
        global S B
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BGS*]] ?] end]
        set B(BGStyp,$id) $type
        Figuration::RestaureBGSall $w $B(BGStre,$id)
    }
    proc NodeColorBgSubTreeUpdateStipple {w i} {
        global S B
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BGS*]] ?] end]
        set B(BGSsti,$id) $S(stipple)
        Figuration::RestaureBGSall $w $B(BGStre,$id)
    }
    #
    proc NodeColorBgSubTreeRemove {t n } {
        global T S B
        set w $S($t,w)
        set listid {}
        foreach {k v} [array get B BGSnod,*] {
            if {$n == $v} {
                lappend listid [string trimleft $k "BGSnod," ]
            }
        }
        foreach id $listid {
            $w delete [format "%s%s%s" BGS ? $id]
            set w $S($t,w)
            set t $B(BGStre,$id)
            foreach key [array names B *,$id] {
                unset B($key)
            }
            #retirer
            set index [lsearch -exact $B($t,bgs) $id]
            set B($t,bgs) [concat [lrange $B($t,bgs) 0 [expr $index - 1]] \
                    [lrange $B($t,bgs) [expr $index + 1] end]]
        }
    }
    #
    proc NodeColorBgSubTreeRemoveAll {t n } {
        global T S B
        set w $S($t,w)
        set p [format "%s%s" $n *]
        set listid {}
        foreach {k v} [array get B BGSnod,*] {
            if {[string match $p $v] == 1} {
                lappend listid [string trimleft $k "BGSnod," ]
            }
        }
        foreach id $listid {
            $w delete [format "%s%s%s" BGS ? $id]
            set w $S($t,w)
            set t $B(BGStre,$id)
            foreach key [array names B *,$id] {
                unset B($key)
            }
            #retirer
            set index [lsearch -exact $B($t,bgs) $id]
            set B($t,bgs) [concat [lrange $B($t,bgs) 0 [expr $index - 1]] \
                    [lrange $B($t,bgs) [expr $index + 1] end]]
        }
    }
    #
    proc NodeColorBgSubTree2 {t n c s} {
        global T S B
        set id [format "%s%s"  $t [Tools::GenId]]
        # MEM
        set B(BGStre,$id) $t
        set B(BGSnod,$id) $n
        set B(BGScol,$id) $c
        set B(BGSsti,$id) $s
        # Liste des BGS par tree
        lappend B($t,bgs) $id
    }
    #
    proc NodeColorBgSubTreeDelete {w i} {
        global B S
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BGS*]] ?] end]
        $w delete [format "%s%s%s" BGS ? $id]
        set t $B(BGStre,$id)
        set w $S($t,w)
        foreach key [array names B *,$id] {
            unset B($key)
        }
        #retirer
        set index [lsearch -exact $B($t,bgs) $id]
        set B($t,bgs) [concat [lrange $B($t,bgs) 0 [expr $index - 1]] \
                [lrange $B($t,bgs) [expr $index + 1] end]]
    }
    #
    proc NodeColorBgSubTreeUpateColor {w i c} {
        global B S
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BGS*]] ?] end]
        $w itemconfigure  [format "%s%s%s" BGS ? $id] -fill $c -outline $c
        set B(BGScol,$id) $c
    }
    proc NodeColorBgSubTreeContourSwitch {w t n mode} {
        switch $mode {
            1 {set lxy [NodeColorBgSubTreeContour $w $t $n]}
            2 {set lxy [NodeColorBgSubTreeContour2 $w $t $n 2]}
            3 {set lxy [NodeColorBgSubTreeContour2 $w $t $n 3]}
            4 {set lxy [NodeColorBgSubTreeContour2 $w $t $n 4]}
            5 {set lxy [NodeColorBgSubTreeContour2 $w $t $n 5]}
        }
        return $lxy
    }
    ###
    proc NodeColorBgSubTreeContour {w t n} {
        #on trace le polygon du contour du sous-arbre
        # depart
        set lxy {}
        set leafs [Tools::NodeNoToLe $t $n]
        set nodes [Tools::SousL [Tools::NodeNoCoFaToNoCoCh $t $n] $n]
        set sbase [string length $n]
        if {[llength $leafs] != 1 } {
            # descandants gauche y compris feuilles
            set ldesgauche {}
            foreach ni [lsort -increasing $nodes] {
                set suffixe [string range $ni $sbase end]
                if {[string match *d* $suffixe] == 0} {
                    lappend ldesgauche $ni
                }
            }
            # ascendants droits y compris feuilles
            set lascdroit {}
            foreach ni [lsort -decreasing $nodes] {
                
                set suffixe [string range $ni $sbase end]
                
                if {[string match *g* $suffixe] == 0} {
                    lappend lascdroit $ni
                }
            }
            # feuilles intermediaires (sans les descandants feuilles g et d)
            set leafsinter [Tools::SousL $leafs [concat $ldesgauche  $lascdroit]]
            # coordonnees
            set lxy {}
            # la base
            set npap [Tools::NodeParentNode $t $n]
            if {$npap == $t || $npap == ""} {
                set npap [format "%s%s" $t C]
            }
            set conp [$w coords $npap]
            set xp [lindex $conp 0]
            set yp [lindex $conp 1]
            
            if {$n  == $t || $n == ""} {
                set n2 [format "%s%s" $t C]
            } else  {
                set n2 $n
            }
            # NB pb avec les copy paste
            set coni [$w coords $n2]
            set x1 [lindex $coni 0]
            set y1 [lindex $coni 1]
            set x2 [lindex $coni 2]
            set y2 [lindex $coni 3]
            set norm1 [expr sqrt((($xp - $x1) * ($xp - $x1)) + (($yp - $y1) * ($yp - $y1)))]
            set norm2 [expr sqrt((($xp - $x2) * ($xp - $x2)) + (($yp - $y2) * ($yp - $y2)))]
            if  {$norm1 <= $norm2} {
                lappend lxy [list $x2 $y2]
            } else  {
                lappend lxy [list $x1 $y1]
            }
            # descandants gauche
            foreach i  $ldesgauche {
                set npap [Tools::NodeParentNode $t $i]
                if {$npap == $t} {
                    set npap [format "%s%s" $t C]
                }
                set conp [$w coords $npap]
                
                set xp [lindex $conp 0]
                set yp [lindex $conp 1]
                set coni [$w coords $i]
                set x1 [lindex $coni 0]
                set y1 [lindex $coni 1]
                set x2 [lindex $coni 2]
                set y2 [lindex $coni 3]
                set norm1 [expr sqrt((($xp - $x1) * ($xp - $x1)) + (($yp - $y1) * ($yp - $y1)))]
                set norm2 [expr sqrt((($xp - $x2) * ($xp - $x2)) + (($yp - $y2) * ($yp - $y2)))]
                if  {$norm1 <= $norm2} {
                    lappend lxy [list $x1 $y1 $x2 $y2]
                } else  {
                    lappend lxy [list $x2 $y2 $x1 $y1]
                }
            }
            # feuilles
            foreach i  $leafsinter {
                set npap [Tools::NodeParentNode $t $i]
                if {$npap == $t} {
                    set npap [format "%s%s" $t C]
                }
                set conp [$w coords $npap]
                set xp [lindex $conp 0]
                set yp [lindex $conp 1]
                set coni [$w coords $i]
                set x1 [lindex $coni 0]
                set y1 [lindex $coni 1]
                set x2 [lindex $coni 2]
                set y2 [lindex $coni 3]
                set norm1 [expr sqrt((($xp - $x1) * ($xp - $x1)) + (($yp - $y1) * ($yp - $y1)))]
                set norm2 [expr sqrt((($xp - $x2) * ($xp - $x2)) + (($yp - $y2) * ($yp - $y2)))]
                if  {$norm1 <= $norm2} {
                    lappend lxy [list $x2 $y2]
                } else  {
                    lappend lxy [list $x1 $y1]
                }
            }
            # ascendants droits
            foreach i  $lascdroit {
                set npap [Tools::NodeParentNode $t $i]
                if {$npap == $t} {
                    set npap [format "%s%s" $t C]
                }
                set conp [$w coords $npap]
                set xp [lindex $conp 0]
                set yp [lindex $conp 1]
                set coni [$w coords $i]
                set x1 [lindex $coni 0]
                set y1 [lindex $coni 1]
                set x2 [lindex $coni 2]
                set y2 [lindex $coni 3]
                set norm1 [expr sqrt((($xp - $x1) * ($xp - $x1)) + (($yp - $y1) * ($yp - $y1)))]
                set norm2 [expr sqrt((($xp - $x2) * ($xp - $x2)) + (($yp - $y2) * ($yp - $y2)))]
                if  {$norm1 <= $norm2} {
                    lappend lxy [list $x2 $y2 $x1 $y1]
                } else  {
                    lappend lxy [list $x1 $y1 $x2 $y2]
                }
            }
            regsub -all "\{" $lxy "" lxy
            regsub -all "\}" $lxy "" lxy
        } else  {
            set lxy [$w coords $n]
        }
        return $lxy
    }
    #
    ### NodeColorBgSubTreeContour2 un background tree en rectangle
    proc NodeColorBgSubTreeContour2 {w t n mode} {
        global S T
        # x1 (partie commune)
        if {$n == $t || $n == ""} {
            set n [format "%s%s" $t C]
        }
        set cop [$w coords $n]
        set xp1 [lindex $cop 0]
        set xp2 [lindex $cop 2]
        if {$xp1 < $xp2} {
            set x1 $xp1
        } else  {
            set x1 $xp2
        }
        # x2 (xmax) y1 (ymin) y2 (ymax)
        set leafs [Tools::NodeNoToLe $t $n]
        set x2 0 ; set y1 100000 ; set y2 0
        # NB pas de switch sur 1 qui correpond au contour 1
        switch -exact $mode {
            2 {
                foreach i  $leafs {
                    # le texte des feuilles n'est pas pris en compte
                    set coi [$w coords $i]
                    set xi1 [lindex $coi 0]
                    set yi1 [lindex $coi 1]
                    set xi2 [lindex $coi 2]
                    set yi2 [lindex $coi 3]
                    # x2
                    if {$xi1 > $xi2} {
                        if {$xi1 > $x2} {set x2 $xi1}
                    } else  {
                        if {$xi2 > $x2} {set x2 $xi2}
                    }
                    # y1 et y2
                    if {$yi1 > $yi2} {
                        # y1: on regarde yi2
                        if {$yi2 < $y1} {set y1 $yi2}
                        # y2: on regarde yi1
                        if {$yi1 > $y2} {set y2 $yi1}
                    } else  {
                        # y1: on regarde yi1
                        if {$yi1 < $y1} {set y1 $yi1}
                        # y2: on regarde yi2
                        if {$yi2 > $y2} {set y2 $yi2}
                    }
                }
            }
            3 {
                # prise en compte des texte feuilles
                foreach i  $leafs {
                    set ii [$w find withtag [list [format "%s%s" EUL $T($t,ctl,$i)] && T$t]]
                    set coi [$w bbox $ii]
                    # le texte des feuilles n'est pas pris en compte
                    #set coi [$w coords $i]
                    set xi1 [lindex $coi 0]
                    set yi1 [lindex $coi 1]
                    set xi2 [lindex $coi 2]
                    set yi2 [lindex $coi 3]
                    # x2
                    if {$xi1 > $xi2} {
                        if {$xi1 > $x2} {set x2 $xi1}
                    } else  {
                        if {$xi2 > $x2} {set x2 $xi2}
                    }
                    # y1 et y2
                    if {$yi1 > $yi2} {
                        # y1: on regarde yi2
                        if {$yi2 < $y1} {set y1 $yi2}
                        # y2: on regarde yi1
                        if {$yi1 > $y2} {set y2 $yi1}
                    } else  {
                        # y1: on regarde yi1
                        if {$yi1 < $y1} {set y1 $yi1}
                        # y2: on regarde yi2
                        if {$yi2 > $y2} {set y2 $yi2}
                    }
                }
            }
            4 {
                # cas d'un xmax commun a tous les backgrounds, non prise en compte des annotations
                set coi [$w bbox [list T$t && L]]
                set x2 [lindex $coi 2]
                foreach i  $leafs {
                    set tagi [format "%s%s" EUL $T($t,ctl,$i)]
                    #set coi [$w coords $tagi]
                    set coi [$w bbox [list $tagi && T$t]]
                    set xi1 [lindex $coi 0]
                    set yi1 [lindex $coi 1]
                    set xi2 [lindex $coi 2]
                    set yi2 [lindex $coi 3]
                    # y1 et y2
                    if {$yi1 > $yi2} {
                        # y1: on regarde yi2
                        if {$yi2 < $y1} {set y1 $yi2}
                        # y2: on regarde yi1
                        if {$yi1 > $y2} {set y2 $yi1}
                    } else  {
                        # y1: on regarde yi1
                        if {$yi1 < $y1} {set y1 $yi1}
                        # y2: on regarde yi2
                        if {$yi2 > $y2} {set y2 $yi2}
                    }
                }
            }
            5 {
                # cas d'un xmax commun a tous les backgrounds, prise en compte des annotations
                set coi [$w bbox T$t]
                set x2 [lindex $coi 2]
                foreach i $leafs {
                    set tagi [format "%s%s" EUL $T($t,ctl,$i)]
                    #set coi [$w coords $tagi]
                    set coi [$w bbox [list $tagi && T$t]]
                    set xi1 [lindex $coi 0]
                    set yi1 [lindex $coi 1]
                    set xi2 [lindex $coi 2]
                    set yi2 [lindex $coi 3]
                    # y1 et y2
                    if {$yi1 > $yi2} {
                        # y1: on regarde yi2
                        if {$yi2 < $y1} {set y1 $yi2}
                        # y2: on regarde yi1
                        if {$yi1 > $y2} {set y2 $yi1}
                    } else  {
                        # y1: on regarde yi1
                        if {$yi1 < $y1} {set y1 $yi1}
                        # y2: on regarde yi2
                        if {$yi2 > $y2} {set y2 $yi2}
                    }
                }
            }
        }
        # redim x2 (du au bounding box du bbox)
        # original  return [list $x1 $y1  [expr $x2 -2] $y1 [expr $x2 -2] $y2 $x1 $y2]
        return [list $x1 [expr $y1 + 3] [expr $x2 -2] [expr $y1 + 3] [expr $x2 -2] [expr $y2 - 3] $x1 [expr $y2 - 3]]
    }
    ###
    proc NodeColorBgLeafToolbox {w command} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            switch -exact $command {
                add {NodeColorBgLeaf $t $n}
                remove  {NodeColorBgLeafRemove $t $n}
            }
            
        }
    }
    ### foreground color leaf via node pere
    proc NodeColorFgLeaf {t n c} {
        global T S
        set w $S($t,w)
        set leafs [Tools::NodeNoToLe $t $n]
        foreach code $leafs {
            $w itemconfigure [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t] -fill $c
            set T($t,lfg,$code) $c
        }
    }
    ###
    proc NodeColorFgLeafToolbox {w} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            NodeColorFgLeaf $t $n $S(col)
        }
    }
    ###
    proc NodeColorFgLeafToolboxRemove {w} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            GraVarInitFgLeaf $w $t $n
        }
    }
    ###
    proc NodeLineDashToolbox {w o} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            NodeLineDash $t $n $o
        }
    }
    # NodeLineDash
    # variable binaire
    # donc on ne creer une variable graphique que pour l'etat dash
    # et une variable globale pour le noeud a l'origine du sous-arbre
    proc NodeLineDash {t n o} {
        global T S
        set w $S($t,w)
        set p [format "%s%s" $n *]
        set listeitems {}
        foreach e $T($t,all_cod) {
            if {[string match $p $e] == 1} {
                lappend listeitems $e
            }
        }
        # creation d'une variable pour chaque node
        if {$o == "1"} {
            foreach i $listeitems {
                $w itemconfigure $i -dash {2 2}
                $w itemconfigure [format "%s%s" $i C] -dash {2 2}
                set T($t,gld,$i) {2 2}
            }
        } else  {
            # il faut supprimer les variables des nodes issues de $code
            # set pattern [format "%s%s" $n *]
            # foreach key [array names T $t,gld,$pattern] {
            # unset T($key)
            # }
            foreach i $listeitems {
                $w itemconfigure $i -dash {}
                $w itemconfigure [format "%s%s" $i C] -dash {}
                set T($t,gld,$i) {}
            }
        }
    }
    
    ###
    proc NodeLineWidthToolbox {w o} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            if {[string length $o] == "1"} {
                NodeLineWidth $t $n $o
            } {NodeLineWidthSet $t $n $o}
            
        }
    }
    # NodeLineWidth augmente (si o = +) ou diminue ( o = -)
    # la valeur des epaisseurs de traits issus de node
    # donc creation d'une variable graphique propre a chaque element
    # (possiblilite d'avoir des epaisseur differentes pour les arretes de n)
    proc NodeLineWidth {t n o} {
        global T S
        set w $S($t,w)
        set p [format "%s%s" $n *]
        set listeitems {}
        foreach e $T($t,all_cod) {
            if {[string match $p $e] == 1} {
                foreach j [$w find withtag [format "%s%s" $e C]] {
                    set width_line [lindex [$w itemconfigure $j -width] end]
                    set new_wl [expr  abs($width_line $o 1)]
                    $w itemconfigure $j -width $new_wl
                    set T($t,gls,$e) $new_wl
                }
            }
        }
    }
    # NodeLineWidth augmente (si o = +) ou diminue ( o = -)
    # la valeur des epaisseurs de traits issus de node
    # donc creation d'une variable graphique propre a chaque element
    # (possiblilite d'avoir des epaisseur differentes pour les arretes de n)
    proc NodeLineWidth2 {t n o} {
        global T S
        set w $S($t,w)
        set item [$w find withtag $n]
        set width_line [lindex [$w itemconfigure $item -width] end]
        set new_wl [expr  abs($width_line $o 1)]
        $w itemconfigure $item -width $new_wl
        
        
    }
    # NodeLineDash2
    # variable binaire
    # donc on ne creer une variable graphique que pour l'etat dash
    # et une variable globale pour le noeud a l'origine du sous-arbre
    proc NodeLineDash2 {t n o} {
        global T S
        set w $S($t,w)
        set item [$w find withtag $n]
        $w itemconfigure $item -dash {2 2}
        
    }
    # cette fonction met l'epaisseur de trait des arretes issues de n
    # a la valeur de l'epaisseur de trait de n augmente/diminue de 1 (toutes
    # les arretes auront la meme epaisseur)
    proc NodeLineWidthSet {t n o} {
        global T S
        if {$o == "++"} {set o +} else {set o -}
        set w $S($t,w)
        set p [format "%s%s" $n *]
        set listeitems {}
        foreach e $T($t,all_cod) {
            if {[string match $p $e] == 1} {
                lappend listeitems $e
            }
        }
        set width_line [lindex [$w itemconfigure $n -width] end]
        set new_wl [expr  abs($width_line $o 1)]
        foreach i $listeitems {
            $w itemconfigure $i -width $new_wl
            $w itemconfigure [format "%s%s" $i C] -width $new_wl
            #set T($t,gls,$i) $new_wl
        }
        # on detruit les variables sous-jacentes
        set pattern [format "%s%s" $n *]
        foreach key [array names T $t,gls,$pattern] {
            unset T($key)
        }
        # on stocke la variable pour le noeud pere
        set T($t,gls,$n) $new_wl
    }
    # le probleme de la presence de multiple arbres ds la meme w et
    # ayant des eu names en commun est resolu via le bbox &&
    proc NodeColorBgLeaf {t n } {
        global T S B
        set w $S($t,w)
        set p [format "%s%s" $n *]
        set listneu {}
        foreach e $T($t,ue_cod) {
            if {[string match $p $e] == 1} {
                lappend listneu $e
            }
        }
        foreach i $listneu {
            set id [format "%s%s"  $t [Tools::GenId]]
            # MEM
            set B(BGLtre,$id) $t
            set B(BGLnod,$id) $i
            set B(BGLcol,$id) $S(col)
            # Liste des BGL par tree
            lappend B($t,bgl) $id
        }
        Figuration::RestaureBGLall $w $t
    }
    #
    proc NodeColorBgLeafRemove {t n } {
        global T S B
        set w $S($t,w)
        set p [format "%s%s" $n *]
        set listid {}
        foreach {k v} [array get B BGLnod,*] {
            if {[string match $p $v] == 1} {
                #lappend listid [string range $k [expr [string first , $k] - 1]] end ]
                lappend listid [string trimleft $k "BGLnod," ]
            }
        }
        foreach id $listid {
            $w delete [format "%s%s%s" BGL ? $id]
            set w $S($t,w)
            set t $B(BGLtre,$id)
            foreach key [array names B *,$id] {
                unset B($key)
            }
            #retirer
            set index [lsearch -exact $B($t,bgl) $id]
            set B($t,bgl) [concat [lrange $B($t,bgl) 0 [expr $index - 1]] \
                    [lrange $B($t,bgl) [expr $index + 1] end]]
        }
        Figuration::RestaureBGLall $w $t
    }
    #
    proc NodeColorBgLeafDelete {w i} {
        global B S
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BGL*]] ?] end]
        $w delete [format "%s%s%s" BGL ? $id]
        set t $B(BGLtre,$id)
        foreach key [array names B *,$id] {
            unset B($key)
        }
        #retirer
        set index [lsearch -exact $B($t,bgl) $id]
        set B($t,bgl) [concat [lrange $B($t,bgl) 0 [expr $index - 1]] \
                [lrange $B($t,bgl) [expr $index + 1] end]]
    }
    #
    proc NodeColorBgLeaf2 {t n c} {
        global T S B
        set p [format "%s%s" $n *]
        foreach e $T($t,ue_cod) {
            if {[string match $p $e] == 1} {
                set id [format "%s%s"  $t [Tools::GenId]]
                # MEM
                set B(BGLtre,$id) $t
                set B(BGLnod,$id) $e
                set B(BGLcol,$id) $c
                # Liste des BGL par tree
                lappend B($t,bgl) $id
            }
        }
    }
    ### idem NodeColorBgLeaf mais l'argument est une liste de leafs et non un code node pere
    proc EUColorBgLeaf {t eus c} {
        global T S B
        set w $S($t,w)
        foreach i $eus {
            set id [format "%s%s"  $t [Tools::GenId]]
            # MEM
            set B(BGLtre,$id) $t
            set B(BGLnod,$id) $T($t,ltc,$i)
            #set B(BGLcol,$id) $S(col)
            set B(BGLcol,$id) $c
            # Liste des BGL par tree
            lappend B($t,bgl) $id
        }
        Figuration::RestaureBGLall $w $t
    }
    ### couleur d'ecriture des text leaf, arg = liste eu
    proc EUColorFgLeaf {t eus c} {
        global T S
        set w $S($t,w)
        foreach i $eus {
            set tag [list [format "%s%s" EUL  $i ] && T$t]
            # creation des variables graphiques
            #set T($t,lfg,$T($t,ltc,$i)) $S(col)
            set T($t,lfg,$T($t,ltc,$i)) $c
            # dessin
            $w itemconfigure $tag -fill $c
        }
    }
    ###
    proc NodeColorFgTag {w tag color} {
        set listeitems [$w find withtag $tag]
        foreach i $listeitems  {
            switch [$w type $i] {
                line - text  {
                    $w itemconfigure $i -fill $color
                }
                rectangle - polygon - oval - arc {
                    $w itemconfigure $i -outline $color
                }
            }
        }
    }
    ###
    proc NodeColorFgItem {w item color} {
        switch [$w type $item] {
            line   {
                $w itemconfigure $item -fill $color
            }
            rectangle - polygon - oval - arc {
                $w itemconfigure $item -outline $color
            }
        }
    }
    ###
    proc NodeColorFgTreeToolbox {w} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            NodeColorFgTree $t $n $S(col)
        }
    }
    ###
    proc NodeColorFgTreeToolboxRemove {w} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            GraVarInitFgTree $w $t $n
        }
    }
    ### cette fonction modifie la valeur $T($ti,gfg,$node) (affecte $color)
    ### elle est utilisee par la localisation et NodeColorFgTreeToolbox
    proc NodeColorFgTree {t code color} {
        global T S
        set w $S($t,w)
        set p [format "%s%s" $code *]
        set listeitems {}
        foreach e $T($t,all_cod) {
            if {[string match $p $e] == 1} {
                foreach j [$w find withtag [format "%s%s" $e C]] {
                    NodeColorFgItem $w $j $color
                }
            }
        }
        # il faut supprimer les variables des nodes issues de $code
        set pattern [format "%s%s" $code *]
        foreach key [array names T $t,gfg,$pattern] {
            unset T($key)
        }
        # on cree la variable graphique pour le node pere seuleument
        set T($t,gfg,$code) $color
    }
    ### cette fonction modifie la valeur $T($ti,gfg,$node) (affecte $color)
    ### elle est utilisee par la localisation et NodeColorFgTreeToolbox
    proc NodeColorFgTree2 {t code color} {
        global T S
        set w $S($t,w)
        #set p [format "%s%s" $code *]
        set item [$w find withtag $code]
        # set item [$w find withtag [format "%s%s" $code C]]
        NodeColorFgItem $w $item $color
    }
    ### cette fonction modifie la valeur $T($ti,gfg,$node) (affecte $color)
    ### elle est utilisee par la localisation et NodeColorFgTreeToolbox
    proc NodeColorFgTreeNoMem {t code color} {
        global T S
        set w $S($t,w)
        set p [format "%s%s" $code *]
        set listeitems {}
        foreach e $T($t,all_cod) {
            if {[string match $p $e] == 1} {
                foreach j [$w find withtag [list [format "%s%s" $e C] && T$t]] {
                    lappend listeitems $j
                }
            }
        }
        foreach i $listeitems {
            NodeColorFgItem $w $i $color
        }
    }
    ###
    proc CatchColor {w} {
        global S
        set i [$w find withtag current]
        set color ""
        switch [$w type $i] {
            rectangle - polygon - oval - line - text {
                set color [lindex [$w itemconfigure $i -fill] end]
            }
            arc {
                set color [lindex [$w itemconfigure $i -outline] end]
            }
        }
        if {$color != ""} {
            set S(col) $color
            if {[winfo exists .colorpanel.sample] == 1} {.colorpanel.sample configure -background $S(col)}
            set winwin [format "%s%s%s" .colorpanel.dic. $S(col) .b]
            if {[winfo exists $winwin] == 1} {$winwin select}
        }
    }
    ###
    proc CatchFont {w} {
        global S
        set i [$w find withtag current]
        set font ""
        switch [$w type $i] {
            text {
                set font [lindex [$w itemconfigure $i -font] end]
            }
        }
        if {$font != ""} {
            set S(gfo) $font
            foreach {var val} $font {
                set S($var) $val
            }
            if {[winfo exists .fontpanel.msg] == 1} {.fontpanel.msg configure -font $S(gfo)}
        }
    }
    
    ###
    proc FontWeight {w} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set leafs [Tools::NodeNoToLe $t $n]
            foreach code $leafs {
                set i [$w find withtag [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t]]
                set f [lindex [$w itemconfigure  $i -font] end]
                set fnew {}
                foreach {var val} $f {
                    if {$var == "-weight"} {
                        if {$val == "bold"} {set val normal} {set val bold}
                    }
                    lappend fnew $var $val
                }
                set T($t,gfo,$code) $fnew
                $w itemconfigure $i -font $fnew
            }
        }
    }
    ###
    proc FontSlant {w} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set leafs [Tools::NodeNoToLe $t $n]
            foreach code $leafs {
                set i [$w find withtag [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t]]
                set f [lindex [$w itemconfigure $i  -font] end]
                set fnew {}
                foreach {var val} $f {
                    if {$var == "-slant"} {
                        if {$val == "roman"} {set val italic} {set val roman}
                    }
                    lappend fnew $var $val
                }
                set T($t,gfo,$code) $fnew
                $w itemconfigure $i  -font $fnew
            }
            
        }
    }
    ###
    proc FontOverstrike {w} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set leafs [Tools::NodeNoToLe $t $n]
            foreach code $leafs {
                set i [$w find withtag [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t]]
                set f [lindex [$w itemconfigure $i -font] end]
                set fnew {}
                foreach {var val} $f {
                    if {$var == "-overstrike"} {
                        if {$val == "true"} {set val false} {set val true}
                    }
                    lappend fnew $var $val
                }
                set T($t,gfo,$code) $fnew
                $w itemconfigure $i -font $fnew
            }
        }
    }
    ###
    proc FontUnderline {w} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set leafs [Tools::NodeNoToLe $t $n]
            foreach code $leafs {
                set i [$w find withtag [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t]]
                set f [lindex [$w itemconfigure $i -font] end]
                set fnew {}
                foreach {var val} $f {
                    if {$var == "-underline"} {
                        if {$val == "true"} {set val false} {set val true}
                    }
                    lappend fnew $var $val
                }
                set T($t,gfo,$code) $fnew
                $w itemconfigure $i -font $fnew
            }
        }
    }
    ### OK
    proc FontSize {w mode} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set leafs [Tools::NodeNoToLe $t $n]
            foreach code $leafs {
                set i [$w find withtag [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t]]
                set f [lindex [$w itemconfigure $i -font] end]
                set fnew {}
                foreach {var val} $f {
                    if {$var == "-size"} {
                        if {$mode == "+"} {set val [incr val]} {set val [incr val -1]}
                    }
                    lappend fnew $var $val
                }
                set T($t,gfo,$code) $fnew
                $w itemconfigure $i -font $fnew
            }
        }
    }
    ### OK
    proc FontSetGlobalToolbox {w} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            FontSetGlobal $t $n $S(gfo)
            
        }
    }
    ### Font du panel Font, via un node pere
    proc FontSetGlobal {t n font} {
        global T S
        set w $S($t,w)
        set leafs [Tools::NodeNoToLe $t $n]
        foreach code $leafs {
            $w itemconfigure [list [format "%s%s" EUL $T($t,ctl,$code)] && T$t] -font $font
            set T($t,gfo,$code) $font
        }
    }
    ### Font du panel Font, via une liste d'eu
    proc FontSetGlobalEU {t eus font} {
        global T S
        set w $S($t,w)
        foreach eu $eus {
            $w itemconfigure [list [format "%s%s" EUL $eu] && T$t] -font $font
            set T($t,gfo,$T($t,ltc,$eu)) $font
        }
    }
    ###
    proc FontSet {t w n variable value} {
        global T
        set f [lindex [$w itemconfigure [format "%s%s" $n EUL] -font] end]
        set fnew {}
        foreach {var val} $f {
            if {$var == $variable} {lappend fnew $var $value} {lappend fnew $var $val}
        }
        set T($t,gfo,$n) $fnew
        $w itemconfigure [format "%s%s" $n EUL] -font $fnew
    }
    ###
    proc RecFoSw {t variable value} {
        global T S
        set w [format "%s%s%s" .t $t .c]
        foreach code $T($t,sel) {
            if {[lsearch -exact $T($t,ue_cod) $code] != -1} {
                FontSet $t $w $code $variable $value
            }
        }
        
    }
    
}
####################


####################
# INTEGRATION
####################
namespace eval Integration {
    
    
    ### renvoie une chaine newick a partir d'un fichier nexus
    proc NexusToNewick {} {
        global S
        set fSource $S(NexusFileIN)
        set fTarget $S(NexusFileOUT)
        if {$fSource != "" && $fTarget != ""} {
            if [catch {open $fSource r} fidS] {
                puts stderr "Error Opening File"
            } else {
                set s [read $fidS]
                regsub -all "\n" $s "" s
                regsub -all {\[} $s "" s
                # suppression des signes - sur les longueurs de branches
                #regsub -all {:-} $s ":" s
                regsub -all {\]} $s "" s
                
                
                #OK puts $s
                set fidT [open $fTarget w]
                # un petit regexp pour  recuperer dans blaa la liste des feuilles 1 BLSK, 2 SHSFH, 3 SGGSS
                regexp {Translate(.+?);} $s bla blaa
                #OK puts $blaa
                # un petit foreach pour ranger dans une liste $l les nom des feuilles {BLSK SHSFH SGGSS}
                foreach e $blaa {
                    if {[regexp {^[0-9]+$} $e ] ==0} {
                        regexp {[^,]+} $e e1
                        lappend l $e1
                    }
                }
                # un petit regexp de nouveau pour recuperer dans blaa1 l'arbre en format ((1:346.34,2:56.6):876.9,3:1.9)
                # original regexp {;[^(]+([^;]+);(E|e)nd;} $s bla1 blaa1
                regexp {;[^(]+([^;]+);(E|e)nd;} $s bla1 blaa1
                # initialisation de la variable qui va contenir le resultat final
                set Nick {}
                set i 0
                # un petit regsub pour spliter $blaa1 de la forme ((1,2),3) pour la forme ( ( 1 , 2 ) , 3 )
                # pour traiter blaa1 comme une liste avec un foreach
                # Tout d'abord l'arbre a t'il des longueur de feuilles ou faut-il en mettre?
                if [regexp : $blaa1] {
                    regsub -all {(\(|,|\)|:)} $blaa1 { & } blaa1
                    # un petit foreach pour remplacer dans l'expression $blaa1 les chiffres par le nom
                    # des feuilles stocke dans $l
                    foreach e $blaa1 {
                        if {[regexp {^[0-9]+$} $e] & [lindex $blaa1 [expr $i+1]] == ":"} {
                            set Nick $Nick[lindex $l [expr $e -1]]
                        } elseif [string equal $e ")"] {
                            set Nick $Nick)
                        } {
                            set Nick $Nick$e
                        }
                        incr i
                    }
                } {
                    regsub -all {(\(|,|\))} $blaa1 { & } blaa1
                    # un petit foreach pour remplacer dans l'expression $blaa1 les chiffres par le nom
                    # des feuilles stocke dans $l
                    foreach e $blaa1 {
                        if [regexp {^[0-9]+$} $e] {
                            set Nick $Nick[lindex $l [expr $e -1]]:1.0
                        } elseif [string equal $e ")"] {
                            set Nick $Nick):1.0
                        } {
                            set Nick $Nick$e
                        }
                    }
                    
                }
                # et c'est fini
                #return $Nick
                puts $fidT "$Nick ;"
                close $fidT
                close $fidS
            }
        }
    }
    # traductoin fichier matrice leaves*variables vers fichier records label file fo treedyn
    proc MakeLabelFile {} {
        global S
        set fSource $S(MakeLabelFileIN)
        set fTarget $S(MakeLabelFileOUT)
        if {$fSource != "" && $fTarget != ""} {
            set fidS [open $fSource r]
            set fidT [open $fTarget w]
            # premiere ligne = liste de variable
            set nbrows 1
            set lrowsBad ""
            gets $fidS variables
            while {[eof $fidS] != 1} {
                incr nbrows
                gets $fidS row
                # verification a faire sur le nombre de valeurs correspondant nombre de variables
                set data ""
                if {[llength $variables] == [llength $row]} {
                    # le premier couple var val doit etre EU / $eu on ecrit que $eu sans {}
                    set data   [lindex $row 0 0]
                    #ok
                    foreach var [lrange $variables 1 end] val [lrange $row 1 end]   {
                        set data   [concat $data $var [format "%s%s%s" "{" $val "}"]]
                    }
                    puts $fidT $data
                } else  {
                    # attention si retour charriot sur la derniere ligne du fichier
                    if {$row != ""}  {
                        set lrowsBad [concat $lrowsBad "Row: $nbrows ([lindex $row 0]) \n"]
                    }
                }
            }
            if {$lrowsBad != ""} {
                tk_messageBox -type ok -default ok -icon warning \
                        -message "Missing non-paired item/value list ($fSource):\n $lrowsBad"
            }
            close $fidS
            close $fidT
        }
    }

    #
    proc MIbackfile {} {
        set files [.fsp.lfb.l get 0 end]
        destroy .fsp
        .int.n.canvas.notebook.cs.page1.cs.ld.l delete 0 end
        foreach f $files {
            .int.n.canvas.notebook.cs.page1.cs.ld.l insert 0 $f
        }
    }
    #
    proc MIupdateAvailableFile {} {
        global S
        .fsp.lfa.l delete 0 end
        set filter [.fsp.fi get]
        if {$filter == "ALL"} { set pattern *
        } else  {
            set pattern [format "%s%s" * $filter]
        }
        #[format "%s%s" $S(userDIR)  /?.nwk]
        set AFN [lsort [glob -nocomplain -type f -dir $S(userDIR) $pattern]]
        set S(MultiImportAFN) "[llength $AFN] File(s)"
        foreach f $AFN {
            .fsp.lfa.l insert end [file tail $f]
        }
        MIConfigBg
    }
    #
    proc MIConfigBg {} {
        global S
        # config bg si deja en selection
        set lfselectavecDir {}
        set lfselectsansDir {}
        foreach e [.fsp.lfb.l get 0 end] {
            lappend lfselectsansDir [file tail $e]
            lappend lfselectavecDir $e
        }
        set index 0
        foreach f [.fsp.lfa.l get 0 end] {
            if {[lsearch $lfselectavecDir [format "%s%s%s" $S(userDIR) / $f]] != -1}  {
                .fsp.lfa.l itemconfigure $index -background NavajoWhite2
            } elseif {[lsearch $lfselectsansDir $f] != -1}  {
                .fsp.lfa.l itemconfigure $index -background NavajoWhite3
            } else  {
                .fsp.lfa.l itemconfigure $index -background LightGoldenrodYellow
            }
            incr index
        }
    }
    #
    proc MIupdateDirectories {} {
        global S
        .fsp.ld.l delete 0 end
        foreach d [lsort [glob -nocomplain -type d -dir $S(userDIR) *]] {
            .fsp.ld.l insert end [file tail $d]
        }
        .fsp.ld.l insert 0 ..
    }
    #
    proc MIupdateFol {f} {
        global S
        set S(userDIR) $f
        MIupdateDirectories
        MIupdateAvailableFile
        MIupdateFilter
    }
    #
    proc MIaddFile {} {
        global S
        set li [.fsp.lfa.l curselection] ;# des index
        set lsel {}
        foreach i $li {
            lappend lsel [.fsp.lfa.l get $i]
            .fsp.lfa.l itemconfigure $i -background NavajoWhite2
        }
        set lall2 [.fsp.lfb.l get 0 end]
        .fsp.lfb.l delete 0 end
        foreach e $lsel {
            lappend lall2 [format "%s%s%s" $S(userDIR) / $e]
        }
        foreach e $lall2 {
            .fsp.lfb.l insert 0 $e
        }
        # deselection des fichiers liste available
        .fsp.lfa.l selection clear 0 end
        # conservation dir deja visitees
        if {[lsearch $S(MultiImportDII) $S(userDIR)] == -1} {
            MIupdateFolRebuild
        }
    }
    #
    proc MIaddFileMouse {listbox x y} {
        global S
        set newfile [format "%s%s%s" $S(userDIR) / [.fsp.lfa.l get @$x,$y]]
        .fsp.lfa.l selection clear @$x,$y
        .fsp.lfb.l insert 0 $newfile
        # conservation dir deja visitees
        if {[lsearch $S(MultiImportDII) $S(userDIR)] == -1} {
            MIupdateFolRebuild
        }
    }
    #
    proc MIupdateFolRebuild {} {
        global S
        .fsp.dir.m delete 0 end
        lappend S(MultiImportDII) $S(userDIR)
        foreach e [file volume] {
            .fsp.dir.m add command -label $e -command "Integration::MIupdateFol $e"
        }
        .fsp.dir.m add separator
        foreach e $S(MultiImportDII) {
            .fsp.dir.m add command -label $e -command "Integration::MIupdateFol $e"
        }
    }
    #
    proc MIremFile {} {
        # attention retrait a partir de l'index le plus bat
        # le delete remet a jour les index
        set li [lsort -decreasing [.fsp.lfb.l curselection]] ;# des index
        foreach i $li {
            .fsp.lfb.l delete $i
        }
        # deselection des fichiers liste available
        .fsp.lfa.l selection clear 0 end
    }
    # retrait d'un elt par double-1 sans toucher la selection
    proc MIremFileMouse {listbox x y} {
        $listbox delete @$x,$y
    }
    #
    proc MIupdateDirectoriesMouse {listbox x y} {
        global S
        set repertoire [$listbox get @$x,$y]
        if {$repertoire != ".."} {
            if {[string length $S(ImportDIR)] == 3} {
                set S(ImportDIR) [format "%s%s" $S(userDIR) $repertoire]
            } else  {
                set S(ImportDIR) [format "%s%s%s" $S(userDIR) / $repertoire]
            }
        } else  {
            set S(ImportDIR) [file dirname $S(userDIR)]
        }
        MIupdateDirectories
        MIupdateAvailableFile
    }
    #
    proc MIupdateFilter {} {
        global S
        .fsp.fi select ALL
    }
    #
    proc RobinsonFoulds {} {
    }
    #
    proc TranslationSelectFile  {txt var} {
        global S
        set typelist {
            {"All Files" {*}}
        }
        set file [tk_getOpenFile  -initialdir $S(userDIR)  \
                -filetypes $typelist -defaultextension "*" \
                -title $txt]
        if {$file != ""} {set S(userDIR) [file dirname $file] ; set S($var) $file}
        
    }
    # procedure de changement des noms des feuilles si les noms des feuilles
    # attention ne pas melanger entre des longueurs de branche et des nombres pour des noms de feuilles
    # feuilles : (f:  soit ,f: attention bien cadrer a gauche et a droite, ne pas prendre que $f:)
    # impossible de melanger avec longueurs de branche
    # qui sont soit ":v," soit ":v)"
    proc NewickTranslation {} {
        global S
        set filename $S(FSPtransTrF)
        if [catch {open $filename r} fid] {
            puts stderr "Error Opening File"
        } else {
            set filename2 $S(FSPtransFF)
            if [catch {open $filename2 r} fid2] {
                puts stderr "Error Opening File"
            } else {
                set translation [read $fid]
                set source [read $fid2]
                regsub -all {\n} $source "" source
                set fidTARGET [open $S(FSPtransTF)  a]
                foreach {val var trans} $translation {
                    set feuilleFrom [format "%s%s%s" "\\(" $val ":" ]
                    set feuilleVers [format "%s%s%s" "\(" $trans ":" ]
                    #set feuilleVers [format "%s%s%s" "\(" [string toupper $trans] ":" ]
                    set trouve [regsub  $feuilleFrom $source $feuilleVers source]
                    if {$trouve == 0} {
                        set feuilleFrom [format "%s%s%s" , $val : ]
                        set feuilleVers [format "%s%s%s" , $trans : ]
                        #set feuilleVers [format "%s%s%s" , [string toupper $trans] : ]
                        regsub  $feuilleFrom $source $feuilleVers source
                    }
                }
                puts $fidTARGET $source
                close $fid
                close $fid2
                close $fidTARGET
            }
        }
    }
    proc FileConcatenation {} {
        global S
        set fSource [.int.p.cs.page0.cs.ld.l get 0 end]
        set fTarget $S(FSPtargetfile)
        if {$fSource != "" && $fTarget != ""} {
            set fidT [open $fTarget a]
            foreach f $fSource {
                set fid [open $f r]
                set data [read $fid]
                puts $fidT $data
                close $fid
            }
            close $fidT
        }
    }
}
####################


####################
# ILLUSTRATION
####################
namespace eval Illustration {

                                
    proc BracketDrawLeafs {w t leafs text colortext fo tab dx color stipple} {
        global S
        set ltag {}
        foreach l $leafs {
            set tag [format "%s%s" EUL $l]
            lappend ltag $tag
        }

        set co [eval $w bbox $ltag]
        if {$tab == 0} {
            set x  [lindex $co 2]
        } else  {
            # on tabul relativement a l'arbre
            set tag [format "%s%s" T$t &&!DRAW]
            set cotree [eval $w bbox $tag]
            set xt [lindex $cotree 2]
            set x [expr $xt + $tab]
        }
         
        set y1 [expr [lindex $co 1] + 3]
        set y2 [expr [lindex $co 3] - 3]
      
            
        set id [format "%s%s"  NBKT [Tools::GenId]]
        $w create rectangle $x $y1 [expr $x + $dx] $y2 \
                -fill $color -outline $color -width 1 -tags "nbracket nbracketrec $id DRAW T$t" \
                -stipple @[file join  $S(TheoPATH) + stipple $stipple]
        set ym [expr ($y1 + $y2) / 2.0]
        $w create text [expr $x + $dx + 5] $ym -text $text \
                -anchor w -font $fo -fill $colortext -tags "nbracket nbracketext $id DRAW T$t"

    }
    
    proc BracketDrawCreateNode {w shape x y} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            set leafs [Tools::NodeNoToLe $t $n]
            set l1 [lindex $leafs 0]
            set l2 [lindex $leafs end]
            set co1 [$w coords $l1]; set co2 [$w coords $l2]
            set x1 [lindex $co1 0] ; set y1 [lindex $co1 1]
            set x2 [lindex $co2 0] ; set y2 [lindex $co2 1]
            set id [format "%s%s"  NBKT [Tools::GenId]]
            switch -exact $shape {
                bracket {
                    $w create rectangle $x1 $y1 [expr $x1 +5] $y2 \
                            -fill $S(col) -width 1 -tags "nbracket nbracketrec $id DRAW T$t" \
                            -stipple @[file join  $S(TheoPATH) + stipple $S(stipple)]
                    set ym [expr ($y1 + $y2) / 2.0]
                    $w create text [expr $x1 + 10] $ym -text $S(AnnotateNote) \
                            -anchor w -font $S(gfo) -fill $S(col) -tags "nbracket nbracketext $id DRAW T$t"
                    
                }
            }
            # passage mode move
            set S(tool) move
            bindtags $w [list $S(tool) $w Canvas . all]
        }
    }
    ### Draw bracket, forcer la ligne verticalite
    # possibilit?Š de grande taille, dessin vectoriel
    # shape sera soit bracket soit accolade
    #
    proc BracketDrawCreate {w shape x y} {
        global S
        set id [$w find closest $x $y]
        set tags [$w gettags $id]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$t != ""} {
            set x [$w canvasx $x] ; set y [$w canvasy $y]
            set id [format "%s%s"  BKT [Tools::GenId]]
            set S(bracketdrawOri) $x
            set S(bracketdrawId) $id
            set S(bracketdrawIdT) T$t
            switch -exact $shape {
                bracket {
                    $w create line [expr $x -5] $y $x $y \
                            -fill black -width 1 -tags "bracket $id DRAW T$t"
                    $w create line $x $y $x $y \
                            -fill black -width 1 -tags "bracket $id rubbershape DRAW T$t"
                }
                accolade {
                    #A FAIRE
                }
            }
        }
    }
    #
    proc BracketDrawDrag {w x y} {
        global S
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        set coords [$w coords "rubbershape"]
        set coords [lreplace $coords 2 3 $S(bracketdrawOri) $y]
        eval $w coords "rubbershape" $coords
    }
    #
    proc BracketDrawEnd {w x y} {
        global S
        BracketDrawDrag $w $S(bracketdrawOri) $y
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        $w create line [expr $S(bracketdrawOri) - 5] $y [expr $S(bracketdrawOri) + 1] $y \
                -fill black -width 1 -tags "bracket $S(bracketdrawId) DRAW $S(bracketdrawIdT)"
        $w dtag "rubbershape"
    }
    proc BracketNproperties {w i what} {
        global S
        switch -- $what {
            text {
                set id [$w find withtag [list $i && nbracketext]]
                set co [$w coords $id]
                set xi [lindex $co 0] ; set yi [lindex $co 1]
                
                set col [lindex [$w itemconfigure $id -fill] end]
                set fo [lindex [$w itemconfigure $id -font] end]
                
                set tags [$w gettags $id]
                $w delete $id
                $w create text $xi $yi -text $S(AnnotateNote) \
                        -anchor w -font $fo -fill $col -tags $tags
            }
            color {
                set id [$w find withtag [list $i && nbracketrec]]
                $w itemconfigure $id -fill $S(col)
                set id [$w find withtag [list $i && nbracketext]]
                $w itemconfigure $id -fill $S(col)
            }
            stipple {
                set id [$w find withtag [list $i && nbracketrec]]
                $w itemconfigure $id -stipple @[file join  $S(TheoPATH) + stipple $S(stipple)]
            }
            font {
                set id [$w find withtag [list $i && nbracketext]]
                $w itemconfigure $id -font $S(gfo)}
        }
    }
    
    #
    proc BracketAddLabel {w i} {
        global S
        set tags [$w gettags $i]
        set id [lindex $tags [lsearch -glob $tags BKT*]]
        $w delete LAB$id
        set cod [$w bbox $id]
        set x [lindex $cod 2]
        set y1 [lindex $cod 1]
        set y2 [lindex $cod 3]
        set y [expr ($y1 + $y2) / 2.0]
        $w create text $x $y -text $S(AnnotateNote) \
                -anchor w \
                -font $S(gfo) -tags "bracket LAB$id $id DRAW"
    }
    #
    proc BracketAlign {w i} {
        global S
        set tags [$w gettags $i]
        set id [lindex $tags [lsearch -glob $tags BKT*]]
        set cod [$w bbox $id]
        set x [lindex $cod 2]
        set bkt [$w find withtag bracket]
        foreach i $bkt {
            set coi [$w bbox $i]
            set newc [list $x [lrange $cod 1 end]]
            $w coords $i $newc
        }
        
    }
    ###
    proc NodeBgContour {w x y} {
        global S B
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set lxy [Figuration::NodeColorBgSubTreeContour $w $t $n]
        set c0 [$w bbox $n]
        set x0 [lindex $c0 0]
        set y0 [lindex $c0 1]
        set id [format "%s%s"  $t [Tools::GenId]]
        set tag [format "%s%s%s" BGS ? $id]
        $w create polygon "$x0 $y0 $lxy $x0 $y0" -smooth 1 -splinesteps 100 \
                -fill $S(col) -outline $S(col) -tags "bgtree T$t $tag"
        $w lower bgtree
        # MEM
        set B(BGStre,$id) $t
        set B(BGSnod,$id) $n
        set B(BGScol,$id) $S(col)
        # Liste des BGS par tree
        lappend B($t,bgs) $id
        
    }
    #
    #
    proc NodeIllustration {w x y} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            set co [$w coords $n]
            set x [lindex $co 0]
            set y [lindex $co 1]
            set tagC [format "%s%s%s" COL ? [Tools::GenId]]
            #set S(symbolcolorfill) $S(col)
            #set S(symbolcoloroutline) $S(col)
            #set S(symbolstipple) $S(stipple)
            Illustration::drawsymbol  $w $x $y [list T$t AnnotMatrix AM$t $tagC AMatrixCo]
            update
        }
    }
    #
    proc NodeIllustration2 {w x y} {
        global S
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            set co [$w coords $n]
            set y [lindex $co 1]
            set tagC [format "%s%s%s" COL ? [Tools::GenId]]
            #set S(symbolcolorfill) $S(col)
            #set S(symbolcoloroutline) $S(col)
            #set S(symbolstipple) $S(stipple)
            Illustration::drawsymbol  $w $x $y [list T$t AnnotMatrix AM$t $tagC AMatrixCo]
            update
        }
    }
    #
    proc SymbolInsert {w x y} {
        global S
        #set S(symbolcolorfill) $S(col)
        #set S(symbolcoloroutline) $S(col)
        #set S(symbolstipple) $S(stipple)
        Illustration::drawsymbol  $w [$w canvasx $x] [$w canvasy $y] [list DRAW symbol]
    }
    proc LillLtoolbox {w x y} {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set p [format "%s%s" $n *]
            set leu {}
            foreach e $T($t,ue_cod) {
                if {[string match $p $e] == 1} {
                    lappend leu $T($t,ctl,$e)
                }
            }
            LillL $w $t $leu
        }
    }
    # Leaves Illustration mode Leave
    proc LillL  {w t leu} {
        global T S
        # tag serie
        switch -exact $S($t,type) {
            PhyNJ - ClaSla - ClaRec {
                set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                foreach l $leu {
                    #set l $T($t,ctl,$code)
                    set i [$w find withtag [list ILLL?$l && T$t]]
                    if {$i == ""} {
                        set i [$w find withtag [list [format "%s%s" EUL  $l] && T$t]]
                        set co [$w coords $i]
                        set y [lindex $co 1]
                        set x [lindex [$w bbox $i] 2]
                    } else  {
                        # cas si plusieurs ajout on recup le i de plus gran x
                        set co [$w coords [lindex $i 0]]
                        set y [lindex $co 1]
                        set x 0
                        foreach ii $i {
                            set xii [lindex [$w bbox $ii] 2]
                            if {$xii >= $x} {
                                set x $xii
                            }
                        }
                    }
                    if {$x != "" && $y != ""} {
                        #set S(symbolcolorfill) $S(col)
                        #set S(symbolcoloroutline) $S(col)
                        #set S(symbolstipple) $S(stipple)
                        Illustration::drawsymbol  $w $x $y [list ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo]
                    }
                }
            }
            PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                LillL360bis $w $t $leu
            }
            ClaCir1 - ClaCir2 - ClaCir3 {
                LillL360 $w $t $leu
            }
        }
    }
    #
    proc LillL360 {} {
    }
    #
    proc LillL360bis {} {
    }
    #
    proc LillCtoolbox {w x y } {
        global T S
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set p [format "%s%s" $n *]
            set leu {}
            foreach e $T($t,ue_cod) {
                if {[string match $p $e] == 1} {
                    lappend leu $T($t,ctl,$e)
                }
            }
            LillC $w $t $leu
        }
    }
    # Leaves Illustration mode Columns
    # tab la variable de tabulation entre differentes colonnes
    proc LillC {w t leu } {
        
        global S ann T
        if {$S(illustration-tabulation) == 1} {
            set S($t,LabelMatrixBase) [expr $S($t,LabelMatrixBase) + $S(TabulationAnnot)]
        }
        #set S($t,LabelMatrixBase) [expr $S($t,LabelMatrixBase) + $S(TabulationAnnot)]
        #
        switch -exact $S($t,type) {
            PhyNJ - ClaSla - ClaRec {
                set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                set x [expr $XMAX + $S($t,LabelMatrixBase)]
                # tag de colonne
                set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                foreach l $leu {
                    # recherche y (code arrete terminale)
                    set item [$w find withtag [list [format "%s%s" EU  $l ] && T$t]]
                    if {$item != ""} {
                        set co [$w coords $item]
                        set y [lindex $co 1]
                        #set S(symbolcolorfill) $S(col)
                        #set S(symbolcoloroutline) $S(col)
                        #set S(symbolstipple) $S(stipple)
                        drawsymbol  $w $x $y [list ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo]
                    }
                }
            }
            PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                # ENCORE DU TRAVAIL A FAIRE
                # PB du rectangle / oval, des zones de dessin arbre en dehors de l'oval
                # LillC360bis $w $t $leu
                LillC360bis2 $w $t $leu
                
            }
            ClaCir1 - ClaCir2 - ClaCir3 {
                LillC360 $w $t $leu
            }
        }
        #Navigation::FitToContents $w
    }
    proc drawsymbol {w x y tags} {
        global S
        
        switch $S(symboltype) {
            01 {
                # carre rectangle ok
                $w create rectangle [expr $x-$S(symboldx)] [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] [expr $y+$S(symboldy)] \
                        -fill $S(symbolcolorfill) -outline $S(symbolcoloroutline)  \
                        -tags $tags  -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            02 {
                # cercle/ocal ok
                $w create oval [expr $x-$S(symboldx)] [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] [expr $y+$S(symboldy)] \
                        -fill $S(symbolcolorfill) -outline $S(symbolcoloroutline)  \
                        -tags $tags  -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            03 {
                # losange ok
                $w create polygon [expr $x-$S(symboldx)] $y $x [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] $y $x [expr $y+$S(symboldy)] \
                        -fill $S(symbolcolorfill) -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            04 {
                # triangle right ok
                $w create polygon [expr $x-$S(symboldx)] [expr $y-$S(symboldy)]  [expr $x+$S(symboldx)] $y  [expr $x-$S(symboldx)] [expr $y+$S(symboldy)] \
                        -fill $S(symbolcolorfill)  -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            05 {
                # triangle left ok
                $w create polygon [expr $x+$S(symboldx)] [expr $y-$S(symboldy)]  [expr $x+$S(symboldx)] [expr $y+$S(symboldy)]  [expr $x-$S(symboldx)] $y \
                        -fill $S(symbolcolorfill) -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            06 {
                # triangle bottom ok
                $w create polygon [expr $x-$S(symboldx)] [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] [expr $y-$S(symboldy)] $x  [expr $y+$S(symboldy)] \
                        -fill $S(symbolcolorfill) -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            07 {
                # triangle top
                $w create polygon [expr $x-$S(symboldx)] [expr $y+$S(symboldy)] [expr $x+$S(symboldx)] [expr $y+$S(symboldy)] $x  [expr $y-$S(symboldy)] \
                        -fill $S(symbolcolorfill) -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            08 {
                #case a cocher 0 OK
                $w create rectangle [expr $x-$S(symboldx)] [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] [expr $y+$S(symboldy)] \
                        -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(symbolstipple)]
            }
            09 {
                #case a cocher 1 OK
                $w create rectangle [expr $x-$S(symboldx)] [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] [expr $y+$S(symboldy)] \
                        -outline $S(symbolcoloroutline)  \
                        -tags $tags -stipple @[file join  $S(TheoPATH) + stipple $S(stipple)]
                $w create line [expr $x-$S(symboldx)] [expr $y-$S(symboldy)] [expr $x+$S(symboldx)] [expr $y+$S(symboldy)] \
                        -fill $S(symbolcolorfill)  \
                        -tags $tags
                $w create line [expr $x-$S(symboldx)] [expr $y+$S(symboldy)] [expr $x+$S(symboldx)] [expr $y-$S(symboldy)] \
                        -fill $S(symbolcolorfill)  \
                        -tags $tags
            }
        }
    }
    proc LillCpolygon {w t leu } {
        global S ann T
        #
        if [catch {expr $S($t,LabelMatrixBase) + $S(TabulationAnnot)} result] {
            set S($t,LabelMatrixBase) $S(TabulationAnnot)
        } else  {
            # tabulation entre colonnes
            # possiblit?Š de rester sur la meme colonne
            if {$S(illustration-tabulation) == 1} {
                set S($t,LabelMatrixBase) $result
            }
        }
        #
        switch -exact $S($t,type) {
            PhyNJ - ClaSla - ClaRec {
                # recherche x
                if {$S(illustration-tabulation) == 1} {
                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                    set XMAX3 [lindex [$w bbox [list T$t && AnnotMatrix]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                } else  {
                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                }
                # tag de colonne
                set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                foreach l $leu {
                    # recherche y (code arrete terminale)
                    set item [$w find withtag [list [format "%s%s" EU  $l ] && T$t]]
                    if {$item != ""} {
                        set co [$w coords $item]
                        set y [lindex $co 1]
                        # avoir 2 caracteres pour bon centrage
                        #set illtxt [concat " " [lindex $S(ill-car-fon) 0 ]]
                        #set illfon [lrange $S(ill-car-fon) 1 end]
                        set illtxt [concat " " $S(ill-car) ]
                        set illfon $S(ill-fon)
                        
                        # On va chercher pour la variable en selection la liste des coords du polygon a trace
                        # f est un facteur d'amplification ?  appliquer sur les coord du polygon
                        # x et y sont utiliser pour appliquer une translation en x et y respectivement
                        set item [$w create text $x $y  \
                                -text $illtxt \
                                -anchor center  -justify center \
                                -fill $S(col) \
                                -font $illfon \
                                -tags "ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"]
                        $w raise $item
                        update
                    }
                }
            }
            PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
            }
            ClaCir1 - ClaCir2 - ClaCir3 {
            }
        }
    }
    ###
    proc LillC360 {w t leu} {
        global S ann T
        set d $S($t,LabelMatrixBase)
        set co [$w bbox [list Z && T$t]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        
        set C(dx) [expr abs(($x2 - $x1)) /2.0]
        set C(dy) [expr abs(($y2 - $y1)) /2.0]
        set a_ref [expr 360.0/ [llength $T($t,ue_cod)]] ;# unit?Š d'angle
        set n 0
        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
        if { $S($t,type) == "ClaCir2"} {
            # inversion de la liste des eus
            set LLE {}
            foreach e $T($t,ue_cod) {
                set LLE [concat $e $LLE]
            }
            set n 1
        } else  {
            set LLE $T($t,ue_cod)
        }
        foreach e  $LLE {
            set C(angle,$e) [expr $n*$a_ref]
            if  { [lsearch $leu $T($t,ctl,$e)] != -1} {
                # degres -> radians
                set angrad [expr (2 * acos(-1) * $C(angle,$e)) / 360.0]
                # d est l'augmentation du rayon du cercle
                set x [expr ($C(dx) + $d ) * cos($angrad)]
                set y [expr ($C(dy) + $d ) * sin($angrad)]
                set l $T($t,ctl,$e)
                #set illtxt [concat " " [lindex $S(ill-car-fon) 0 ]]
                #set illfon [lrange $S(ill-car-fon) 1 end]
                set illtxt [concat " " $S(ill-car) ]
                set illfon $S(ill-fon)
                set item [$w create text [expr $x + $x1 + $C(dx)] [expr $y  + $y1 + $C(dy)] \
                        -text $illtxt \
                        -anchor center  -justify center \
                        -fill $S(col) \
                        -font $illfon \
                        -tags "ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"]
                $w raise $item
                update
            }
            incr n
        }
        unset C
    }
    ###
    # s est soit tab- soit tab+
    # cette fonction permet d'inc?Šmenter (+) // d?Šcr?Šmenter (-)
    # la variable de tabulation pour les arbres en target
    # manuellement (afin de tab entre 2 series de requetes)
    proc IllCTabulation {s} {
        global S T
        # A-list window/tree des arbres en target d'une session treedyn
        foreach {w t} [Selection::TreeTar] {
            switch -exact $s  {
                tab+ {
                    if [catch {expr $S($t,LabelMatrixBase) + $S(TabulationAnnot)} result] {
                        set S($t,LabelMatrixBase) $S(TabulationAnnot)
                    } else  {
                        set S($t,LabelMatrixBase) $result
                    }
                }
                tab- {
                    if [catch {expr $S($t,LabelMatrixBase) - $S(TabulationAnnot)} result] {
                        # rien
                    } else  {
                        set S($t,LabelMatrixBase) $result
                    }
                }
            }
        }
    }
    proc IllCTabulationSet {s v} {
        global S T
        # A-list window/tree des arbres en target d'une session treedyn
        foreach {w t} [Selection::TreeTar] {
            switch -exact $s  {
                tab+ {
                    if [catch {expr $S($t,LabelMatrixBase) + $v} result] {
                        set S($t,LabelMatrixBase) $v
                    } else  {
                        set S($t,LabelMatrixBase) $result
                    }
                }
                tab- {
                    if [catch {expr $S($t,LabelMatrixBase) - $v} result] {
                        # rien
                    } else  {
                        set S($t,LabelMatrixBase) $result
                    }
                }
                tab= {
                    set S($t,LabelMatrixBase) $v
                    
                }
            }
        }
    }
    
    proc LillC360bis2 {w t leu} {
        global S ann T
        # cercle d'illustration fixer R le rayon du cercle d'illustration
        # on peut fixer une valeur pour par ex. 200 + tabulation
        # mais mieux de chercher une valeur adapt?Še ?  chaque
        # arbre
        # set R [expr 200 + $S($t,LabelMatrixBase)]
        #set co [$w bbox [list L && T$t]]
        set co [$w bbox [list Z && T$t]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set Rx [expr double(($x2 - $x1) /2.0)]
        set Ry [expr double(($y2 - $y1) /2.0)]
        if {$Rx > $Ry} {
            set R [expr $Rx + $S($t,LabelMatrixBase)]
        } else  {
            set R [expr $Ry + $S($t,LabelMatrixBase)]
        }
        set a_ref [expr double(6.28318530717958 / [llength $T($t,ue_cod)])]
        set n 0
        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
        foreach e $T($t,ue_cod) {
            set a [expr double($n*$a_ref)]
            if  {[lsearch $leu $T($t,ctl,$e)] != -1} {
                set x [expr double($R * cos($a))]
                set y [expr double($R * sin($a))]
                set l $T($t,ctl,$e)
                #set illtxt [concat " " [lindex $S(ill-car-fon) 0 ]]
                #set illfon [lrange $S(ill-car-fon) 1 end]
                set illtxt [concat " " $S(ill-car) ]
                set illfon $S(ill-fon)
                set item [$w create text $x $y \
                        -text $illtxt \
                        -anchor center  -justify center \
                        -fill $S(col) \
                        -font $illfon \
                        -tags "ILLCo?$l AnnotMatrix AM$t MA?$l T$t $tagC AMatrixCo"]
            }
            incr n
        }
        # centrage sur arbre tags root "[format "%s%s" $t C] T$t Z"
        set co [$w coords [format "%s%s" $t C]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set xcenter [expr ($x1 + $x2) /2.0]
        set ycenter [expr ($y1 + $y2) /2.0]
        $w move $tagC $xcenter $ycenter
    }
    ###
    proc LillC360bis {w t leu} {
        global S ann T
        
        #set f [expr double($R / $T($t,xmax))]
        set d $S($t,LabelMatrixBase)
        set co [$w bbox [list Z && T$t]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set C(dx) [expr abs(($x2 - $x1)) /2.0]
        set C(dy) [expr abs(($y2 - $y1)) /2.0]
        # pb il y a 4 zones de dessin en dehors de l'oval : forme phycir, phyrad etc.
        # on va donc toujours dessiner un cercle, on prend ds ce cas
        # le plus grand cote, soit dx soit dy, et on corrige x et y
        set delta [expr (abs($C(dx) - $C(dy))) / 2.0]
        if {[expr abs($x2 - $x1)] < [expr abs($y2 - $y1)]} {
            # update des x
            set x1 [expr $x1 - $delta]
            set x2 [expr $x2 + $delta]
            # update dx
            set C(dx) $C(dy)
        } {
            # update des y
            set y1 [expr $y1 - $delta]
            set y2 [expr $y2 + $delta]
            # update dy
            set C(dy) $C(dx)
        }
        $w create oval [expr $x1 -$d] [expr $y1 -$d] [expr $x2 +$d] [expr $y2 +$d] \
                -tags "T$t" -outline grey80
        
        $w create rectangle [expr $x1 -$d] [expr $y1 -$d] [expr $x2 +$d] [expr $y2 +$d] \
                -tags "T$t" -outline grey80
        
        set a_ref [expr 360.0/ [llength $T($t,ue_cod)]] ;# unit?Š d'angle
        set n 0
        foreach e  $T($t,ue_cod) {
            set C(angle,$e) [expr $n*$a_ref]
            if  { [lsearch $leu $T($t,ctl,$e)] != -1} {
                # passer ?  l'egalit?Š nom de feuilles
                # degres -> radians
                set angrad [expr (2 * acos(-1) * $C(angle,$e)) / 360.0]
                
                set x [expr ($C(dx) + $d ) * cos($angrad)]
                set y [expr ($C(dy) + $d ) * sin($angrad)]
                $w create oval [expr $x + $x1 + $C(dx) -2] [expr $y  + $y1 + $C(dy) -2] \
                        [expr $x + $x1 + $C(dx) +2] [expr $y  + $y1 + $C(dy) +2] \
                        -fill $S(col) -outline $S(col) \
                        -tags "T$t" \
                    }
            incr n
        }
        unset C
    }
    ###
    proc CreateShape {w shape x y} {
        global S
        set x [$w canvasx $x]
        set y [$w canvasy $y]
        set id [$w find closest $x $y]
        set tags [$w gettags $id]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$t != ""} {
            switch -exact $shape {
                line {
                    $w create $shape $x $y $x $y \
                            -fill $S(col) -width 1 -tags "rubbershape DRAW T$t"
                }
                rectangle - oval {
                    $w create $shape $x $y $x $y \
                            -fill $S(col) -width 1 -tags "rubbershape DRAW T$t"
                }
            }
        }
    }
    #
    proc CreateShapeFill {w shape x y} {
        global S
        set x [$w canvasx $x]
        set y [$w canvasy $y]
        set id [$w find closest $x $y]
        set tags [$w gettags $id]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$t != ""} {
            switch -exact $shape {
                line {
                    $w create $shape $x $y $x $y \
                            -outline $S(col) -width 1 -tags "rubbershape DRAW T$t"
                }
                rectangle - oval {
                    $w create $shape $x $y $x $y \
                            -outline $S(col) -width 1 -tags "rubbershape DRAW T$t"
                }
            }
        }
    }
    ###
    proc DragShape {w x y} {
        set x [$w canvasx $x]
        set y [$w canvasy $y]
        set coords [$w coords "rubbershape"]
        set coords [lreplace $coords 2 3 $x $y]
        eval $w coords "rubbershape" $coords
    }
    ###
    proc EndShape {w x y} {
        DragShape $w $x $y
        $w dtag "rubbershape"
    }
}
####################


####################
# IMPORT EXPORT
####################
namespace eval ImportExport {
    
        proc NewickParser_Root {t s} {
            global T S
            set code $t
            set n 0
            set sx 0
            #
            set T($t,xmax) 0
            set T($t,tot) 0
            set T($t,all_cod) $code
            set T($t,dbv,$code) 0
            set T($t,dbl,$code) 0
            set T($t,nwk,$code) $s
            set tp [string last ")" $s]
            set dt [string range $s 0 $tp]
            set dx [string range $s [expr $tp + 1] end]
            set id [BgBdx $dt]
            set bg [string range $dt [expr $id + 1] [expr [string length $dt] - 2]]
            set bd [string range $dt 1 [expr $id - 1]]
            lappend T($t,cbg,$n) $n
            NewickParser2 $t $bg [format "%s%s" $code  g] [expr $n + 1] $sx
            NewickParser2 $t $bd [format "%s%s" $code  d] [expr $n + 1] $sx
        }
            ###
            proc BgBdx {s} {
                set i -1
                set id -1
                foreach c [split $s {}] {
                    incr id
                    switch -exact -- $c {
                        ( {incr i}
                        ) {incr i -1}
                        , {if {$i == 0} {return $id}}
                    }
                }
                return ""
            }
        ###
        proc NewickParser2 {t s code n sx} {
            global T S
            lappend T($t,all_cod) $code
            set T($t,nwk,$code) $s
            if {[string match *,* $s]} {
                ######
                if {[TDcom::Dicho $s] == 1} {
                    set s [format "%s%s%s" ( $s ):0]
                }
                ######
                set tp [string last ")" $s]
                set dt [string range $s 0 $tp]
                set dx [string range $s [expr $tp + 1] end]
                set T($t,dbl,$code) [string range $dx [expr [string last ":" $dx] + 1] end]
                set T($t,dbv,$code) [string range $dx 0 [expr [string last ":" $dx] - 1]]
                ######
                if {[string compare [string range $dt 0 0] ( ] != 0 || \
                            [string compare [string range $dt end end] ) ] != 0} {
                    set dt [format "%s%s%s" ( $dt )]
                }
                set id [BgBdx $dt]
                set bg [string range $dt [expr $id + 1] [expr [string length $dt] - 2]]
                set bd [string range $dt 1 [expr $id - 1]]
                lappend T($t,cbg,$n) [format "%s%s" $code $n]
                NewickParser2 $t $bg [format "%s%s%s" $code $n g] [expr $n +1] [expr $sx + $T($t,dbl,$code)]
                NewickParser2 $t $bd [format "%s%s%s" $code $n d] [expr $n +1] [expr $sx + $T($t,dbl,$code)]
            } { set tp [string last ":" $s]
                set dt [string range $s 0 [expr $tp - 1]]
                set dx [string range $s [expr $tp + 1] end]
                set T($t,dbl,$code) [string range $dx [expr [string last ":" $dx] + 1] end]
                set T($t,ctl,$code) $dt
                set T($t,ltc,$dt) $code
                lappend T($t,ue_cod) $code
                lappend T($t,ue_lab) $dt
                set sx [expr $sx + $dx]
                set T($t,sox,$code) $sx
                if {$sx >= $T($t,xmax)} {set T($t,xmax) $sx}
                if {$n >= $T($t,tot)} {set T($t,tot) $n}
                return
            }
        }
    ###
    proc UpdateArrayCanvas {w t}  {
        global T S B
        ### canvas
        $w delete T$t
        ### array T
        foreach {key value} [array get T $t,*] {
            unset T($key)
        }
        ### array S
        foreach {key value} [array get S $t,*] {
            unset S($key)
        }
        # array B/BLL
        foreach bll $B($t,bll) {
            foreach key  [array names B *,$bll] {
                unset B($key)
            }
        }
        unset B($t,bll)
        # array B/SHI
        foreach shi $B($t,shi) {
            
            foreach key  [array names B *,$shi] {
                unset B($key)
            }
        }
        unset B($t,shi)
        #array B/ OVA
        foreach ova $B($t,ova) {
            foreach key  [array names B *,$ova] {
                unset B($key)
            }
        }
        #array B/ QYN
        unset B($t,ova)
        foreach qyn $B($t,qyn) {
            foreach key  [array names B *,$qyn] {
                unset B($key)
            }
        }
        unset B($t,qyn)
        #mise a jour la liste des tree   S(ilt)
        set index [lsearch -exact $S(ilt) $t]
        set S(ilt) [concat [lrange $S(ilt) 0 [expr $index - 1]] \
                [lrange $S(ilt) [expr $index + 1] end]]
        #mise a jour la liste des tree   S(w,t)
        set index [lsearch -exact $S($w,t) $t]
        set S($w,t) [concat [lrange $S($w,t) 0 [expr $index - 1]] \
                [lrange $S($w,t) [expr $index + 1] end]]
        
    }
    
}

####################

####################
# NAVIGATION
####################
namespace eval Navigation {
    
    ### FitToContents
    proc FitToContents {w} {
        global S
        $w configure -scrollregion [$w bbox all]
    }
    ###  FitToWindow
    proc FitToWindow {w t} {
        global S T
        foreach {x0 y0 x1 y1} [$w bbox all] {}
        set widw [winfo width $w]
        set heiw [winfo height $w]
        set fx [expr abs($widw. /[expr $x1 - $x0])]
        set fy [expr abs($heiw. /[expr $y1 - $y0])]
        $w scale T$t 0 0 $fx $fy
        $w configure -scrollregion [$w bbox all]
    }
    
    proc deleteDocumentAnnotationL {w} {
        global S
        foreach t $S($w,t) {$w delete AM$t}
    }
    proc deleteDocumentAnnotationN {w} {
        global S
        foreach t $S($w,t) {Interface::D3ActionTree $w $t removeallannotation}
    }
    
    proc resetDocumentVar {w  v} {
        global S
        foreach ti $S($w,t) {
            switch $v {
                tbg {Figuration::GraVarInitBgSubTree $w $ti}
                tfg {Figuration::GraVarInitFgTree $w $ti}
                tlw {Figuration::GraVarInitLineWidth $w $ti}
                tld {Figuration::GraVarInitLineDash $w $ti}
                t {
                    Figuration::GraVarInitBgSubTree $w $ti
                    Figuration::GraVarInitFgTree $w $ti
                    Figuration::GraVarInitLineWidth $w $ti
                    Figuration::GraVarInitLineDash $w $ti
                }
                lbg {Figuration::GraVarInitBgLeaf $w $ti}
                lfg {Figuration::GraVarInitFgLeaf $w $ti}
                lfo {Figuration::GraVarInitFont $w $ti}
                l {
                    Figuration::GraVarInitBgLeaf $w $ti
                    Figuration::GraVarInitFgLeaf $w $ti
                    Figuration::GraVarInitFont $w $ti
                }
                tl {
                    Figuration::GraVarInitBgSubTree $w $ti
                    Figuration::GraVarInitFgTree $w $ti
                    Figuration::GraVarInitLineWidth $w $ti
                    Figuration::GraVarInitLineDash $w $ti
                    Figuration::GraVarInitBgLeaf $w $ti
                    Figuration::GraVarInitFgLeaf $w $ti
                    Figuration::GraVarInitFont $w $ti
                }
            }
        }
    }
    proc resetTreeVar {w ti v} {
        global S
        switch $v {
            tbg {Figuration::GraVarInitBgSubTree $w $ti}
            tfg {Figuration::GraVarInitFgTree $w $ti}
            tlw {Figuration::GraVarInitLineWidth $w $ti}
            tld {Figuration::GraVarInitLineDash $w $ti}
            t {
                Figuration::GraVarInitBgSubTree $w $ti
                Figuration::GraVarInitFgTree $w $ti
                Figuration::GraVarInitLineWidth $w $ti
                Figuration::GraVarInitLineDash $w $ti
            }
            lbg {Figuration::GraVarInitBgLeaf $w $ti}
            lfg {Figuration::GraVarInitFgLeaf $w $ti}
            lfo {Figuration::GraVarInitFont $w $ti}
            l {
                Figuration::GraVarInitBgLeaf $w $ti
                Figuration::GraVarInitFgLeaf $w $ti
                Figuration::GraVarInitFont $w $ti
            }
            tl {
                Figuration::GraVarInitBgSubTree $w $ti
                Figuration::GraVarInitFgTree $w $ti
                Figuration::GraVarInitLineWidth $w $ti
                Figuration::GraVarInitLineDash $w $ti
                Figuration::GraVarInitBgLeaf $w $ti
                Figuration::GraVarInitFgLeaf $w $ti
                Figuration::GraVarInitFont $w $ti
            }
        }
    }
    proc resetNodeVar {w ti n v} {
        global S
        switch $v {
            tbg {Figuration::GraVarInitBgSubTree $w $ti $n}
            tfg {Figuration::GraVarInitFgTree $w $ti $n}
            tlw {Figuration::GraVarInitLineWidth $w $ti $n}
            tld {Figuration::GraVarInitLineDash $w $ti $n}
            t {
                Figuration::GraVarInitBgSubTree $w $ti $n
                Figuration::GraVarInitFgTree $w $ti $n
                Figuration::GraVarInitLineWidth $w $ti $n
                Figuration::GraVarInitLineDash $w $ti $n
            }
            lbg {Figuration::GraVarInitBgLeaf $w $ti $n}
            lfg {Figuration::GraVarInitFgLeaf $w $ti $n}
            lfo {Figuration::GraVarInitFont $w $ti $n}
            l {
                Figuration::GraVarInitBgLeaf $w $ti $n
                Figuration::GraVarInitFgLeaf $w $ti $n
                Figuration::GraVarInitFont $w $ti $n
            }
            tl {
                Figuration::GraVarInitBgSubTree $w $ti $n
                Figuration::GraVarInitFgTree $w $ti $n
                Figuration::GraVarInitLineWidth $w $ti $n
                Figuration::GraVarInitLineDash $w $ti $n
                Figuration::GraVarInitBgLeaf $w $ti $n
                Figuration::GraVarInitFgLeaf $w $ti $n
                Figuration::GraVarInitFont $w $ti $n
            }
        }
    }
    
    #
    proc CoPaCollectionCreateInsert {w t n} {
        global S T
        # si aucune collection
        # le [Tools::GenId] est l'ID de la collection
        set IDcollection [Tools::GenId]
        # S(collection) est la liste des ID collections
        lappend S(collection) $IDcollection
        # creation de la fenetre de collection
        set collection [ImportExport::NewCanvas]
        #chaque ID collection reference la path window correspondant
        set S(collection,$IDcollection) $collection
        # ...final, copy paste
        Navigation::CoPaCollectionInsert $w $t $n $IDcollection
    }
    #
    proc CoPaCollectionInsert {wsource tsource nodesource IDcollection} {
        global S T
        set wtarget $S(collection,$IDcollection)
        set t [expr [lrange  [lsort  -integer -increasing $S(ilt)] end end] + 1]
        lappend S(ilt) $t
        lappend S($wtarget,t) $t
        set code $t
        set data $T($tsource,nwk,$nodesource)
        set T($t,nwk) $data
        ImportExport::TreeInit $t
        if {[catch [ImportExport::NewickParser_Root $t $data] result] != 0} {
            ImportExport::CleanArrayTree $t
        }  else {
            set T($t,xmax) $T($tsource,xmax)
            set S($t,w) $wtarget
            set S($t,tit) -
            set S($t,type) $S($tsource,type)
            Conformation::ArrToCanType2 $t $wtarget
            ImportExport::NodeBind $wtarget $t
            Figuration::TransitionVG $wtarget $tsource $nodesource $t
            Figuration::RestaureT $wtarget $t
            Operation::TreeViewerPanelUpdate
        }
    }
    
    # organisation des arbres d'un canvas en rows columns
    proc Reorganize {w {c ?} {r ?}} {
        global S
        set heMAX 0
        set wiMAX 0
        if {$S($w,BIcol) == "?"} {set S($w,BIcol) 3}
        if {$S($w,BIrow) == "?"} {set S($w,BIrow) [expr round(0.5 + ([llength $S($w,t)]/3))]  }
        if {$c == "?"} { set c $S($w,BIcol)}
        if {$r == "?"} { set r $S($w,BIrow)}
        #
        foreach ti $S($w,t) {
            # NON [$w bbox [list Z && T$ti]] (prise en compte taille des feuilles)
            set coords [$w bbox T$ti]
            set wi [expr abs([lindex $coords 0] - [lindex $coords 2])]
            if {$wi >= $wiMAX} {set wiMAX $wi}
            set he [expr abs([lindex $coords 1] - [lindex $coords 3])]
            if {$he >= $heMAX} {set heMAX $he}
        }
        set n [llength $S($w,t)]
        set index -1
        for  {set i 0} {$i < $r} {incr i} {
            for  {set j 0} {$j < $c} {incr j} {
                incr index
                if {$index < $n} {
                    set ti [lindex $S($w,t) $index]
                    # attention le move ajoute, donc remettre a zero avant
                    set coords [$w bbox T$ti]
                    set x [lindex $coords 0]
                    set y [lindex $coords 1]
                    $w move T$ti [expr  0 - $x] [expr  0 - $y]
                    set px [expr $j * $wiMAX]
                    set py [expr $i * $heMAX]
                    $w move T$ti $px $py
                }
            }
        }
        Navigation::FitToContents $w
    }
    
    
    # proc associ?Še a un return sur les entry hauteur/largeur , main panel, onglet navigation
    proc ResizeAuto {} {
        # retourne la A-liste $windows $tree pour tous les tree en target d'une session treedyn
        set Alist     [Selection::TreeTar]
        foreach {wi ti} $Alist {
            Navigation::ResizeOneGo $wi $ti
            Figuration::RestaureT $wi $ti
        }
    }
    #
    
    proc ResizeOneGo  {w t} {
        global S
        set co [$w bbox T$t]
        set x [lindex $co 0]
        set y [lindex $co 1]
        Conformation::ArrToCanType3 $t $w $x $y $S(newW) $S(newH)
        Figuration::RestaureT $w $t
    }
}
####################


####################
# ANNOTATION
####################
namespace eval Annotation {
    
    #
    proc  HTTPPanel {} {
        global S
        set S(httpref) ?
        
        toplevel .annothttp
        wm title .annothttp {W3}
        # frame control
        set f [frame .annothttp.control ]
        #
        # boxlist url
        iwidgets::combobox $f.combourl -width 12 -labeltext "URL:"
        foreach e [list "http://pbil.univ-lyon1.fr/cgi-bin/acnuc-search-ac?query="] {
            $f.combourl insert list end $e
        }
        $f.combourl selection set "http://pbil.univ-lyon1.fr/cgi-bin/acnuc-search-ac?query="
        # Entry reference gene/pr etc
        iwidgets::entryfield $f.ref  -textvariable S(httpref) -labeltext "Ref:" -command Annotation::AnnotHttp2
        # boxlist database
        iwidgets::combobox $f.combo -labeltext "Database:" -selectioncommand Annotation::AnnotHttp2
        foreach e [list GenBank EMBL EMGLib NRSub SwissProt NBRF "Hobacgen nucl." \
                "Hobacgen prot." "Hovergen nucl." "Hovergen prot." "RTKdb nucl." "RTKdb prot." \
                "HoGenome nucl." "HoGenome prot." "Hovergen Clean nucl." "Hovergen Clean prot." \
                "HAMAP nucl." "HAMAP prot." "MitALib prot." "MitALib nucl." "Hoppsigen Nurebase nucl." \
                "Nurebase prot." "TestForm prot." "TestForm nucl."] {
                    $f.combo insert list end $e
                }
        $f.combo selection set GenBank
        # browser
        set htm [optcl::new -window .annothttp.htm Shell.Explorer.2] ;# MSIE ActiveX Control
        set S(navigator) $htm
        .annothttp.htm config -width 500 -height 400
        #
        grid $f.combourl -row 0 -column 0 -columnspan 2 -sticky news
        grid $f.combo -row 1 -column 0 -sticky news
        grid $f.ref -row 1 -column 1 -sticky news
        grid $f -row 0 -column 0 -sticky news
        grid .annothttp.htm -row 1 -column 0 -sticky news
        grid rowconfigure .annothttp 1 -weight 1
        grid columnconfigure .annothttp 0 -weight 1
    }
    #
    proc AnnotHttp {w x y} {
        global S T
        set unit [$w itemcget current -text]
        if {$unit != ""} {
            if {[winfo exists .annothttp] == 0 }  {HTTPPanel}
            set S(httpref) $unit
            set url [.annothttp.control.combourl getcurselection]
            append url $unit
            append url "&db="
            append url [.annothttp.control.combo getcurselection]
            $S(navigator) navigate $url
        }
    }
    #
    proc AnnotHttp2 {} {
        global S T
        set unit $S(httpref)
        if {$unit != "" && $unit != "?"} {
            if {[winfo exists .annothttp] == 0 }  {HTTPPanel}
            set url [.annothttp.control.combourl getcurselection]
            append url $unit
            append url "&db="
            append url [.annothttp.control.combo getcurselection]
            $S(navigator) navigate $url
        }
    }
    #
    # .ann.l.lfa.l
    proc MatrixAnnotateGo {} {
        global S ann T
        set lv {}
        set lindex [.ann.l.lfa.l curselection]
        foreach i $lindex {
            lappend lv [.ann.l.lfa.l get $i]
        }
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        MatrixAnnotateGoGo $lv $ltreetarget
    }
    proc MatrixColorsAnnotateGo {} {
        global S ann T
        set lv {}
        set lindex [.ann.l.lfa.l curselection]
        foreach i $lindex {
            lappend lv [.ann.l.lfa.l get $i]
        }
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        MatrixColorsAnnotateGoGo $lv $ltreetarget
        
    }
    #
    proc MatrixAnnotateGoGo {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            set w $S($ti,w)
            set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
            set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
            set XMAX3 [lindex [$w bbox [list T$ti && AnnotMatrix]] 2]
            if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
            if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
            if [catch {expr $S($ti,LabelMatrixBase) + 7} result] {
                set S($ti,LabelMatrixBase) 7
            } else  {
                set S($ti,LabelMatrixBase) $result
            }
            #set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
            #set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
            #if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    set x [expr $XMAX + $S($ti,LabelMatrixBase)]
                    set colnumber 0
                    foreach var $lv {
                        incr colnumber 1
                        incr x $ann(binmatPadding)
                        set dx [expr $ann(binmatWidth) / 2]
                        set dy [expr $ann(binmatHeight) / 2]
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        if {$ann(binmatColumnsNumber) == 1} {
                            set spliNB 0
                            foreach lettre [split $colnumber {}] {
                                set ycolumns [lindex [$w bbox [list T$ti && Z]] 1]
                                $w create text $x [expr $ycolumns - 10 - $spliNB] -text $lettre \
                                        -fill black -tags "T$ti AnnotMatrix"
                                incr spliNB 8
                            }
                        }
                        foreach l $T($ti,ue_lab) {
                            # recherche y
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            if {$item == ""} {
                                set items [$w find withtag [list ADD?$l && T$ti]]
                                set y 0
                                foreach ii $items {
                                    set yii [lindex [$w coords $ii] 1]
                                    if {$yii >= $y} {
                                        set y $yii
                                    }
                                }
                            } else  {
                                set co [$w coords $item]
                                set y [lindex $co 1]
                            }
                            # construction de itemtext sur query
                            # attention si des feuilles ds l'arbre mais absentes du fichier de labels !
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            if {$val == "1"} {
                                                set color $ann(binmatColor1)
                                            } else  {
                                                set color $ann(binmatColor0)
                                            }
                                        }
                                    }
                                }
                                # coordonnees
                                if {$ann(binmatOutline) == 0} {
                                    $w create rectangle [expr $x-$dx] [expr $y-$dy] [expr $x+$dx] [expr $y+$dy] \
                                            -fill $color -outline $color  \
                                            -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo NBC$colnumber"
                                } else  {
                                    $w create rectangle [expr $x-$dx] [expr $y-$dy] [expr $x+$dx] [expr $y+$dy] \
                                            -fill $color -outline black  \
                                            -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo NBC$colnumber"
                                }
                            }
                        }
                    }
                    Navigation::FitToContents $w
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    #
    proc MatrixColorsAnnotateGoGo {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            set w $S($ti,w)
            set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
            set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
            set XMAX3 [lindex [$w bbox [list T$ti && AnnotMatrix]] 2]
            if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
            if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
            if [catch {expr $S($ti,LabelMatrixBase) + 7} result] {
                set S($ti,LabelMatrixBase) 7
            } else  {
                set S($ti,LabelMatrixBase) $result
            }
            #set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
            #set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
            #if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    set x [expr $XMAX + $S($ti,LabelMatrixBase)]
                    set colnumber 0
                    foreach var $lv {
                        incr colnumber 1
                        incr x $ann(binmatPadding)
                        set dx [expr $ann(binmatWidth) / 2]
                        set dy [expr $ann(binmatHeight) / 2]
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        if {$ann(binmatColumnsNumber) == 1} {
                            set spliNB 0
                            foreach lettre [split $colnumber {}] {
                                set ycolumns [lindex [$w bbox [list T$ti && Z]] 1]
                                $w create text $x [expr $ycolumns - 10 - $spliNB] -text $lettre \
                                        -fill black -tags "T$ti AnnotMatrix"
                                incr spliNB 8
                            }
                        }
                        foreach l $T($ti,ue_lab) {
                            # recherche y
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            if {$item == ""} {
                                set items [$w find withtag [list ADD?$l && T$ti]]
                                set y 0
                                foreach ii $items {
                                    set yii [lindex [$w coords $ii] 1]
                                    if {$yii >= $y} {
                                        set y $yii
                                    }
                                }
                            } else  {
                                set co [$w coords $item]
                                set y [lindex $co 1]
                            }
                            # construction de itemtext sur query
                            # attention si des feuilles ds l'arbre mais absentes du fichier de labels !
                            set records  [Database::dbQueryRecordsFromVarVal $database EU $l]
                            if {$records == {}} {
                                $w create text [expr $x-$dx+1] [expr $y-$dy+1] -text - \
                                        -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC  AMatrixCo NBC$colnumber"
                            } elseif {[llength $records] >= 2} {
                                $w create text [expr $x-$dx+1] [expr $y-$dy+1] -text * \
                                        -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC  AMatrixCo NBC$colnumber"
                            } else  {
                                set record [lindex $records 0]
                                foreach {vari val} $X($record) {
                                    
                                    if {[string equal $var $vari] == 1}  {
                                        
                                        set rgb [split $val ,]
                                        set r [lindex $rgb 0]
                                        set g [lindex $rgb 1]
                                        set b [lindex $rgb 2]
                                        puts RGB****$rgb
                                        puts R***$r
                                        puts G***$g
                                        puts B***$b
                                        set color [format "#%.2x%.2x%.2x" $r $g $b ]
                                        puts color***$color
                                        $w create rectangle [expr $x-$dx] [expr $y-$dy] [expr $x+$dx] [expr $y+$dy] \
                                                -fill $color -outline $color  \
                                                -tags "T$ti AnnotMatrix AM$ti BIN?$$val MA?$l $tagC  AMatrixCo NBC$colnumber"
                                    }
                                }
                                
                            }
                        }
                    }
                    Navigation::FitToContents $w
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    
    proc DrawAnnotateGo {} {
    }
    
    
    # ls : listbox source ; lt listbox target
    proc AnnotateAddItem {ls lt} {
        global S
        if {$S(database) != ""} {
            set lindexvariables [$ls curselection] ;# des index
            foreach index $lindexvariables {
                set variable [$ls get $index]
                $ls itemconfigure $index -background NavajoWhite2
                set lvalues [Database::dbQueryValFromVar $S(database) $variable]
                foreach value [lsort -dictionary $lvalues] {
                    $lt insert end [format "%s%s%s%s%s" $value < $variable < $S(database)]
                }
            }
        }
    }
    proc AnnotateQuit {} {
        set choix [tk_messageBox -type okcancel -default ok  \
                -message "Exit Annotation Browser ?" -icon question]
        if {$choix == "ok"} {
            eval destroy .annotation
        }
    }

    #
    proc AnnotateLabelsFileSwitch {m} {
        global S
        set select [$m get]
        switch -exact $select {
            "?" {puts Default}
            default {set S(database) $select}
        }
        # mise a jour listbox des variables
        set lvar [Database::dbQueryVarAll $S(database)]
        # remplissage listbox
        .annotation.p.pane0.childsite.n.canvas.notebook.cs.page1.cs.lfa.l delete 0 end
        eval {.annotation.p.pane0.childsite.n.canvas.notebook.cs.page1.cs.lfa.l insert end} $lvar
    }
    
    #
    proc SwitchCol0 {w} {
        global S ann
        $w configure -background $S(col)
        set ann(binmatColor0) $S(col)
    }
    #
    proc SwitchCol1 {w} {
        global S ann
        $w configure -background $S(col)
        set ann(binmatColor1) $S(col)
    }
    #
    proc ANmoveMatrix {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set S(mox) $x
            set S(moy) $y
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                # motion sur AM$t
                set i  [lindex $tags [lsearch -glob $tags T*]]
                set t [string range $i 1 end]
                bind movematrix <B1-Motion> "Annotation::ANmoveMotion %W %x %y AM$t"
            }
        }
    }
    #
    proc ANmoveCOL {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set S(mox) $x
            set S(moy) $y
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                bind movecol <B1-Motion> "Annotation::ANmoveMotion %W %x %y $tag"
            }
        }
    }
    #
    proc ANmoveMotion {w x y tag} {
        global S T
        $w move $tag [expr $x - $S(mox)] 0
        #$w move $tag [expr $x - $S(mox)] [expr $y - $S(moy)]
        set S(mox) $x
        set S(moy) $y
    }
    proc ANannfgcol {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                $w itemconfigure $tag -fill $S(col)
            }
        }
    }
    proc ANannfgrow {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags MA?*]]
                catch {$w itemconfigure $tag -fill $S(col)}
            }
        }
    }
    proc ANannfocol {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            if {[$w type $id] == "text"} {
                set tags [$w gettags $id]
                if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                    set tag [lindex $tags [lsearch -glob $tags COL?*]]
                    set li [$w find withtag $tag]
                    foreach i $li {
                        if {[$w type $i] == "text"} {
                            $w itemconfigure $i -font $S(gfo)}
                    }
                    
                }
            }
        }
    }
    proc ANannRowCol {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                set lid [$w find withtag $tag]
                foreach i $lid {
                    set co [$w coords $i]
                    #set x [$w canvasx [lindex $co 0]] ; set y [$w canvasy [lindex $co 1]]
                    set x [lindex $co 0] ; set y [lindex $co 1]
                    set text [lindex [$w itemconfigure $i -text] end]
                    if {$text != "" && $text != " -"} {
                        set id [format "%s%s" 1 [Tools::GenId]]
                        set idtext [format "%s%s%s" anntext ? $id]
                        set idlink [format "%s%s%s" annlink ? $id]
                        set  font [lindex [$w itemconfigure $i -font] end]
                        set color [lindex [$w itemconfigure $i -fill] end]
                        $w delete $i
                        regsub -all " " $text "\n" newtext
                        set newtext [string trimleft $newtext "\n"]
                        # -stipple @[file join + stipple $S(stipple)]
                        $w create oval [expr $x -3] [expr $y - 3] [expr $x + 3] [expr $y + 3] \
                                -fill black -outline black -tags $tags
                        $w create text [expr $x + 30 ]  $y   \
                                -text $newtext  -anchor nw  \
                                -tags "bullann $idtext $tags" -font $font -fill $color
                        #
                        $w create line  $x $y [expr $x + 30 ]  $y  \
                                -width 1 -fill $color -tags "Link $idlink $tags"
                    } else  {
                        $w delete i
                    }
                }
            }
        }
        $w bind bullann <Button-1> {Annotation::ANmovebullann %W %x %y}
    }
    proc ANmovebullann {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set S(mox) $x
            set S(moy) $y
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags bullann] != -1} {
                set tag [lindex $tags [lsearch -glob $tags anntext?*]]
                $w bind bullann <B1-Motion> "Annotation::ANmotionbullann %W %x %y $tag"
            }
        }
    }
    #
    proc ANmotionbullann {w x y tag} {
        global S T
        # move du text
        $w move $tag [expr $x - $S(mox)] [expr $y - $S(moy)]
        # delete et reconstruction du lien
        set taglink [format "%s%s%s" annlink ? [string trimleft $tag anntext? ]]
        set co [$w coords $taglink]
        set xl [lindex $co 0] ; set yl [lindex $co 1]
        set tags [$w gettags $taglink]
        set color [lindex [$w itemconfigure $taglink -fill] end]
        $w delete $taglink
        set idc [$w create line  $xl $yl [$w canvasx $x] [$w canvasy $y]  \
                -width 1 -fill $color -tags "Link $taglink $tags"]
        $w lower $idc
        # ok
        set S(mox) $x
        set S(moy) $y
    }
    proc ANannillcol {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                $w itemconfigure $tag -font $S(ill-fon)
            }
        }
    }
    proc ANannillcar {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                $w itemconfigure $tag -text $S(ill-car) -font $S(ill-fon)
            }
        }
    }
    
    proc ANannforow {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags MA?*]]
                $w itemconfigure $tag -font $S(gfo)
            }
        }
    }
    proc ANannanchw {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                $w itemconfigure $tag -anchor w
            }
        }
    }
    proc ANannanche {w x y} {
        global S
        set id [$w find withtag current]
        if  {$id == ""} {set id [$w find closest $x $y]}
        if  {$id != ""} {
            set tags [$w gettags $id]
            if  {[lsearch -exact $tags AnnotMatrix] != -1} {
                set tag [lindex $tags [lsearch -glob $tags COL?*]]
                $w itemconfigure $tag -anchor e
            }
        }
    }
    #
    proc AnnotationPanelUpdate {} {
        global S
        set m .ann.l.m
        if {[winfo exists .ann] == "1"} {
            $m delete 0 end
            foreach lf $S(ldatabase) {$m insert end $lf}
            $m select end
            ANVariablesUpdate
        }
    }
    #
    proc ANLabelsFileSwitch {m} {
        global S
        set select [$m get]
        switch -exact $select {
            "?" {puts Default}
            default {set S(database) $select}
        }
        ANVariablesUpdate
        #pour l'instant
        #.ann.l.lfb.l delete 0 end
    }
    # mise a jour liste des variables pour le fichier de label courant
    proc ANVariablesUpdate {} {
        global S
        # liste des variables
        set lvar [Database::dbQueryVarAll $S(database)]
        # remplissage listbox
        .ann.l.lfa.l delete 0 end
        eval {.ann.l.lfa.l insert end} $lvar
        # reconfiguration background des feuilles de la listbox
        # pour celles deja en selection
        # if {[.ann.l.lfb.l get 0 end] != {}} {ANConfigBg}
    }
    # config bg si deja en selection
    proc ANConfigBg {} {
        global S
        set li {}
        set lni {}
        set lavailable [.ann.l.lfa.l get 0 end] ;# var available
        set selectL [.ann.l.lfb.l get 0 end] ;# feuilles en selection
        foreach e $lavailable {
            set r [lsearch $selectL $e]
            set index [lsearch $lavailable $e]
            if {$r != -1} {
                .ann.l.lfa.l itemconfigure $index -background NavajoWhite2
            } else {
                .ann.l.lfa.l itemconfigure $index -background LightGoldenrodYellow
            }
        }
    }
    #
    proc ANaddVarMouse {listbox x y} {
        global S abs
        set leaf [$listbox get @$x,$y]
        set selectL [.ann.l.lfb.l get 0 end]
        if {[lsearch $selectL $leaf] == -1}  {
            .ann.l.lfb.l insert end $leaf
        }
        .ann.l.lfa.l selection clear @$x,$y
        ANConfigBg
    }
    # boutton ajout de la selection leave available dans la liste selection
    proc ANAddL {} {
        global S abs
        # mise a jour listbox fichiers selection
        # on conserve l'ordre des groupes de selection
        set li [.ann.l.lfa.l curselection] ;# des index
        set lsel {}
        foreach i $li {
            lappend lsel [.ann.l.lfa.l get $i]
            .ann.l.lfa.l itemconfigure $i -background NavajoWhite2
        }
        set lall2 [.ann.l.lfb.l get 0 end]
        .ann.l.lfb.l delete 0 end
        # c moche je sais
        foreach e $lsel {
            lappend lall2 $e
        }
        #
        foreach e [Tools::DelRep $lall2] {
            .ann.l.lfb.l insert 0 $e
        }
        # deselection des fichiers liste available
        .ann.l.lfa.l selection clear 0 end
        # update nb de tree total
    }
    #
    proc ANRemL {} {
        global abs
        # attention retrait a partir de l'index le plus bat
        # le delete remet a jour les index
        set li [lsort -decreasing [.ann.l.lfb.l curselection]] ;# des index
        foreach i $li {
            .ann.l.lfb.l delete $i
        }
        # deselection des fichiers liste available
        .ann.l.lfa.l selection clear 0 end
        ANConfigBg
    }
    #
    proc ANremVarMouse {listbox x y} {
        global S abs
        $listbox delete @$x,$y
        ANConfigBg
    }
    
    # Query Leaves Annotation Mode Leave
    proc qLannL {w t leu} {
        global S ann T
        # tag de colonne
        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
        foreach l $leu {
            set i [$w find withtag [list ADD?$l && T$t]]
            if {$i == ""} {
                set i [$w find withtag [list [format "%s%s" EU  $l] && T$t]]
                set co [$w coords $i]
                set y [lindex $co 1]
                set i2 [$w find withtag [list [format "%s%s" EUL  $l] && T$t]]
                
                if {[$w itemcget $i2 -state] == "hidden"} {
                    set x [lindex [$w bbox $i] 2]
                } else  {
                    set x [lindex [$w bbox $i2] 2]
                }
                
            } else  {
                set co [$w coords [lindex $i 0]]
                set y [expr [lindex $co 1] + 6]
                set x 0
                foreach ii $i {
                    set xii [lindex [$w bbox $ii] 2]
                    if {$xii >= $x} {
                        set x $xii
                    }
                }
            }
            #
            if {$x != "" && $y != ""} {
                if {$S(DisplayVOV) == 0} {set sss [lrange $S(query) 2 end]}
                set lc [split $sss {}]
                set nbc [llength $lc]
                if  {[expr $nbc / 2 * 2] == $nbc} {
                    set s $sss
                } else  {
                    set s " $sss"
                }
                
                $w create text $x $y -text $s \
                        -font $S(gfo) \
                        -fill $S(col) \
                        -anchor center  -justify center \
                        -tags "ADD?$l T$t  AnnotMatrix $tagC AM$t MA?$l" -anchor w
            }
            
        }
    }
    #
    proc qLannC {w t leu} {
        global S ann T
        switch -exact $S($t,type) {
            PhyNJ - ClaSla - ClaRec {
                # recherche x
                if {$S(illustration-tabulation) == 1} {
                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                    set XMAX3 [lindex [$w bbox [list T$t && AnnotMatrix]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                } else  {
                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                }
                
                # tag de colonne
                set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                foreach l $leu {
                    # recherche y (code arrete terminale)
                    set item [$w find withtag [list [format "%s%s" EU  $l ] && T$t]]
                    if {$item != ""} {
                        set co [$w coords $item]
                        set y [lindex $co 1]
                        # avoir un nombre pair de caractere pour bien centrer
                        # sinon on ajoute devant un espace
                        #if {$S(DisplayVOV) == 0} {set sss [lrange $S(query) 2 end]}
                        if {$S(DisplayVOV) == 0} {set sss $S(query)}
                        set lc [split $sss {}]
                        set nbc [llength $lc]
                        if  {[expr $nbc / 2 * 2] == $nbc} {
                            set s $sss
                        } else  {
                            set s " $sss"
                        }
                        $w create text $x $y  \
                                -text  $s \
                                -fill $S(col) \
                                -font $S(gfo) \
                                -anchor w  -justify center \
                                -tags "T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"
                    }
                }
            }
            PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                qLannC360 $w $t $leu
            }
            ClaCir1 - ClaCir2 - ClaCir3 {
                qLannC360 $w $t $leu
            }
        }
    }
    ###
    proc qLannC360old {w t leu} {
        global S ann T
        #puts coucou
        set d $S($t,LabelMatrixBase)
        #set co [$w bbox [list Z && T$t]]
        set co [$w bbox [list L && T$t]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set C(dx) [expr abs(($x2 - $x1)) /2.0]
        set C(dy) [expr abs(($y2 - $y1)) /2.0]
        
        # test pour eviter l'oval
        #if {$C(dx) >= $C(dy)} {set C(dy) $C(dx)}  {set C(dx) $C(dy)}
        set R [expr 200 + $S($t,LabelMatrixBase)]
        
        
        set a_ref [expr 360.0/ [llength $T($t,ue_cod)]] ;# unit?Š d'angle
        set n 0
        # tag de colonne
        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
        # inversion de la liste des eus
        if { $S($t,type) == "ClaCir2"} {
            set LLE {}
            foreach e $T($t,ue_cod) {
                set LLE [concat $e $LLE]
            }
            set n 1
        } else  {
            set LLE $T($t,ue_cod)
        }
        # l?Šger d?Šcalage du a anchor/justify si l'annotation a un seul caractere
        # on ajoute a l'avant un espace
        foreach e $LLE {
            set C(angle,$e) [expr $n*$a_ref]
            if  {[lsearch $leu $T($t,ctl,$e)] != -1} {
                # degres -> radians
                set angrad [expr (2 * acos(-1) * $C(angle,$e)) / 360.0]
                # d est l'augmentation du rayon du cercle
                set x [expr ($C(dx) + $d ) * cos($angrad)]
                set y [expr ($C(dy) + $d ) * sin($angrad)]
                
                set l $T($t,ctl,$e)
                # query
                if {$S(DisplayVOV) == 0} {set sss [lrange $S(query) 2 end]}
                # avoir un nombre pair de caractere pour bien centrer
                # sinon on ajoute devant un espace
                set lc [split $sss {}]
                set nbc [llength $lc]
                if  {[expr $nbc / 2 * 2] == $nbc} {
                    set s $sss
                } else  {
                    set s " $sss"
                }
                $w create text [expr $x + $x1 + $C(dx)] [expr $y  + $y1 + $C(dy)] \
                        -text $s \
                        -anchor center  -justify center \
                        -fill $S(col) \
                        -font $S(gfo) \
                        -tags "ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"
            }
            incr n
        }
        unset C
    }
    # NB pb si les feuilles de sont pas affich?Šes
    # en plus attention en circulaire sans longueur de branche
    # il
    proc qLannC360 {w t leu} {
        global S ann T
        # cercle d'illustration fixer R le rayon du cercle d'illustration
        # on peut fixer une valeur pour par ex. 200 + tabulation
        # mais mieux de chercher une valeur adapt?Še ?  chaque
        # arbre
        # set R [expr 200 + $S($t,LabelMatrixBase)]
        set co [$w bbox [list L && T$t]]
        # si les feuilles ne sont pas affich?Šes on prend les arretes terminales
        set co [$w bbox [list Z && T$t]]
        # et si on utillisait toujours sur Z ?
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set Rx [expr ($x2 - $x1) /2.0]
        set Ry [expr ($y2 - $y1) /2.0]
        if {$Rx > $Ry} {
            set R [expr $Rx + $S($t,LabelMatrixBase)]
        } else  {
            set R [expr $Ry + $S($t,LabelMatrixBase)]
        }
        set a_ref [expr 6.28318530717958 / [llength $T($t,ue_cod)]]
        set n 0
        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
        # inversion ordre liste feuilles selon conformation
        if { $S($t,type) == "ClaCir2"} {
            set LLE {}
            foreach e $T($t,ue_cod) {
                set LLE [concat $e $LLE]
            }
            set n 1
        } else  {
            set LLE $T($t,ue_cod)
        }
        # l?Šger d?Šcalage du a anchor/justify si l'annotation a un seul caractere
        # ou nombre impair, on ajoute a l'avant un espace
        foreach e $LLE {
            set a [expr double($n*$a_ref)]
            if  {[lsearch $leu $T($t,ctl,$e)] != -1} {
                set x [expr $R * cos($a)]
                set y [expr $R * sin($a)]
                # TAG
                set l $T($t,ctl,$e)
                # query
                if {$S(DisplayVOV) == 0} {set sss [lrange $S(query) 2 end]}
                # avoir un nombre pair de caractere pour bien centrer
                # sinon on ajoute devant un espace
                set lc [split $sss {}]
                set nbc [llength $lc]
                if  {[expr $nbc / 2 * 2] == $nbc} {
                    set s $sss
                } else  {
                    set s " $sss"
                }
                $w create text $x $y \
                        -text $s \
                        -anchor center  -justify center \
                        -fill $S(col) \
                        -font $S(gfo) \
                        -tags "ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"
            }
            incr n
        }
        # centrage sur arbre tags root "[format "%s%s" $t C] T$t Z"
        set co [$w coords [format "%s%s" $t C]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set xcenter [expr ($x1 + $x2) /2.0]
        set ycenter [expr ($y1 + $y2) /2.0]
        $w move $tagC $xcenter $ycenter
    }
    # Leaves Annotation Mode Leave
    proc LannLtoolbox {w x y} {
        global T
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set p [format "%s%s" $n *]
            set leu {}
            foreach e $T($t,ue_cod) {
                if {[string match $p $e] == 1} {
                    lappend leu $T($t,ctl,$e)
                }
            }
            LannL $w $t $leu
        }
    }
    #
    proc LannL {w t leu} {
        global S ann T
        switch -exact $S($t,type) {
            PhyNJ - ClaSla - ClaRec {
                # tag de colonne
                set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                foreach l $leu {
                    set i [$w find withtag [list ADD?$l && T$t]]
                    if {$i == ""} {
                        set i [$w find withtag [list [format "%s%s" EU  $l] && T$t]]
                        set co [$w coords $i]
                        set y [lindex $co 1]
                        set i2 [$w find withtag [list [format "%s%s" EUL  $l] && T$t]]
                        
                        if {[$w itemcget $i2 -state] == "hidden"} {
                            set x [lindex [$w bbox $i] 2]
                        } else  {
                            set x [lindex [$w bbox $i2] 2]
                        }
                        
                    } else  {
                        set co [$w coords [lindex $i 0]]
                        set y [lindex $co 1]
                        set x 0
                        foreach ii $i {
                            set xii [lindex [$w bbox $ii] 2]
                            if {$xii >= $x} {
                                set x $xii
                            }
                        }
                    }
                    if {$x != "" && $y != ""} {
                        # avoir un nombre pair de caractere pour bien centrer
                        # sinon on ajoute devant un espace
                        set lc [split $S(AnnotateNote) {}]
                        set nbc [llength $lc]
                        if  {[expr $nbc / 2 * 2] == $nbc} {
                            set s $S(AnnotateNote)
                        } else  {
                            set s " $S(AnnotateNote)"
                        }
                        $w create text $x $y -text $s \
                                -font $S(gfo) \
                                -fill $S(col) \
                                -anchor center  -justify center \
                                -tags "ADD?$l T$t $tagC AnnotMatrix AM$t MA?$l" -anchor w
                    }
                }
                
            }
            PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                # rien pour l'instant
            }
            ClaCir1 - ClaCir2 - ClaCir3 {
                # pour l'instant on reste sur LannC360 mais il faudra
                # passer par une proc LannL360
                LannC360 $w $t $leu
            }
        }
    }
    # AnnotMatrix AM$t MA?$l
    proc LannCtoolbox {w x y} {
        global T
        set tags [$w gettags [$w find withtag current]]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set p [format "%s%s" $n *]
            set leu {}
            foreach e $T($t,ue_cod) {
                if {[string match $p $e] == 1} {
                    lappend leu $T($t,ctl,$e)
                }
            }
            LannC $w $t $leu
        }
    }
    #
    proc LannC {w t leu} {
        global S ann T
        switch -exact $S($t,type) {
            PhyNJ - ClaSla - ClaRec {
                # recherche x
                if {$S(illustration-tabulation) == 1} {
                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                    set XMAX3 [lindex [$w bbox [list T$t && AnnotMatrix]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                } else  {
                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                }
                
                # tag de colonne
                set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                foreach l $leu {
                    # recherche y (code arrete terminale)
                    set item [$w find withtag [list [format "%s%s" EU  $l ] && T$t]]
                    if {$item != ""} {
                        set co [$w coords $item]
                        set y [lindex $co 1]
                        # avoir un nombre pair de caractere pour bien centrer
                        # sinon on ajoute devant un espace
                        set lc [split $S(AnnotateNote) {}]
                        set nbc [llength $lc]
                        if  {[expr $nbc / 2 * 2] == $nbc} {
                            set s $S(AnnotateNote)
                        } else  {
                            set s " $S(AnnotateNote)"
                        }
                        $w create text $x $y  \
                                -text  $s \
                                -fill $S(col) \
                                -font $S(gfo) \
                                -anchor center  -justify center \
                                -tags "T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"
                    }
                }
            }
            PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                LannC360 $w $t $leu
            }
            ClaCir1 - ClaCir2 - ClaCir3 {
                LannC360 $w $t $leu
            }
        }
    }
    ###
    proc LannC360 {w t leu} {
        global S ann T
        # cercle d'illustration fixer R le rayon du cercle d'illustration
        # on peut fixer une valeur pour par ex. 200 + tabulation
        # mais mieux de chercher une valeur adapt?Še ?  chaque
        # arbre
        # set R [expr 200 + $S($t,LabelMatrixBase)]
        set co [$w bbox [list L && T$t]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set Rx [expr ($x2 - $x1) /2.0]
        set Ry [expr ($y2 - $y1) /2.0]
        if {$Rx > $Ry} {
            set R [expr $Rx + $S($t,LabelMatrixBase)]
        } else  {
            set R [expr $Ry + $S($t,LabelMatrixBase)]
        }
        set a_ref [expr 6.28318530717958 / [llength $T($t,ue_cod)]]
        set n 0
        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
        # inversion ordre liste feuilles selon conformation
        if { $S($t,type) == "ClaCir2"} {
            set LLE {}
            foreach e $T($t,ue_cod) {
                set LLE [concat $e $LLE]
            }
            set n 1
        } else  {
            set LLE $T($t,ue_cod)
        }
        # l?Šger d?Šcalage du a anchor/justify si l'annotation a un seul caractere
        # on ajoute a l'avant un espace
        foreach e $LLE {
            set a [expr double($n*$a_ref)]
            if  {[lsearch $leu $T($t,ctl,$e)] != -1} {
                set x [expr $R * cos($a)]
                set y [expr $R * sin($a)]
                # TAG
                set l $T($t,ctl,$e)
                # avoir un nombre pair de caractere pour bien centrer
                # sinon on ajoute devant un espace
                set lc [split $S(AnnotateNote) {}]
                set nbc [llength $lc]
                if  {[expr $nbc / 2 * 2] == $nbc} {
                    set s $S(AnnotateNote)
                } else  {
                    set s " $S(AnnotateNote)"
                }
                #-text $S(AnnotateNote)
                $w create text $x $y \
                        -text $s \
                        -anchor center  -justify center \
                        -fill $S(col) \
                        -font $S(gfo) \
                        -tags "ILLCo?$l T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"
            }
            incr n
        }
        # centrage sur arbre tags root "[format "%s%s" $t C] T$t Z"
        set co [$w coords [format "%s%s" $t C]]
        set x1 [lindex $co 0]
        set y1 [lindex $co 1]
        set x2 [lindex $co 2]
        set y2 [lindex $co 3]
        set xcenter [expr ($x1 + $x2) /2.0]
        set ycenter [expr ($y1 + $y2) /2.0]
        $w move $tagC $xcenter $ycenter
    }
    proc DrawANGo {} {
        global S ann T
        set lv {}
        set lindex [.ann.l.lfa.l curselection]
        foreach i $lindex {
            lappend lv [.ann.l.lfa.l get $i]
        }
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        DrawANGoGo $lv $ltreetarget
    }
    
    proc DrawANGoGo {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    
                    foreach var $lv {
                        set w $S($ti,w)
                        set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
                        set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
                        set XMAX3 [lindex [$w bbox [list T$ti && AnnotMatrix]] 2]
                        if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                        if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                        if [catch {expr $S($ti,LabelMatrixBase) + $S(TabulationAnnot)} result] {
                            set S($ti,LabelMatrixBase) $S(TabulationAnnot)
                        } else  {
                            set S($ti,LabelMatrixBase) $result
                        }
                        set x [expr $XMAX + $S($ti,LabelMatrixBase)]
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        foreach l $T($ti,ue_lab) {
                            #
                            # x  et y appliquent une translation en et y respectivement
                            # f est un facteur d'amplication de taille
                            set lcoordsCONTOUR {} ; set f 100.0
                            # recherche y
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            if {$item == ""} {
                                set items [$w find withtag [list ADD?$l && T$ti]]
                                set y 0
                                foreach ii $items {
                                    set yii [lindex [$w coords $ii] 1]
                                    if {$yii >= $y} {
                                        set y $yii
                                    }
                                }
                            } else  {
                                set co [$w coords $item]
                                set y [lindex $co 1]
                            }
                            switch $ann(ann-fgfiguration) {
                                asleaf {set itemfgcolor [$w itemcget $item -fill]}
                                asuser {set itemfgcolor $S(col)}
                            }
                            switch $ann(ann-fofiguration) {
                                asleaf {set itemfont [$w itemcget $item -font]}
                                asuser {set itemfont $S(gfo)}
                            }
                            # construction de itemtext sur query
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            append itemtext " $val"
                                        }
                                    }
                                }
                            }
                            set ID [Tools::GenId]
                            # transformation coordonnees
                            foreach {xi yi} $itemtext {
                                set xx [expr $x + ($xi * $ann(DrawFactor))]
                                set yy [expr $y + ($yi * $ann(DrawFactor))]
                                append lcoordsCONTOUR $xx
                                append lcoordsCONTOUR " "
                                append lcoordsCONTOUR $yy
                                append lcoordsCONTOUR " "
                                if {$ann(DrawNode) == 1} {
                                    $w create rectangle [expr $xx -1] [expr $yy-1] [expr $xx+1] [expr $yy+1] -fill white -outline black \
                                            -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo Morpho MOR$ID"
                                }
                                
                            }
                            set iitteemm  [$w create polygon $lcoordsCONTOUR -fill white -outline black \
                                    -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo Morpho MOR$ID" ]
                            $w lower $iitteemm
                        }
                    }
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    proc DrawPlotANGo {} {
        global S ann T
        set lv {}
        set lindex [.ann.l.lfa.l curselection]
        foreach i $lindex {
            lappend lv [.ann.l.lfa.l get $i]
        }
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        DrawPlotANGoGo $lv $ltreetarget
    }
    proc DrawPlotANGoGo {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    
                    foreach var $lv {
                        set w $S($ti,w)
                        set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
                        set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
                        set XMAX3 [lindex [$w bbox [list T$ti && AnnotMatrix]] 2]
                        if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                        if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                        if [catch {expr $S($ti,LabelMatrixBase) + $S(TabulationAnnot)} result] {
                            set S($ti,LabelMatrixBase) $S(TabulationAnnot)
                        } else  {
                            set S($ti,LabelMatrixBase) $result
                        }
                        set x [expr $XMAX + $S($ti,LabelMatrixBase)]
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        foreach l $T($ti,ue_lab) {
                            #
                            # x  et y appliquent une translation en et y respectivement
                            # f est un facteur d'amplication de taille
                            set lcoordsCONTOUR {} ; set f 100.0
                            
                            
                            # recherche y
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            if {$item == ""} {
                                set items [$w find withtag [list ADD?$l && T$ti]]
                                set y 0
                                foreach ii $items {
                                    set yii [lindex [$w coords $ii] 1]
                                    if {$yii >= $y} {
                                        set y $yii
                                    }
                                }
                            } else  {
                                set co [$w coords $item]
                                set y [lindex $co 1]
                            }
                            switch $ann(ann-fgfiguration) {
                                asleaf {set itemfgcolor [$w itemcget $item -fill]}
                                asuser {set itemfgcolor $S(col)}
                            }
                            switch $ann(ann-fofiguration) {
                                asleaf {set itemfont [$w itemcget $item -font]}
                                asuser {set itemfont $S(gfo)}
                            }
                            # construction de itemtext sur query
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            append itemtext " $val"
                                        }
                                    }
                                }
                            }
                            # transformation coordonnees
                            set ximax 0 ; set yimax 0
                            # recherche xmax ymax
                            foreach {xi yi} $itemtext {
                                if {$xi >= $ximax} {set ximax $xi}
                                if {$yi >= $yimax} {set yimax $yi}
                            }
                            set fx [expr $ann(DrawXsize) / $ximax]
                            set fy [expr $ann(DrawYsize) / $yimax]
                            switch $ann(XYmode) {
                                scatter {
                                    foreach {xi yi} $itemtext {
                                        set xx [expr $x + ($xi * $fx)]
                                        set yy [expr $y + ($yi * $fy)]
                                        $w create line $xx $yy [expr $xx +1] [expr $yy +1] -fill black \
                                                -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo"
                                    }
                                }
                                batons {
                                    foreach {xi yi} $itemtext {
                                        set xx [expr $x + ($xi * $fx)]
                                        set yy [expr $y + ($yi * $fy)]
                                        $w create line $xx [expr $y + $ann(DrawYsize) + 3] $xx [expr $yy +1] -fill black \
                                                -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo"
                                    }
                                }
                                curve {
                                    set ldot ""
                                    foreach {xi yi} $itemtext {
                                        set xx [expr $x + ($xi * $fx)]
                                        set yy [expr $y + ($yi * $fy)]
                                        $w create line $xx $yy [expr $xx +1] [expr $yy +1] -fill black \
                                                -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo"
                                        append ldot " $xx $yy"
                                    }
                                    $w create line $ldot -fill black \
                                            -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo"
                                }
                            }
                            
                            # voir si bbox
                            set iit [$w create rectangle \
                                    [expr $x - $ann(DrawXsize) - 3 ] [expr $y - $ann(DrawYsize) - 3] \
                                    [expr $x + $ann(DrawXsize) + 3] [expr $y + $ann(DrawYsize) + 3] -fill white -outline black \
                                    -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo" ]
                            $w lower $iit
                        }
                    }
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    
    #
    proc PlotNodeMGo {w t n database variable} {
        set ln [Tools::NodeNoCoFaToNoCoCh $t $n]
        foreach ni $ln {
            if {$ni == $t} {
                set co [$w coords [format "%s%s" $n C]]
                set x [lindex $co 0]
                set y [expr ([lindex $co 3] - [lindex $co 1]) / 2.0]
            } else  {
                set co [$w coords $ni]
                set x [lindex $co 0]
                set y [lindex $co 1]
            }
            PlotNodeGo $w $t $ni $database $variable $x $y
        }
    }
    #
    proc PlotNodeGo {w t n database variable x y} {
        global S T ann B
        # liste feuilles sources
        set SouRefLea [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $n]]
        
        # liste records correspondant aux feuilles sources
        set MatchingRecords {}
        foreach f $SouRefLea {
            set recordsOK [Database::dbQueryRecordsFromVarPatVal $database EU $f]
            foreach r $recordsOK {
                lappend MatchingRecords $r
            }
        }
        # liste valeurs pour $variable sur les matching records
        upvar #0 $database X
        set MatchingValues {}
        foreach r $MatchingRecords {
            set toc $X($r)
            if {!([set pos [lsearch $toc $variable]]%2)} {
                set val [lindex $toc [incr pos]]
                if {[lsearch -exact $MatchingValues $val] == -1} {lappend MatchingValues $val}
            }
        }
        # $MatchingValues est une liste de liste de coordonn?Šes non ordonn?Še
        set nb [llength $MatchingValues] ;# on va calculer la moyenne
        foreach lc $MatchingValues  {
            set cindex 0
            foreach c $lc {
                incr cindex
                if [catch {expr $Somme($cindex) + $c} result] {
                    set Somme($cindex) $c
                } else  {
                    set Somme($cindex) $result
                }
            }
        }
        # passage array vers liste
        # probleme recuperer dans l'ordre
        set itemtext {}
        for {set i 1} {$i <= $cindex} {incr i 1} {
            append itemtext " [expr $Somme($i) / $nb]"
        }
        # transformation coordonnees
        set ID [Tools::GenId]
        
        
        # transformation coordonnees
        set ximax 0 ; set yimax 0
        # recherche xmax ymax
        foreach {xi yi} $itemtext {
            if {$xi >= $ximax} {set ximax $xi}
            if {$yi >= $yimax} {set yimax $yi}
        }
        set fx [expr $ann(DrawXsize) / $ximax]
        set fy [expr $ann(DrawYsize) / $yimax]
        switch $ann(XYmode) {
            scatter {
                foreach {xi yi} $itemtext {
                    set xx [expr $x + ($xi * $fx)]
                    set yy [expr $y + ($yi * $fy)]
                    $w create line $xx $yy [expr $xx +1] [expr $yy +1] -fill black \
                            -tags "T$t bullab BLL?$ID AnnotMatrix AM$t AMatrixCo Plot Plot$ID"
                }
            }
            batons {
                foreach {xi yi} $itemtext {
                    set xx [expr $x + ($xi * $fx)]
                    set yy [expr $y + ($yi * $fy)]
                    $w create line $xx [expr $y + $ann(DrawYsize) + 3] $xx [expr $yy +1] -fill black \
                            -tags "T$t bullab BLL?$ID AnnotMatrix AM$t AMatrixCo Plot Plot$ID"
                }
            }
            curve {
                set ldot ""
                foreach {xi yi} $itemtext {
                    set xx [expr $x + ($xi * $fx)]
                    set yy [expr $y + ($yi * $fy)]
                    $w create line $xx $yy [expr $xx +1] [expr $yy +1] -fill black \
                            -tags "T$t bullab BLL?$ID AnnotMatrix AM$t AMatrixCo Plot Plot$ID"
                    append ldot " $xx $yy"
                }
                $w create line $ldot -fill black \
                        -tags "T$t AnnotMatrix AM$t MA?$l $tagC AMatrixCo"
            }
        }
        
        set iit [$w create rectangle \
                [expr $x - $ann(DrawXsize) - 3] [expr $y - $ann(DrawYsize) - 3] \
                [expr $x + $ann(DrawXsize) + 3] [expr $y + $ann(DrawYsize) + 3] -fill white -outline black \
                -tags "T$t bullab BLL?$ID AnnotMatrix AM$t AMatrixCo Plot Plot$ID" ]
        $w lower $iit
        BLLmake4 $w $t $x $y $ID $n
    }
    
    proc SubtreeShapeMGo {w t n database variable} {
        set ln [Tools::NodeNoCoFaToNoCoCh $t $n]
        foreach ni $ln {
            if {$ni == $t} {
                set co [$w coords [format "%s%s" $n C]]
                set x [lindex $co 0]
                set y [expr ([lindex $co 3] - [lindex $co 1]) / 2.0]
            } else  {
                set co [$w coords $ni]
                set x [lindex $co 0]
                set y [lindex $co 1]
            }
            SubtreeShapeGo $w $t $ni $database $variable $x $y
        }
    }
    #
    proc SubtreeShapeGo {w t n database variable x y} {
        global S T ann B
        # liste feuilles sources
        set SouRefLea [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $n]]
        
        # liste records correspondant aux feuilles sources
        set MatchingRecords {}
        foreach f $SouRefLea {
            set recordsOK [Database::dbQueryRecordsFromVarPatVal $database EU $f]
            foreach r $recordsOK {
                lappend MatchingRecords $r
            }
        }
        # liste valeurs pour $variable sur les matching records
        upvar #0 $database X
        set MatchingValues {}
        foreach r $MatchingRecords {
            set toc $X($r)
            if {!([set pos [lsearch $toc $variable]]%2)} {
                set val [lindex $toc [incr pos]]
                if {[lsearch -exact $MatchingValues $val] == -1} {lappend MatchingValues $val}
            }
        }
        # $MatchingValues est une liste de liste de coordonn?Šes non ordonn?Še
        set nb [llength $MatchingValues] ;# on va calculer la moyenne
        foreach lc $MatchingValues  {
            set cindex 0
            foreach c $lc {
                incr cindex
                if [catch {expr $Somme($cindex) + $c} result] {
                    set Somme($cindex) $c
                } else  {
                    set Somme($cindex) $result
                }
            }
        }
        # passage array vers liste
        # probleme recuperer dans l'ordre
        set itemtext {}
        for {set i 1} {$i <= $cindex} {incr i 1} {
            append itemtext " [expr $Somme($i) / $nb]"
        }
        # transformation coordonnees
        set ID [Tools::GenId]
        foreach {xi yi} $itemtext {
            set xx [expr $x + ($xi * $ann(DrawFactor))]
            set yy [expr $y + ($yi * $ann(DrawFactor))]
            append lcoordsCONTOUR $xx
            append lcoordsCONTOUR " "
            append lcoordsCONTOUR $yy
            append lcoordsCONTOUR " "
            if {$ann(DrawNode) == 1} {
                $w create rectangle [expr $xx -1] [expr $yy-1] [expr $xx+1] [expr $yy+1] -fill white -outline black \
                        -tags "T$t bullab BLL?$ID AnnotMatrix AM$t AMatrixCo Morpho MOR$ID"
            }
        }
        if {$S(stipple) == "z.xbm"} {
            if {$ann(DrawFill) == 1} {
                set iitt [$w create polygon $lcoordsCONTOUR -outline black -fill $S(col) \
                        -tags "bullab BLL?$ID T$t AnnotMatrix AM$t AMatrixCo Morpho MOR$ID"]
            } else  {
                set iitt [$w create polygon $lcoordsCONTOUR -outline black -fill white \
                        -tags "bullab BLL?$ID T$t AnnotMatrix AM$t AMatrixCo Morpho MOR$ID"]
            }
        } else  {
            set iitt [$w create polygon $lcoordsCONTOUR -fill $S(col) -outline black \
                    -stipple @[file join  $S(TheoPATH)  + stipple $S(stipple)]  \
                    -tags "bullab BLL?$ID T$t AnnotMatrix AM$t AMatrixCo Morpho MOR$ID"]
        }
        $w lower $iitt
        BLLmake4 $w $t $x $y $ID $n
    }
    # nb anchor a remplacer par justify
    proc ANGoNew {} {
        global S ann T
        set lv {}
        set lib .annotation.p.pane0.childsite.n.canvas.notebook.cs.page1.cs.lfa.l
        set lindex [$lib curselection]
        foreach i $lindex {
            lappend lv [$lib get $i]
        }
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        ANGoGo $lv $ltreetarget
    }
    proc ANGo {} {
        global S ann T
        set lv {}
        set lindex [.ann.l.lfa.l curselection]
        foreach i $lindex {
            lappend lv [.ann.l.lfa.l get $i]
        }
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        ANGoGo $lv $ltreetarget
    }
    #
    proc ANGoLeaves {lv ltreetarget} {
        global S ann T
        switch $ann(ann-leavemod) {
            add {
                ANGoLeavesAdd $lv $ltreetarget
            }
            replace {
                ANGoLeavesReplace $lv $ltreetarget
            }
        }
    }
    # lv liste de variables
    proc ANGoGoNew {lv ltreetarget} {
        global S ann T
        switch $ann(ann-textmod) {
            add {
                ANGoLeavesAdd $lv $ltreetarget
                #
                
                set li .annotation.p.pane2.childsite.n.canvas.notebook.cs.page1.cs.s1.l
                #$li insert end "color $ann(ann-fgfiguration) asleaf
                #set ann(ann-fofiguration)
                foreach v $lv {
                    $li insert end  "AN LeavesAdd {$S(database) {$v}} {prefix \"$ann(ann-prefix)\" suffix \"$ann(ann-suffix)\" exposant \"$ann(ann-exposant)\"}"
                }
            }
            replace {
                ANGoLeavesReplace $lv $ltreetarget
                set li .annotation.p.pane2.childsite.n.canvas.notebook.cs.page1.cs.s1.l
                foreach v $lv {
                    $li insert end  "AN LeavesReplace {$S(database) {$v}} {prefix \"$ann(ann-prefix)\" suffix \"$ann(ann-suffix)\" exposant \"$ann(ann-exposant)\"}"
                }
            }
            addcolumns   {
                ANGoColumns $lv $ltreetarget
                set li .annotation.p.pane2.childsite.n.canvas.notebook.cs.page1.cs.s1.l
                foreach v $lv {
                    $li insert end  "AN LeavesAddColumns {$S(database) {$v}} {prefix \"$ann(ann-prefix)\" suffix \"$ann(ann-suffix)\" exposant \"$ann(ann-exposant)\"}"
                }
            }
        }
    }
    proc ANGoGo {lv ltreetarget} {
        global S ann T
        switch $ann(ann-position) {
            add {
                ANGoLeaves $lv $ltreetarget
            }
            justify   {
                ANGoColumns $lv $ltreetarget
            }
        }
    }
    # set S($t,type) ClaCir5 (circulaire interne)
    proc ANGoColumns {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    foreach var $lv {
                        set w $S($ti,w)
                        
                        set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
                        set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
                        set XMAX3 [lindex [$w bbox [list T$ti && AnnotMatrix]] 2]
                        if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                        if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                        if [catch {expr $S($ti,LabelMatrixBase) + 7} result] {
                            set S($ti,LabelMatrixBase) 7
                        } else  {
                            set S($ti,LabelMatrixBase) $result
                        }
                        set x [expr $XMAX + $S($ti,LabelMatrixBase)]
                        
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        foreach l $T($ti,ue_lab) {
                            # recherche y
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            if {$item == ""} {
                                set items [$w find withtag [list ADD?$l && T$ti]]
                                set y 0
                                foreach ii $items {
                                    set yii [lindex [$w coords $ii] 1]
                                    if {$yii >= $y} {
                                        set y $yii
                                    }
                                }
                            } else  {
                                set co [$w coords $item]
                                set y [lindex $co 1]
                            }
                            switch $ann(ann-fgfiguration) {
                                asleaf {set itemfgcolor [$w itemcget $item -fill]}
                                asuser {set itemfgcolor $S(col)}
                            }
                            switch $ann(ann-fofiguration) {
                                asleaf {set itemfont [$w itemcget $item -font]}
                                asuser {set itemfont $S(gfo)}
                            }
                            # construction de itemtext sur query
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            append itemtext " $val"
                                        }
                                    }
                                }
                            }
                            # coordonnees
                            set texto [format "%s%s%s" $ann(ann-prefix) $itemtext $ann(ann-suffix)]
                            $w create text $x [expr $y + $ann(ann-exposant)] \
                                    -text $texto \
                                    -fill $itemfgcolor \
                                    -font $itemfont \
                                    -tags "T$ti AnnotMatrix AM$ti MA?$l $tagC AMatrixCo" -anchor w
                        }
                    }
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    
    # ATTENTION PB si leaf hidden
    proc ANGoLeavesAdd {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    foreach var $lv {
                        set w $S($ti,w)
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        foreach l $T($ti,ue_lab) {
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            set itemfgcolor [$w itemcget $item -fill]
                            set itemfont [$w itemcget $item -font]
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            append itemtext $val
                                        }
                                    }
                                }
                            }
                            foreach vi $itemtext {
                                set i [$w find withtag [list ADD?$l && T$ti]]
                                if {$i == ""} {
                                    set i [$w find withtag [list [format "%s%s" EU  $l] && T$ti]]
                                    set co [$w coords $i]
                                    set y [lindex $co 1]
                                    set i2 [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                    
                                    if {[$w itemcget $i2 -state] == "hidden"} {
                                        set x [lindex [$w bbox $i] 2]
                                    } else  {
                                        set x [lindex [$w bbox $i2] 2]
                                    }
                                } else  {
                                    set co [$w coords [lindex $i 0]]
                                    set y [lindex $co 1]
                                    set x 0
                                    foreach ii $i {
                                        set xii [lindex [$w bbox $ii] 2]
                                        if {$xii >= $x} {
                                            set x $xii
                                        }
                                    }
                                }
                                switch $ann(ann-fgfiguration) {
                                    asleaf {
                                        set item [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                        set itemfgcolor [$w itemcget $item -fill]
                                    }
                                    asuser {set itemfgcolor $S(col)}
                                }
                                switch $ann(ann-fofiguration) {
                                    asleaf {
                                        set item [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                        set itemfont [$w itemcget $item -font]
                                    }
                                    asuser {set itemfont $S(gfo)}
                                }
                                if {$x != "" && $y != ""} {
                                    set vi [string trimleft $vi " "]
                                    set texto [format "%s%s%s" $ann(ann-prefix) $vi $ann(ann-suffix)]
                                    $w create text $x [expr $y + $ann(ann-exposant)] -text "$texto" \
                                            -font $itemfont \
                                            -fill $itemfgcolor \
                                            -tags "ADD?$l T$ti MA$l $tagC AnnotMatrix AM$ti" -anchor w
                                }
                            }
                        }
                    }
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    #
    proc ANGoLeavesReplaceORI {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    
                    foreach var $lv {
                        set w $S($ti,w)
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        
                        foreach l $T($ti,ue_lab) {
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            set itemfgcolor [$w itemcget $item -fill]
                            set itemfont [$w itemcget $item -font]
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            append itemtext $val
                                        }
                                    }
                                }
                            }
                            foreach vi $itemtext {
                                set i [$w find withtag [list ADD?$l && T$ti]]
                                if {$i == ""} {
                                    set i [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                    set co [$w coords $i]
                                    set y [lindex $co 1]
                                    set x [lindex [$w bbox $i] 0]
                                } else  {
                                    # cas si plusieurs ajout on recup le i de plus gran x
                                    set co [$w coords [lindex $i 0]]
                                    set y [lindex $co 1]
                                    set x 0
                                    foreach ii $i {
                                        set xii [lindex [$w bbox $ii] 2]
                                        if {$xii >= $x} {
                                            set x $xii
                                        }
                                    }
                                }
                                
                                switch $ann(ann-fgfiguration) {
                                    asleaf {
                                        set item [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                        set itemfgcolor [$w itemcget $item -fill]
                                    }
                                    asuser {set itemfgcolor $S(col)}
                                }
                                switch $ann(ann-fofiguration) {
                                    asleaf {
                                        set item [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                        set itemfont [$w itemcget $item -font]
                                    }
                                    asuser {set itemfont $S(gfo)}
                                }
                                set vi [string trimleft $vi " "]
                                $w itemconfigure $item -state hidden
                                set texto [format "%s%s%s" $ann(ann-prefix) $vi $ann(ann-suffix)]
                                $w create text $x [expr $y + $ann(ann-exposant)] -text "$texto" \
                                        -font $itemfont \
                                        -fill $itemfgcolor \
                                        -tags "ADD?$l T$ti  MA$l $tagC AnnotMatrix AM$ti" -anchor w
                            }
                        }
                    }
                }
                
                
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    #
    proc ANGoLeavesReplace {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    
                    foreach var $lv {
                        set w $S($ti,w)
                        # tag de colonne
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        
                        foreach l $T($ti,ue_lab) {
                            set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$ti]]
                            set itemfgcolor [$w itemcget $item -fill]
                            set itemfont [$w itemcget $item -font]
                            set record [Database::dbQueryRecordsFromVarVal $database EU $l]
                            set itemtext ""
                            if {$record == {}} {
                                set itemtext "-"
                            } else  {
                                foreach ri $record {
                                    foreach {vari val} $X($ri) {
                                        if {[string equal $var $vari] == 1}  {
                                            append itemtext $val
                                        }
                                    }
                                }
                            }
                            
                                set i [$w find withtag [list ADD?$l && T$ti]]
                                if {$i == ""} {
                                    set i [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                    set co [$w coords $i]
                                    set y [lindex $co 1]
                                    set x [lindex [$w bbox $i] 0]
                                } else  {
                                    # cas si plusieurs ajout on recup le i de plus gran x
                                    set co [$w coords [lindex $i 0]]
                                    set y [lindex $co 1]
                                    set x 0
                                    foreach ii $i {
                                        set xii [lindex [$w bbox $ii] 2]
                                        if {$xii >= $x} {
                                            set x $xii
                                        }
                                    }
                                }
                                
                                switch $ann(ann-fgfiguration) {
                                    asleaf {
                                        set item [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                        set itemfgcolor [$w itemcget $item -fill]
                                    }
                                    asuser {set itemfgcolor $S(col)}
                                }
                                switch $ann(ann-fofiguration) {
                                    asleaf {
                                        set item [$w find withtag [list [format "%s%s" EUL  $l] && T$ti]]
                                        set itemfont [$w itemcget $item -font]
                                    }
                                    asuser {set itemfont $S(gfo)}
                                }
                                set vi [string trimleft $itemtext " "]
                                $w itemconfigure $item -state hidden
                                set texto [format "%s%s%s" $ann(ann-prefix) $vi $ann(ann-suffix)]
                                $w create text $x [expr $y + $ann(ann-exposant)] -text "$texto" \
                                        -font $itemfont \
                                        -fill $itemfgcolor \
                                        -tags "ADD?$l T$ti  MA$l $tagC AnnotMatrix AM$ti" -anchor w
                           
                        }
                    }
                }
                
                
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    # A FAIRE
                }
                ClaCir1 - ClaCir2 - ClaCir3 {
                    # A FAIRE
                }
            }
        }
    }
    ###
    proc CanvasTextSelect  {w x y} {
        global S
        set x [$w canvasx $x]
        set y [$w canvasy $y]
        CanvasTextDone $w
        if {[$w type current] == "text"} {
            $w addtag "EdiText" withtag current
        } else {
            set ltags {EdiText TXT}
            foreach ti $S($w,t) {
                lappend ltags "T$ti"
            }
            $w create text $x $y -font $S(gfo) -fill $S(col)  -justify left -tags $ltags
        }
        focus $w
        $w focus "EdiText"
        $w icursor "EdiText" @$x,$y
    }
    ###
    proc CanvasTextEditAdd  {w s} {
        $w insert  "EdiText" insert $s
    }
    ###
    proc CanvasTextEnd  {w } {
        $w delete "EdiText"
    }
    ###
    proc CanvasTextEditBacksp  {w} {
        set pos [expr [$w index "EdiText" insert] -1]
        if {$pos >= 0} {
            $w dchars "EdiText" $pos
        }
    }
    ###
    proc CanvasTextDone  {w} {
        set msg [$w itemcget "EdiText" -text]
        if {[string length [string trim $msg]] == 0} {
            $w delete "EdiText"
        }
        $w dtag "EdiText"
        $w focus ""
    }
    ### A REVOIR
    proc Insert {what} {
        global S T
        set w [format "%s%s%s" .t $S(ict) .c]
        switch -exact $what {
            Scale {$w delete SCA
                set kv [array get T $S(ict),dbl,*]
                set max 0
                foreach {key value} $kv {
                    if {$value >= $max} {set max $value ; set keymax $key}
                }
                set code [string range $keymax [expr [string last "," $keymax] +1] end]
                set cood [$w coords $code]
                set leng [expr  [lrange $cood 0 0] - [lrange $cood 2 2]]
                set wgoal [expr [winfo width $w] / 10.0]
                set r [expr $wgoal / $leng]
                set dxfinal [expr $r * $max]
                set deci [string last . $dxfinal]
                set dxfinal [string range $dxfinal 0 [expr $deci +2] ]
                set lefinal [expr $r * $leng]
                set ori_x 20.0
                set ori_y 20.0
                $w create line $ori_x  $ori_y  \
                        $ori_x [expr $ori_y + 7.0] \
                        $ori_x [expr $ori_y + 3.0] \
                        [expr $ori_x + $lefinal] [expr $ori_y + 3.0] \
                        [expr $ori_x + $lefinal] [expr $ori_y + 7.0] \
                        [expr $ori_x + $lefinal] $ori_y \
                        -width 1 -fill blue -tags SCA
                $w create text [expr $ori_x + $lefinal / 2] [expr $ori_y + 10.0] \
                        -text  $dxfinal -font $T($S(ict),gfo) -fill blue -tags SCA -anchor center
                set S(und) "$w delete SCA"
            }
            Date {set s  [clock format [clock seconds] -format "%A %B %d %H:%M:%S %Z %Y"]
                $w create text  30 30 -text $s -font $S(gfo) -fill $T($S(ict),gfg) -tags "TXT"
            }
            File {set s  $T($S(ict),fil)
                $w create text 40 40 -text $s -font $S(gfo) -fill $T($S(ict),gfg) -tags "TXT"
            }
            Text {set s  $T($S(ict),fil)
                Interface::toolbar_select .treedyn.n.tab.notebook.page1.w.pt textinsert
                TBA::CanvasTextSelect $w 10 10
            }
        }
    }
    #
    proc AnnotateBuiltIn {w t x y what {color black} } {
        global S T
        switch -exact $what {
            Scale {
                #$w delete SCA
                set kv [array get T $t,dbl,*]
                # recherche d'une longueur de branche moyenne
                set dblB 0.0
                foreach {key value} $kv {
                    if {$value >= $dblB} {set dblB $value ; set keymax $key}
                }
                set dblA $dblB
                foreach {key value} $kv {
                    if {$value <= $dblA} {set dblA $value ; set keymin $key}
                }
                
                set dblmoy [expr ($dblB - $dblA) / 2.0]
                # longueur C du trait correspondant a la dblmoy
                set code [string range $keymax [expr [string last "," $keymax] +1] end]
                
                if { $S($t,type) == "PhyRad"} {
                    set code [format "%s%s"  $code C]
                }
                set cood [$w coords $code]
                
                set B [expr  [lrange $cood 0 0] - [lrange $cood 2 2]]
                
                set C [expr ($dblmoy * $B) / $dblB]
                #arrondir dblmoy
                set scientif [format "%e" $dblmoy]
                set exposant [string range $scientif [string first e $scientif] end]
                set prefixe [expr round([string range $scientif 0 [expr [string first e $scientif] -1]])]
                set dblmoyarrondi [format "%f" [format "%s%s" $prefixe $exposant]]
                #ajuster la longueur du trait moyen a l'arrondi
                set D [expr ($dblmoyarrondi * $C) / $dblmoy]
                # dessin
                set ori_x $x
                set ori_y $y
                set tagi [format "%s%s" TSCA [Tools::GenId]]
                $w create line $ori_x  $ori_y [expr $ori_x + $D] $ori_y \
                        -width 1 -fill $color  -tags "SCA T$t $tagi"
                $w create text [expr $ori_x + $D / 2] [expr $ori_y + 10.0] \
                        -text  [string trimright $dblmoyarrondi 0 ] -font $S(gfo) -fill $color  -tags "SCA T$t $tagi" -anchor center
                set S(und) "$w delete [list SCA && T$t]"
            }
            Scale100 {
                set co [$w bbox [list T$t && Z]]
                set x1 [lindex $co 0]
                set x2 [lindex $co 2]
                set dx [expr $x2 - $x1]
                set unit [expr $dx / 10.0]
                set tagi [format "%s%s" TSCA [Tools::GenId]]
                for {set i 0} {$i <= 10} {incr i 1} {
                    $w create line [expr $x + ($i * $unit)] [expr $y -3] \
                            [expr $x + ($i * $unit)] [expr $y +4] -width 1 -fill black -tags "SCA T$t $tagi"
                    set texto [format "%s%s" [expr 10 * $i] "%"]
                    $w create text [expr $x + ($i * $unit)] [expr $y -5] -text $texto \
                            -fill black -tags "SCA T$t $tagi" -anchor s -justify center
                }
                $w create line $x $y [expr $x + $dx] $y -width 1 -fill black -tags "SCA T$t $tagi"
            }
            Date {
                $w create text  $x $y -text [clock format [clock seconds] -format "%A %B %d %Y"] \
                        -font $S(gfo) -fill $S(col) -tags "TXT T$t"
            }
            File {
                #
                #[wm title [winfo parent $w]]
                $w create text $x $y -text $S($t,tit) -font $S(gfo) -fill $S(col) -tags "TXT T$t" -anchor w
            }
        }
    }
    ###
    proc DisplayDBL {w t} {
        global T S
        set li [$w find withtag [list T$t && DBL]]
        if {$li != ""} {
            $w delete [list T$t && DBL]
        } else  {
            $w delete [list T$t && DBL]
            set l [lrange $T($t,all_cod) 1 end]
            foreach i $l {
                if {[$w itemcget $i -state] != "hidden"} {
                    
                    set co [$w coords $i]
                    if {$co != ""} {
                        set x [lrange $co 2 2]
                        set y [lrange $co 1 1]
                        eval {$w create text} \
                                {$x $y} \
                                {-text $T($t,dbl,$i) -fill $S(col) \
                                    -font $S(gfo) -anchor nw -tags "T$t DBL"}
                    }
                }
            }
        }
    }
    ###
    proc DisplayDBLpercent {w t} {
        global T S
        # recherche plus grande longueur de branche
        set ls [lrange $T($t,all_cod) 1 end]
        set blmax 0
        foreach l $ls {
            if {$T($t,dbl,$l) > $blmax} {set blmax $T($t,dbl,$l)}
        }
        # facteur / 100
        set N [expr $blmax / 100.0]
        set li [$w find withtag [list T$t && DBL]]
        if {$li != ""} {
            $w delete [list T$t && DBL]
        } else  {
            $w delete [list T$t && DBL]
            set l [lrange $T($t,all_cod) 1 end]
            foreach i $l {
                if {[$w itemcget $i -state] != "hidden"} {
                    set co [$w coords $i]
                    if {$co != ""} {
                        set x [lrange $co 2 2]
                        set y [lrange $co 1 1]
                        set bl [format "%s%s" [expr round($T($t,dbl,$i) / $N)] %]
                        eval {$w create text} \
                                {$x $y} \
                                {-text $bl -fill $S(col) \
                                    -font $S(gfo) -anchor nw -tags "T$t DBL"}
                    }
                }
            }
        }
    }
    #
    proc NodeDBLp {w x y} {
        global S T
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            # recherche plus grande longueur de branche
            set ls [lrange $T($t,all_cod) 1 end]
            set blmax 0
            foreach l $ls {
                if {$T($t,dbl,$l) > $blmax} {set blmax $T($t,dbl,$l)}
            }
            # facteur / 100
            set N [expr $blmax / 100.0]
            set bl [format "%s%s" [expr round($T($t,dbl,$n) / $N)] %]
            $w create text $x $y -text $bl -fill $S(col) \
                    -font $S(gfo) -anchor nw -tags "T$t DBL"
        }
    }
    #
    proc NodeDBL {w x y} {
        global S T
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            $w create text $x $y -text $T($t,dbl,$n) -fill $S(col) \
                    -font $S(gfo) -anchor nw -tags "T$t DBL"
        }
    }
    #
    proc NodeDBV {w x y} {
        global S T
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            if [catch {set test $T($t,dbv,$n)} res] {
                #nothing
            } else {
                $w create text $x $y -text $T($t,dbv,$n) -fill $S(col) \
                        -font $S(gfo) -anchor nw -tags "T$t DBL"
            }
        }
    }
    #
    proc NodeDBVp {w x y} {
        global S T
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            if [catch {set test $T($t,dbv,$n)} res] {
                #nothing
            } else {
                set lall [lrange $T($t,all_cod) 1 end]
                # on retire les codes des ue
                set l [Tools::SousL $lall $T($t,ue_cod)]
                # recherche plus grande valeur bootstrap
                set bvmax 0
                foreach i $l {
                    if {$T($t,dbv,$i) > $bvmax} {set bvmax $T($t,dbv,$i)}
                }
                # facteur / 100
                set N [expr $bvmax / 100.0]
                if {$T($t,dbv,$n) != ""} {
                    set txt  [format "%s%s" [expr round($T($t,dbv,$n) / $N)] %]
                    $w create text $x $y -text $txt -fill $S(col) \
                            -font $S(gfo) -anchor nw -tags "T$t DBL"
                }
            }
        }
    }
    ###
    proc DisplayDBV {w t} {
        global T S
        set x [$w canvasx $x] ; set y [$w canvasy $y]
        set li [$w find withtag [list T$t && DBV]]
        if {$li != ""} {
            $w delete [list T$t && DBV]
        } else  {
            set lall [lrange $T($t,all_cod) 1 end]
            # on retire les codes des ue
            set l [Tools::SousL $lall $T($t,ue_cod)]
            $w delete [list T$t && DBV]
            foreach i $l {
                if {[$w itemcget $i -state] != "hidden"} {
                    set co [$w coords $i]
                    if {$co != ""} {
                        set x [lrange $co 0 0]
                        set y [lrange $co 1 1]
                        if {$T($t,dbv,$i) != ""} {
                            set txt $T($t,dbv,$i)
                            eval {$w create text} \
                                    {$x $y} \
                                    {-text $txt -fill $S(col) \
                                        -font $S(gfo) -anchor nw -tags "T$t DBV"}
                        }
                    }
                }
            }
        }
    }
    
    proc DisplayDBVseuilGO {w t} {
        global T S
        $w delete [list T$t && DBV]
        set lall [lrange $T($t,all_cod) 1 end]
        set l [Tools::SousL $lall $T($t,ue_cod)]
        foreach i $l {
            if {[$w itemcget $i -state] != "hidden"} {
                set co [$w coords $i]
                if {$co != ""} {
                    set x [lrange $co 0 0]
                    set y [lrange $co 1 1]
                    if {$T($t,dbv,$i) != "" && $T($t,dbv,$i) >= $S(dbvseuil) } {
                        set txt $T($t,dbv,$i)
                        eval {$w create text} \
                                {$x $y} \
                                {-text $txt -fill $S(col) \
                                    -font $S(gfo) -anchor nw -tags "T$t DBV"}
                    }
                }
            }
        }
    }
    
    proc DisplayDBLseuilGO {w t} {
        global T S
        $w delete [list T$t && DBL]
        set l [lrange $T($t,all_cod) 1 end]
        foreach i $l {
            if {[$w itemcget $i -state] != "hidden"} {
                set co [$w coords $i]
                if {$co != ""} {
                    set x [lrange $co 2 2]
                    set y [lrange $co 1 1]
                    if {$T($t,dbl,$i) != "" && $T($t,dbl,$i) >= $S(dblseuil) } {
                        eval {$w create text} \
                                {$x $y} \
                                {-text $T($t,dbl,$i) -fill $S(col) \
                                    -font $S(gfo) -anchor nw -tags "T$t DBL"}
                    }
                }
            }
        }
        
    }
    ###
    proc DisplayDBVpercent {w t} {
        global T S
        $w delete [list T$t && DBV]
        set lall [lrange $T($t,all_cod) 1 end]
        # on retire les codes des ue
        set l [Tools::SousL $lall $T($t,ue_cod)]
        # recherche plus grande valeur bootstrap
        set bvmax 0
        foreach i $l {
            if {$T($t,dbv,$i) > $bvmax} {set bvmax $T($t,dbv,$i)}
        }
        # facteur / 100
        set N [expr $bvmax / 100.0]
        $w delete [list T$t && DBV]
        foreach i $l {
            if {[$w itemcget $i -state] != "hidden"} {
                set co [$w coords $i]
                if {$co != ""} {
                    set x [lrange $co 0 0]
                    set y [lrange $co 1 1]
                    if {$T($t,dbv,$i) != ""} {
                        set txt  [format "%s%s" [expr round($T($t,dbv,$i) / $N)] %]
                        eval {$w create text} \
                                {$x $y} \
                                {-text $txt -fill $S(col) \
                                    -font $S(gfo) -anchor nw -tags "T$t DBV"}
                    }
                    
                }
            }
        }
        
    }
    #
    proc LabelMatrix  {w t EUS tagquery} {
        global S
        set tagquery [format "%s%s%s" MA ? $tagquery]
        set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
        set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
        if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
        if [catch {expr $S($t,LabelMatrixBase) + $S(TabulationAnnot)} result] {
            set S($t,LabelMatrixBase) $S(TabulationAnnot)
        } else  {
            set S($t,LabelMatrixBase) $result
        }
        set x [expr $XMAX + $S($t,LabelMatrixBase)]
        foreach eu $EUS {
            set i  [$w find withtag [list T$t && EUL$eu]]
            if {$i != ""} {
                set co [$w coords $i]
                set y [lindex $co 1]
                $w create text $x $y -text + -fill $S(col) -tags "T$t $tagquery AnnotMatrix ML?$eu"
            }
        }
        $w bind AnnotMatrix <Any-Enter> "after 500 Annotation::AnyEnterAM %W %x %y"
        $w bind AnnotMatrix <Any-Leave> "after 500 Annotation::AnyLeaveAM %W"
    }
    #
    proc  AnyEnterAM {w x y} {
        set tags [$w gettags current]
        set color [$w itemcget current -fill]
        set maq  [lindex $tags [lsearch -glob $tags MA*]]
        set maf  [lindex $tags [lsearch -glob $tags ML*]]
        set q [lindex [split $maq ?] end]
        set ql [lindex [split $maf ?] end]
        $w create text  [expr  $x + 15] $y -text [format "%s%s%s" $ql : $q] \
                -anchor w -tag AMi -fill $color
    }
    proc  AnyLeaveAM {w} {
        $w delete AMi
    }
    #
    proc BLLmake {w t x y titre text n} {
        global B S
        # attention  1n:nBLL
        set id [format "%s%s" $t [Tools::GenId]]
        set idtext [format "%s%s%s" BLL ? $id]
        set idlink [format "%s%s%s" LIN ? $id]
        #BLL
        set txt $text
        set txtfinal $txt
        $w create text [$w canvasx [expr $x + 30 ] ] [$w canvasy [expr $y + 30 ]]  \
                -text $txtfinal -font $S(gfo) -fill $S(col) -anchor nw \
                -tags "bullab T$t $idtext"
        # LIN [expr $x + 30 ] [expr $y + 30 ]
        $w create line  [$w canvasx $x] [$w canvasy $y] [$w canvasx [expr $x + 30 ] ] [$w canvasy [expr $y + 30 ]]  \
                -width 1 -fill $S(col) -tags "Link T$t $idlink"
        # MEM
        set B(BLLtre,$id) $t
        set B(BLLnod,$id) $n
        set B(BLLtxt,$id) $txtfinal
        set B(BLLidt,$id) $idtext
        set B(BLLidl,$id) $idlink
        set B(BLLcol,$id) $S(col)
        set B(BLLgfo,$id) $S(gfo)
        set B(BLLxxx,$id) [expr $x + 30 ]
        set B(BLLyyy,$id) [expr $y + 30 ]
        # Liste des BLL par tree
        lappend B($t,bll) $id
    }
    # idem que BLLmake mais ne cree pas les items graphiques
    # utilise dans les copy/paste et restauration
    # 2 arguments suple la couleur et la fonte
    proc BLLmake2 {w t x y titre text n col gfo} {
        global B S
        # attention  1n:nBLL
        set id [format "%s%s" $t [Tools::GenId]]
        set idtext [format "%s%s%s" BLL ? $id]
        set idlink [format "%s%s%s" LIN ? $id]
        #BLL
        set txt $text
        #set txtfinal [format "%s%s%s" $titre \n $txt]
        set txtfinal $txt
        # MEM
        set B(BLLtre,$id) $t
        set B(BLLnod,$id) $n
        set B(BLLtxt,$id) $txtfinal
        set B(BLLidt,$id) $idtext
        set B(BLLidl,$id) $idlink
        set B(BLLcol,$id) $col
        set B(BLLgfo,$id) $gfo
        set B(BLLxxx,$id) [expr $x + 30 ]
        set B(BLLyyy,$id) [expr $y + 30 ]
        # Liste des BLL par tree
        lappend B($t,bll) $id
    }
    # comme BLLmake mais ici on utilise les fontes pour illustration
    proc BLLmake3 {w t x y text n} {
        global B S
        # attention  1n:nBLL
        set id [format "%s%s" $t [Tools::GenId]]
        set idtext [format "%s%s%s" BLL ? $id]
        set idlink [format "%s%s%s" LIN ? $id]
        #BLL
        set txt $text
        set txtfinal $txt
        $w create text [$w canvasx [expr $x + 30 ] ] [$w canvasy [expr $y + 30 ]]  \
                -text $txtfinal -font $S(ill-fon) -fill $S(col) -anchor nw \
                -tags "bullab T$t $idtext"
        # LIN [expr $x + 30 ] [expr $y + 30 ]
        $w create line  [$w canvasx $x] [$w canvasy $y] [$w canvasx [expr $x + 30 ] ] [$w canvasy [expr $y + 30 ]]  \
                -width 1 -fill $S(col) -tags "Link T$t $idlink"
        # MEM
        set B(BLLtre,$id) $t
        set B(BLLnod,$id) $n
        set B(BLLtxt,$id) $txtfinal
        set B(BLLidt,$id) $idtext
        set B(BLLidl,$id) $idlink
        set B(BLLcol,$id) $S(col)
        set B(BLLgfo,$id) $S(ill-fon)
        set B(BLLxxx,$id) [expr $x + 30 ]
        set B(BLLyyy,$id) [expr $y + 30 ]
        # Liste des BLL par tree
        lappend B($t,bll) $id
    }
    ###
    # comme BLLmake mais ici une forme complexe type polygon
    # id est un tag unique partage par tous les items composant la structure
    proc BLLmake4 {w t x y id n} {
        global B S
        # attention  1n:nBLL
        # set id [format "%s%s" $t [Tools::GenId]]
        # set idtext [format "%s%s%s" BLL ? $id]
        set idlink [format "%s%s%s" LIN ? $id]
        $w create line  [$w canvasx $x] [$w canvasy $y] [$w canvasx [expr $x + 30 ] ] [$w canvasy [expr $y + 30 ]]  \
                -width 1 -fill $S(col) -tags "Link T$t $idlink"
        # MEM
        set B(BLLtre,$id) $t
        set B(BLLnod,$id) $n
        set B(BLLtxt,$id) -
        set B(BLLidt,$id) MOR$id
        set B(BLLidl,$id) $idlink
        set B(BLLcol,$id) $S(col)
        set B(BLLgfo,$id) $S(ill-fon)
        set B(BLLxxx,$id) [expr $x + 30 ]
        set B(BLLyyy,$id) [expr $y + 30 ]
        # Liste des BLL par tree
        lappend B($t,bll) $id
    }
    ###
    proc BLLDelete {w i} {
        global B
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BLL*]] ?] end]
        $w delete [format "%s%s%s" BLL ? $id]
        $w delete [format "%s%s%s" LIN ? $id]
        set t $B(BLLtre,$id)
        foreach key [array names B *,$id] {
            unset B($key)
        }
        #retirer
        set index [lsearch -exact $B($t,bll) $id]
        set B($t,bll) [concat [lrange $B($t,bll) 0 [expr $index - 1]] \
                [lrange $B($t,bll) [expr $index + 1] end]]
    }
    ###
    proc BLLDelete2 {w id} {
        global B
        $w delete [format "%s%s%s" BLL ? $id]
        $w delete [format "%s%s%s" LIN ? $id]
        set t $B(BLLtre,$id)
        foreach key [array names B *,$id] {
            unset B($key)
        }
        #retirer
        set index [lsearch -exact $B($t,bll) $id]
        set B($t,bll) [concat [lrange $B($t,bll) 0 [expr $index - 1]] \
                [lrange $B($t,bll) [expr $index + 1] end]]
    }
    ###
    proc BLLUpdateColor {w i} {
        global B S
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BLL*]] ?] end]
        $w itemconfigure [format "%s%s%s" BLL ? $id] -fill $S(col)
        $w itemconfigure [format "%s%s%s" LIN ? $id] -fill $S(col)
        set B(BLLcol,$id) $S(col)
    }
    ###
    proc BLLUpdateFont {w i} {
        global B S
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BLL*]] ?] end]
        $w itemconfigure [format "%s%s%s" BLL ? $id]  -font $S(gfo)
        set B(BLLgfo,$id) $S(gfo)
    }
    ###
    proc BLLmove {w x y i} {
        global B S
        $w move $S(mov) [expr $x - $S(mox)] [expr $y - $S(moy)]
        set S(mox) $x
        set S(moy) $y
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags BLL*]] ?] end]
        if {$B(BLLnod,$id) == $B(BLLtre,$id)} {
            set co_sou [$w coords [format "%s%s" $B(BLLnod,$id) C]]
            set x1 [lindex $co_sou 0]
            set y1 [expr ([lindex $co_sou 3] - [lindex $co_sou 1]) / 2.0]
        } else  {
            set co_sou [$w coords $B(BLLnod,$id)]
            set x1 [lindex $co_sou 0]
            set y1 [lindex $co_sou 1]
        }
        set co_tar [$w coords $i]
        set x2 [lindex $co_tar 0]
        set y2 [lindex $co_tar 1]
        # il peu y avoir des tags suplementaires a la liste "Link T$B(BLLtre,$id) $idlink"
        # en particulier le tag lie aux decompositions
        set tagslink [$w gettags $B(BLLidl,$id)]
        $w delete $B(BLLidl,$id)
        $w create line $x1 $y1 $x2 $y2 \
                -width 1 -fill $B(BLLcol,$id) -tags $tagslink
        set B(BLLxxx,$id) $x
        set B(BLLyyy,$id) $y
    }
    # QUERYNODE
    proc QueryNode {w t eu} {
        global S T B
        set id [format "%s%s" $t [Tools::GenId]]
        set idtext [format "%s%s%s" QYN ? $id]
        set co [$w bbox [list Z && T$t]]
        $w create text [lindex $co 0] [lindex $co 1]  -text $S(query)  \
                -fill $S(col) -font $S(gfo) -tags "querynode T$t $idtext" -anchor nw
        $w raise Q$t
        # restriction de result aux EU appartenant au tree target
        set leu {}
        foreach e $eu {
            if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
        }
        set B(QYNres,$id) $leu
        set B(QYNqry,$id) $S(query)
        set B(QYNtre,$id) $t
        set B(QYNidt,$id) $idtext
        set B(QYNcol,$id) $S(col)
        set B(QYNgfo,$id) $S(gfo)
        set B(QYNxxx,$id) 0
        set B(QYNyyy,$id) 0
        lappend B($t,qyn) $id
    }
    ### NB : pas de QueryNodeLink sur les nodes, trop de recouvrements
    proc QueryNodeLinkLeaf {id leu} {
        global B S T
        # set tags [$w gettags $i]
        # set id [lindex [split [lindex $tags [lsearch -glob $tags QYN*]] ?] end]
        set w $S($B(QYNtre,$id),w)
        set co_sou  [$w coords [format "%s%s%s" QYN ? $id]]
        set x1 [lindex $co_sou 0]
        set y1 [lindex $co_sou 1]
        foreach eu $leu {
            set i2 [$w find withtag [list [format "%s%s" EU $eu] && T$B(QYNtre,$id)]]
            set co_tar  [$w coords $i2]
            set x2 [lindex $co_tar 0]
            set y2 [lindex $co_tar 1]
            set idlink [format "%s%s%s" LIN ? $id]
            QueryNodeLink $w $x1 $y1 $x2 $y2 $B(QYNcol,$id) "Link $idlink  T$B(QYNtre,$id)"
        }
    }
    proc QueryNodeUnLinkLeaf {id leu} {
        global B S
        set w $S($B(QYNtre,$id),w)
        set idlink [format "%s%s%s" LIN ? $id]
        $w delete $idlink
    }
    ###
    proc QueryNodeLink {w x1 y1 x2 y2 c tags} {
        $w create line $x1 $y1 $x2 $y2 -width 1 -fill $c -tags $tags
    }
    ###
    proc QueryNodeUpdateColor {w id} {
        global B S
        $w itemconfigure [format "%s%s%s" QYN ? $id] -fill $S(col)
        $w itemconfigure [format "%s%s%s" LIN ? $id] -fill $S(col)
        set B(QYNcol,$id) $S(col)
    }
    ###
    proc QueryNodeUpdateFont {w id} {
        global B S
        $w itemconfigure [format "%s%s%s" QYN ? $id] -font $S(gfo)
        set B(QYNgfo,$id) $S(gfo)
    }
    
    ### OK
    proc QueryNodeLocalisation {id} {
        global B S T
        set t $B(QYNtre,$id)
        set w $S($t,w)
        # restriction aux eus du tree target,
        # voir aussi si prise en compte des eus sous shrink
        set EUS {}
        foreach e $B(QYNres,$id) {
            if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend EUS $e}
        }
        Operation::Operation  $w $t $EUS
    }
    ###
    proc QueryNodeMove {w x y i} {
        global S T B
        $w move $S(mov) [expr $x - $S(mox)] [expr $y - $S(moy)]
        set S(mox) $x
        set S(moy) $y
        set tags [$w gettags $i]
        set id [lindex [split [lindex $tags [lsearch -glob $tags QYN*]] ?] end]
        # delete et redraw des link
        if {[$w find withtag [format "%s%s%s" LIN ? $id]] != {} } {
            $w delete [format "%s%s%s" LIN ? $id]
            set co_sou  [$w coords $i]
            set x1 [lindex $co_sou 0]
            set y1 [lindex $co_sou 1]
            foreach eu $B(QYNres,$id) {
                set i2 [$w find withtag [list [format "%s%s" EU $eu] && T$B(QYNtre,$id)]]
                set co_tar  [$w coords $i2]
                set x2 [lindex $co_tar 0]
                set y2 [lindex $co_tar 1]
                set idlink [format "%s%s%s" LIN ? $id]
                QueryNodeLink $w $x1 $y1 $x2 $y2 $B(QYNcol,$id) "Link $idlink  T$B(QYNtre,$id)"
            }
        }
        set B(QYNxxx,$id) $x
        set B(QYNyyy,$id) $y
    }
    ###
    proc QueryNodeDelete {w id} {
        global B
        $w delete [format "%s%s%s" QYN ? $id]
        $w delete [format "%s%s%s" LIN ? $id]
        set t $B(QYNtre,$id)
        
        foreach key [array names B *,$id] {
            unset B($key)
        }
        #retirer
        set index [lsearch -exact $B($t,qyn) $id]
        set B($t,bll) [concat [lrange $B($t,qyn) 0 [expr $index - 1]] \
                [lrange $B($t,qyn) [expr $index + 1] end]]
    }
    ###
    proc InsertTextNode {w x y} {
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            InsertTextNodeMake $w $t $x $y $n
        }
    }
    ###
    proc InsertTextNodeMake {w t x y n} {
        global S
        #       set x [$w canvasx $x]
        #       set y [$w canvasy $y]
        set text $S(AnnotateNote)
        Annotation::BLLmake $w $t $x $y "Note :" $text $n
        $w configure -scrollregion [$w bbox all]
    }
    #
    proc InsertSymbolNode {w x y} {
        set tags [$w gettags [$w find withtag current]]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        set t [string range \
                [lindex $tags [lsearch -glob $tags T*]] 1 end]
        if {$n != ""} {
            InsertSymbolNodeMake $w $t $x $y $n
        }
    }
    ###
    proc InsertSymbolNodeMake {w t x y n} {
        global S
        #        set x [$w canvasx $x]
        #        set y [$w canvasy $y]
        set text $S(ill-car)
        Annotation::BLLmake3 $w $t $x $y $text $n
        $w configure -scrollregion [$w bbox all]
    }
    ###
    # s est soit tab- soit tab+
    # cette fonction permet d'inc?Šmenter (+) // d?Šcr?Šmenter (-)
    # la variable de tabulation pour les arbres en target
    # manuellement (afin de tab entre 2 series de requetes)
    proc AnnCTabulation {s} {
        global S T
        # A-list window/tree des arbres en target d'une session treedyn
        foreach {w t} [Selection::TreeTar] {
            switch -exact $s  {
                tab+ {
                    if [catch {expr $S($t,LabelMatrixBase) + $S(TabulationAnnot)} result] {
                        set S($t,LabelMatrixBase) $S(TabulationAnnot)
                    } else  {
                        set S($t,LabelMatrixBase) $result
                    }
                }
                tab- {
                    if [catch {expr $S($t,LabelMatrixBase) - $S(TabulationAnnot)} result] {
                        # rien
                    } else  {
                        set S($t,LabelMatrixBase) $result
                    }
                }
            }
        }
    }
    
    
    
}
####################

####################
# ABSTRACTION
####################
namespace eval Abstraction {
    
    # Collapse cumulatif de la selection user
    proc CollapseToolbox {w} {
        global B T
        set item [$w find withtag current]
        set tags [$w gettags $item]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set TarCodLea [Tools::NodeNoToLe $t $n]
            set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
            # ON AJOUTE
            foreach i $TarRefLea {lappend T($t,eu_collapse) $i}
            set finalleaves [Tools::SousL $T($t,ue_lab) $T($t,eu_collapse)]
            # on envoie les feuilles qu'on garde
            NewickAbstract  $w $t $finalleaves
        }
    }
    # UnCollapse cumulatif de la selection user
    proc CollapseUnToolbox {w} {
        global B T
        set item [$w find withtag current]
        set tags [$w gettags $item]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright \
                [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            set TarCodLea [Tools::NodeNoToLe $t $n]
            set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
            # ON SOUSTRAIT
            set T($t,eu_collapse) [Tools::SousL $T($t,eu_collapse) $TarRefLea]
            set finalleaves [Tools::SousL $T($t,ue_lab) $T($t,eu_collapse)]
            # on envoie les feuilles qu'on garde
            NewickAbstract  $w $t $finalleaves
        }
    }
    # Collapse cumulatif de la selection user
    proc Collapse {w t TarRefLea} {
        global B T
        # ON AJOUTE
        foreach i $TarRefLea {lappend T($t,eu_collapse) $i}
        set finalleaves [Tools::SousL $T($t,ue_lab) $T($t,eu_collapse)]
        # on envoie les feuilles qu'on garde
        NewickAbstract  $w $t $finalleaves
    }
    # UnCollapse cumulatif de la selection user
    proc CollapseUn {w t TarRefLea} {
        global B T
        # ON SOUSTRAIT
        set T($t,eu_collapse) [Tools::SousL $T($t,eu_collapse) $TarRefLea]
        set finalleaves [Tools::SousL $T($t,ue_lab) $T($t,eu_collapse)]
        # on envoie les feuilles qu'on garde
        NewickAbstract  $w $t $finalleaves
        
    }
    proc Shrink3 {w t n} {
        global S T B IMGshn
        set id [format "%s%s" $t [Tools::GenId]]
        set TAG [format "%s%s%s" SHI ? $id]
        set c0 [$w bbox $n]
        set x0 [lindex $c0 0]
        set y0 [lindex $c0 1]
        set leafs [Tools::NodeNoToLe $t $n]
        set lxy [Figuration::NodeColorBgSubTreeContour $w $t $n]
        $w create polygon "$x0 $y0 $lxy $x0 $y0" -smooth 1 -splinesteps 100 \
                -fill $S(col) -outline $S(col) -tags "SHRINK [format "%s%s%s" SHN ? $id] T$t"
        $w lower [format "%s%s%s" SHN ? $id] all
        # BLL
        set pattern [format "%s%s" $n *]
        foreach idbll $B($t,bll) {
            if {[string match $pattern $B(BLLnod,$idbll)] == 1 } {
                if {[$w itemcget $B(BLLidt,$idbll) -state] != "hidden"} {
                    $w addtag $TAG withtag $B(BLLidt,$idbll)
                    $w addtag $TAG withtag $B(BLLidl,$idbll)
                    $w itemconfigure $B(BLLidt,$idbll) -state hidden
                    $w itemconfigure $B(BLLidl,$idbll) -state hidden
                }
            }
        }
        # leaves
        set leafs [Tools::NodeNoToLe $t $n]
        foreach i $leafs {
            set tagi [list [format "%s%s" EUL  $T($t,ctl,$i)] && T$t]
            if {[$w itemcget $tagi -state] != "hidden"} {
                $w addtag  $TAG withtag $tagi
                $w itemconfigure $tagi -state hidden
            }
        }
        # background leaves
        set pattern [format "%s%s" $n *]
        foreach idi $B($t,bgl)  {
            if  {[string match $pattern $B(BGLnod,$idi)] == 1 } {
                if {[$w itemcget [format "%s%s%s" BGL ? $idi] -state] != "hidden"} {
                    $w addtag $TAG withtag  [format "%s%s%s" BGL ? $idi]
                    $w itemconfigure [format "%s%s%s" BGL ? $idi] -state hidden
                }
            }
        }
        # arretes terminales
        set Le [Tools::NodeNoToLe $t $n]
        foreach e $Le {
            if {[$w itemcget $e -state] != "hidden"} {
                $w addtag $TAG withtag $e
                $w itemconfigure $e -state hidden
            }
        }
        # tree
        set lchild [Tools::NodeNoCoFaToNoCoCh $t $n]
        foreach i $lchild {
            if {[$w itemcget $i -state] != "hidden"} {
                $w addtag $TAG withtag [format "%s%s" $i C]
                $w itemconfigure [format "%s%s" $i C] -state hidden
            }
        }
        # ova (en fait que le link)
        set pattern [format "%s%s" $n *]
        foreach idi $B($t,ova)  {
            if  {[string match $pattern $B(OVAnod1,$idi)] == 1 } {
                if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                    $w addtag $TAG withtag  [format "%s%s%s"  link ? $idi ]
                    $w itemconfigure [format "%s%s%s"  link ? $idi ] -state hidden
                    
                }
            }
        }
        # background tree
        set pattern [format "%s%s" $n *]
        foreach idi $B($t,bgs)  {
            if  {[string match $pattern $B(BGSnod,$idi)] == 1 } {
                if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                    $w addtag $TAG withtag  [format "%s%s%s" BGS ? $idi]
                    $w itemconfigure [format "%s%s%s" BGS ? $idi] -state hidden
                    
                }
            }
        }
        ### mem & text a afficher en D3
        lappend B($t,shi) $id
        set B(SHInod,$id) $n
        set B(SHItxt,$id) -
        set B(SHItre,$id) $t
        set B(SHIcol,$id) $S(col)
        set B(SHIsta,$id) normal
        # UNDO
        set S(und) "Abstraction::ShrinkUn $w $t $id"
        return $id
    }
    proc Shrink4 {w t n} {
        global S T B IMGshn
        set id [format "%s%s" $t [Tools::GenId]]
        set TAG [format "%s%s%s" SHI ? $id]
        set c0 [$w bbox $n]
        set x0 [lindex $c0 0]
        set y0 [lindex $c0 1]
        set leafs [Tools::NodeNoToLe $t $n]
        set lxy [Figuration::NodeColorBgSubTreeContour $w $t $n]
        $w create polygon "$x0 $y0 $lxy $x0 $y0" -smooth 1 -splinesteps 100 \
                -fill $S(col) -outline $S(col) -tags "SHRINK [format "%s%s%s" SHN ? $id] T$t"
        $w lower [format "%s%s%s" SHN ? $id] all
        # BLL
        set pattern [format "%s%s" $n *]
        foreach idbll $B($t,bll) {
            if {[string match $pattern $B(BLLnod,$idbll)] == 1 } {
                if {[$w itemcget $B(BLLidt,$idbll) -state] != "hidden"} {
                    $w addtag $TAG withtag $B(BLLidt,$idbll)
                    $w addtag $TAG withtag $B(BLLidl,$idbll)
                    $w itemconfigure $B(BLLidt,$idbll) -state hidden
                    $w itemconfigure $B(BLLidl,$idbll) -state hidden
                }
            }
        }
        # leaves
        set leafs [Tools::NodeNoToLe $t $n]
        foreach i $leafs {
            set tagi [list [format "%s%s" EUL  $T($t,ctl,$i)] && T$t]
            if {[$w itemcget $tagi -state] != "hidden"} {
                $w addtag  $TAG withtag $tagi
                $w itemconfigure $tagi -state hidden
            }
        }
        # background leaves
        set pattern [format "%s%s" $n *]
        foreach idi $B($t,bgl)  {
            if  {[string match $pattern $B(BGLnod,$idi)] == 1 } {
                if {[$w itemcget [format "%s%s%s" BGL ? $idi] -state] != "hidden"} {
                    $w addtag $TAG withtag  [format "%s%s%s" BGL ? $idi]
                    $w itemconfigure [format "%s%s%s" BGL ? $idi] -state hidden
                }
            }
        }
        # arretes terminales
        set Le [Tools::NodeNoToLe $t $n]
        foreach e $Le {
            if {[$w itemcget $e -state] != "hidden"} {
                $w addtag $TAG withtag $e
                $w itemconfigure $e -state hidden
            }
        }
        # tree
        set lchild [Tools::NodeNoCoFaToNoCoCh $t $n]
        foreach i $lchild {
            if {[$w itemcget $i -state] != "hidden"} {
                $w addtag $TAG withtag [format "%s%s" $i C]
                $w itemconfigure [format "%s%s" $i C] -state hidden
            }
        }
        # ova (en fait que le link)
        set pattern [format "%s%s" $n *]
        foreach idi $B($t,ova)  {
            if  {[string match $pattern $B(OVAnod1,$idi)] == 1 } {
                if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                    $w addtag $TAG withtag  [format "%s%s%s"  link ? $idi ]
                    $w itemconfigure [format "%s%s%s"  link ? $idi ] -state hidden
                    
                }
            }
        }
        # background tree
        set pattern [format "%s%s" $n *]
        foreach idi $B($t,bgs)  {
            if  {[string match $pattern $B(BGSnod,$idi)] == 1 } {
                if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                    $w addtag $TAG withtag  [format "%s%s%s" BGS ? $idi]
                    $w itemconfigure [format "%s%s%s" BGS ? $idi] -state hidden
                    
                }
            }
        }
        ### mem & text a afficher en D3
        lappend B($t,shi) $id
        set B(SHInod,$id) $n
        set B(SHItxt,$id) -
        set B(SHItre,$id) $t
        set B(SHIcol,$id) $S(col)
        set B(SHIsta,$id) normal
        # UNDO
        set S(und) "Abstraction::ShrinkUn $w $t $id"
        return $id
    }
    ###
    proc Shrink {w t n {txt user}} {
        global T S B IMGshn
        set id [format "%s%s" $t [Tools::GenId]]
        # le tag commun a tous les items qui vont passer en mode hidden
        set TAG [format "%s%s%s" SHI ? $id]
        if {[lsearch -exact $B($t,shi) $id] == -1} {
            # dessin
            set c0 [$w coords $n]
            set x0 [lindex $c0 2]
            set y0 [lindex $c0 3]
            $w create text [expr $x0 +5] $y0 -text + \
                    -tags "SHRINK [format "%s%s%s" SHN ? $id]  T$t" -font $S(gfo) -fill $S(col)
            # BLL
            set pattern [format "%s%s" $n *]
            foreach idbll $B($t,bll) {
                if {[string match $pattern $B(BLLnod,$idbll)] == 1 } {
                    if {[$w itemcget $B(BLLidt,$idbll) -state] != "hidden"} {
                        $w addtag $TAG withtag $B(BLLidt,$idbll)
                        $w addtag $TAG withtag $B(BLLidl,$idbll)
                        $w itemconfigure $B(BLLidt,$idbll) -state hidden
                        $w itemconfigure $B(BLLidl,$idbll) -state hidden
                    }
                }
            }
            # leaves
            set leafs [Tools::NodeNoToLe $t $n]
            foreach i $leafs {
                set tagi [list [format "%s%s" EUL  $T($t,ctl,$i)] && T$t]
                if {[$w itemcget $tagi -state] != "hidden"} {
                    $w addtag  $TAG withtag $tagi
                    $w itemconfigure $tagi -state hidden
                }
            }
            # background leaves
            set pattern [format "%s%s" $n *]
            foreach idi $B($t,bgl)  {
                if  {[string match $pattern $B(BGLnod,$idi)] == 1 } {
                    if {[$w itemcget [format "%s%s%s" BGL ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s" BGL ? $idi]
                        $w itemconfigure [format "%s%s%s" BGL ? $idi] -state hidden
                    }
                }
            }
            # arretes terminales
            set Le [Tools::NodeNoToLe $t $n]
            foreach e $Le {
                if {[$w itemcget $e -state] != "hidden"} {
                    $w addtag $TAG withtag $e
                    $w itemconfigure $e -state hidden
                }
            }
            # tree
            set lchild [Tools::NodeNoCoFaToNoCoCh $t $n]
            foreach i $lchild {
                if {[$w itemcget $i -state] != "hidden"} {
                    $w addtag $TAG withtag [format "%s%s" $i C]
                    $w itemconfigure [format "%s%s" $i C] -state hidden
                }
            }
            # ova (en fait que le link)
            set pattern [format "%s%s" $n *]
            foreach idi $B($t,ova)  {
                if  {[string match $pattern $B(OVAnod1,$idi)] == 1 } {
                    if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s"  link ? $idi ]
                        $w itemconfigure [format "%s%s%s"  link ? $idi ] -state hidden
                        
                    }
                }
            }
            # background tree
            set pattern [format "%s%s" $n *]
            foreach idi $B($t,bgs)  {
                if  {[string match $pattern $B(BGSnod,$idi)] == 1 } {
                    if {[$w itemcget [format "%s%s%s" BGS ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s" BGS ? $idi]
                        $w itemconfigure [format "%s%s%s" BGS ? $idi] -state hidden
                        
                    }
                }
            }
            # sous shrink
            set pattern [format "%s%s" $n *]
            foreach idi $B($t,shi)  {
                if  {[string match $pattern $B(SHInod,$idi)] == 1 } {
                    if {[$w itemcget [format "%s%s%s" SHN ? $idi] -state] != "hidden"} {
                        $w addtag $TAG withtag  [format "%s%s%s" SHN ? $idi]
                        $w itemconfigure [format "%s%s%s" SHN ? $idi] -state hidden
                        set B(SHIsta,$idi) hidden
                    }
                }
            }
            ### mem & text a afficher en D3
            lappend B($t,shi) $id
            set B(SHInod,$id) $n
            set B(SHItxt,$id) $txt
            set B(SHItre,$id) $t
            set B(SHIcol,$id) $S(col)
            set B(SHIfon,$id) $S(gfo)
            set B(SHIsta,$id) normal
            # UNDO
            set S(und) "Abstraction::ShrinkUn $w $t $id"
            return $id
        }
    }
    ### comme shrink mais array seuleument col argument en plus
    proc Shrink2 {w t n col {txt user} } {
        global T S B IMGshn
        set id [format "%s%s" $t [Tools::GenId]]
        lappend B($t,shi) $id
        set B(SHInod,$id) $n
        set B(SHItxt,$id) $txt
        set B(SHItre,$id) $t
        set B(SHIcol,$id) $col
        set B(SHIsta,$id) normal
    }
    ###
    proc ShrinkUn {w t id} {
        global B S
        if {[lsearch -exact $B($t,shi) $id] != -1} {
            set p [format "%s%s%s" SHI ? $id]
            set litems [$w find withtag $p]
            foreach j $litems {
                $w itemconfigure $j -state normal
                $w dtag $j $p
            }
            $w delete [format "%s%s%s" SHN ? $id]
            
            # UNDO
            set S(und) "Abstraction::Shrink $w $t $B(SHInod,$id)"
            #mise a jour array B
            set index [lsearch -exact $B($t,shi) $id]
            set B($t,shi) [concat [lrange $B($t,shi) 0 [expr $index - 1]] \
                    [lrange $B($t,shi) [expr $index + 1] end]]
            unset B(SHIsta,$id) ; unset B(SHItre,$id) ; unset B(SHItxt,$id) ; unset B(SHIcol,$id) ; unset B(SHInod,$id)
            
        }
    }
    proc ShrinkUnAll {w t} {
        global B
        foreach id $B($t,shi) {
            ShrinkUn $w $t $id
        }
    }
    # unshrink sachant une liste de node
    proc ShrinkUnLN {w t ln} {
        global B
        set lnshi {}
        foreach id $B($t,shi) {
            lappend lnshi $B(SHInod,$id)
            set transit($B(SHInod,$id)) $id
        }
        foreach n $ln {
            if {[lsearch $lnshi $n] != -1} {
                ShrinkUn $w $t $transit($n)
            }
            
        }
        if [array exists transit] {unset transit}
    }
    ###
    proc ShrinkNodeUpdateColor {w i} {
        global B S
        set tags [$w gettags $i]
        $w itemconfigure $i -fill $S(col)
        set type   [$w type $i]
        if {$type == "polygon"} {
            $w itemconfigure $i -outline $S(col)
        }
        set id [lindex [split [lindex $tags [lsearch -glob $tags SHN*]] ?] end]
        set B(SHIcol,$id) $S(col)
    }
    #
    proc LeafShrink {w t leu} {
        global T S B
        # leaves
        foreach i $leu {
            set tagi [list [format "%s%s" EUL  $i] && T$t]
            $w itemconfigure $tagi -state hidden
        }
        # background leaves
        set ln [Operation::FindFatherNode $t $leu]
        foreach n $ln {
            set pattern [format "%s%s" $n *]
            foreach idi $B($t,bgl)  {
                if  {[string match $pattern $B(BGLnod,$idi)] == 1 } {
                    $w itemconfigure [format "%s%s%s" BGL ? $idi] -state hidden
                }
            }
        }
    }
    #
    proc LeafUnShrink {w t leu} {
        global T S B
        # leaves
        foreach i $leu {
            set tagi [list [format "%s%s" EUL  $i] && T$t]
            $w itemconfigure $tagi -state normal
        }
        # background leaves
        set ln [Operation::FindFatherNode $t $leu]
        foreach n $ln {
            set pattern [format "%s%s" $n *]
            foreach idi $B($t,bgl)  {
                if  {[string match $pattern $B(BGLnod,$idi)] == 1 } {
                    $w itemconfigure [format "%s%s%s" BGL ? $idi] -state normal
                }
            }
        }
    }
    ### SHRINK OPEN/CLOSE NEXT LEVEL
    proc NodeOpen {{w ?}} {
        global S T
        if {$w == "?"} {set w [format "%s%s%s" .t $S(ict) .c]}
        set t [string range $w 2 [expr [string first .c $w] -1]]
        if {$T($t,currentlevel) ==  "?"} {
            set level $T($t,tot)
        } elseif {$T($t,currentlevel) ==  $T($t,tot) } {
            set level $T($t,tot)
        } else {set level $T($t,currentlevel)}
        if {$level !=  $T($t,tot)} {
            set T($t,currentlevel) [expr $level + 1]
            foreach i $T($t,cbg,$level) {
                set bg [format "%s%s" $i g]
                set bd [format "%s%s" $i d]
                foreach n [list $bg $bd] {
                    if {$S(DebugMod) == 1} {
                        puts "LEVEL: $level // NODES $T($t,cbg,$level)"
                        puts "NODE: $n"
                    }
                    set Le [TRE::NoToLe $t $n]
                    set T($t,lsk) [TRE::SousL $T($t,lsk) $Le]
                    set T($t,nsk) [TRE::SousL $T($t,nsk) $n]
                    $w delete Z
                }
            }
        }
        TRE::ArrayToCanvasRedisplay $t
    }
    #
    proc NodeClose {{w ?}} {
        global T S
        if {$w == "?"} {set w [format "%s%s%s" .t $S(ict) .c]}
        set t [string range $w 2 [expr [string first .c $w] -1]]
        if {$T($t,currentlevel) ==  "?"} {
            set level [expr $T($t,tot) - 1]
        } elseif {$T($t,currentlevel) ==  0 } {
            set level 0
        } else {set level [expr $T($t,currentlevel) - 1]}
        if {$T($t,currentlevel) !=  0} {
            set T($t,currentlevel) $level
            foreach i $T($t,cbg,$level) {
                set bg [format "%s%s" $i g]
                set bd [format "%s%s" $i d]
                foreach n [list $bg $bd] {
                    set tagshrink [format "%s%s" $i S]
                    set tags [$w gettags [$w find withtag $n]]
                    set c0 [$w coords $n]
                    if {$S(DebugMod) == 1} {
                        puts "LEVEL: $level // NODES $T($t,cbg,$level)"
                        puts "NODE: $n // TAGS: $tags"
                    }
                    set x0 [lindex $c0 2]
                    set y0 [lindex $c0 1]
                    set Le [TRE::NoToLe $t $n]
                    set T($t,lsk) [concat $T($t,lsk) $Le]
                    set T($t,nsk) [concat $T($t,nsk) $n]
                    foreach e $Le {$w delete $e}
                    set lchild [TRE::NoCoFaToNoCoCh $t $n]
                    foreach i $lchild {
                        $w delete [format "%s%s" $i C]
                        $w delete [format "%s%s" $i R] ;# Box
                    }
                    $w create oval [expr $x0 +2] $y0  [expr $x0 +5] [expr $y0 +3] \
                            -outline $T($t,gfg)  -fill $T($t,gbg) \
                            -tags "$tags L LH Z $tagshrink $Le SHRINK"
                }
            }
        }
    }
    ### Simplification sur la base d'une valeur seuil de bootstrap
    proc NodeOpenClose {{w ?} mode} {
        global T S
        if {$w == "?"} {set w [format "%s%s%s" .t $S(ict) .c]}
        set t [string range $w 2 [expr [string first .c $w] -1]]
        set l {}
        foreach n $T($t,all_cod) {
            if {$n != 0 && [lsearch  $T($t,ue_cod) $n] == -1} {
                if {$T($t,dbv,$n) != "?" && $T($t,dbv,$n)  != "" && $T($t,dbv,$n) <= $S(lim)} {
                    lappend l $n
                }
            }
        }
        set lsup [TRE::FaNoId {} $l]
        # CLOSE
        if {$mode == "c"} {
            foreach i $lsup {
                set n $i
                set tagshrink [format "%s%s" $i S]
                set tags [$w gettags [$w find withtag $n]]
                set c0 [$w coords $n]
                if {$c0 != ""} {
                    set x0 [lindex $c0 2]
                    set y0 [lindex $c0 1]
                    set Le [TRE::NoToLe $t $n]
                    set T($t,lsk) [concat $T($t,lsk) $Le]
                    set T($t,nsk) [concat $T($t,nsk) $n]
                    foreach e $Le {$w delete $e}
                    set lchild [TRE::NoCoFaToNoCoCh $t $n]
                    foreach i $lchild {
                        $w delete [format "%s%s" $i C]
                        $w delete [format "%s%s" $i R] ;# Box
                    }
                    $w create oval [expr $x0 +2] $y0  [expr $x0 +5] [expr $y0 +3] \
                            -outline $T($t,gfg)  -fill $T($t,gbg) \
                            -tags "$tags L LH Z $tagshrink $Le SHRINK"
                }
            }
        }
        # OPEN
        if {$mode == "o"} {
            foreach i $lsup {
                set Le [TRE::NoToLe $t $i]
                set T($t,lsk) [TRE::SousL $T($t,lsk) $Le]
                set T($t,nsk) [TRE::SousL $T($t,nsk) $i]
                $w delete Z
            }
        }
        TRE::ArrayToCanvasRedisplay $t
    }
    
    #
    proc AbsGo {} {
        global S abs
        if {[.abs.lfb.l get 0 end] != {}} {
            # liste de tree target
            set lkv [array get S *,tar]
            set ltreetarget {}
            foreach {k v} $lkv {
                if {$S($k) == 1} {
                    lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
                }
            }
            # feuilles en selection
            # si on est en remove, la liste des feuilles est la
            # liste des feuilles available moins la liste des feuilles en selection
            switch $abs(What) {
                display {
                    set EUS [.abs.lfb.l get 0 end]
                }
                hidden   {
                    set EUS [Tools::SousL [.abs.lfa.l get 0 end] [.abs.lfb.l get 0 end]]
                }
            }
            #
            switch $abs(Mode) {
                shrink {
                    # pour chaque tree en target identifier SHRINK
                    # des noeuds pere sachant la liste leaf en selection
                    foreach t $ltreetarget {
                        set peres  [FindFatherNode $t $EUS]
                        foreach e $peres {
                            Shrink $S($t,w) $t $e "Leaves Abstraction"
                        }
                    }
                }
                collapse {
                    # pour chaque tree en target identifier COLLAPSE
                    # des noeuds pere sachant la liste leaf en selection
                    foreach t $ltreetarget {
                        NewickAbstract  $S($t,w) $t $EUS
                    }
                }
            }
        }
    }
    
    # mise a jour liste des feuilles en fonction des arbres en target
    proc AbsAddAvailableLeaves {} {
        global S abs T
        # liste de tree target
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        # construction de la liste des feuilles de tous lmes arbres en selection
        # liste sans repetitions, classe par ordre alpha et respectant le filtre
        set leu {}
        if {$abs(stringsearch) != "*"} {
            foreach t $ltreetarget  {
                foreach i $T($t,ue_lab) {
                    if {[string match $abs(stringsearch) $i]} {lappend leu $i }
                }
            }
        } else  {
            foreach t $ltreetarget  {
                set leu [concat $leu $T($t,ue_lab)]
            }
        }
        if {[llength $ltreetarget] != 1} {set leu [Tools::DelRep $leu]}
        set leu [lsort -dictionary $leu]
        # remplissage listbox
        .abs.lfa.l delete 0 end
        eval {.abs.lfa.l insert end} $leu
        # reconfiguration background des feuilles de la listbox
        # pour celles deja en selection
        if {[.abs.lfb.l get 0 end] != {}} {AbsConfigBg}
        # mise ajour nb de feuille availabale
        set abs(nbLavailable) [llength [.abs.lfa.l get 0 end]]
    }
    # l'utilisateur modifie le filtre, mise a jour de la listbox des feuilles available
    # attention respect de la casse
    proc AbsUpdateActionFilter {} {
        Abstraction::AbsAddAvailableLeaves
    }
    # config bg si deja en selection
    proc AbsConfigBg {} {
        global S
        set li {}
        set lavailable [.abs.lfa.l get 0 end] ;# feuilles available
        .abs.lfa.l delete 0 end
        eval {.abs.lfa.l insert end} $lavailable
        set selectL [.abs.lfb.l get 0 end] ;# feuilles en selection
        foreach e $selectL {
            set r [lsearch $lavailable $e]
            if {$r != -1} {lappend li $r}
        }
        foreach i $li {
            .abs.lfa.l itemconfigure $i -background NavajoWhite2
        }
    }
    #
    proc AbsaddLeafMouse {listbox x y} {
        global S abs
        set leaf [$listbox get @$x,$y]
        set selectL [.abs.lfb.l get 0 end]
        if {[lsearch $selectL $leaf] == -1}  {
            .abs.lfb.l insert 0 $leaf
        }
        .abs.lfa.l selection clear @$x,$y
        AbsConfigBg
        set abs(nbLselection) [llength [.abs.lfb.l get 0 end]]
    }
    # boutton ajout de la selection leave available dans la liste selection
    proc AbsAddL {} {
        global S abs
        # mise a jour listbox fichiers selection
        # on conserve l'ordre des groupes de selection
        set li [.abs.lfa.l curselection] ;# des index
        set lsel {}
        foreach i $li {
            lappend lsel [.abs.lfa.l get $i]
            .abs.lfa.l itemconfigure $i -background NavajoWhite2
        }
        set lall2 [.abs.lfb.l get 0 end]
        .abs.lfb.l delete 0 end
        # c moche je sais
        foreach e $lsel {
            lappend lall2 $e
        }
        #
        foreach e [Tools::DelRep $lall2] {
            .abs.lfb.l insert 0 $e
        }
        # deselection des fichiers liste available
        .abs.lfa.l selection clear 0 end
        # update nb de tree total
        set abs(nbLselection) [llength $lall2]
    }
    #
    proc AbsRemL {} {
        global abs
        # attention retrait a partir de l'index le plus bat
        # le delete remet a jour les index
        set li [lsort -decreasing [.abs.lfb.l curselection]] ;# des index
        foreach i $li {
            .abs.lfb.l delete $i
        }
        # deselection des fichiers liste available
        .abs.lfa.l selection clear 0 end
        set abs(nbLselection) [llength [.abs.lfb.l get 0 end]]
        AbsConfigBg
    }
    #
    proc AbsremLeafMouse {listbox x y} {
        global S abs
        $listbox delete @$x,$y
        AbsConfigBg
        set abs(nbLselection) [llength [.abs.lfb.l get 0 end]]
    }
    ### OPTIMISATION : si un node est ok : ne pas tester ses nodes fils
    proc FindFatherNode {t SouRefLea} {
        global S T
        set L {}
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $T($t,all_cod)] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test inclusion des references leaf de TARGET avec SOURCE
                if {$S(nodefilter) == 0} {
                    set r [Tools::ListInclu $TarRefLea $SouRefLea]
                    if {$r == 1} {lappend L $TarCodNod}
                } else  {
                    set r [Tools::ListIncluSauf $TarRefLea $SouRefLea $S(nodefilter)]
                    if {$r == 1} {lappend L $TarCodNod}
                }
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {
            if {[lsearch -exact $T($t,ue_lab) $SouRefLea] != -1} {return $T($t,ltc,$SouRefLea)} else {return {}}
        }
    }
}
####################


####################
# LOCALISATION
####################
namespace eval Localisation {
    
    
    
    ###
    proc LocalisationEU {w t EUS } {
        Operation::Operation $w $t $EUS
    }
    ###
    proc LocalisationDB {w t database var val } {
        global S
        set S(query) [format "%s%s%s" $var " == " $val]
        set records [Database::dbQueryRecordsFromVarVal $database $var $val]
        set EUS [Database::dbQueryEusFromRecords $database $records]
        Operation::Operation $w $t $EUS
    }
}
####################


####################
# IDENTIFICATION
####################
namespace eval Identification {
    
    
    #
    proc SelectUpdateAscend {t SouRefLea} {
        global S
        if {$S(nodefilter) == 0} {
            SelectUpdateAscendOriginal $t $SouRefLea
        } else  {
            SelectUpdateAscendSauf $t $SouRefLea
        }
    }
    ### OPTIMISATION : si un node est ok : ne pas tester ses nodes fils
    proc SelectUpdateAscendOriginal {t SouRefLea} {
        global S T
        set L {}
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $T($t,all_cod)] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test inclusion des references leaf de TARGET avec SOURCE
                if {$S(nodefilter) == 0} {
                    set r [Tools::ListInclu $TarRefLea $SouRefLea]
                    if {$r == 1} {lappend L $TarCodNod}
                } else  {
                    set r [Tools::ListIncluSauf $TarRefLea $SouRefLea $S(nodefilter)]
                    if {$r == 1} {lappend L $TarCodNod}
                }
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {return $T($t,ltc,$SouRefLea) }
    }
    ### OPTIMISATION : si un node est ok : ne pas tester ses nodes fils
    proc SelectUpdateAscendSauf {t SouRefLea} {
        global S T
        set L {}
        # on ne prend pas en compte les codes des feuilles
        set latest [Tools::SousL $T($t,all_cod) $T($t,ue_cod)]
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $latest] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test inclusion des references leaf de TARGET avec SOURCE
                set r [Tools::ListIncluSauf $TarRefLea $SouRefLea $S(nodefilter)]
                if {$r == 1} {lappend L $TarCodNod}
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {return $T($t,ltc,$SouRefLea) }
    }
    ###
    proc InitGraph {} {
        global S
        foreach key [array names S *,tar]  {
            if {$S($key) == 1} {
                set t [string range $key 0 [expr [string first , $key] - 1]]
                Figuration::NodeGraVarInit $t
            }
        }
    }
    ### Bulle Labels : UEs
    proc InsertBulUE {w x y i} {
        global S T
        set tags [$w gettags $i]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        if {[lsearch -exact $T($t,all_cod) $n] != -1} {
            set La {}
            set SouCodLea [Tools::NodeNoToLe $t $n]
            set UE [lsort -dictionary [Tools::NodeLeCoToRe $t $SouCodLea]]
            foreach i $UE {
                regsub -all {?} $i " " texti
                lappend La $texti
                #lappend La [string toupper $i]
            }
            
            Annotation::BLLmake $w $t $x $y  \
                    [format "%s%s" [llength $La] " Leaves : "]\
                    [Tools::FormatText  $La] $n
            
        }
    }
    ### Bulle Labels : DB
    proc InsertBulDBCommonTags {w x y i} {
        global S T db
        set tags [$w gettags $i]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        set euls [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $n]]
        set lrecords {}
        set database $S(database)
        if {$database != ""} {
            foreach eu $euls {
                lappend lrecords [Database::dbQueryRecordsFromVarVal $database EU $eu]
            }
            # pour chaque record on reduit la A-List a une liste de var#val (concat)
            # on a donc une liste de liste, on cherche l'intersection
            upvar #0 $database X
            set ll {}
            foreach record $lrecords {
                set l {}
                foreach {var val} $X($record) {
                    lappend l [format "%s%s%s" $var = $val]
                }
                lappend ll $l
            }
            set intersection [lsort -dictionary [Tools::operatorANDll $ll]]
            # ?
            #lappend intersection
            Annotation::BLLmake $w $t $x $y \
                    [format "%s%s" [llength $intersection] " Labels (Common, $database) : "]\
                    [Tools::FormatText  $intersection] $n
        }
    }
    ### LABEL : NODE / Intersection Variables-Modalites avec Specificite
    proc InsertBulDBSpecificTags {w x y i}  {
        global S T db
        set tags [$w gettags $i]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        set euls [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $n]]
        set lrecords {}
        set database $S(database)
        if {$database != ""} {
            foreach eu $euls {
                lappend lrecords [dbQueryRecordsFromVarVal $database EU $eu]
            }
            # pour chaque record on reduit la A-List a une liste de var=val (concat)
            # on a donc une liste de liste, on cherche l'intersection
            upvar #0 $database X
            set ll {}
            foreach record $lrecords {
                set l {}
                foreach {var val} $X($record) {
                    lappend l [format "%s%s%s" $var = $val]
                }
                lappend ll $l
            }
            #
            set intersection [lsort -dictionary [Tools::operatorANDll $ll]]
            
        }
    }
    #
    proc InsertBulDBCouple {w t x y n couple} {
        global S
        set database $S(database)
        Annotation::BLLmake $w $t $x $y \
                $database\
                $couple $n
    }
    #
    proc InsertVarVal {w t x y n} {
        global S
        set database $S(database)
        set q $S(query)
        Annotation::BLLmake $w $t  [$w canvasx $x] [$w canvasy $y ]  \
                $database [lrange $q [expr [lsearch $q where] + 1] end] $n
    }
    proc InsertVarVal2 {w t x y n} {
        global S
        set database $S(database)
        set q $S(query)
        Annotation::BLLmake $w $t [$w canvasx $x] [$w canvasy $y ] \
                $database [lindex $q  end] $n
    }
    
    
    
    
}
####################


####################
# ORIENTATION
####################

namespace eval Orientation {
    ### proc ok(sauf conformation circulaire)
    ### nb : tourne sur T$t pour l'instant
    ### le menu/submenu "orientation" du menu contextuel TREE
    ### n'apparait pas si le type de l'arbre est circulaire
    ### pour etendre Anchor aux vues circulaires : integrer la gestion des arcs
    ### donc filtrer selon le type de l'item
    proc Anchor {w t} {
        global T S
        set co [$w bbox T$t]
        set wi [expr [lindex $co 2] - [lindex $co 0]]
        set he [expr [lindex $co 3] - [lindex $co 1]]
        set items [$w find withtag T$t]
        set b [$w bbox T$t]
        set x0 [lindex $b 3]
        set x0prim [lindex $b 0]
        foreach i $items {
            set ic [$w coords $i]
            set x1 [lindex $ic 0]
            set y1 [lindex $ic 1]
            set x2 [lindex $ic 2]
            set y2 [lindex $ic 3]
            switch [$w type $i] {
                line  {
                    $w coords $i [expr $x0 + ($x0 - $x1)] $y1 [expr $x0 + ($x0 - $x2)] $y2
                }
                text {
                    $w coords $i [expr $x0 + ($x0 - $x1)] $y1
                    $w itemconfigure $i -anchor e
                }
            }
        }
        $w move T$t [expr $x0prim - $x0] 0
        Figuration::RestaureT $w $t
    }
}
####################


####################
# CONFORMATION
####################
namespace eval Conformation {
    
    
    
    # Stage de Alex Guez
    ###
    proc Swap {w {t ?} {n ?}} {
        global S
        if {$n == "?" } {
            set tags [$w gettags [$w find withtag current]]
            set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
            set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        }
        #
        if {$t != "" && $n != ""} {
            SwapOperation $w $t $n
            Figuration::RedrawT $w $t
            Navigation::FitToContents $w
        }
    }
    ###
    proc SwapOperation {w {t ?} {n ?}} {
        global T S B
        if {$n == $t} {
            set gen $t
            set sg [format "%s%s" $gen g]
            set sd [format "%s%s" $gen d]
        }  else  {
            set gen [expr [llength [split $n {g d}]] - 1]
            set sg [format "%s%s%s" $n $gen g]
            set sd [format "%s%s%s" $n $gen d]
        }
        set NoCoFaToNoCoCh [Tools::NodeNoCoFaToNoCoCh  $t $n]
        set SouCodLeaALL $T($t,ue_cod)
        set SouRefLeaALL $T($t,ue_lab)
        set SouCodLeaG [Tools::NodeNoToLe $t $sg]
        set SouRefLeaG [Tools::NodeLeCoToRe $t $SouCodLeaG]
        set SouCodLeaD [Tools::NodeNoToLe $t $sd]
        set SouRefLeaD [Tools::NodeLeCoToRe $t $SouCodLeaD]
        ### T ARRAY MAJ T(t,xxx,from n)
        # ne pas utiliser l'option -all avec les regsub, car 0g* matche 10g*
        set pg [format "%s%s" $sg *]
        set pd [format "%s%s" $sd *]
        set kvg [array get T $t,*,$pg]
        set kvd [array get T $t,*,$pd]
        foreach {key value} $kvd {unset T($key)}
        foreach {key value} $kvg {unset T($key)}
        foreach {key value} $kvg {
            regsub $sg $key $sd keyswi ; set T($keyswi) $value
        }
        foreach {key value} $kvd {
            regsub $sd $key $sg keyswi ; set T($keyswi) $value
        }
        ### T ARRAY MAJ T(t,ltc,*)
        foreach codeleaf $SouCodLeaG nameleaf $SouRefLeaG {
            regsub  $sg $T($t,ltc,$nameleaf) \
                    $sd T($t,ltc,$nameleaf)
        }
        foreach codeleaf $SouCodLeaD nameleaf $SouRefLeaD {
            regsub  $sd $T($t,ltc,$nameleaf) \
                    $sg T($t,ltc,$nameleaf)
        }
        # si clic racine et si indice arbre 2 et arbre,tot =2 ca plante
        for {set i 0} {$i < $T($t,tot)} {incr i} {
            set codegene $T($t,cbg,$i)
            set T($t,cbg,$i) {}
            #puts "SWAP DEDANS iteration codegene= $codegene"
            
            foreach e $codegene {
                switch -glob $e \
                        $pg {regsub $sg $e $sd e ; lappend T($t,cbg,$i) $e} \
                        $pd {regsub $sd $e $sg e ; lappend T($t,cbg,$i) $e} \
                        default {lappend T($t,cbg,$i) $e}
            }
            puts "SWAP T($t,cbg,$i) $T($t,cbg,$i)"
        }
        
        ### T ARRAY MAJ T(t,all_cod)
        set codall $T($t,all_cod)
        set T($t,all_cod) {}
        foreach e $codall {
            switch -glob $e \
                    $pg {regsub $sg $e $sd e ; lappend T($t,all_cod) $e} \
                    $pd {regsub $sd $e $sg e ; lappend T($t,all_cod) $e} \
                    default {lappend T($t,all_cod) $e}
        }
        # B ARRAY MAJ B(BLLnod,$id)
        set lkv [array get B BLLnod,*]
        foreach {key value} $lkv {
            switch -glob $value \
                    $pg {regsub $sg $value $sd value ; set B($key) $value} \
                    $pd {regsub $sd $value $sg value ; set B($key) $value} \
                    default {set B($key) $value}
        }
        # B ARRAY MAJ B(SHInod,$id)
        set lkv [array get B SHInod,*]
        foreach {key value} $lkv {
            switch -glob $value \
                    $pg {regsub $sg $value $sd value ; set B($key) $value} \
                    $pd {regsub $sd $value $sg value ; set B($key) $value} \
                    default {set B($key) $value}
        }
        # B ARRAY MAJ B(OVAnod,$id)
        set lkv [array get B OVAnod*,*]
        foreach {key value} $lkv {
            switch -glob $value \
                    $pg {regsub $sg $value $sd value ; set B($key) $value} \
                    $pd {regsub $sd $value $sg value ; set B($key) $value} \
                    default {set B($key) $value}
        }
        # B ARRAY MAJ B(BGSnod,$id)
        set lkv [array get B BGSnod*,*]
        foreach {key value} $lkv {
            switch -glob $value \
                    $pg {regsub $sg $value $sd value ; set B($key) $value} \
                    $pd {regsub $sd $value $sg value ; set B($key) $value} \
                    default {set B($key) $value}
        }
        # B ARRAY MAJ B(BGSnod,$id)
        set lkv [array get B BGLnod*,*]
        foreach {key value} $lkv {
            switch -glob $value \
                    $pg {regsub $sg $value $sd value ; set B($key) $value} \
                    $pd {regsub $sd $value $sg value ; set B($key) $value} \
                    default {set B($key) $value}
        }
        # B ARRAY MAJ B(CONnod,$id)
        # ATTENTION value est une liste de node le switch ne passe pas si le node
        # en question n'est pas en debut de liste, on passe tous les elements de value
        # en revue
        set lkv [array get B CONnod,*]
        foreach {key value} $lkv {
            foreach v $value {
                switch -glob $v \
                        $pg {regsub $sg $value $sd value ; set B($key) $value} \
                        $pd {regsub $sd $value $sg value ; set B($key) $value} \
                        default {set B($key) $value}
            }
            
        }
        set lkv [array get B CONnod,*]
        ### T ARRAY MAJ T(t,ue_cod)
        ### T ARRAY MAJ T(t,ue_lab)
        ### ATTENTION LISTES ORDONNEES
        set esup [lrange $SouRefLeaG 0 0]
        set einf [lrange $SouRefLeaD end end]
        set isup [lsearch $SouRefLeaALL $esup]
        set iinf [lsearch $SouRefLeaALL $einf]
        set T($t,ue_lab) [join [lreplace $SouRefLeaALL $isup $iinf $SouRefLeaD $SouRefLeaG]]
        unset T($t,ue_cod)
        foreach ref $T($t,ue_lab) {
            lappend T($t,ue_cod) $T($t,ltc,$ref)
        }
    }
    ### OUTGROUP
    proc Outgroup {w mode {tsource ?} {n ?}} {
        global T S B
        if {$tsource == "?"} {
            set id [$w find withtag current]
            set tags [$w gettags $id]
            set tsource [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
            set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        }
        if {$n != "" && $n != $tsource} {
            set co [$w bbox [list Z && T$tsource]]
            set px [lindex $co 0]
            set py [lindex $co 1]
            set wi   [expr [lindex $co 2] - [lindex $co 0]]
            set he   [expr [lindex $co 3] - [lindex $co 1]]
            set t [expr [lrange  [lsort  -integer -increasing $S(ilt)] end end] + 1]
            lappend S(ilt) $t
            set T($t,nwk) [NewickReBuild $tsource $n]
            ImportExport::TreeInit $t
            if {[catch [ImportExport::NewickParser_Root $t $T($t,nwk)] result] != 0} {
                ImpotExport::UpdateArrayCanvas $w $t
                Interface::TreeDynMessage "Error"
            }  else {
                set w2 [ImportExport::NewCanvas]
                set S($t,w) $w2
                set S($t,tit) $S($tsource,tit)
                set S($t,type) $S($tsource,type)
                lappend S($w2,t) $t
                Conformation::ArrToCanType2 $t $w2 0 0 $wi $he
                ImportExport::NodeBind $w2 $t
                Operation::TreeViewerPanelUpdate
            }
        }
    }
    # outgroup tree meme window delete du tree precedent
    proc Outgroup2 {w mode {tsource ?} {n ?}} {
        global T S B
        if {$tsource == "?"} {
            set id [$w find withtag current]
            set tags [$w gettags $id]
            set tsource [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
            set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        }
        if {$n != "" && $n != $tsource} {
            set co [$w bbox [list Z && T$tsource]]
            set px [lindex $co 0]
            set py [lindex $co 1]
            set wi   [expr [lindex $co 2] - [lindex $co 0]]
            set he   [expr [lindex $co 3] - [lindex $co 1]]
            set t [expr [lrange  [lsort  -integer -increasing $S(ilt)] end end] + 1]
            lappend S(ilt) $t
            set T($t,nwk) [NewickReBuild $tsource $n]
            TDcom::TreeInit $t
            if {[catch [ImportExport::NewickParser_Root $t $T($t,nwk)] result] != 0} {
                ImportExport::UpdateArrayCanvas $w $t
                #Interface::TreeDynMessage "Error"
            }  else {
                #set w2 [ImportExport::NewCanvas]
                set S($t,w) $w
                set S($t,tit) $S($tsource,tit)
                set S($t,type) $S($tsource,type)
                lappend S($w,t) $t
                TDcom::PhyNJ $t $w
                #Conformation::ArrToCanType2 $t $w 0 0 $wi $he
                #ImportExport::NodeBind $w $t
                # delete tree
                ImportExport::UpdateArrayCanvas $w $tsource
                set S($t,tar) 1
                #Operation::TreeViewerPanelUpdate
            }
        }
    }
    #
    proc NewickReBuild {t n} {
        global T
        # 50%
        set bl [expr 0.5 * $T($t,dbl,$n)]
        if [catch {set test $T($t,dbv,$n)} res] {
            set bv ""
        } else {
            set np [Tools::NodeParentNode $t $n]
            set bv $T($t,dbv,$np)
        }
        # noeud pointe garde bv et bl/2 (50%)
        set id [string last ":" $T($t,nwk,$n)]
        set nwkn [format "%s%s%s" [string range $T($t,nwk,$n) 0 [expr $id - 1]] ":" $bl]
        # brother node
        set bn [Tools::NodeBrotherNode $n]
        set nwkbn $T($t,nwk,$bn)
        ###
        set T(newick)  [format "%s%s%s%s%s%s%s%s%s%s" "(" $nwkn  ",(" $nwkbn "," xxx ")"  ":" $bl ");"]
        NewickReBuildRec $t $n
        return $T(newick)
    }
    proc NewickReBuildRec {t n} {
        global T
        set nn [string trimleft $n $t]
        switch -exact $nn {
            d1d {NewickInsertFinal $t [format "%s%s" $t g]}
            d1g {NewickInsertFinal $t [format "%s%s" $t g]}
            g1d {NewickInsertFinal $t [format "%s%s" $t d]}
            g1g {NewickInsertFinal $t [format "%s%s" $t d]}
            default {
                set pn [Tools::NodeParentNode $t $n]
                set bn [Tools::NodeBrotherNode $pn]
                NewickInsert $t $bn $pn
                NewickReBuildRec $t $pn
            }
        }
    }
    ###
    proc NewickInsert {t n no} {
        global T
        if [catch {set test $T($t,dbv,$no)} res] {
            set bv ""
        } else {
            set np [Tools::NodeParentNode $t $n]
            set bv $T($t,dbv,$no)
        }
        set ns [format "%s%s%s%s%s%s%s%s" ( xxx , $T($t,nwk,$n) ) $bv : $T($t,dbl,$no) ]
        regsub "xxx" $T(newick) $ns T(newick)
    }
    ###
    proc NewickInsertFinal {t n} {
        global T
        set bl [expr $T($t,dbl,[format "%s%s" $t g]) + $T($t,dbl,[format "%s%s" $t d])]
        set id [string last ":" $T($t,nwk,$n)]
        #set id [string last ")" $T($t,nwk,$n)]
        set nwkn [format "%s%s%s" [string range $T($t,nwk,$n) 0 [expr $id - 1]] ":" $bl]
        
        puts $T($t,nwk,$n)
        puts $nwkn
        regsub "xxx" $T(newick) $nwkn T(newick)
    }
    ###
    proc NewickReBuildInit {t n} {
        global T
        set bn [Tools::NodeBrotherNode $n]
        set bnd1 [expr 0.8 * $T($t,dbl,$bn)]
        set bnd2 [expr 0.2 * $T($t,dbl,$bn)]
        set tp2 [string last ":" $T($t,nwk,$bn)]
        set nwk [string range $T($t,nwk,$bn) 0 [expr $tp2 - 1]]
        if {[array exists T($t,dbv,$n)] == 0} {
            set T(newick) [format "%s%s%s%s%s%s%s%s%s%s%s" \
                    "((" "xxx" "," $nwk ":" $bnd1 "):" $bnd2 "," $T($t,nwk,$n) ")" ]
        } else {
            set T(newick) [format "%s%s%s%s%s%s%s%s%s%s%s%s%s" \
                    "((" "xxx" "," $nwk ":" $bnd1 ")" $T($t,dbv,$n) ":" $bnd2 "," $T($t,nwk,$n) ")" ]
        }
    }
    ### LADDER
    proc Ladder {w t in m} {
        global T S
        set pg [format "%s%s%s" $in * g ]
        set espaceg [array get T $t,dbl,$pg ]
        set lcode {}
        foreach {k v} $espaceg {
            set codeg [string range $k [expr [string last "," $k] + 1] end]
            set longcodeg [string length $codeg]
            #set coded [format "%s%s" [string range $codeg 0 [expr $longcodeg - 2] ] d]
            set coded [format "%s%s" [string trimright $codeg g] d]
            set nbchildd [Tools::NodeNoToLeNum $t $coded]
            set nbchildg [Tools::NodeNoToLeNum $t $codeg]
            set cmd [list $nbchildd $m $nbchildg]
            if $cmd  {
                set level [expr [regsub -all d $coded d pwet] + [regsub -all g $coded g pwet] -1]
                set longpattern [string length [format "%s%s" $level d]]
                set coco [string range  $coded 0 [expr [string length $coded] - $longpattern -1 ] ]
                if {$coco != ""} {lappend lcode $coco}
            }
        }
        set LCODE [lsort -command LengthCompar $lcode]
        foreach code $LCODE {
            SwapOperation $w $t $code
        }
        Figuration::RedrawT $w $t
    }
    ###
    proc LengthCompar {c1 c2} {
        if {[string length $c1] >= [string length $c2]} {
            return 0
        } {
            return 1
        }
    }
    ###
    proc LaddUp {w} {
        set id [$w find withtag current]
        set tags [$w gettags $id]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            Ladder $w $t $n >
        }
    }
    ###
    proc LaddDown {w} {
        set id [$w find withtag current]
        set tags [$w gettags $id]
        set t [string range  [lindex $tags [lsearch -glob $tags T*]] 1 end]
        set n [string trimright [lindex $tags [lsearch -glob $tags *C]] C]
        if {$n != ""} {
            Ladder $w $t $n <
        }
    }
}
####################


####################
# SELECTION
####################
namespace eval Selection {
    
    # retourne la A-liste $windows $tree pour tous les tree en target d'une session treedyn
    proc TreeTar {} {
        global S
        set l {}
        foreach key [array names S *,tar]  {
            if {$S($key) == 1} {
                set t [string range $key 0 [expr [string first , $key] - 1]]
                if {$t != 0} {
                    if {[lsearch -exact $l $t] == -1} {lappend l $S($t,w) $t}
                }
            }
        }
        return $l
    }
}
####################



####################
# DATABASE query langage implementation + browser interface
####################
namespace eval Database {
    
    ### OK extraire la liste de tous les enregistrements
    proc dbQueryRecordsAll {database} {
        upvar #0 $database X
        return [array names X]
    }
    ### OK extraire la liste des variables d'une database
    proc dbQueryVarAll {database} {
        upvar #0 $database X
        set l {}
        foreach record [array names X] {
            foreach {key value} $X($record) {
                if {[lsearch -exact $l $key] == -1} {lappend l $key}
            }
        }
        return $l
    }
    ### OK extraire la liste des EUs sachant une liste de records
    proc dbQueryEusFromRecords {database lid} {
        upvar #0 $database X
        set l {}
        foreach record $lid {
            set t $X($record)
            if {!([set pos [lsearch $t EU]]%2)} {
                # lappend l [lindex $t [incr pos]]
                # modif au cas ou plusieurs records pour la meme eu
                set val [lindex $t [incr pos]]
                if {[lsearch -exact $l $val] == -1} {lappend l $val}
            }
        }
        return $l
    }
    ###
    proc dbQueryVarFromRecords {database var lid} {
        upvar #0 $database X
        set l {}
        foreach record $lid {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                # lappend l [lindex $t [incr pos]]
                # modif au cas ou plusieurs records pour la meme eu
                set val [lindex $t [incr pos]]
                if {[lsearch -exact $l $val] == -1} {lappend l $val}
            }
        }
        return $l
    }
    ### OK extraire la liste des val sachant une var
    proc dbQueryValFromVar {database var} {
        upvar #0 $database X
        set l {}
        foreach record [array names X] {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                set val [lindex $t [incr pos]]
                if {[lsearch -exact $l $val] == -1} {lappend l $val}
            }
        }
        return $l
    }
    ### OK extraire la liste des Records verifiant un couple variable valeur
    ### EGALITE
    proc dbQueryRecordsFromVarVal {database var val} {
        upvar #0 $database X
        set l {}
        foreach record [array names X] {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                set valquery [lindex $t [incr pos]]
                if {[lsearch -exact $valquery $val] != -1} {
                    lappend l $record
                }
            }
        }
        return $l
    }
    ### OK extraire la liste des Records verifiant l'operator sur un couple variable valeur
    proc dbQueryRecordsFromVarOpVal {database var operator val} {
        upvar #0 $database X
        set l {}
        foreach record [array names X] {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                set valquery [lindex $t [incr pos]]
                set a [format "%s%s%s" \" $val \"]
                set b [format "%s%s%s" \" $valquery \"]
                if [expr $b $operator $a ] {
                    lappend l $record
                }
            }
        }
        return $l
    }
    ### OK extraire la liste des Records verifiant l'operator ## sur un couple variable valeur
    ### l'operator ## est utilis?Š pour un pattern matching
    ### permet de traiter des listes
    proc dbQueryRecordsFromVarPatVal {database var val} {
        upvar #0 $database X
        set l {}
        regsub -all " " $val "" val
        foreach record [array names X] {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                set valquery [lindex $t [incr pos]]
                # attention le pattern
                # if {[lsearch -exact $valquery $val] != -1} {
                # lappend l $record
                # }
                foreach v $valquery {
                    if [string match -nocase $val $v ] {
                        lappend l $record
                    }
                }
            }
        }
        return $l
    }
    ### l'inverse de dbQueryRecordsFromVarPatVal
    ### permet de traiter des cas comme select les eu qui ne contiennent pas
    ### telle valeur (val) pour telle variable
    ### les listes sont possibles
    proc dbQueryRecordsFromVarPat2Val {database var val} {
        upvar #0 $database X
        set l {}
        regsub -all " " $val "" val
        foreach record [array names X] {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                set valquery [lindex $t [incr pos]]
                # attention doit etre verifier sur tous les elements de la liste
                set presence 0
                foreach v $valquery {
                    if {[string match -nocase $val $v ]} {
                        set presence 1
                    }
                }
                if {$presence == 0} {lappend l $record}
            }
        }
        return $l
    }
    
    ### OK extraire la liste des eus verifiant un couple variable valeur
    proc dbQueryEusFromVarVal {database var val} {
        upvar #0 $database X
        set l {}
        foreach record [array names X] {
            set t $X($record)
            if {!([set pos [lsearch $t $var]]%2)} {
                set valquery [lindex $t [incr pos]]
                if {$val == $valquery} {
                    lappend l $record
                }
            }
        }
        set eus [dbQueryEusFromRecords $database $l]
        return $eus
    }
    
    ### SELECT $var1 FROM $database WHERE $var2 $operator $val2 AND/OR ...
    ### SELECT + ResAndOr : cool :)
    proc Select {args} {
        global S T
        regsub -all "\}|\{|and|or" $args "" nb
        switch [llength $nb] {
            0 { set help " "
                return $help
            }
            3 {
                set var [lindex $args 0]
                set database [lindex $args 2]
            }
            7 {
                ### SELECT $var1 FROM $database WHERE $var2 $operator $val2
                set var1 [lindex $args 0]
                set database [lindex $args 2]
                set var2 [lindex $args 4]
                set operator [lindex $args 5]
                set val2 [lindex $args 6]
                if {$operator == "##"} {
                    set res1 [Database::dbQueryRecordsFromVarPatVal $database $var2 $val2]
                } elseif {$operator == "!#"} {
                    set res1 [Database::dbQueryRecordsFromVarPat2Val $database $var2 $val2]
                } else {
                    set res1 [Database::dbQueryRecordsFromVarOpVal $database $var2 $operator $val2]
                }
                set res2 [Database::dbQueryVarFromRecords $database $var1 $res1]
                # allumage
                if {$var1 == "EU" && $S(loc) == 1} {
                    set AlistWTtarget [Selection::TreeTar]
                    if {$AlistWTtarget != {}} {
                        foreach {wi ti} $AlistWTtarget {
                            Operation::Operation $wi $ti $res2
                            set leu {}
                            foreach e $res2 {
                                if {[lsearch -exact $T($ti,ue_lab) $e] != -1} {lappend leu $e}
                            }
                        }
                    }
                }
            }
            default {
                if {[lsearch -exact $args and] != -1 || [lsearch -exact $args or] != -1} {
                    ########### PHASE 1 résolution des couples $var $op $val
                    set S(loc) 0
                    set var1 [lindex $args 0]
                    set database [lindex $args 2]
                    set where [lsearch -exact $args where]
                    set queries [lrange $args [expr $where + 1] end]
                    regsub -all "\}|\{| and | or " $queries " " Alistqueries
                    set i 0
                    set lq $queries
                    global q
                    foreach {var op val} $Alistqueries {
                        incr i
                        if {$op == "##"} {
                            set res1 [Database::dbQueryRecordsFromVarPatVal $database $var $val]
                        } elseif {$op == "!#"} {
                            set res1 [Database::dbQueryRecordsFromVarPat2Val $database $var $val]
                        } else {
                            set res1 [Database::dbQueryRecordsFromVarOpVal $database $var $op $val]
                        }
                        set q($i) $res1
                        # je remplace le triplet var op val par l'indice ds array q
                        # qui contient le resultat de ce triplet
                        regsub -all {\+} "$var $op $val" {\+} vov
                        regsub $vov $lq $i lq
                        #regsub "$var $op $val" $lq $i lq
                    }
                    regsub -all {\*} $lq "" lq
                    ########### PHASE 2
                    # resolution des operateurs AND , OR avec ordre de priorite selon {}
                    # ... where $q1 AND {{$q2 OR $q3} AND $q4}
                    # ou q est est une liste resulat d'un triplet(var op val)
                    set finalrecords [lsort -dictionary [ResAndOr $lq]]
                    set res2 [Database::dbQueryVarFromRecords $database $var1 $finalrecords]
                    set S(loc) 1
                    if {$var1 == "EU" && $S(loc) == 1} {
                        set AlistWTtarget [Selection::TreeTar]
                        if {$AlistWTtarget != {}} {
                            foreach {wi ti} $AlistWTtarget {
                                Operation::Operation $wi $ti $res2
                                set leu {}
                                foreach e $res2 {
                                    if {[lsearch -exact $T($ti,ue_lab) $e] != -1} {lappend leu $e}
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    # recurssif
    # query est de la forme {{1 and 2} or 3}
    # ou 1 2 3 sont des indices du array q
    proc ResAndOr {query} {
        global q
        set arg1 [lindex $query 0]
        set op [lindex $query 1]
        set arg2 [lindex $query 2]
        if {[llength $arg1] != 1 } {
            set l1 [ResAndOr $arg1]
        } else  {
            set l1 $q($arg1)
        }
        if {[llength $arg2] != 1 } {
            set l2 [ResAndOr $arg2]
        } else  {
            set l2 $q($arg2)
        }
        if {$op == "and"} {
            return [Tools::operatorAND $l1 $l2]
        }
        if {$op == "or"} {
            return [Tools::operatorOR $l1 $l2]
        }
    }
    ###
    proc NodeFilterPanel {} {
        global S
        eval destroy .nodefilter
        set w [toplevel .nodefilter]
        wm title $w "Node Filter"
        # NODE FILTER // tolerance
        set S(nodefilter) 0
        iwidgets::entryfield .nodefilter.ns -width 4 -textvariable S(nodefilter) \
                -labeltext     "Missing Leaves / Node :" -labelpos w -validate numeric -fixed 30
        # NODE FILTER // nb de leafs
        set S(nodefilterNB) np
        iwidgets::entryfield .nodefilter.nn  -width 4 -textvariable S(nodefilterNB) \
                -labeltext "Minimun Leaves / Node :" -labelpos w -validate numeric  -fixed 30
        # PACK
        pack .nodefilter.ns -fill x -expand yes
        pack .nodefilter.nn -fill x -expand yes
    }
    # Percent to color: The following routine produces a color
    # from an integer between 0 and 100, where 0 is red, 50 is yellow,
    # and 100 is green (useful e.g. for painting progress bars):
    proc percent2rgb {n} {
        # map 0..100 to a red-yellow-green sequence
        set n     [expr {$n < 0? 0: $n > 100? 100: $n}]
        set red   [expr {$n > 75? 60 - ($n * 15 / 25) : 15}]
        set green [expr {$n < 50? $n * 15 / 50 : 15}]
        format    "#%01x%01x0" $red $green
    }
    #presented this simple beauty in the Tcl chatroom on 2002-12-18:
    proc randomColor {} {format #%06x [expr {int(rand() * 0xFFFFFF)}]}
    
    #
    proc AddConsole {s} {
        global window
        puts $s
    }
    #
    proc AddColumn {} {
        # construire la colonne du tableur
        .identification.pw.pane0.childsite.ma.t insert cols end 1
        # remplir la table f
        global f
        set NBvariables [expr [llength [array names f 0,*]] -1]
        set NBrecords [expr [llength [array names f *,0]] -1]
        set col [expr $NBvariables + 1]
        for  {set row 1} {$row <= $NBrecords} {incr row} {
            set f($row,$col) -
        }
        set f(0,$col) ?
        # mise a jour
        dbUpdate
    }
    
    # mise a jour database suite MAJ user sur array f
    # de f vers database
    proc dbUpdate {} {
        global f S
        set NBvariables [expr [llength [array names f 0,*]] -1]
        set NBrecords [expr [llength [array names f *,0]] -1]
        set database $S(database)
        upvar #0 $database X
        #on delete X
        unset X
        #et on reconstruit
        db $database
        for  {set row 1} {$row <= $NBrecords} {incr row} {
            set data {}
            append data " \{$f($row,0)\}"
            for  {set col 1} {$col <= $NBvariables} {incr col} {
                # on construit la A-List Var Val
                append data " $f(0,$col) \{[split $f($row,$col)]\}"
            }
            set id [incr S(lastid)]
            eval $database [concat $id EU $data]
        }
        BuiltAddVariableConsole
    }
    # pour l'instant on ne traite que les $rows,0
    # pour ca on utilise pas $f($s) directement
    proc LocalisationMatrixUser {s} {
        global f S T
        set row [string range $s 0 [expr [string first , $s] - 1]]
        set indice [format "%s%s%s" $row , 0]
    }
    #
    proc reset {} {
        global asedCon
        interp eval $asedCon {
            if {[lsearch [package names] Tk] != -1} {
                foreach child [winfo children .] {
                    if {[winfo exists $child]} {destroy $child}
                }
                wm withdraw .
            }
        }
    }
    #
    proc SetValues {_code _result _errorInfo} {
        global code result errorInfo
        set code $_code
        set result $_result
        set errorInfo $_errorInfo
    }
    
}
####################


####################
# OPERATION
####################
namespace eval Operation {
    
    
    proc ResetAllFig+ {} {
        global S
        set S(OpResetLFgC) 1
        set S(OpResetLBgC) 1
        set S(OpResetLF) 1
        set S(OpResetNFgC) 1
        set S(OpResetNBgC) 1
        set S(OpResetNLW) 1
        set S(OpResetNLD) 1
        set S(OpResetNUS) 1
        set S(OpResetNUC) 1
        set S(OpResetAL) 1
        set S(OpResetAN) 1
        set S(OpResetAC) 1
    }
    #
    proc ResetAllFig- {} {
        global S
        set S(OpResetLFgC) 0
        set S(OpResetLBgC) 0
        set S(OpResetLF) 0
        set S(OpResetNFgC) 0
        set S(OpResetNBgC) 0
        set S(OpResetNLW) 0
        set S(OpResetNLD) 0
        set S(OpResetNUS) 0
        set S(OpResetNUC) 0
        set S(OpResetAL) 0
        set S(OpResetAN) 0
        set S(OpResetAC) 0
    }
    #
    proc ResetGraphicVariables {} {
        global S T
        # cette fonction travaille sur la liste des trees en target
        foreach key [array names S *,tar]  {
            if {$S($key) == 1} {
                set t [string range $key 0 [expr [string first , $key] - 1]]
                set w $S($t,w)
                # t va etre reset sur une, plusieurs, ou toutes les variables graphiques
                # ...voir optimisation...
                # Leaf Foreground Color
                if {$S(OpResetLFgC) == 1} {Figuration::GraVarInitFgLeaf $w $t}
                # Leaf Background Color
                if {$S(OpResetLBgC) == 1} {Figuration::GraVarInitBgLeaf $w $t}
                # Leaf Font
                if {$S(OpResetLF) == 1}   {Figuration::GraVarInitFont $w $t}
                # Node Foreground Color
                if {$S(OpResetNFgC) == 1} {Figuration::GraVarInitFgTree $w $t}
                # Node Background Color
                if {$S(OpResetNBgC) == 1} {Figuration::GraVarInitBgSubTree $w $t}
                # Node Line Witdh
                if {$S(OpResetNLW) == 1}  {Figuration::GraVarInitLineWidth $w $t}
                # Node Line Dash
                if {$S(OpResetNLD) == 1}  {Figuration::GraVarInitLineDash $w $t}
                # Node Unshrink
                if {$S(OpResetNUS) == 1}  {}
                # Node UnCollapse
                if {$S(OpResetNUC) == 1}  {}
                # Remove Annotation Leaf
                if {$S(OpResetAL) == 1}  {}
                # Remove Annotation Node
                if {$S(OpResetAN) == 1}  {}
                # Remove Annotation Canvas
                if {$S(OpResetAC) == 1}  {}
            }
        }
    }
    ### OPTIMISATION : si un node est ok : ne pas tester ses nodes fils
    proc FindFatherNode {t SouRefLea} {
        global S T
        set L {}
        # on ne prend pas en compte les codes des feuilles
        # set latest [Tools::SousL $T($t,all_cod) $T($t,ue_cod)]
        # on prend en compte les codes des feuilles
        set latest $T($t,all_cod)
        
        
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $latest] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test inclusion des references leaf de TARGET avec SOURCE
                set r [Tools::ListIncluSauf $TarRefLea $SouRefLea $S(nodefilter)]
                if {$r == 1} {lappend L $TarCodNod}
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {return $T($t,ltc,$SouRefLea) }
    }
    # operation switch en fonction target, si $t :
    # * : on opere sur la liste des tree en target (panel operation)
    # = : on opere sur la liste des tree de la fenetre en argument
    # finalement on traite $t comme une liste de tree, pouvant se restreindre a un seul elt
    proc Operation {w t EUS} {
        global S
        switch -exact $t {
            \* {
                foreach key [array names S *,tar]  {
                    if {$S($key) == 1} {
                        set ti [string range $key 0 [expr [string first , $key] - 1]]
                        if {$ti != 0} {
                            set wi $S($ti,w)
                            Operation::OperationAction $wi $ti $EUS
                        }
                    }
                }
            }
            =  {
                foreach ti $S($w,t) {
                    Operation::OperationAction $w $ti $EUS
                }
            }
            default {
                foreach ti $t {
                    Operation::OperationAction $w $ti $EUS
                }
            }
        }
    }
    proc OperationAction {w t EUS} {
        global T S
        
        # Reset Automatic ?
        if {$S(AutoReset)== 1} {Operation::ResetGraphicVariables}
        foreach op $S(operation) {
            
            switch $op {
                leafbgcolor {
                    set leu {}
                    foreach e $EUS {
                        if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                    }
                    Figuration::EUColorBgLeaf $t $leu $S(col)
                }
                leaffgcolor {
                    set leu {}
                    foreach e $EUS {
                        if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                    }
                    Figuration::EUColorFgLeaf $t $leu $S(col)
                }
                leaffontglob {
                    set leu {}
                    foreach e $EUS {
                        if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                    }
                    Figuration::FontSetGlobalEU $t $leu $S(gfo)
                }
                leafshrink {
                    set leu {}
                    foreach e $EUS {
                        if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                    }
                    Abstraction::LeafShrink $w $t $leu
                }
                leafunshrink {
                    set leu {}
                    foreach e $EUS {
                        if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                    }
                    Abstraction::LeafUnShrink $w $t $leu
                }
                qLannL {
                    Annotation::qLannL $w $t $EUS
                }
                qLannC {
                    Annotation::qLannC $w $t $EUS
                }
                LannL {
                    Annotation::LannL $w $t $EUS
                }
                LannC {
                    Annotation::LannC $w $t $EUS
                }
                LillL {
                    Illustration::LillL $w $t $EUS
                }
                LillC {
                    Illustration::LillC $w $t $EUS
                }
                LillCpolygon {
                    Illustration::LillCpolygon $w $t $EUS
                }
                nodefgcolor {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeColorFgTree $t $e $S(col)}
                }
                nodefgcolor2 {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeColorFgTree2 $t $e $S(col)}
                }
                nodebgcolor {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeColorBgSubTree $t $e}
                    Figuration::RestaureBGSall $w $t
                }
                insertvarval {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {
                        set co [$w coords $e]
                        set x [lindex $co 0]
                        set y [lindex $co 1]
                        Identification::InsertVarVal $w $t $x $y $e
                    }
                }
                insertvarval2 {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {
                        set co [$w coords $e]
                        set x [lindex $co 0]
                        set y [lindex $co 1]
                        Identification::InsertVarVal2 $w $t $x $y $e
                    }
                }
                nodeannotate {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {
                        set co [$w bbox $e]
                        set x [$w canvasx [lindex $co 0]]
                        set y [$w canvasy [lindex $co 1]]
                        Annotation::BLLmake $w $t $x $y "" $S(AnnotateNote) $e
                    }
                }
                nodeillustration {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {
                        set co [$w coords $e]
                        set x [$w canvasx [lindex $co 0]]
                        set y [$w canvasy [lindex $co 1]]
                        #set S(symbolcolorfill) $S(col)
                        #set S(symbolcoloroutline) $S(col)
                        #set S(symbolstipple) $S(stipple)
                        Illustration::drawsymbol  $w [expr $x + 30 ]  [expr $y + 30] [list T$t]
                    }
                }
                shrink {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Abstraction::Shrink $w $t $e ""}
                }
                unshrink {
                    set peres  [FindFatherNode $t $EUS]
                    Abstraction::ShrinkUnLN $w $t $peres
                }
                collapse {Abstraction::Collapse $w $t $EUS}
                uncollapse {Abstraction::CollapseUn $w $t $EUS}
                widthline+ {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeLineWidth $t $e +}
                }
                widthline+2 {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeLineWidth2 $t $e +}
                }
                widthline- {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeLineWidth $t $e -}
                }
                nodedashOn {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeLineDash $t $e 1}
                }
                nodedashOn2 {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeLineDash2 $t $e 1}
                }
                nodedashOff {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {Figuration::NodeLineDash $t $e 0}
                }
                nodenetwork {
                    set lkv {}
                    set peres  [FindFatherNode $t $EUS]
                    foreach ni $peres {
                        lappend lkv $t $ni
                    }
                    Reflection::NodeNetworkBuild $w $lkv " "
                }
                querynode {Annotation::QueryNode $w $t $EUS}
                nodeextract {
                    set peres  [FindFatherNode $t $EUS]
                    PROTO::NodeExtract $t $peres
                }
                symbolnode {
                    set peres  [FindFatherNode $t $EUS]
                    foreach e $peres {
                        set co [$w coords $e]
                        set x [lindex $co 0]
                        set y [lindex $co 1]
                        Annotation::InsertSymbolNodeMake $w $t $x $y $e
                    }
                }
            }
        }
    }
}

####################
# ICONOGRAPHIE
####################
namespace eval Iconographie {
    proc MakeIconographie {} {
        global S
        set S(stidir) [file join [file dirname [info script]] +/stipple/]
        image create photo STIz -file [file join [file dirname [info script]] +/stipple/z.xbm]
        image create photo STIa -file [file join [file dirname [info script]] +/stipple/a.xbm]
        image create photo STIb -file [file join [file dirname [info script]] +/stipple/b.xbm]
        image create photo STIc -file [file join [file dirname [info script]] +/stipple/c.xbm]
        image create photo STIe -file [file join [file dirname [info script]] +/stipple/e.xbm]
        image create photo STIf -file [file join [file dirname [info script]] +/stipple/f.xbm]
        image create photo STIl -file [file join [file dirname [info script]] +/stipple/l.xbm]
        image create photo STIm -file [file join [file dirname [info script]] +/stipple/m.xbm]
        image create photo STIg -file [file join [file dirname [info script]] +/stipple/g.xbm]
        image create photo STIh -file [file join [file dirname [info script]] +/stipple/h.xbm]
        image create photo STIi -file [file join [file dirname [info script]] +/stipple/i.xbm]
        image create photo STIj -file [file join [file dirname [info script]] +/stipple/j.xbm]
        image create photo STIk -file [file join [file dirname [info script]] +/stipple/k.xbm]
    }
    
}

####################
# TOOLS
####################
namespace eval Tools {
    
    
    ### NODE
    proc NodeParentNode {t node} {
        if  {[string equal  $node $t] == 1} {
            return $t
        } elseif {[string equal $node [format "%s%s" $t g]] == 1} {
            return $t
        } elseif {[string equal $node [format "%s%s" $t d]] == 1} {
            return $t
        } else  {
            set gennode [string range $node 0 end-1]
            set fathernode [string trimright $gennode {0 1 2 3 4 5 6 7 8 9}]
            return $fathernode
        }
    }
    # calcul de la distance feuille a feuille
    proc DistLL {t l1 l2} {
        global T
        if {[string equal $l1 $l2] == 1} {
            return 0
        } else  {
            set l1code $T($t,ltc,$l1)
            set l2code  $T($t,ltc,$l2)
            set node [string trimright [CommunRoot2 0 $l1code $l2code ""] "0123456789"]
            set cumul 0
            foreach n [NodeFathers $t $node] {
                set cumul [expr $cumul + $T($t,dbl,$n)]
            }
            return [expr $T($t,sox,$l1code) + $T($t,sox,$l2code) - (2 * $cumul)]
        }
    }
    #
    proc CommunRoot2 {index s1 s2 string} {
        if {[string equal $s1 $s2]} {
            return $string
        }
        if {[string equal  [string index $s1 $index] [string index $s2 $index]]} {
            CommunRoot2 [expr $index +1] $s1 $s2 $string[string index $s1 $index]
        } else  {
            return $string
        }
    }
    
    ###
    proc NodeBrotherNode {node} {
        set gennode [string range $node 0 end-1]
        set letter [string range $node end end ]
        if {$letter == "g"} {
            set brothernode [format "%s%s" $gennode d]
        } {set brothernode [format "%s%s" $gennode g]}
        return $brothernode
    }
    # renvoie la liste des codes nodes de la racine a n (le chemin)
    # lf est initialise a $t a l'appel de la procedure
    proc NodeFathers {lf n} {
        if {$n == "" || $n == [lindex $lf 0]} {
            return $lf
        } else  {
            lappend lf $n
            NodeFathers $lf [NodeParentNode  [lindex $lf 0] $n]
        }
    }
    ###  NoToLe retourne la liste des codes feuilles issues de node
    proc NodeNoToLe {treeid nodecode} {
        global T
        set p [format "%s%s" $nodecode *]
        set l {}
        foreach codei $T($treeid,ue_cod) {
            if {[string match $p $codei]} {lappend l $codei}
        }
        return $l
    }
    ###  NoToLeNum
    proc NodeNoToLeNum {t n} {
        global T
        set p [format "%s%s" $n *]
        set l {}
        foreach ni $T($t,ue_cod) {
            if {[string match $p $ni]} {lappend l $ni}
        }
        return [llength $l]
    }
    ###  LeCoToRe retourne la liste des REFERENCES feuilles sachant les CODES feuilles
    proc NodeLeCoToRe {treeid lin} {
        global T
        set lout {}
        foreach c $lin {
            lappend lout $T($treeid,ctl,$c)
        }
        return $lout
    }
    # l est une liste de code node
    # FaNoId retourne la liste des nodes de plus haut niveau
    proc NodeFaNoId {leltpass l} {
        set elt [lindex $l 0]
        set lnew [lrange $l 1 end]
        if {[lsearch -exact $leltpass $elt] == -1} {
            set lprov {}
            lappend leltpass $elt
            set p [format "%s%s" $elt *]
            foreach i $l {
                if {[string match $p $i] != 1} {lappend lprov $i}
            }
            Tools::NodeFaNoId $leltpass [lappend lprov $elt]
        } {return $l}
    }
    ### Node Code Father To Node Code Children
    ### (Node Code Father Inclus )
    proc NodeNoCoFaToNoCoCh {IdTree NoCoFa} {
        global T
        set List_NoCoCh {}
        set pattern [format "%s%s" $NoCoFa *]
        foreach NoCoCh $T($IdTree,all_cod) {
            if {[string match $pattern $NoCoCh]} {lappend List_NoCoCh $NoCoCh}
        }
        return $List_NoCoCh
    }
    # recherche d'un node pere commun aux leafs
    proc FatherSearch {t SouRefLea} {
        global S T
        set L {}
        # on ne prend pas en compte les codes des feuilles
        set latest [Tools::SousL $T($t,all_cod) $T($t,ue_cod)]
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $latest] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test inclusion des references leaf de TARGET avec SOURCE
                set r [Tools::ListIncluSauf $TarRefLea $SouRefLea $S(nodefilter)]
                if {$r == 1} {lappend L $TarCodNod}
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {return $T($t,ltc,$SouRefLea) }
    }
    # recherche d'un node pere commun aux leafs
    proc FatherSearch2 {t SouRefLea} {
        global S T
        set L {}
        # on ne prend pas en compte les codes des feuilles
        set latest [Tools::SousL $T($t,all_cod) $T($t,ue_cod)]
        if {[llength $SouRefLea] != 1} {
            foreach TarCodNod [lsort -dictionary $latest] {
                # selection des codes leaf issus de node
                set TarCodLea [Tools::NodeNoToLe $t $TarCodNod]
                # passage codes leaf -> references leaf
                set TarRefLea [Tools::NodeLeCoToRe $t $TarCodLea]
                # test egalit?Š
                set r1 [Tools::SousL $TarRefLea $SouRefLea]
                set r2 [Tools::SousL $SouRefLea $TarRefLea]
                if {$r1 == {} && $r2 == {}} {lappend L $TarCodNod}
            }
            # meme node pere possibles
            # differents nodes peres possibles
            # -> identification des nodes peres de plus haut niveau
            set l [Tools::NodeFaNoId {} $L]
            if {$L == {}} {return {}} {return $l}
        } {return $T($t,ltc,$SouRefLea) }
    }
    ### /home/user/data/x.tree -> x.tree
    proc PathCut {spath} {
        set id [expr [string last "/" $spath] + 1]
        return [string range $spath $id end]
    }
    ### /home/user/data/x.tree -> x
    proc PathCut2 {spath} {
        set id1 [expr [string last "/" $spath] + 1]
        set id2 [expr [string last "." $spath] - 1]
        return [string range $spath $id1 $id2]
    }
    ### {a b c} -> {a \n b \n c}
    proc FormatText {Lin} {
        set Lout {}
        set ll [lsort -dictionary $Lin]
        lappend Lout [lindex $ll 0]
        set ll1end [lrange $ll 1 end]
        foreach e $ll1end {
            lappend Lout \n
            lappend Lout $e
        }
        regsub -all {\}} $Lout "" Lout
        regsub -all {\{} $Lout "" Lout
        regsub -all , $Lout = Lout
        regsub -all "  " $Lout " " Lout
        regsub -all " \n" $Lout "\n" Lout
        regsub -all "\n " $Lout "\n" Lout
        return $Lout
    }
    #
    proc GenId {} {
        global S
        incr S(nbobj)
        return [format "%s%s" [clock second] $S(nbobj)]
    }
    ### DelRep suppression des repetitions d'une liste
    proc DelRep {lin}   {
        set lou {}
        foreach i $lin {
            if {[lsearch -exact $lou $i] == -1} {lappend lou $i}
        }
        return $lou
    }
    ### Retourne 1 si l1 est incluse dans l2
    proc ListInclu {l1 l2}   {
        foreach i1 $l1 {
            if {[lsearch -exact $l2 $i1] == -1} {set b 0 ; break} {set b 1}
        }
        return $b
    }
    ###
    proc ListIncluSauf {l1 l2 nb} {
        # c est le nb d'elt de l1 n'etant pas dans l2
        set c 0
        foreach i1 $l1 {
            if {[lsearch -exact $l2 $i1] == -1} {incr c}
        }
        if {$c > $nb} {return 0} {return 1}
    }
    # l2 est une liste d'elts devant etre retires de l1
    proc SousL {l1 l2} {
        set lout {}
        foreach e $l1 {
            if {[lsearch -exact $l2 $e] == -1} {lappend lout $e} {}
        }
        return $lout
    }
    # operateur AND # l'intersection des listes
    # ll est une liste de liste
    proc operatorANDll {ll} {
        set lintersect {}
        set l1 [lindex $ll 0]
        set ln [lrange $ll 1 end]
        foreach e $l1 {
            set x 1
            foreach l $ln {
                if {[lsearch -exact $l $e] == -1} {set x 0}
            }
            if {$x != 0} {lappend lintersect $e}
        }
        return [Tools::DelRep $lintersect]
    }
    proc operatorAND {l1 l2} {
        set lintersect {}
        foreach i $l1 {
            if {[lsearch -exact $l2 $i] != -1} {lappend lintersect $i}
        }
        return [Tools::DelRep $lintersect]
    }
    # operator OR # l'union des listes en supprimant les repetitions
    # ll est une liste de liste
    proc operatorORll {ll} {
        set lunion {}
        foreach l $ll {
            lappend lunion $l
        }
        return [Tools::DelRep $lunion]
    }
    proc operatorOR {l1 l2} {
        set lunion {}
        foreach i $l2 {
            lappend l1 $i
        }
        return [Tools::DelRep $l1]
    }
    ### {a b c} -> {a \n b \n c}
    proc FormatText {Lin} {
        set Lout {}
        set ll [lsort -dictionary $Lin]
        lappend Lout [lindex $ll 0]
        set ll1end [lrange $ll 1 end]
        foreach e $ll1end {
            lappend Lout \n
            lappend Lout $e
        }
        regsub -all {\}} $Lout "" Lout
        regsub -all {\{} $Lout "" Lout
        regsub -all , $Lout = Lout
        regsub -all "  " $Lout " " Lout
        regsub -all " \n" $Lout "\n" Lout
        regsub -all "\n " $Lout "\n" Lout
        return $Lout
    }
}
####################


####################
# PACKAGE
####################
namespace eval Package {
    
    namespace eval CanToSVG {
        #  can2svg.tcl ---
        #  This file provides translation from canvas commands to XML/SVG format.
        #  Copyright (c) 2002  Mats Bengtsson
        
        package provide can2svg 0.1
        
        namespace eval ::can2svg:: {
            
            namespace export can2svg canvas2file
            
            variable formatArrowMarker
            variable formatArrowMarkerLast
            
            # The key into this array is 'arrowMarkerDef_$col_$a_$b_$c', where
            # col is color, and a, b, c are the arrow's shape.
            variable defsArrowMarkerArr
            
            # Similarly for stipple patterns.
            variable defsStipplePatternArr
            
            # This shouldn't be hardcoded!
            variable defaultFont {Helvetica 12}
            
            variable anglesToRadians [expr 3.14159265359/180.0]
            variable grayStipples {gray75 gray50 gray25 gray12}
            
            # Make 4x4 squares. Perhaps could be improved.
            variable stippleDataArr
            
            set stippleDataArr(gray75)  \
                    {M 0 0 h3 M 0 1 h1 m 1 0 h2 M 0 2 h2 m 1 0 h1 M 0 3 h3}
            set stippleDataArr(gray50)  \
                    {M 0 0 h1 m 1 0 h1 M 1 1 h1 m 1 0 h1 \
                        M 0 2 h1 m 1 0 h1 M 1 3 h1 m 1 0 h1}
            set stippleDataArr(gray25)  \
                    {M 0 0 h1 M 2 1 h1 M 1 2 h1 M 3 3 h1}
            set stippleDataArr(gray12) {M 0 0 h1 M 2 2 h1}
            
        }
        proc ::can2svg::can2svg {cmd args} {
            
            variable defsArrowMarkerArr
            variable defsStipplePatternArr
            variable anglesToRadians
            variable defaultFont
            variable grayStipples
            
            set nonum_ {[^0-9]}
            set wsp_ {[ ]+}
            set xml ""
            
            #array set argsArr {-usetags all}
            array set argsArr {-usetags 0}
            array set argsArr $args
            
            switch -- [lindex $cmd 0] {
                
                create {
                    set type [lindex $cmd 1]
                    
                    set rest [lrange $cmd 2 end]
                    regexp -indices -- "-${nonum_}" $rest ind
                    set ind1 [lindex $ind 0]
                    set coo [string trim [string range $rest 0 [expr $ind1 - 1]]]
                    set opts [string range $rest $ind1 end]
                    array set optArr $opts
                    
                    # Figure out if we've got a spline.
                    set haveSpline 0
                    if {[info exists optArr(-smooth)] && ($optArr(-smooth) != "0") &&  \
                                [info exists optArr(-splinesteps)] && ($optArr(-splinesteps) > 2)} {
                        set haveSpline 1
                    }
                    if {[info exists optArr(-fill)]} {
                        set fillValue $optArr(-fill)
                    } else {
                        set fillValue black
                    }
                    if {($argsArr(-usetags) != "0") && [info exists optArr(-tags)]} {
                        switch -- $argsArr(-usetags) {
                            all {
                                set idAttr [list "id" $optArr(-tags)]
                            }
                            first {
                                set idAttr [list "id" [lindex $optArr(-tags) 0]]
                            }
                            last {
                                set idAttr [list "id" [lindex $optArr(-tags) end]]
                            }
                        }
                    } else {
                        set idAttr ""
                    }
                    
                    # If we need a marker (arrow head) need to make that first.
                    if {[info exists optArr(-arrow)]} {
                        if {[info exists optArr(-arrowshape)]} {
                            
                            # Make a key of the arrowshape list into the array.
                            regsub -all -- $wsp_ $optArr(-arrowshape) _ shapeKey
                            set arrowKey ${fillValue}_${shapeKey}
                            set arrowShape $optArr(-arrowshape)
                        } else {
                            set arrowKey ${fillValue}
                            set arrowShape {8 10 3}
                        }
                        if {![info exists defsArrowMarkerArr($arrowKey)]} {
                            set defsArrowMarkerArr($arrowKey)  \
                                    [eval {MakeArrowMarker} $arrowShape {$fillValue}]
                            append xml $defsArrowMarkerArr($arrowKey)
                            append xml "\n\t"
                        }
                    }
                    
                    # If we need a stipple bitmap, need to make that first. Limited!!!
                    # Only: gray12, gray25, gray50, gray75
                    foreach key {-stipple -outlinestipple} {
                        if {[info exists optArr($key)] &&  \
                                    ([lsearch $grayStipples $optArr($key)] >= 0)} {
                            set stipple $optArr($key)
                            if {![info exists defsStipplePatternArr($stipple)]} {
                                set defsStipplePatternArr($stipple)  \
                                        [MakeGrayStippleDef $stipple]
                            }
                            append xml $defsStipplePatternArr($stipple)
                            append xml "\n\t"
                        }
                    }
                    
                    switch -- $type {
                        
                        arc {
                            
                            # Had to do it the hard way! (?)
                            # "Wrong" coordinate system :-(
                            set elem "path"
                            set style [MakeStyle $type $opts]
                            foreach {x1 y1 x2 y2} $coo {}
                            set cx [expr ($x1 + $x2)/2.0]
                            set cy [expr ($y1 + $y2)/2.0]
                            set rx [expr abs($x1 - $x2)/2.0]
                            set ry [expr abs($y1 - $y2)/2.0]
                            set rmin [expr $rx > $ry ? $ry : $rx]
                            
                            # This approximation gives a maximum half pixel error.
                            set deltaPhi [expr 2.0/sqrt($rmin)]
                            set extent [expr $anglesToRadians * $optArr(-extent)]
                            set start [expr $anglesToRadians * $optArr(-start)]
                            set nsteps [expr int(abs($extent)/$deltaPhi) + 2]
                            set delta [expr $extent/$nsteps]
                            set data [format "M %.1f %.1f L"   \
                                    [expr $cx + $rx*cos($start)] [expr $cy - $ry*sin($start)]]
                            for {set i 0} {$i <= $nsteps} {incr i} {
                                set phi [expr $start + $i * $delta]
                                append data [format " %.1f %.1f"  \
                                        [expr $cx + $rx*cos($phi)] [expr $cy - $ry*sin($phi)]]
                            }
                            if {[info exists optArr(-style)]} {
                                switch -- $optArr(-style) {
                                    chord {
                                        append data " Z"
                                    }
                                    pieslice {
                                        append data [format " %.1f %.1f Z" $cx $cy]
                                    }
                                }
                            } else {
                                
                                # Pieslice is the default.
                                append data [format " %.1f %.1f Z" $cx $cy]
                            }
                            set attr [list "d" $data "style" $style]
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set xmlList [MakeXMLList $elem -attrlist $attr]
                        }
                        image - bitmap {
                            set elem "image"
                            set attr [MakeImageAttr $coo $opts]
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set xmlList [MakeXMLList $elem -attrlist $attr]
                        }
                        line {
                            if {$haveSpline} {
                                set elem "path"
                                set style [MakeStyle $type $opts]
                                set data "M [lrange $coo 0 1] Q"
                                set i 4
                                foreach {x y} [lrange $coo 2 end-4] {
                                    set x0 [expr ($x + [lindex $coo $i])/2.0]
                                    incr i
                                    set y0 [expr ($y + [lindex $coo $i])/2.0]
                                    incr i
                                    append data " $x $y $x0 $y0"
                                }
                                append data " [lrange $coo end-3 end]"
                                set attr [list "d" $data "style" $style]
                            } else {
                                set elem "polyline"
                                set style [MakeStyle $type $opts]
                                set attr [list "points" $coo "style" $style]
                            }
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set xmlList [MakeXMLList $elem -attrlist $attr]
                        }
                        oval {
                            foreach {x y w h} [NormalizeRectCoords $coo] {}
                            if {[expr $w == $h]} {
                                set elem "circle"
                                set attr [list  \
                                        "cx" [expr $x + $w/2.0]  \
                                        "cy" [expr $y + $h/2.0]  \
                                        "r"  [expr $w/2.0]]
                            } else {
                                set elem "ellipse"
                                set attr [list  \
                                        "cx" [expr $x + $w/2.0]  \
                                        "cy" [expr $y + $h/2.0]  \
                                        "rx" [expr $w/2.0]       \
                                        "ry" [expr $h/2.0]]
                            }
                            set style [MakeStyle $type $opts]
                            lappend attr "style" $style
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set xmlList [MakeXMLList $elem -attrlist $attr]
                        }
                        polygon {
                            
                            if {$haveSpline} {
                                set elem "path"
                                set style [MakeStyle $type $opts]
                                
                                # Translating a closed polygon into a qubic bezier
                                # path is a little bit tricky.
                                set x0 [expr ([lindex $coo end-1] + [lindex $coo 0])/2.0]
                                set y0 [expr ([lindex $coo end] + [lindex $coo 1])/2.0]
                                set data "M $x0 $y0 Q"
                                set i 2
                                foreach {x y} [lrange $coo 0 end-2] {
                                    set x1 [expr ($x + [lindex $coo $i])/2.0]
                                    incr i
                                    set y1 [expr ($y + [lindex $coo $i])/2.0]
                                    incr i
                                    append data " $x $y $x1 $y1"
                                }
                                append data " [lrange $coo end-1 end] $x0 $y0"
                                set attr [list "d" $data "style" $style]
                            } else {
                                
                                set elem "polygon"
                                set style [MakeStyle $type $opts]
                                puts "AVANT $type $opts APRES $style"
                                set attr [list "points" $coo "style" $style]
                            }
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set xmlList [MakeXMLList $elem -attrlist $attr]
                        }
                        rectangle {
                            set elem "rect"
                            set style [MakeStyle $type $opts]
                            
                            # width and height must be non-negative!
                            foreach {x y w h} [NormalizeRectCoords $coo] {}
                            set attr [list "x" $x "y" $y "width" $w "height" $h]
                            lappend attr "style" $style
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set xmlList [MakeXMLList $elem -attrlist $attr]
                        }
                        text {
                            set elem "text"
                            set style [MakeStyle $type $opts]
                            set nlines 1
                            if {[info exists optArr(-text)]} {
                                set chdata $optArr(-text)
                                set nlines [expr [regexp -all "\n" $chdata] + 1]
                            } else {
                                set chdata ""
                            }
                            
                            # Figure out the coords of the first baseline.
                            set anchor center
                            if {[info exists optArr(-anchor)]} {
                                set anchor $optArr(-anchor)
                            }
                            if {[info exists optArr(-font)]} {
                                set theFont $optArr(-font)
                            } else {
                                set theFont $defaultFont
                            }
                            set ascent [font metrics $theFont -ascent]
                            set lineSpace [font metrics $theFont -linespace]
                            
                            foreach {xbase ybase}  \
                                    [GetTextSVGCoords $coo $anchor $chdata $theFont $nlines] {}
                            
                            set attr [list "x" $xbase "y" $ybase]
                            lappend attr "style" $style
                            if {[string length $idAttr] > 0} {
                                set attr [concat $attr $idAttr]
                            }
                            set dy 0
                            if {$nlines > 1} {
                                
                                # Use the 'tspan' trick here.
                                set subList {}
                                foreach line [split $chdata "\n"] {
                                    lappend subList [MakeXMLList "tspan"  \
                                            -attrlist [list "x" $xbase "dy" $dy] -chdata $line]
                                    set dy $lineSpace
                                }
                                set xmlList [MakeXMLList $elem -attrlist $attr \
                                        -subtags $subList]
                            } else {
                                set xmlList [MakeXMLList $elem -attrlist $attr \
                                        -chdata $chdata]
                            }
                        }
                    }
                }
                move {
                    foreach {tag dx dy} [lrange $cmd 1 3] {}
                    set attr [list "transform" "translate($dx,$dy)"  \
                            "xlink:href" "#$tag"]
                    set xmlList [MakeXMLList "use" -attrlist $gattr]
                }
                scale {
                    
                }
            }
            append xml [MakeXML $xmlList]
            return $xml
        }
        proc ::can2svg::MakeStyle {type opts} {
            
            # Defaults for everything except text.
            if {![string equal $type "text"]} {
                array set styleArr {fill none stroke black}
            }
            set fillCol black
            
            foreach {key value} $opts {
                
                switch -- $key {
                    -arrow {
                        set arrowValue $value
                    }
                    -arrowshape {
                        set arrowShape $value
                    }
                    -capstyle {
                        if {[string equal $value "projecting"]} {
                            set value "square"
                        }
                        if {![string equal $value "butt"]} {
                            set styleArr(stroke-linecap) $value
                        }
                    }
                    -dash {
                        set dashValue $value
                    }
                    -dashoffset {
                        if {$value != 0} {
                            set styleArr(stroke-dashoffset) $value
                        }
                    }
                    -fill {
                        set fillCol $value
                        
                        if {[string equal $type "line"]} {
                            set styleArr(stroke) [MapEmptyToNone $value]
                        } else {
                            set styleArr(fill) [MapEmptyToNone $value]
                        }
                        
                    }
                    -font {
                        set styleArr(font-family) [lindex $value 0]
                        if {[llength $value] > 1} {
                            set styleArr(font-size) [format "%s%s" [lindex $value 1] pt]
                        }
                        if {[llength $value] > 2} {
                            set tkstyle [lindex $value 2]
                            switch -- $tkstyle {
                                bold {
                                    set styleArr(font-weight) $tkstyle
                                }
                                italic {
                                    set styleArr(font-style) $tkstyle
                                }
                                underline {
                                    set styleArr(text-decoration) underline
                                }
                                overstrike {
                                    set styleArr(text-decoration) overline
                                }
                            }
                        }
                        
                    }
                    -joinstyle {
                        set styleArr(stroke-linejoin) $value
                    }
                    -outline {
                        set styleArr(stroke) [MapEmptyToNone $value]
                    }
                    -outlinestipple {
                        set outlineStippleValue $value
                    }
                    -stipple {
                        set stippleValue $value
                    }
                    -width {
                        set styleArr(stroke-width) $value
                    }
                }
            }
            
            # If any arrow specify its marker def url key.
            if {[info exists arrowValue]} {
                if {[info exists arrowShape]} {
                    foreach {a b c} $arrowShape {}
                    set arrowIdKey "arrowMarkerDef_${fillCol}_${a}_${b}_${c}"
                    set arrowIdKeyLast "arrowMarkerLastDef_${fillCol}_${a}_${b}_${c}"
                } else {
                    set arrowIdKey "arrowMarkerDef_${fillCol}"
                }
                switch -- $arrowValue {
                    first {
                        set styleArr(marker-start) "url(#$arrowIdKey)"
                    }
                    last {
                        set styleArr(marker-end) "url(#$arrowIdKeyLast)"
                    }
                    both {
                        set styleArr(marker-start) "url(#$arrowIdKey)"
                        set styleArr(marker-end) "url(#$arrowIdKeyLast)"
                    }
                }
            }
            
            if {[info exists stippleValue]} {
                
                # Overwrite any existing.
                set styleArr(fill) "url(#tile$stippleValue)"
            }
            if {[info exists outlineStippleValue]} {
                
                # Overwrite any existing.
                set styleArr(stroke) "url(#tile$stippleValue)"
            }
            
            # Transform dash value.
            if {[info exists dashValue]} {
                
                # Two different syntax here.
                if {[regexp {[\.,\-_ ]} $dashValue]} {
                    
                    # .=2 ,=4 -=6 space=4    times stroke width.
                    # A space enlarges the... space.
                    # Not foolproof!
                    regsub -all -- {[^ ]} $dashValue "& " dash
                    regsub -all -- "   "  $dash  "12 " dash
                    regsub -all -- "  "   $dash  "8 " dash
                    regsub -all -- " "    $dash  "4 " dash
                    regsub -all -- {\.}   $dash  "2 " dash
                    regsub -all -- {,}    $dash  "4 " dash
                    regsub -all -- {-}    $dash  "6 " dash
                    
                    # Multiply with stroke width if > 1.
                    if {[info exists styleArr(stroke-width)] &&  \
                                ($styleArr(stroke-width) > 1)} {
                        set width $styleArr(stroke-width)
                        set dashOrig $dash
                        set dash {}
                        foreach num $dashOrig {
                            lappend dash [expr int($width * $num)]
                        }
                    }
                    set styleArr(stroke-dasharray) [string trim $dash]
                } else {
                    set styleArr(stroke-dasharray) $value
                }
            }
            if {[string equal $type "polygon"]} {
                set styleArr(fill-rule) "evenodd"
            }
            
            set style ""
            foreach {key value} [array get styleArr] {
                append style "${key}: ${value}; "
            }
            return [string trim $style]
        }
        proc ::can2svg::MakeImageAttr {coo opts} {
            
            array set optArr {-anchor nw}
            array set optArr $opts
            set theImage $optArr(-image)
            set w [image width $theImage]
            set h [image height $theImage]
            
            # We should make this an URI.
            set theFile [$theImage cget -file]
            set uri [UriFromLocalFile $theFile]
            foreach {x0 y0} $coo {}
            switch -- $optArr(-anchor) {
                nw {
                    set x $x0
                    set y $y0
                }
                n {
                    set x [expr $x0 - $w/2.0]
                    set y $y0
                }
                ne {
                    set x [expr $x0 - $w]
                    set y $y0
                }
                e {
                    set x $x0
                    set y [expr $y0 - $h/2.0]
                }
                se {
                    set x [expr $x0 - $w]
                    set y [expr $y0 - $h]
                }
                s {
                    set x [expr $x0 - $w/2.0]
                    set y [expr $y0 - $h]
                }
                sw {
                    set x $x0
                    set y [expr $y0 - $h]
                }
                w {
                    set x $x0
                    set y [expr $y0 - $h/2.0]
                }
                center {
                    set x [expr $x0 - $w/2.0]
                    set y [expr $y0 - $h/2.0]
                }
            }
            set attrList [list "x" $x "y" $y "width" $w "height" $h  \
                    "xlink:href" $uri]
            return $attrList
        }
        proc ::can2svg::GetTextSVGCoords {coo anchor chdata theFont nlines} {
            
            foreach {x y} $coo {}
            set ascent [font metrics $theFont -ascent]
            set lineSpace [font metrics $theFont -linespace]
            
            # If not anchored to the west it gets more complicated.
            if {![string match $anchor "*w*"]} {
                
                # Need to figure out the extent of the text.
                if {$nlines <= 1} {
                    set textWidth [font measure $theFont $chdata]
                } else {
                    set textWidth 0
                    foreach line [split $chdata "\n"] {
                        set lineWidth [font measure $theFont $line]
                        if {$lineWidth > $textWidth} {
                            set textWidth $lineWidth
                        }
                    }
                }
            }
            
            switch -- $anchor {
                nw {
                    set xbase $x
                    set ybase [expr $y + $ascent]
                }
                w {
                    set xbase $x
                    set ybase [expr $y - $nlines*$lineSpace/2.0 + $ascent]
                }
                sw {
                    set xbase $x
                    set ybase [expr $y - $nlines*$lineSpace + $ascent]
                }
                s {
                    set xbase [expr $x - $textWidth/2.0]
                    set ybase [expr $y - $nlines*$lineSpace + $ascent]
                }
                se {
                    set xbase [expr $x - $textWidth]
                    set ybase [expr $y - $nlines*$lineSpace + $ascent]
                }
                e {
                    set xbase [expr $x - $textWidth]
                    set ybase [expr $y - $nlines*$lineSpace/2.0 + $ascent]
                }
                ne {
                    set xbase [expr $x - $textWidth]
                    set ybase [expr $y + $ascent]
                }
                n {
                    set xbase [expr $x - $textWidth/2.0]
                    set ybase [expr $y + $ascent]
                }
                center {
                    set xbase [expr $x - $textWidth/2.0]
                    set ybase [expr $y - $nlines*$lineSpace/2.0 + $ascent]
                }
            }
            
            return [list $xbase $ybase]
        }
        proc ::can2svg::MakeArrowMarker {a b c col} {
            
            variable formatArrowMarker
            variable formatArrowMarkerLast
            
            catch {unset formatArrowMarker}
            
            if {![info exists formatArrowMarker]} {
                
                # "M 0 c, b 0, a c, b 2*c Z" for the start marker.
                # "M 0 0, b c, 0 2*c, b-a c Z" for the last marker.
                set data "M 0 %s, %s 0, %s %s, %s %s Z"
                set style "fill: %s; stroke: %s;"
                set attr [list "d" $data "style" $style]
                set arrowList [MakeXMLList "path" -attrlist $attr]
                set markerAttr [list "id" %s "markerWidth" %s "markerHeight" %s  \
                        "refX" %s "refY" %s "orient" "auto"]
                set defElemList [MakeXMLList "defs" -subtags  \
                        [list [MakeXMLList "marker" -attrlist $markerAttr \
                        -subtags [list $arrowList] ] ] ]
                set formatArrowMarker [MakeXML $defElemList]
                
                # ...and the last arrow marker.
                set dataLast "M 0 0, %s %s, 0 %s, %s %s Z"
                set attrLast [list "d" $dataLast "style" $style]
                set arrowLastList [MakeXMLList "path" -attrlist $attrLast]
                set defElemLastList [MakeXMLList "defs" -subtags  \
                        [list [MakeXMLList "marker" -attrlist $markerAttr \
                        -subtags [list $arrowLastList] ] ] ]
                set formatArrowMarkerLast [MakeXML $defElemLastList]
            }
            set idKey "arrowMarkerDef_${col}_${a}_${b}_${c}"
            set idKeyLast "arrowMarkerLastDef_${col}_${a}_${b}_${c}"
            
            # Figure out the order of all %s substitutions.
            set markerXML [format $formatArrowMarker $idKey  \
                    $b [expr 2*$c] 0 $c  \
                    $c $b $a $c $b [expr 2*$c] $col $col]
            set markerLastXML [format $formatArrowMarkerLast $idKeyLast  \
                    $b [expr 2*$c] $b $c \
                    $b $c [expr 2*$c] [expr $b-$a] $c $col $col]
            
            return "$markerXML\n\t$markerLastXML"
        }
        proc ::can2svg::MakeGrayStippleDef {stipple} {
            
            variable stippleDataArr
            
            set pathList [MakeXMLList "path" -attrlist  \
                    [list "d" $stippleDataArr($stipple) "style" "stroke: black; fill: none;"]]
            set patterAttr [list "id" "tile$stipple" "x" 0 "y" 0 "width" 4 "height" 4 \
                    "patternUnits" "userSpaceOnUse"]
            set defElemList [MakeXMLList "defs" -subtags  \
                    [list [MakeXMLList "pattern" -attrlist $patterAttr \
                    -subtags [list $pathList] ] ] ]
            
            return [MakeXML $defElemList]
        }
        proc ::can2svg::MapEmptyToNone {val} {
            
            if {[string length $val] == 0} {
                return "none"
            } else {
                return $val
            }
        }
        proc ::can2svg::NormalizeRectCoords {coo} {
            
            foreach {x1 y1 x2 y2} $coo {}
            return [list [expr $x2 > $x1 ? $x1 : $x2]  \
                    [expr $y2 > $y1 ? $y1 : $y2]  \
                    [expr abs($x1-$x2)]  \
                    [expr abs($y1-$y2)]]
        }
        proc ::can2svg::makedocument {width height xml} {
            
            set pre "<?xml version=\"1.0\"?>
            <!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"
            \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">"
            
            #           <?xml version='1.1'?>\n\
            #                   <!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\
            #                   \"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd\">"
            #set svgStart "<svg width='$width' height='$height'>"
            set svgStart "<svg xmlns=\"http://www.w3.org/2000/svg\"> \n <g id=\"g\" transform=\"translate(10, 10) scale(1.5)\">"
            set svgEnd " </g>\n</svg>"
            return "${pre}\n${svgStart}\n${xml}${svgEnd}"
        }
        
        proc ::can2svg::canvas2file {wcan path args} {
            variable defsArrowMarkerArr
            variable defsStipplePatternArr
            # Need to make a fresh start for marker def's.
            catch {unset defsArrowMarkerArr}
            catch {unset defsStipplePatternArr}
            
            #array set argsArr  \
            #        [list -width [winfo width $wcan] -height [winfo height $wcan]]
            # correction chevenet
            $wcan configure -scrollregion [$wcan bbox all]
            $wcan xview moveto 0
            $wcan yview moveto 0
            set width [expr [lindex [$wcan bbox all] 2] - [lindex [$wcan bbox all] 0]]
            set height [expr [lindex [$wcan bbox all] 3] - [lindex [$wcan bbox all] 1]]
            array set argsArr   [list -width $width -height $height]
            array set argsArr $args
            set fd [open $path w]
            set xml ""
            # ici pour la modification sur les tags // hidden
            foreach id [$wcan find all] {
                set type [$wcan type $id]
                set opts [$wcan itemconfigure $id]
                set opcmd {}
                foreach opt $opts {
                    set op [lindex $opt 0]
                    set val [lindex $opt 4]
                    
                    # Empty val's except -fill can be stripped off.
                    if {![string equal $op "-fill"] && ([string length $val] == 0)} {
                        continue
                    }
                    lappend opcmd $op $val
                }
                set co [$wcan coords $id]
                set cmd [concat "create" $type $co $opcmd]
                append xml "\t[can2svg $cmd]\n"
            }
            regsub -all "'" [makedocument $argsArr(-width) $argsArr(-height) $xml] "\"" sgvdisplay
            
            puts $fd $sgvdisplay
            close $fd
        }
        proc ::can2svg::MakeXML {xmlList} {
            
            # Extract the XML data items.
            foreach {tag attrlist isempty chdata childlist} $xmlList {}
            set rawxml "<$tag"
            foreach {attr value} $attrlist {
                append rawxml " ${attr}='${value}'"
            }
            if {$isempty} {
                append rawxml "/>"
                return $rawxml
            } else {
                append rawxml ">"
            }
            foreach child $childlist {
                append rawxml [MakeXML $child]
            }
            
            # Make standard entity replacements.
            if {[string length $chdata]} {
                append rawxml [XMLCrypt $chdata]
            }
            append rawxml "</$tag>"
            return $rawxml
        }
        proc ::can2svg::MakeXMLList {tagname args} {
            array set xmlarr {-isempty 1 -attrlist {} -chdata {} -subtags {}}
            if {[llength $args] > 0} {
                array set xmlarr $args
            }
            if {!(($xmlarr(-chdata) == "") && ($xmlarr(-subtags) == ""))} {
                set xmlarr(-isempty) 0
            }
            set sublist {}
            foreach child $xmlarr(-subtags) {
                lappend sublist $child
            }
            set xmlList [list $tagname $xmlarr(-attrlist) $xmlarr(-isempty)  \
                    $xmlarr(-chdata) $sublist]
            return $xmlList
        }
        proc ::can2svg::XMLCrypt {chdata} {
            foreach from {\& < > {"} {'}}   \
                    to {{\&amp;} {\&lt;} {\&gt;} {\&quot;} {\&apos;}} {
                        regsub -all $from $chdata $to chdata
                    }
            return $chdata
        }
        proc ::can2svg::UriFromLocalFile {path} {
            if {[string equal $::tcl_platform(platform) "windows"]} {
                set vol_ {([A-Z]:/|[A-Z]:\\)}
                regexp "${vol_}+(.+)$" $path match x path
            }
            set pathList [split $path "/:\\"]
            set pathJoin [join $pathList /]
            regsub -all -- " " $pathJoin "%20" pathJoin
            return file:///${pathJoin}
        }
    }
    
}




####################
# AMELIE
####################
namespace eval Amelie {
    
    #
    proc faiaddGo1 {lv} {
        global S
        set lkv [array get S *,tar]
        set ltreetarget {}
        foreach {k v} $lkv {
            if {$S($k) == 1} {
                lappend ltreetarget [string range $k 0 [expr [string first , $k] - 1]]
            }
        }
        foreach v $lv {
            DrawGoAuto [list $v] $ltreetarget
        }
    }
    #
    proc faiaddGo2 {w t database variable eu} {
        global S
        set records [Database::dbQueryRecordsFromVarVal $database EU $eu]
        set values [Database::dbQueryVarFromRecords $database $variable $records]
        set i [format "%s%s%s" $eu : $values ]
        faiaddGo1 [list $i]
    }
    
    #
    proc userColor {id} {
        global S
        set S(col) [tk_chooseColor]
        $id configure -background $S(col)
    }
    #
    proc PatternSelection {w} {
        global S
        $w selection clear 0 end
        set litems [$w get 0 end]
        set id 0
        foreach i $litems {
            set leaf [lindex [split $i :] 0]
            if {[string match $S(IGfilter) $leaf]} {$w selection set $id }
            incr id
        }
        $w yview [lindex [$w curselection] 0]
    }
    
    #
    proc GenId {} {
        global S
        incr S(nbobj)
        return [format "%s%s" [clock second] $S(nbobj)]
    }
    
    #
    proc ColorSpecific {w} {
        global S
        $w configure -background $S(col)
        set S(AmelieColor) $S(col)
    }
    # ls : listbox source ; lt listbox target
    proc AnnotateAddItem {ls lt} {
        global S
        if {$S(database) != ""} {
            $lt delete 0 end
            set variable [$ls get [$ls curselection]]
            set lrecords [Database::dbQueryRecordsAll $S(database)]
            set lres {}
            foreach record $lrecords {
                set leaf [Database::dbQueryVarFromRecords $S(database) EU $record]
                set int [Database::dbQueryVarFromRecords $S(database) $variable $record]
                #$lt insert end [format "%s%s%s" $leaf : $int ]
                lappend lres [format "%s%s%s" $leaf : $int ]
            }
            foreach r [lsort -dictionary $lres] {
                $lt insert end $r
            }
        }
    }
    
    #
    proc CommunRoot {index s1 s2 string} {
        if {[string equal  [string index $s1 $index] [string index $s2 $index]]} {
            CommunRoot [expr $index +1] $s1 $s2 $string[string index $s1 $index]
        } else  {
            return [string length $string]
        }
    }
    #
    proc CommunRoot2 {index s1 s2 string} {
        if {[string equal $s1 $s2]} {
            return $string
        }
        if {[string equal  [string index $s1 $index] [string index $s2 $index]]} {
            CommunRoot2 [expr $index +1] $s1 $s2 $string[string index $s1 $index]
        } else  {
            return $string
        }
    }
    #
    proc DrawGoUser {lv ltreetarget} {
        global S ann T
        foreach ti $ltreetarget {
            switch -exact $S($ti,type) {
                PhyNJ - ClaSla - ClaRec {
                    set database $S(database)
                    upvar #0 $S(database) X
                    set w $S($ti,w)
                    set XMAX1 [lindex [$w bbox [list T$ti && Z]] 2]
                    set XMAX2 [lindex [$w bbox [list T$ti && L]] 2]
                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                    set x [expr $XMAX + $S(IGtabul)]
                    set tagS [format "%s%s%s" SEL ? [Tools::GenId]]
                    foreach v $lv {
                        
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        set vsplit [split $v ":"]
                        set l [lindex $vsplit 0] ;# source
                        set ll [lindex [lindex $vsplit end] 0] ;# targets
                        set y1 [WhatY $w $ti $l]
                        foreach vi [split $ll] {
                            
                            set tagos [format "%s%s%s%s%s" ARCU ? $l ? $vi]
                            if {$vi != $l} {
                                set y2 [WhatY $w $ti $vi]
                                set ymoy [expr ($y1 + $y2) / 2]
                                if {$y1 != 0 && $y2 !=0 } {
                                    
                                    $w create line $x $y1 [expr $x + $S(IGcurve)] $ymoy \
                                            $x $y2 -width $S(IGline) -smooth 1 -splinesteps 100 -fill $S(col) \
                                            -tags "T$ti A$ti $tagC Arc$l Arc$vi Arc $tagS $tagos"
                                    if {$S(IGannot) == 1} {
                                        $w create text $x $y1 \
                                                -fill $S(col) -anchor e -text "$l" -font $S(gfo)\
                                                -tags "T$ti A$ti $tagC Arc$l Arc$vi Arc $tagS $tagos"
                                        
                                        $w create text $x $y2 \
                                                -fill $S(col) -anchor e -text "$vi" -font $S(gfo)\
                                                -tags "T$ti A$ti $tagC Arc$l Arc$vi Arc $tagS $tagos"
                                    }
                                }
                            } else  {
                                set y2 [WhatY $w $ti $vi]
                                set ymoy [expr ($y1 + $y2) / 2]
                                if {$y1 != 0 && $y2 !=0 } {
                                    $w create oval [expr $x - 20]  [expr $y1 -5] $x  [expr $y1 +5]   -outline $S(col) \
                                            -tags "T$ti A$ti $tagC Arc$l Arc$vi Arc $tagos $tagS "
                                }
                            }
                        }
                    }
                }
                PhyRad - PhyCir1 - PhyCir2 - ClaRad  {
                    
                }
                ClaCir1 - ClaCir2  {
                    
                }
                ClaCir3 {
                    set database $S(database)
                    upvar #0 $S(database) X
                    set w $S($ti,w)
                    set co [$w bbox [list T$ti && Z]]
                    set x1 [lindex $co 0]
                    set y1 [lindex $co 1]
                    set x2 [lindex $co 2]
                    set y2 [lindex $co 3]
                    set xcenter [expr double($x2 + $x1)/2]
                    set ycenter [expr double($y2 + $y1)/2]
                    set tagS [format "%s%s%s" SEL ? [Tools::GenId]]
                    foreach v $lv {
                        set tagC [format "%s%s%s" COL ? [Tools::GenId]]
                        set vsplit [split $v ":"]
                        set l [lindex $vsplit 0] ;# source
                        set ll [lindex [lindex $vsplit end] 0] ;# targets
                        foreach vi [split $ll] {
                            set tagos [format "%s%s%s%s%s" ARCU ? $l ? $vi]
                            if {[lsearch $T($ti,ue_lab) $vi] != -1  && [lsearch $T($ti,ue_lab) $l] != -1} {
                                set coVI [$w coords [$w find withtag [list [format "%s%s" $T($ti,ltc,$vi) C ] && T$ti]]]
                                set coL [$w coords [$w find withtag [list [format "%s%s" $T($ti,ltc,$l) C ] && T$ti]]]
                                set xVI [lindex $coVI 2]
                                set yVI [lindex $coVI 3]
                                set xL [lindex $coL 2]
                                set yL [lindex $coL 3]
                                if {$yVI != 0 &&  $yL !=0  && $xVI !=0 && $xL !=0} {
                                    $w create line $xVI $yVI $xcenter $ycenter $xL $yL \
                                            -width $S(IGline) -smooth 1 -splinesteps 100 -fill $S(col) \
                                            -tags "T$ti A$ti $tagC Arc$l Arc$vi Arc $tagos $tagS"
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    #
    proc WhatY {w t l} {
        
        set item [$w find withtag [list [format "%s%s" EUL  $l ] && T$t]]
        if {$item == ""} {
            set items [$w find withtag [list ADD?$l && T$t]]
            set y 0
            foreach ii $items {
                set yii [lindex [$w coords $ii] 1]
                if {$yii >= $y} {
                    set y $yii
                }
            }
        } else  {
            set co [$w coords $item]
            set y [lindex $co 1]
        }
        return $y
    }
    
}
####################

####################
# TDCOM
####################

namespace eval TDcom {
    
    proc com {argv} {
        wm withdraw .
        global T S Export asedCon fileGeneric
        set S(version) 179
        set S(ilw) 0
        set S(display_eu) normal
        set S(gfo) {Helvetica 8 normal}
        set S(lastid) 0
        set S(nbobj) 0
        set S(database) ""
        set S(ldatabase) {}
        set S(nodefilter) 0
        set S(stipple) z.xbm
        set S(defaultshape) 1
        # default values for tree command
        set S(tree-conformation) 01
        set S(tree-x) 10
        set S(tree-y) 20
        set S(tree-height) auto
        set S(tree-width) 150
        set S(tree-font) {Helvetica 8 normal}
        set S(tree-foreground) black
        set S(tree-background) none
        set S(tree-outline) none
        set S(tree-state) normal
        set S(tree-linewidth) 1
        set S(tree-symbol) none
        set S(tree-text) none
        set S(tree-scale) none
                          
        #
        set S(operation) nodebgcolor
        set S(symboldy) 3
        set fileTLF ""
        set fileTDS ""
        set fileGeneric out
        
        # pour test en local
        set S(TDOcgiDIR)  [pwd]
        set S(TDOhtmlDIR)  [pwd]
        
        foreach {k v} $argv {
            switch -- $k {
                "-tree" {
                    set fileNWK [file join $S(TDOcgiDIR)  $v]
                }
                "-label" {
                    set fileTLF [file join $S(TDOcgiDIR) $v]
                }
                "-script" {
                    set fileTDS [file join $S(TDOcgiDIR) $v]
                }
                "-out" {
                    set fileGeneric $v
                }
            }
        }
        set fid [open $fileNWK r]
        set s [read -nonewline $fid]
        close $fid
        regsub -all "\n| " $s "" s
        regsub -all {\[} $s "" s
        regsub -all {:-} $s ":" s
        regsub -all {\]} $s "" s
        set l [split $s ";"]
        set t 0
        set c .c
        set S($c,t) {}
        set S($c,con) {} ;# la liste des ID des connectors de la fenetre
        set S($c,com) {} ;# la liste des ID des comments de la fenetre
        set S(sav,$c) ""
        set S($c,BIcol) ?
        set S($c,BIrow) ?
        canvas .c
        foreach s [lrange $l 0 end-1] {
            TDcom::NewickToTreeDyn $s
            set lkv [array get Export]
            foreach {key value} $lkv {set T(xxx,$key) $value}
            unset Export
            incr t
            lappend S(ilt) $t
            lappend S($c,t) $t
            set S($t,w) $c
            set S($t,tar) 1
            TDcom::TreeInit $t
            TDcom::xxxEncode $t
            TDcom::PhyNJ $t $c
            
        }
        set S(targetTree) $t
        set S(targetWind) $c
        if {$fileTLF != ""} {TDcom::LoadAnnotations $fileTLF}
        if {$fileTDS != ""} {TDcom::OpenScript $fileTDS}
        
        ### EXPORT
        TDcom::exportPS [file join $S(TDOhtmlDIR) $fileGeneric]  $c
        TDcom::exportTGF [file join $S(TDOhtmlDIR)  $fileGeneric] $c
        TDcom::exportSVG [file join $S(TDOhtmlDIR)  $fileGeneric] $c
        exit
    }
    
    ###
    proc xxxEncode {t} {
        global T
        set uold xxx
        set unew $t
        set kvT [array get T xxx*]
        foreach {key value} $kvT {
            regsub  -all xxx $value $t valueswi
            unset T($key) ; regsub  -all xxx $key $t keyswi ; set T($keyswi) $valueswi
        }
    }
    ### TreeInit
    proc TreeInit {t} {
        global T S B
        set S($t,orient) W
        set S($t,a_ori) 0 ;# angle aditionel utilise dans les rotations
        set S($t,a_uni) 0 ;# unite d'angle
        set S($t,tit) "" ;# le pathcut2 du fichier tdy
        set S($t,type) PhyNJ    ;# le type de tree par defaut
        set S($t,init) 0 ;# cette variable fixe le mode inclusif/exclusif du panel identification
        set S($t,display_eu) $S(display_eu)
        set S($t,LabelMatrixBase) 5 ;# matrice d'annotation
        set T($t,eu_collapse) {} ;# liste des noms de feuilles a retirer en abstraction
        set T($t,xmax) 0        ;# branch length max
        set T($t,tot) 0         ;# level max
        set T($t,all_cod) {}    ;# codes nodes
        set T($t,ue_cod) {}     ;# UE - codes LISTE ORDONNEE
        set T($t,ue_lab) {}     ;# UE - labels LISTE ORDONNEE
        set B($t,shi) {}        ;# List des nodes shrink
        set B($t,qyn) {}        ;# list des items querynode
        set B($t,ova) {}        ;# la liste des node reliant 1 tree (decomposition)
        set B($t,bll) {}        ;# la liste des nodes ayant des BLL (bulles labels link : eu;db,users)
        set B($t,bgs) {}        ;# la liste des items background nodes
        set B($t,bgl) {}        ;# la liste des items background leaves
        set B($t,con) {}        ;# la liste des r?Šseaux de connection
    }
    ###
    proc exportPS {file c} {
        global S T
        foreach {x0 y0 x1 y1} [$c bbox all] {}
        set w [expr $x1 - $x0]
        set h [expr $y1 - $y0]
        $c postscript  -file  [format "%s%s" $file .ps] -colormode color \
                -x $x0 -y $y0 -width $w -height $h \
                -pagex 0 -pagey 0 -pagewidth 20.c -pageheight 30.c \
                -pageanchor nw
    }
    ###
    proc exportTGF {file c} {
        global S
        set file [format "%s%s" $file .tgf]
        set script [canvas_saveArray $c $S($c,t)]
        append script [canvas_saveItems $c $S($c,t)]
        set fid [open $file w]
        set data [split $script "\n"]
        foreach elt $data {puts $fid $elt}
        close $fid
    }
    ###
    proc exportSVG {file c} {
        global S
        set file [format "%s%s" $file .svg]
        ::can2svg::canvas2file $c $file
    }
    ###
    proc canvas_saveArray {w lt} {
        global S T B
        set script    "### $S(version)\n"
        append script "set E(tree) \{$lt\} \n"
        #set script "set E(tree) \{$lt\} \n"
        # attention a conserver l'espace entre "\{" et $v
        foreach t $lt {
            set pattern  [format "%s%s%s" $t , * ]
            ######### ARRAY T
            append script "### T\n"
            foreach {k v} [array get T [format "%s%s" $t *]] {
                append script "set ET($k) \{ $v\} \n"
            }
            ######### ARRAY S
            append script "### S\n"
            foreach {k v} [array get S [format "%s%s" $t *]] {
                append script "set ES($k) \{ $v\} \n"
            }
            ######### ARRAY B ici pas d'espace avant v
            append script "### B\n"
            foreach {k v} [array get B [format "%s%s" $t *]] {
                append script "set EB($k) \{$v\} \n"
            }
            # B // BGS
            foreach Id $B($t,bgs) {
                set pattern [format "%s%s%s" BGS* , $Id]
                foreach {k v} [array get B $pattern] {
                    append script "set EB($k) \{ $v\} \n"
                }
            }
            # B // BGL
            foreach Id $B($t,bgl) {
                set pattern [format "%s%s%s" BGL* , $Id]
                foreach {k v} [array get B $pattern] {
                    append script "set EB($k) \{ $v\} \n"
                }
            }
            # B // SHI
            foreach Id $B($t,shi) {
                set pattern [format "%s%s%s" SHI* , $Id]
                foreach {k v} [array get B $pattern] {
                    append script "set EB($k) \{ $v\} \n"
                }
            }
            # B // BLL
            foreach Id $B($t,bll) {
                set pattern [format "%s%s%s" BLL* , $Id]
                foreach {k v} [array get B $pattern] {
                    append script "set EB($k) \{ $v\} \n"
                }
            }
            # B // QYN
            
            foreach i $B($t,qyn) {
                set pattern [format "%s%s%s" QYN* , $i]
                foreach {k v} [array get B $pattern] {
                    append script "set EB($k) \{ $v\} \n"
                }
            }
            # B // OVA
            foreach i $B($t,ova) {
                set pattern [format "%s%s%s" OVA* , $i]
                foreach {k v} [array get B $pattern] {
                    append script "set EB($k) \{ $v\} \n"
                }
            }
        }
        # items sans reference a un IDtree, ou faisant reference a plusieurs IDtree
        # B // CON = connectors
        append script "set ES(con) \{$S($w,con)\} \n"
        foreach i $S($w,con) {
            set pattern [format "%s%s%s" CON* , $i]
            foreach {k v} [array get B $pattern] {
                append script "set EB($k) \{ $v\} \n"
            }
        }
        # B // COM = comments
        
        # FIN
        return $script
    }
    ###
    proc canvas_saveItems {w lt} {
        global S
        foreach t $lt {
            set lid { }
            foreach item [$w find withtag T$t] {
                set id [Tools::GenId]
                lappend lid $id
                set tags [$w gettags $item]
                set type   [$w type $item]
                set coords [$w coords $item]
                set opts ""
                foreach desc [$w itemconfigure $item] {
                    set name [lindex $desc 0]
                    set init [lindex $desc 3]
                    set val  [lindex $desc 4]
                    # correction bug canvas qui place la valeur "bezier" au lieu de "true"
                    # comme valeur de l'option -smooth dans les items canvas
                    if {$val == "bezier"} {set val true}
                    if {$val != $init} {
                        if {$name != "-tags"} {
                            lappend opts $name $val
                        }
                    }
                }
                append script "set EC($t,opts,$id) \{ $type $coords $opts\} \n"
                append script "set EC($t,tags,$id) \{ $tags\} \n"
            }
            append script "set EC($t,ids) \{ $lid\} \n"
        }
        # items graphique non identifie par $id
        # cas des connectors par exemple
        # cas des notes canvas par exemple
        # CONNECTORS, 2 type d'items : line et chaine d'iconification (tags distincts)
        foreach item [$w find withtag {Connect || ConnectIcon}] {
            set id [Tools::GenId]
            lappend lid $id
            set tags [$w gettags $item]
            set type   [$w type $item]
            set coords [$w coords $item]
            set opts ""
            foreach desc [$w itemconfigure $item] {
                set name [lindex $desc 0]
                set init [lindex $desc 3]
                set val  [lindex $desc 4]
                if {$val != $init} {
                    if {$name != "-tags"} {
                        lappend opts $name $val
                    }
                }
            }
            append script "set EC($t,opts,$id) \{ $type $coords $opts\} \n"
            append script "set EC($t,tags,$id) \{ $tags\} \n"
        }
        #essai save legend
        foreach item [$w find withtag Legend] {
            set id [Tools::GenId]
            lappend lid $id
            set tags [$w gettags $item]
            set type   [$w type $item]
            set coords [$w coords $item]
            set opts ""
            foreach desc [$w itemconfigure $item] {
                set name [lindex $desc 0]
                set init [lindex $desc 3]
                set val  [lindex $desc 4]
                if {$val != $init} {
                    if {$name != "-tags"} {
                        lappend opts $name $val
                    }
                }
            }
            append script "set EC($t,opts,$id) \{ $type $coords $opts\} \n"
            append script "set EC($t,tags,$id) \{ $tags\} \n"
        }
        append script "set EC($t,ids) \{ $lid\} \n"
        # FIN
        return $script
    }
    ###
    proc NewickToTreeDyn {s} {
        global Export
        set code xxx ; set n 0
        set Export(xmax) 0
        set Export(tot) 0
        set Export(all_cod) $code
        set Export(ue_lab) {}
        set Export(ue_cod) {}
        set Export(Duplication) {}
        if {[string match *:* $s] == 0} {
            regsub -all "," $s {:1.0,} s
            regsub -all {\)} $s {:1.0)} s
        }
        set Export(dbl,$code) 0
        set Export(nwk,$code) $s
        if {[Dicho $s] == 1} {
            set s [format "%s%s%s" ( $s ):0]
        }
        set tp [string last ")" $s]
        set dt [string range $s 0 $tp]
        if {[string compare [string range $dt 0 0] ( ] != 0 || \
                    [string compare [string range $dt end end] ) ] != 0} {
            set dt [format "%s%s%s" ( $dt )]
        }
        set id [BgBdx $dt]
        set bg [string range $dt [expr $id + 1] [expr [string length $dt] - 2]]
        set bd [string range $dt 1 [expr $id - 1]]
        lappend Export(cbg,$n) 0
        incr n
        NewickParser $bg [format "%s%s" $code g] $n 0
        NewickParser $bd [format "%s%s" $code d] $n 0
        return
    }
    ###
    proc NewickParser {s code n sx} {
        global Export
        lappend Export(all_cod) $code
        set Export(nwk,$code) $s
        if {[string match *,* $s]} {
            if {[Dicho $s] == 1} {
                set s [format "%s%s%s" ( $s ):0]
            }
            set tp [string last ")" $s]
            set dt [string range $s 0 $tp]
            set dx [string range $s [expr $tp + 1] end]
            set Export(dbl,$code) [expr abs([string range $dx [expr [string last ":" $dx] + 1] end])]
            set Export(dbv,$code) [string range $dx 0 [expr [string last ":" $dx] - 1]]
            if {[string compare [string range $dt 0 0] ( ] != 0 || \
                        [string compare [string range $dt end end] ) ] != 0} {
                set dt [format "%s%s%s" ( $dt )]
            }
            set id [BgBdx $dt]
            set bg [string range $dt [expr $id + 1] [expr [string length $dt] - 2]]
            set bd [string range $dt 1 [expr $id - 1]]
            lappend Export(cbg,$n) [format "%s%s" $code $n]
            NewickParser $bg [format "%s%s%s" $code $n g] [expr $n +1] [expr $sx + $Export(dbl,$code)]
            NewickParser $bd [format "%s%s%s" $code $n d] [expr $n +1] [expr $sx + $Export(dbl,$code)]
        } {
            set tp [string last ":" $s]
            set dt [string range $s 0 [expr $tp - 1]]
            set dx [string range $s [expr $tp + 1] end]
            set Export(dbl,$code) [expr abs([string range $dx [expr [string last ":" $dx] + 1] end])]
            if {[lsearch $Export(ue_lab) $dt] == -1}  {
                lappend Export(ue_lab) $dt
                set Export(ctl,$code) $dt
                set Export(ltc,$dt) $code
            } else {
                set newdt [format "%s%s%s" $dt - [GenId]]
                lappend Export(Duplication) "$dt swtich to $newdt"
                lappend Export(ue_lab) $newdt
                set Export(ctl,$code) $newdt
                set Export(ltc,$newdt) $code
            }
            lappend Export(ue_cod) $code
            set sx [expr $sx + $dx]
            set Export(sox,$code) $sx
            if {$sx >= $Export(xmax)} {set Export(xmax) $sx}
            if {$n >= $Export(tot)} {set Export(tot) $n}
            return
        }
    }
    ###
    proc GenId {} {
        global S
        incr S(nbobj)
        return [format "%s%s" [clock second] $S(nbobj)]
    }
    ###
    proc BgBdx {s} {
        set i -1
        set id -1
        foreach c [split $s {}] {
            incr id
            switch -exact -- $c {
                ( {incr i}
                ) {incr i -1}
                , {if {$i == 0} {return $id}}
            }
        }
        return ""
    }
    ###
    proc Dicho {s} {
        set i 0 ; set id 0 ; set r 1
        foreach c [split $s {}] {
            switch -exact -- $c {
                ( {incr i}
                ) {incr i -1}
            }
            if {$i == 0} {
                set r [string match *,* [string range $s [expr $id + 1] end]]
                break
            }
            incr id
        }
        return $r
    }
    ###
    proc PhyNJ {t w} {
        global T S
        set y 0
        set nb [llength $T($t,ue_cod)]
        set largeur $S(tree-width)
        if {$S(tree-height) == "auto"} {
            set hauteur [expr 10 * $nb]
        } else  {
            set hauteur $S(tree-height)
        }
        set fy [expr double($hauteur)  / $nb ]
        set fx [expr double($largeur) / $T($t,xmax)]
        set n 0
        set t3 [format "%s%s" T $t ]
        ### EU
        foreach i $T($t,ue_cod) {
            incr n
            set y [expr $n * $fy ]
            set G($i,x) [expr ($T($t,sox,$i) - $T($t,dbl,$i) )* $fx]
            set G($i,y) $y
            set t2 [format "%s%s" EU $T($t,ctl,$i) ]
            set t4 [format "%s%s" EUL $T($t,ctl,$i) ]
            set t2bis [format "%s%s" $i C]
            $w create line [expr $T($t,sox,$i) * $fx] $G($i,y) $G($i,x) $G($i,y)  \
                    -tags "$i $t2 $t3 $t2bis Z"   -fill  $S(tree-foreground)  -width $S(tree-linewidth)
            $w create text [expr ($T($t,sox,$i) * $fx) + 2]  $G($i,y) \
                    -text  $T($t,ctl,$i) -anchor w   \
                    -tags " $t3 $t4 L" \
                    -font $S(tree-font) -state $S(tree-state)
        }
        ### NODES
        for {set i [expr $T($t,tot) - 1 ]} {$i >= 1} {incr i -1} {
            foreach b $T($t,cbg,$i) {
                set bg [format "%s%s" $b g]
                set bd [format "%s%s" $b d]
                set yn [expr $G($bg,y) - (($G($bg,y) - $G($bd,y)) / 2)]
                set j [string range $bg 0 [expr [string last $i $bg] - 1]]
                set t2 [format "%s%s" $j C]
                # Vertical
                $w create line $G($bg,x) $G($bg,y) $G($bg,x) $G($bd,y) -tags "$t2 $t3 Z" -fill  $S(tree-foreground)  -width $S(tree-linewidth)
                # Horizontal
                set G($j,x) [expr $G($bg,x) - ($T($t,dbl,$j) * $fx)]
                $w create line $G($bg,x) $yn $G($j,x) $yn  -tags "$j $t2 $t3 Z" -fill  $S(tree-foreground)  -width $S(tree-linewidth)
                set G($j,y) $yn
            }
        }
        unset G
        ### ROOT
        set ch [$w coords [format "%s%s" $t g]]
        set cb [$w coords [format "%s%s" $t d]]
        set yh [lrange $ch 1 1]
        set yb [lrange $cb 3 3]
        set x [lrange $ch 2 2]
        set yn [expr $yh - (($yh - $yb) / 2)]
        $w create line $x $yh $x $yb -tags "[format "%s%s" $t C] $t3 Z" -fill  $S(tree-foreground)  -width $S(tree-linewidth)
        $w configure -scrollregion [$w bbox all]
        
        # POSITION TREE
        $w move $t3  $S(tree-x) $S(tree-y)
        
        # BACKGROUND TREE passer au bg sur node 0
        # if {$S(tree-background)  != "none"} {
            # set coords  [$w bbox $t3]
            # set x1   [lindex $coords 0]
            # set y1  [lindex $coords 1]
            # set x2  [lindex $coords 2]
            # set y2  [lindex $coords 3]
            # set id [ $w create rectangle $x1 $y1 $x2 $y2  -tags "$t3 " -fill  $S(tree-background) -outline $S(tree-outline)  ]
            # $w lower $id
        # }
        # SYMBOL TREE {none ou  {$type $x $y $width $height  $color $stipple}}
        if {$S(tree-symbol)  != "none"} {
            set S(symboltype) [lindex $S(tree-symbol) 0]
            set x  [lindex $S(tree-symbol) 1]
            set y  [lindex $S(tree-symbol) 2]
            set S(symboldx)  [expr [lindex $S(tree-symbol) 3] / 2.0]
            set S(symboldy)  [expr [lindex $S(tree-symbol) 4] / 2.0]
            set S(symbolcolorfill)  [lindex $S(tree-symbol) 5]
            set S(symbolcoloroutline)  [lindex $S(tree-symbol) 5]
            switch -- [lindex $S(tree-symbol) 6] {
                 01 { set S(symbolstipple) z.xbm}
                 02 { set S(symbolstipple) a.xbm}
                 03 { set S(symbolstipple) b.xbm}
                 04 { set S(symbolstipple) h.xbm}
                 05 { set S(symbolstipple) j.xbm}
             }
            Illustration::drawsymbol $w $x $y $t3
        }
        # TEXT TREE {none ou   {$text $x $y $font $color}}
        if {$S(tree-text)  != "none"} {
            set text  [lindex $S(tree-text) 0]
            set x  [lindex $S(tree-text) 1]
            set y  [lindex $S(tree-text) 2]
            set font  [lindex $S(tree-text) 3]
            set color  [lindex $S(tree-text) 4]
            $w create text $x $y  -text  $text -anchor w   -tags " $t3" -font $font -fill $color
            
        }
        # SCALE TREE {none ou {$x $y $color}}
        if {$S(tree-scale)  != "none"} {
            set x [lindex $S(tree-scale) 0]
            set y  [lindex $S(tree-scale) 1]
            set color  [lindex $S(tree-scale) 2]
            Annotation::AnnotateBuiltIn $w $t  $x $y Scale $color
            
        }
    }
    proc PhyRad {t  w} {
        global T S G
        set S($t,a_ori) 0
        set nb  [llength $T($t,ue_cod)]
        set largeur $S(treewidth)
        if {$S(treeheight) == "auto"} {
            set hauteur [expr 10 * $nb]
        } else  {
            set hauteur $S(treeheight)
        }
        set x0 [expr $largeur/2.0]
        set y0 [expr $hauteur/2.0]
        if {$x0 <= $y0} {set R $x0} {set R $y0}
        set pi2 [expr 2 * acos(-1)]
        set f [expr $R / $T($t,xmax)]
        set dd [expr ((acos(-1)) * [expr 360.0 / $nb])/ 180.0]
        set S($t,a_uni) $dd
        set td [format "%s%s" $t d]
        set tg [format "%s%s" $t g]
        set nbg [Tools::NodeNoToLeNum $t $tg]
        set nbd [Tools::NodeNoToLeNum $t $td]
        #  $t d
        set G($td,a_amplitude) [expr $nbd * $dd]
        #set G($td,a_from) 0 modification pour la rotation
        set G($td,a_from) $S($t,a_ori)
        set G($td,a_to) [expr $G($td,a_from) + $G($td,a_amplitude) ]
        #set G($td,a) [expr $G($td,a_from) + ($G($td,a_amplitude) / 2.0)]
        set G($td,a) [expr ($G($td,a_from) + ($G($td,a_amplitude) / 2.0)) + $S($t,a_ori)]
        set G($td,x) [expr $T($t,dbl,$td) * $f * cos($G($td,a))]
        set G($td,y) [expr $T($t,dbl,$td) * $f * sin($G($td,a))]
        # $t g
        set G($tg,a_amplitude) [expr $nbg * $dd]
        set G($tg,a_from) $G($td,a_to)
        set G($tg,a_to) [expr $G($tg,a_from) + $G($tg,a_amplitude) ]
        #set G($tg,a) [expr $G($tg,a_from) + ($G($tg,a_amplitude) / 2.0)]
        set G($tg,a) [expr ($G($tg,a_from) + ($G($tg,a_amplitude) / 2.0)) + $S($t,a_ori)]
        set G($tg,x) [expr $T($t,dbl,$tg) * $f * cos($G($tg,a))]
        set G($tg,y) [expr $T($t,dbl,$tg) * $f * sin($G($tg,a))]
        # tags
        set tag1 [format "%s%s" $t C]
        set tag2 [format "%s%s" $t C]
        set tag11 [format "%s%s" $tg C]
        set tag22 [format "%s%s" $td C]
        # trace $td & $tg
        $w create line 0 0 $G($tg,x) $G($tg,y) -tags "$tag1 $tag11  T$t Z" -fill black
        $w create line 0 0 $G($td,x) $G($td,y) -tags "$tag2 $tag22  T$t Z" -fill black
        #
        for {set i 1} {$i < $T($t,tot)} {incr i} {
            foreach b $T($t,cbg,$i) {
                set j [string trimright $b {[0123456789]}]
                set t2 [format "%s%s" $j C]
                set bd [format "%s%s" $b d]
                set bg [format "%s%s" $b g]
                set nbg [Tools::NodeNoToLeNum $t $bg]
                set nbd [Tools::NodeNoToLeNum $t $bd]
                
                ### D
                set G($bd,a_amplitude) [expr $nbd * $dd]
                set G($bd,a_from) $G($j,a_from)
                set G($bd,a_to) [expr $G($bd,a_from) + $G($bd,a_amplitude) ]
                set G($bd,a) [expr $G($bd,a_from) + ($G($bd,a_amplitude) / 2.0)]
                set gamma [expr abs($G($j,a) - $G($bd,a))]
                set a [expr cos($gamma) * $T($t,dbl,$j)]
                set b2 [expr sin($gamma) * $T($t,dbl,$j)]
                set c [expr sqrt( abs (($T($t,dbl,$bd) * $T($t,dbl,$bd)) - ($b2 * $b2) ))]
                set L [expr $c + $a]
                set G($bd,x) [expr $G($j,x) + $f * cos($G($bd,a)) * $L]
                set G($bd,y) [expr $G($j,y) + $f * sin($G($bd,a)) * $L]
                ### G
                set G($bg,a_amplitude) [expr $nbg * $dd]
                set G($bg,a_from) $G($bd,a_to)
                set G($bg,a_to) [expr $G($bg,a_from) + $G($bg,a_amplitude) ]
                set G($bg,a) [expr $G($bg,a_from) + ($G($bg,a_amplitude) / 2.0)]
                set gamma [expr abs($G($j,a) - $G($bg,a))]
                set a [expr cos($gamma) * $T($t,dbl,$j)]
                set b2 [expr sin($gamma) * $T($t,dbl,$j)]
                set c [expr sqrt( abs( ($T($t,dbl,$bg)*$T($t,dbl,$bg)) - ($b2 * $b2) ))]
                set L [expr $c + $a]
                set G($bg,x) [expr $G($j,x) + $f * cos($G($bg,a)) * $L]
                set G($bg,y) [expr $G($j,y) + $f * sin($G($bg,a)) * $L]
                ### trace
                $w create line $G($j,x) $G($j,y) $G($bg,x) $G($bg,y) \
                        -tags "[format "%s%s" $bg C] $bg T$t Z" -fill black
                $w create line $G($j,x) $G($j,y) $G($bd,x) $G($bd,y) \
                        -tags "[format "%s%s" $bd C] $bd T$t Z" -fill black
            }
        }
        # leaf labels
        foreach i $T($t,ue_cod) {
            set angledegre [expr ($G($i,a) * 360) / 6.283185]
            set anchor center
            if {$angledegre >= 0 && $angledegre < 90} {
                set anchor nw
            } elseif {$angledegre >= 90 && $angledegre < 180}  {
                set anchor ne
            } elseif {$angledegre >= 180 && $angledegre < 270}  {
                set anchor se
            } elseif {$angledegre >= 270 && $angledegre < 360}  {
                set anchor sw
            }
            regsub -all {?} $T($t,ctl,$i) " " texto
            $w create text $G($i,x) $G($i,y) -text $texto \
                    -tags "T$t [format "%s%s" EUL $T($t,ctl,$i) ]  L"  \
                    -font $S(gfo) -state $S($t,display_eu) -anchor $anchor
        }
        # ajout tag des arretes terminales (eu)
        foreach i $T($t,ue_cod) {
            set t2 [format "%s%s" EU $T($t,ctl,$i)]
            $w addtag $t2 withtag [list $i && T$t]
            $w addtag Z withtag [list $i && T$t]
        }
        # centrage et scrollregion
        $w move T$t $x0 $y0
        $w configure -scrollregion [$w bbox all]
        set S($t,type) PhyRad
        unset G
    }
    
    ### ArrayToCanvasCirculaire
    proc PhyCir1 {t w} {
        global T S
        set nb  [llength $T($t,ue_cod)]
        set hauteur [expr 10 * $nb]
        set largeur $hauteur
        set basedegre [expr 360.0 / [llength $T($t,ue_cod)]]
        # passage radians
        set dd [expr ((acos(-1)) * $basedegre)/ 180.0]
        set S($t,a_uni) $dd
        #rayon du cercle primaire
        set xcenter [expr double($largeur)/2]
        set ycenter [expr double($hauteur)/2]
        if {$xcenter <= $ycenter} {set R $xcenter} {set R $ycenter}
        #if {$xcenter < $ycenter} {set R $ycenter} {set R $xcenter}
        set n 0
        # facteur de zoom
        set f [expr double($R / $T($t,xmax))]
        ### EU
        foreach i $T($t,ue_cod) {
            # incr n
            set G($i,a) [expr ($n * $dd) + $S($t,a_ori)]
            set x1 [expr ($T($t,sox,$i)* $f) * cos($G($i,a))]
            set y1 [expr ($T($t,sox,$i)* $f) * sin($G($i,a))]
            set x2 [expr ((($T($t,sox,$i) - $T($t,dbl,$i) )* $f) * cos($G($i,a)))]
            set y2 [expr ((($T($t,sox,$i) - $T($t,dbl,$i) )* $f) * sin($G($i,a)))]
            set G($i,x) $x2
            set G($i,y) $y2
            $w create line $x2 $y2 $x1 $y1  \
                    -tags "$i [format "%s%s" EU $T($t,ctl,$i) ] [format "%s%s" $i C] T$t Z" -fill $S(Preference_fgc)
            # feuilles en radial
            
            regsub -all {?} $T($t,ctl,$i) " " texto
            #set ls [split $T($t,ctl,$i) {}]
            set ls [split $texto {}]
            set an center ;# anchor
            set ju center ;# justification
            set angledegre [expr ($G($i,a) * 360) / 6.283185]
            if {$angledegre >= 90 && $angledegre < 270} {
                set b [expr 6 * [llength $ls]]
                foreach s $ls {
                    # SPLIT + LEAVES
                    # COK
                    set xbis [expr $x1 + ($b * cos($G($i,a)))]
                    set ybis [expr $y1 + ($b * sin($G($i,a)))]
                    $w create text $xbis $ybis \
                            -text  $s -anchor $an -justify $ju    \
                            -tags "T$t [format "%s%s" EUL $T($t,ctl,$i) ] L" \
                            -font $S(gfo)  -state $S($t,display_eu)
                    incr b -6
                }
            } else {
                set b 2
                foreach s $ls {
                    # SPLIT + LEAVES
                    # COK
                    set xbis [expr $x1 + ($b * cos($G($i,a)))]
                    set ybis [expr $y1 + ($b * sin($G($i,a)))]
                    $w create text $xbis $ybis \
                            -text  $s -anchor $an -justify $ju    \
                            -tags "T$t [format "%s%s" EUL $T($t,ctl,$i) ] L" \
                            -font $S(gfo) -state $S($t,display_eu)
                    incr b 6
                }
            }
            incr n
        }
        ### NODES
        for {set i [expr $T($t,tot) - 1 ]} {$i >= 1} {incr i -1} {
            foreach b $T($t,cbg,$i) {
                set bg [format "%s%s" $b g] ;# code bras gauche precedent (un niveau de profondeur plus loin)
                set bd [format "%s%s" $b d] ;# code bras droit precedent (un niveau de profondeur plus loin)
                set j [string trimright $b {[0123456789]}] ;# code bras gauche ou droit
                set t2 [format "%s%s" $j C]
                set ad [expr (180.0 * $G($bd,a)) / acos(-1)]
                set ag [expr (180.0 * $G($bg,a)) / acos(-1)]
                set G($j,a) [expr ($G($bg,a) + $G($bd,a)) / 2.0  ]
                set rho [expr $G($bg,x) / cos($G($bg,a))]
                set x1 [expr $rho * cos($G($j,a))]
                set y1 [expr $rho * sin($G($j,a))]
                set x2 [expr $x1 - ($T($t,dbl,$j) * $f * cos($G($j,a)))]
                set y2 [expr $y1 - ($T($t,dbl,$j) * $f * sin($G($j,a)))]
                set G($j,x) $x2
                set G($j,y) $y2
                $w create arc [expr 0 -$rho] $rho $rho [expr 0 -$rho] \
                        -start -$ad -extent [expr $ad - $ag] -style arc  \
                        -tags "$t2 T$t Z" -outline $S(Preference_fgc)
                $w create line $x1 $y1 $x2 $y2  \
                        -tags "$j $t2 T$t Z" -fill $S(Preference_fgc)
            }
        }
        # root
        #$w create line $xcenter $ycenter $xcenter $ycenter \
        #        -tags "[format "%s%s" $t C] T$t Z" -fill $S(Preference_fgc)
        
        #translation
        $w move T$t $xcenter $ycenter
        $w configure -scrollregion [$w bbox all]
        $w create line $xcenter $ycenter $xcenter $ycenter \
                -tags "[format "%s%s" $t C] T$t Z" -fill $S(Preference_fgc)
        unset G
    }
    proc ResizeAllGo {w} {
        global S
        foreach t $S($w,t) {
            set co [$w bbox T$t]
            set x [lindex $co 0]
            set y [lindex $co 1]
            $w delete T$t
            switch -exact $S($t,type) {
                PhyNJ {set S($t,type) PhyNJ ; TDcom::PhyNJ $t $w }
                PhyRad {set S($t,type) PhyRad ; TDcom::PhyRad $t $w }
                PhyCir1 {set S($t,type) PhyCir1 ; TDcom::PhyCir1 $t $w }
                default {set S($t,type) PhyNJ ; TDcom::PhyNJ  $t $w }
            }
            $w move T$t $x $y
            Figuration::RestaureT $w $t
            Reflection::UpdateAll $w
        }
        set S(treeheight) auto
    }
    ###
    proc LoadAnnotations {filename} {
        global S asedCon
        set currentfile [Tools::PathCut2 $filename]
        if {[lsearch $S(ldatabase) $currentfile] != -1 } {
            upvar #0 $currentfile X
            array unset X
        } else  {
            lappend S(ldatabase) $currentfile
        }
        # TDcom::db $currentfile
        TDcom::db TDO
        catch {open $filename r} fid
        while {[eof $fid] != 1} {
            set id [incr S(lastid)]
            gets $fid data
            # modif
            regsub -all " " [lindex $data 0] "?" sans
            set datasans [lreplace $data 0 0 $sans]
            interp eval treedyn TDO [concat $id EU $datasans]
            # interp eval treedyn $currentfile [concat $id EU $datasans]
            # interp eval treedyn $currentfile [concat $id EU $data]
        }
        close $fid
        #set S(database) $currentfile
        set S(database) TDO
    }
    ###
    # proc db de Richard Suchenwirth
    proc db {database args} {
        global asedCon
        upvar #0 $database db
        set key ""
        foreach {- key item value} $args break
        set exists [info exists db($key)]
        set res {}
        switch [llength $args] {
            0 {
                array set db {}
                interp alias {} $database {} TDcom::db $database -
                $asedCon alias  $database TDcom::db $database -
                set res $database
            }
            1 {set res [array names db]}
            2 {
                if {$key != ""} {
                    if {$exists} {set res $db($key)}
                } else {array unset db }
            }
            3 {if {$item != ""} {
                    if {$exists} {
                        set t $db($key)
                        if {!([set pos [lsearch $t $item]]%2)} {
                            set res [lindex $t [incr pos]]
                        }
                    }
                } elseif {$exists} {unset db($key)}
            }
            4 {
                if {$exists} {
                    if {!([set pos [lsearch $db($key) $item]]%2)} {
                        if {$value != ""} {
                            set db($key) [lreplace $db($key) [incr pos] $pos $value]
                        } else {set db($key) [lreplace $db($key) $pos [incr pos]]}
                    } elseif {$value != ""} {
                        lappend db($key) $item $value
                    }
                } elseif {$value != ""} {set db($key) [list $item $value]}
                set res $value
            }
            default {
                if {[llength $args]%2} {error "non-paired item/value list"}
                foreach {item value} [lrange $args 2 end] {
                    db $database - $key $item $value
                }
            }
        }
    }
    proc OpenScript {filename} {
        global S T tds fileGeneric
        catch {open $filename r} fid
        set ltreetarget {} ; set lwindowtarget {}
        foreach {w t} [Selection::TreeTar] {
            lappend ltreetarget $t
            lappend lwindowtarget $w
        }
        set  lwindowtarget [Tools::DelRep $lwindowtarget]
        # valeur par defaut
        set S(ScriptingLegend) 0
        while {[eof $fid] != 1} {
            gets $fid raw
            set type [lindex $raw 0]
            set command [lrange $raw 1 end]
            #conPuts $raw
            switch -exact $type {
                annotation {
                    # il faut  AN Columns {TDO {TypeStrain}}
                    # on a  annotation Columns {TypeStrain}
                    global ann
                    set mode [lindex $command 0]
                    if {$mode == "matrix"} {
                        set S(database) TDO
                        set ann(binmatPadding) 6
                        set ann(binmatHeight) 4
                        set ann(binmatWidth) 4
                        set ann(binmatColor0) white
                        set ann(binmatColor1) black
                        set ann(binmatOutline) 1
                        set ann(binmatColumnsNumber) 0
                        Annotation::MatrixAnnotateGoGo [lindex $command 1] $ltreetarget
                    } elseif {$mode == "matrixrgb"} {
                        set S(database) TDO
                        set ann(binmatPadding) 6
                        set ann(binmatHeight) 4
                        set ann(binmatWidth) 4
                        set ann(binmatColor0) white
                        set ann(binmatColor1) black
                        set ann(binmatOutline) 1
                        set ann(binmatColumnsNumber) 0
                        Annotation::MatrixColorsAnnotateGoGo [lindex $command 1] $ltreetarget
                    }  elseif {$mode == "newick"} {
                        set command [lrange $command 1 end]
                        # annotationnewick ?[-what ":x ou x:"] ?[-treshold $valeur] ?[-leaf "0 ou 1"] ?[-where "nw sw ne se n s"] -color -font
                        # valeur par defaut
                        set S(-what) :x ;#  :x ou x:
                        set S(-treshold) all ;# all ou $valeur
                        set S(-leaf) 1 ;# 0 1
                        set S(-where) nw ;# "nw sw ne se n s e"
                        set S(-font) {Helvetica 8 normal} ;#
                        set S(-color) blue ;#
                        # traitements flags
                        foreach {variable value} $command {
                            eval  set S($variable) $value
                        }
                        # display
                        foreach {w t} [Selection::TreeTar]  {
                            ANBLgo $w $t
                        }
                    } elseif {$mode == "draw"} {
                        set command [lrange $command 1 end]
                        # default values
                        set x(-l) {}
                        set x(-text) ""
                        set x(-color) red
                        set x(-font) {Arial 8 normal}
                        set x(-tab) 0
                        set x(-width) 5
                        set x(-background) red
                        set x(-stipple) 01
                        # traitements flags
                        foreach {variable value} $command {
                            eval  set x($variable) $value
                        }
                        switch  -exact $x(-stipple) {
                            01 { set x(-stipple) z.xbm}
                            02 { set x(-stipple) a.xbm}
                            03 { set x(-stipple) b.xbm}
                            04 { set x(-stipple) h.xbm}
                            05 { set x(-stipple) j.xbm}
                        }
                        foreach {w t} [Selection::TreeTar] {
                            # ds leafs eventuellement des patterns
                            set l {}
                            foreach li $x(-l) {
                                append l " [lsearch -all -inline -regexp $T($t,ue_lab) $li]"
                            }
                            if {$l != {}} {
                                # recuperer la liste des noeuds peres
                                set peres  [Operation::FindFatherNode $t $l]
                                foreach p $peres { 
                                    set SouCodLea [Tools::NodeNoToLe $t $p]
                                    set SouRefLea [Tools::NodeLeCoToRe $t $SouCodLea]
                                    Illustration::BracketDrawLeafs $w $t $SouRefLea $x(-text) $x(-color) \
                                            $x(-font) $x(-tab) $x(-width) $x(-background) $x(-stipple)
                                }
                            }
                        }
                        unset x
                    }  elseif {$mode == "arcs"} {
                        set command [lrange $command 1 end]
                        # valeur par defaut
                        set S(-tab) 50
                        set S(-text) 1
                        set S(-curve) 10
                        set S(-line) 1
                        set S(-color) blue
                        # traitements flags
                        foreach {variable value} $command {
                            eval  set S($variable) $value
                        }
                        # affectation des variables globales
                        set S(col)  $S(-color)
                        set S(IGtabul) $S(-tab)
                        set S(IGcurve) $S(-curve)
                        set S(IGline) $S(-line)
                        set S(IGannot) $S(-text)
                        # construction liste lv : leaf source listes des feuilles target
                        set S(database) TDO
                        set id [Database::dbQueryRecordsFromVarVal TDO EU $S(-leaf)]
                        set l [Database::dbQueryVarFromRecords TDO $S(-variable)    $id]
                        set lv [list [format "%s%s%s%s" $S(-leaf) ":{" $l "}"]]
                        # display
                        foreach {w t} [Selection::TreeTar]  {
                            Amelie::DrawGoUser $lv $t
                        }
                    }  else  {
                        if {$mode == "replace" } {set mode LeavesReplace }
                        if {$mode == "juxtapose" } {set mode LeavesAdd }
                        if {$mode == "column" } {set mode Columns }
                        set ann(ann-fgfiguration) asuser
                        set ann(ann-fofiguration) asuser
                        set ann(ann-prefix) " "
                        set ann(ann-suffix) ""
                        set ann(ann-exposant) 0
                        set fct [format "%s%s" Annotation::ANGo $mode] ;# la fonction d'annotation
                        set lv [lindex $command 1] ;# database liste_de_variables
                        #set S(database) [lindex $var 0]
                        set S(database) TDO
                        #set lv [lindex $var 1] ;# liste de variables
                        set args [lindex $command 2] ;# options
                        if {$args != ""} {
                            foreach {option value} $args {
                                set ann(ann-$option) $value
                            }
                        }
                        eval $fct $lv [list $ltreetarget]
                        set ann(ann-prefix) " "
                        set ann(ann-suffix) ""
                        set ann(ann-exposant) 0
                    }
                }
                find {
                    set S(query) $command
                    foreach {w t} [Selection::TreeTar]  {
                        foreach ci [lindex $command 0]  {
                            #set leu {}
                            #foreach i $T($t,ue_lab) {
                            #    if {[string match  $ci $i]} {lappend leu $i }
                            #}
                            set leu  [ lsearch -all -inline -regexp  $T($t,ue_lab) $ci  ]
                            Operation::Operation $w $t $leu
                            if {$S(ScriptingLegend)} {
                                # legende MODIF si symbol
                                if {$S(operation) == "LillC"} {
                                    foreach wi $lwindowtarget {
                                        set co [$wi bbox Legend]
                                        if {$co == ""} {
                                            set x 0 ; set y 0
                                        } else  {
                                            set x 0 ; set y [expr [lindex $co end] + $S(symboldy)+3]
                                        }
                                        #set S(symbolcolorfill) $S(col)
                                        #set S(symbolcoloroutline) $S(col)
                                        #set S(symbolstipple) $S(stipple)
                                        Illustration::drawsymbol  $wi $x $y [list Legend $S(ScriptingLegendTAG)]
                                        $wi create text [expr $x + 15] [expr $y + 2] \
                                                -text $ci   -tags "Legend txt $S(ScriptingLegendTAG)"
                                    }
                                    incr y 15
                                } else  {
                                    foreach wi $lwindowtarget {
                                        set co [$wi bbox Legend]
                                        if {$co == ""} {
                                            set x 0 ; set y 0
                                        } else  {
                                            set x 0 ; set y [expr [lindex $co end] + $S(symboldy)+3]
                                        }
                                        #set S(symbolcolorfill) $S(col)
                                        #set S(symbolcoloroutline) $S(col)
                                        #set S(symbolstipple) $S(stipple)
                                        Illustration::drawsymbol  $wi $x $y [list Legend $S(ScriptingLegendTAG)]
                                        $wi create text [expr $x + 11] [expr $y + 2] \
                                                -text $ci  -tags "Legend txt $S(ScriptingLegendTAG)"
                                    }
                                    incr y 10
                                }
                            }
                        }
                    }
                }
                query {
                    set var [lindex $command 0]
                    set ope [lindex $command 1]
                    foreach val [lindex $command 2] {
                        set com [concat  EU from TDO where $var $ope $val]
                        eval Database::Select $com
                        if {$S(ScriptingLegend)} {
                            # legende MODIF si symbol
                            if {$S(operation) == "LillC"} {
                                foreach wi $lwindowtarget {
                                    set co [$wi bbox Legend]
                                    if {$co == ""} {
                                        set x 0 ; set y 0
                                    } else  {
                                        set x 0 ; set y [expr [lindex $co end] + $S(symboldy)+3]
                                    }
                                    #set S(symbolcolorfill) $S(col)
                                    #set S(symbolcoloroutline) $S(col)
                                    #set S(symbolstipple) $S(stipple)
                                    Illustration::drawsymbol  $wi $x $y [list Legend $S(ScriptingLegendTAG)]
                                    $wi create text [expr $x + 15] [expr $y + 2] \
                                            -text [lindex $com end]   -tags "Legend txt $S(ScriptingLegendTAG)"
                                }
                                incr y 15
                            } else  {
                                foreach wi $lwindowtarget {
                                    set co [$wi bbox Legend]
                                    if {$co == ""} {
                                        set x 0 ; set y 0
                                    } else  {
                                        set x 0 ; set y [expr [lindex $co end] + $S(symboldy)+3]
                                    }
                                    #set S(symbolcolorfill) $S(col)
                                    #set S(symbolcoloroutline) $S(col)
                                    #set S(symbolstipple) $S(stipple)
                                    Illustration::drawsymbol  $wi $x $y [list Legend $S(ScriptingLegendTAG)]
                                    $wi create text [expr $x + 11] [expr $y + 2] \
                                            -text [lindex $com end]  -tags "Legend txt $S(ScriptingLegendTAG)"
                                }
                                incr y 10
                            }
                        }
                    }
                }
                font {
                    set S(gfo) $command
                    
                }
                tree {

                    # traitements flags  -height  -width -font -foreground -background etc
                    foreach {variable value} $command {
                        set variabletree [format "%s%s" tree $variable]
                        eval  set S($variabletree) $value
                    }
                    foreach {w t} [Selection::TreeTar]  {
                        $w delete T$t
                        switch --  $S(tree-conformation) {
                            01 { TDcom::PhyNJ  $t $w}
                            02 { TDcom::PhyRad  $t $w}
                        }
                        #Figuration::RestaureT $w $t
                    }
                }
                legend {
                    switch  -exact $command {
                        on {
                            set S(ScriptingLegend) 1
                            set tagi [format "%s%s" LE [Tools::GenId]]
                            set S(ScriptingLegendTAG) $tagi
                        }
                        off {
                            set S(ScriptingLegend) 0
                        }
                    }
                }
                text {
                    set S(AnnotateNote) $command
                }
                scale  {
                    foreach {w t} [Selection::TreeTar]  {
                        set co [$w bbox T$t]
                        set x [lindex $co 0]
                        set y [lindex $co 1]
                        Annotation::AnnotateBuiltIn $w $t  [expr [lindex $command 0] + $x] [expr [lindex $command 1] + $y] Scale
                    }
                }
                conformation  {
                    set mode [lindex $command 0]
                    switch  -exact $mode {
                        01 {
                            foreach {w t} [Selection::TreeTar]  {
                                $w delete T$t
                                TDcom::PhyNJ  $t $w
                            }
                        }
                        02 {
                            foreach {w t} [Selection::TreeTar]  {
                                $w delete T$t
                                TDcom::PhyRad  $t $w
                            }
                        }
                        03 {
                            foreach {w t} [Selection::TreeTar]  {
                                $w delete T$t
                                TDcom::PhyCir1  $t $w
                            }
                        }
                    }
                }
                swap  {
                    set ll [lindex $command 0]
                    foreach {w t} [Selection::TreeTar]  {
                        set leu {}
                        foreach e $ll {
                            if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                        }
                        set n  [Operation::FindFatherNode $t $leu]
                        if {[lindex $n 0] != ""} {
                            Conformation::Swap $w $t $n
                        }
                    }
                }
                root   {
                    set ll [lindex $command 0]
                    foreach {w t} [Selection::TreeTar]  {
                        set leu {}
                        foreach e $ll {
                            if {[lsearch -exact $T($t,ue_lab) $e] != -1} {lappend leu $e}
                        }
                        set n  [Operation::FindFatherNode $t $leu]
                        if {[lindex $n 0] != ""} {
                            Conformation::Outgroup2 $w - $t $n
                        }
                    }
                }
                size {
                    set S(newW) [lindex $command 0]
                    set S(newH) [lindex $command 1]
                    set S(treewidth) [lindex $command 0]
                    set S(treeheight) [lindex $command 1]
                    foreach wi $lwindowtarget {TDcom::ResizeAllGo $wi}
                }
                rowcolumn {
                    set row [lindex $command 0]
                    set column [lindex $command 1]
                    foreach wi $lwindowtarget {Navigation::Reorganize $wi $column $row}
                }
                symbol {
                    set S(symboltype) [lindex $command 0]
                    set S(symboldx) [lindex $command 1]
                    set S(symboldy) [lindex $command 2]
                    set S(symbolcolorfill) [lindex $command 3]
                    set S(symbolcoloroutline) [lindex $command 4]
                    switch  -exact [lindex $command 5] {
                        01 { set S(symbolstipple) z.xbm}
                        02 { set S(symbolstipple) a.xbm}
                        03 { set S(symbolstipple) b.xbm}
                        04 { set S(symbolstipple) h.xbm}
                        05 { set S(symbolstipple) j.xbm}
                        default { set S(symbolstipple) z.xbm}
                    }
                }
                tabulation {
                    switch  -exact [lindex $command 0] {
                        + {Illustration::IllCTabulationSet tab+ [lindex $command 1]}
                        - {Illustration::IllCTabulationSet tab- [lindex $command 1]}
                        = {Illustration::IllCTabulationSet tab= [lindex $command 1]}
                        auto {set S(TabulationAnnot) [lindex $command 1] ; set S(illustration-tabulation) 1}
                        manual {set S(illustration-tabulation) 0}
                    }
                }
                color {
                    eval set S(col) $command
                }
                stipple {
                    switch  -exact [lindex $command 0] {
                        01 { set S(stipple) z.xbm}
                        02 { set S(stipple) a.xbm}
                        03 { set S(stipple) b.xbm}
                        04 { set S(stipple) h.xbm}
                        05 { set S(stipple) j.xbm}
                    }
                }
                shape {
                    switch  -exact [lindex $command 0] {
                        01 { set S(defaultshape) 1}
                        02 { set S(defaultshape) 2}
                        03 { set S(defaultshape) 3}
                        04 { set S(defaultshape) 4}
                        05 { set S(defaultshape) 5}
                    }
                }
                operation {
                    set S(operation) {}
                    foreach op $command {
                        switch  $op {
                            l01 {eval lappend S(operation) leaffgcolor}
                            l02 {eval lappend S(operation) leafbgcolor}
                            l03 {eval lappend S(operation) leaffontglob}
                            l04 {eval lappend S(operation) LillL}
                            l05 {eval lappend S(operation) LillC}
                            l06 {eval lappend S(operation) LannL}
                            l07 {eval lappend S(operation) LannC}
                            l08 {eval lappend S(operation) leafshrink}
                            l09 {eval lappend S(operation) leafunshrink}
                            n00 {eval lappend S(operation) nodefgcolor}
                            n01 {eval lappend S(operation) nodebgcolor}
                            n02 {eval lappend S(operation) widthline+}
                            n03 {eval lappend S(operation) widthline-}
                            n04 {eval lappend S(operation) nodedashOn}
                            n05 {eval lappend S(operation) nodedashOff}
                            n06 {eval lappend S(operation) nodeillustration}
                            n07 {eval lappend S(operation) symbolnode}
                            n08 {eval lappend S(operation) nodeannotate}
                            n09 {eval lappend S(operation) insertvarval}
                            n10 {eval lappend S(operation) insertvarval2}
                            n11 {eval lappend S(operation) shrink}
                            n12 {eval lappend S(operation) unshrinnk}
                            n13 {eval lappend S(operation) nodenetwork}
                            n14 {eval lappend S(operation) nodeextract}
                            n15 {eval lappend S(operation) nodefgcolor2}
                            n16 {eval lappend S(operation) widthline+2}
                            n17 {eval lappend S(operation) nodedashOn2}
                            c00 {eval lappend S(operation) querynode}
                        }
                    }
                    
                }

                infocoord {
                    switch $command {
                        leave {
                            set fileINFO [format "%s%s" [file join $S(TDOhtmlDIR) $fileGeneric] infocoordleave.txt]
                            set fid2 [open $fileINFO w]
                            foreach {w t} [Selection::TreeTar]  {
                                
                                foreach l $T($t,ue_lab) {
                                    set coL [$w bbox [$w find withtag [list [format "%s%s" EUL $l ] && T$t]]]
                                    #set coL [$w coords [$w find withtag [list [format "%s%s" $T($t,ltc,$l) C ] && T$t]]]
                                    puts $fid2 "$l $coL"
                                }
                            }
                            close $fid2
                        }
                        tree {
                            set fileINFO [format "%s%s" [file join $S(TDOhtmlDIR) $fileGeneric] infocoordtree.txt]
                            set fid2 [open $fileINFO w]
                            foreach {w t} [Selection::TreeTar]  {
                                if {$S(illustration-tabulation) == 1} {
                                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                                    set XMAX3 [lindex [$w bbox [list T$t && AnnotMatrix]] 2]
                                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                                    if {$XMAX < $XMAX3} {set XMAX $XMAX3 }
                                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                                } else  {
                                    set XMAX1 [lindex [$w bbox [list T$t && Z]] 2]
                                    set XMAX2 [lindex [$w bbox [list T$t && L]] 2]
                                    if {$XMAX1 < $XMAX2} {set XMAX $XMAX2 } {set XMAX $XMAX1}
                                    set x [expr $XMAX + $S($t,LabelMatrixBase)]
                                }
                                puts $fid2 "$t $x"
                            }
                            close $fid2
                        }
                        node {
                            set fileINFO [format "%s%s" [file join $S(TDOhtmlDIR) $fileGeneric] infocoordnode.txt]
                            set fid2 [open $fileINFO w]
                            
                            foreach {w t} [Selection::TreeTar]  {
                                set id 0
                                foreach node $T($t,all_cod) {
                                    set l [Tools::NodeLeCoToRe $t [Tools::NodeNoToLe $t $node]]
                                    puts $fid2 "$id \t $node \t [list [lsort -dictionary $l]] \t [list [$w coords $node]]"
                                    incr id
                                }
                            }
                            close $fid2
                        }
                    }
                }
            }
        }
        close $fid
    }
    
    proc ANBLgo {w t} {
        global T S
        
        switch -- $S(-what) {
            ":x" {
                if {$S(-treshold) == "all"} {
                    set l [lrange $T($t,all_cod) 1 end]
                    if {$S(-leaf) == 0} {set l [Tools::SousL $l $T($t,ue_cod)]}
                    foreach i $l {
                        if {[$w itemcget $i -state] != "hidden"} {
                            set co [$w coords $i]
                            if {$co != ""} {
                                switch -- $S(-where) {
                                    nw {
                                        # gauche haut
                                        set x [expr [lindex $co 2] + 2]
                                        set y [lindex $co 1]
                                        set anchor sw ; set justify left
                                    }
                                    sw {
                                        # gauche bas
                                        set x [expr [lindex $co 2] + 2]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor nw ; set justify left
                                    }
                                    ne {
                                        # droite haut
                                        set x [lindex $co 0]
                                        set y [lindex $co 1]
                                        set anchor se ; set justify right
                                    }
                                    se {
                                        # doite bas
                                        set x [lindex $co 0]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor ne ; set justify right
                                    }
                                    n  {
                                        # centre haut
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [lindex $co 1]
                                        set anchor s ; set justify center
                                    }
                                    s  {
                                        # centre bas
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor n ; set justify center
                                    }
                                    e  {
                                        # special
                                        set x [expr [lindex $co 0] +2]
                                        set y [expr [lindex $co 1] +1]
                                        set anchor w ; set justify left
                                    }
                                }
                                if [catch {set test $T($t,dbl,$i)} res] {} else {
                                    eval {$w create text} \
                                            {$x $y} \
                                            {-text $T($t,dbl,$i) -fill $S(-color) \
                                                -font $S(-font) -anchor $anchor -justify $justify -tags "T$t DBL"}
                                }
                            }
                        }
                    }
                    
                } else  {
                    set l [lrange $T($t,all_cod) 1 end]
                    if {$S(-leaf) == 0} {set l [Tools::SousL $l $T($t,ue_cod)]}
                    foreach i $l {
                        if {[$w itemcget $i -state] != "hidden"} {
                            set co [$w coords $i]
                            if {$co != ""} {
                                switch -- $S(-where) {
                                    nw {
                                        # gauche haut
                                        set x [expr [lindex $co 2] + 2]
                                        set y [lindex $co 1]
                                        set anchor sw ; set justify left
                                    }
                                    sw {
                                        # gauche bas
                                        set x [expr [lindex $co 2] + 2]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor nw ; set justify left
                                    }
                                    ne {
                                        # droite haut
                                        set x [lindex $co 0]
                                        set y [lindex $co 1]
                                        set anchor se ; set justify right
                                    }
                                    se {
                                        # doite bas
                                        set x [lindex $co 0]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor ne ; set justify right
                                    }
                                    n  {
                                        # centre haut
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [lindex $co 1]
                                        set anchor s ; set justify center
                                    }
                                    s  {
                                        # centre bas
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor n ; set justify center
                                    }
                                    e  {
                                        # special
                                        set x [expr [lindex $co 0] +2]
                                        set y [expr [lindex $co 1] +1]
                                        set anchor w ; set justify left
                                    }
                                }
                                if [catch {set test $T($t,dbl,$i)} res] {} else {
                                    if { $T($t,dbl,$i) >= $S(-treshold) } {
                                        eval {$w create text} \
                                                {$x $y} \
                                                {-text $T($t,dbl,$i) -fill $S(-color) \
                                                    -font $S(-font) -anchor $anchor -tags "T$t DBL"}
                                    }
                                }
                            }
                        }
                    }
                }
            }
            "x:" {
                if {$S(-treshold) == "all"} {
                    set l [lrange $T($t,all_cod) 1 end]
                    if {$S(-leaf) == 0} {set l [Tools::SousL $l $T($t,ue_cod)]}
                    foreach i $l {
                        if {[$w itemcget $i -state] != "hidden"} {
                            set co [$w coords $i]
                            if {$co != ""} {
                                switch -- $S(-where) {
                                    nw {
                                        # gauche haut
                                        set x [expr [lindex $co 2] + 2]
                                        set y [lindex $co 1]
                                        set anchor sw ; set justify left
                                    }
                                    sw {
                                        # gauche bas
                                        set x [expr [lindex $co 2] + 2]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor nw ; set justify left
                                    }
                                    ne {
                                        # droite haut
                                        set x [lindex $co 0]
                                        set y [lindex $co 1]
                                        set anchor se ; set justify right
                                    }
                                    se {
                                        # doite bas
                                        set x [lindex $co 0]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor ne ; set justify right
                                    }
                                    n  {
                                        # centre haut
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [lindex $co 1]
                                        set anchor s ; set justify center
                                    }
                                    s  {
                                        # centre bas
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor n ; set justify center
                                    }
                                    e  {
                                        # special
                                        set x [expr [lindex $co 0] +2]
                                        set y [expr [lindex $co 1] +1]
                                        set anchor w ; set justify left
                                    }
                                }
                                if [catch {set test $T($t,dbv,$i)} res] {} else {
                                    eval {$w create text} \
                                            {$x $y} \
                                            {-text $T($t,dbv,$i) -fill $S(-color) \
                                                -font $S(-font) -anchor $anchor -tags "T$t DBL"}
                                }
                            }
                        }
                    }
                } else  {
                    set l [lrange $T($t,all_cod) 1 end]
                    if {$S(-leaf) == 0} {set l [Tools::SousL $l $T($t,ue_cod)]}
                    foreach i $l {
                        if {[$w itemcget $i -state] != "hidden"} {
                            set co [$w coords $i]
                            if {$co != ""} {
                                switch -- $S(-where) {
                                    nw {
                                        # gauche haut
                                        set x [expr [lindex $co 2] + 2]
                                        set y [lindex $co 1]
                                        set anchor sw ; set justify left
                                    }
                                    sw {
                                        # gauche bas
                                        set x [expr [lindex $co 2] + 2]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor nw ; set justify left
                                    }
                                    ne {
                                        # droite haut
                                        set x [lindex $co 0]
                                        set y [lindex $co 1]
                                        set anchor se ; set justify right
                                    }
                                    se {
                                        # doite bas
                                        set x [lindex $co 0]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor ne ; set justify right
                                    }
                                    n  {
                                        # centre haut
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [lindex $co 1]
                                        set anchor s ; set justify center
                                    }
                                    s  {
                                        # centre bas
                                        set x [expr abs([lindex $co 0] + (([lindex $co 2] - [lindex $co 0]) / 2.0) ) ]
                                        set y [expr [lindex $co 1] + 2]
                                        set anchor n ; set justify center
                                    }
                                    e  {
                                        # special
                                        set x [expr [lindex $co 0] +2]
                                        set y [expr [lindex $co 1] +1]
                                        set anchor w ; set justify left
                                    }
                                }
                                if [catch {set test $T($t,dbv,$i)} res] {} else {
                                    if { $T($t,dbv,$i) >= $S(-treshold) } {
                                        eval {$w create text} \
                                                {$x $y} \
                                                {-text $T($t,dbv,$i) -fill $S(-color) \
                                                    -font $S(-font) -anchor $anchor -tags "T$t DBL"}
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    
}
####################


####################
# GO
####################
Interface::TreeDynInitialisation
#proc bgerror {m} {}

global S
#source tdopath.tcl
#set S(ImportDIR) $S(TDOcgiDIR)
#set S(userDIR) $S(TDOcgiDIR)
#set S(TheoPATH) [pwd]
set S(TheoPATH) /data/http/www/binaries/theo
$asedCon alias db "TDcom::db"
TDcom::com $argv
exit
####################