/binaries/theo/data

Large files files are truncated, but you can click here to view the full file

####################
# 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)
        # in…