"SortDeSeq $K %x %y"
set DessinCourant $K
}
if {$PourGif} { return $LesOrdresPourGif }
return $w
}
proc CreeLeFichierTFAsDesRNsDeCbriggsae {} {
set LesTFAs {}
foreach Ligne [LesRecepteursNucleairesDe "briggsae"] {
scan $Ligne "%s %s" Bidon Access
if {[info exists DejaVu($Access)]} { continue }
set DejaVu($Access) 1
set TFA [LaSequenceDuTFAs "/catalog/blast/Cbriggsae" $Access]
lappend LesTFAs $TFA
}
Espionne [SauveLesLignes $LesTFAs dans "[RepertoireDuGenome]/Cbriggsae_nr.tfa"]
}
proc LesRNsDeYann {} {
foreach Nom [ListeDesPABs] {
set TexteNR [ExtraitInfo $Nom NR]
if { ! [regexp "oui" $TexteNR]} { continue }
regsub "oui " $TexteNR "" GN
scan $GN "%s" GN
InformeSansDemander $Nom "=ValiGN: $GN"
lappend LesNRsDeYann "$Nom $GN"
}
SauveLesLignes $LesNRsDeYann dans "[RepertoireDuGenome]/fiches/les_nr_de_yann"
exit
}
proc CreeBornesDesPABsDuFichierSubset FichierSubset {
set LesNoms {}
foreach Ligne [LesLignesDuFichier $FichierSubset] {
set Nom ""
scan $Ligne "%s" Nom
if { ! [EstUnPAB $Nom]} { continue }
lappend LesNoms $Nom
}
if {$LesNoms=={}} { return "" }
set OldFin 101
foreach Nom $LesNoms {
set FTFA "[RepertoireDuGenome]/prottfa/$Nom"
set Long [expr [string length [QueLaSequenceDuFichierTFA $FTFA]] * 3]
set Debut [expr $OldFin + 101]
set Fin [expr $Debut+$Long-1]
lappend LesNouvellesBornes "$Nom $Debut $Fin F"
set OldFin $Fin
}
set FichierBornes "[RepertoireDuGenome]/fiches/bornesdespabs"
Garde $FichierBornes
SauveLesLignes $LesNouvellesBornes dans $FichierBornes
exit
}
proc BlastPPourTousDuFichier Fichier {
set LesNoms {}
foreach Ligne [LesLignesDuFichier $Fichier] {
set Nom ""
scan $Ligne "%s" Nom
if { ! [EstUnPAB $Nom]} { continue }
lappend LesNoms $Nom
}
if {$LesNoms=={}} { return "" }
BlastPPourTous $LesNoms
}
proc BlastPPourTousDuFichier Fichier {
set LesNoms {}
foreach Ligne [LesLignesDuFichier $Fichier] {
set Nom ""
scan $Ligne "%s" Nom
if { ! [EstUnPAB $Nom]} { continue }
lappend LesNoms $Nom
}
if {$LesNoms=={}} { return "" }
BlastPPourTous $LesNoms
}
proc LesRecepteursNucleairesDe {{Qui ""}} {
if {$Qui==""} {
set LesPossibles [glob -nocomplain "[RepertoireDuGenome]/blastp*"]
set Qui [ChoixParmi $LesPossibles]
if {$Qui==""} { return {} }
set Qui [file tail $Qui]
regsub "blastp" $Qui "" Qui
}
foreach Nom [ListeDesPABs] {
set Fichier "[RepertoireDuGenome]/blastp$Qui/$Nom"
DecortiqueBlast $Fichier 0.001 9999 Query lBanqueId lAccess lDE lProfil lPN
if {$Qui=="briggsae"} { set lAccess $lBanqueId }
foreach Access $lAccess PN $lPN {
lappend VerExpect($Access) "$PN $Nom"
}
}
set LesRNs {}
foreach Access [lsort [array names VerExpect]] {
set VerExpect($Access) [lsort -command CompareLesFloatsEnDebut [set VerExpect($Access)]]
if {$Qui=="Ciona"} {
set CIONA [CioNarcisse $Access]
lappend LesRNs "$CIONA $Access [join [set VerExpect($Access)] { }]"
} else {
lappend LesRNs "xxxxxx $Access [join [set VerExpect($Access)] { }]"
}
}
return $LesRNs
}
proc OrgPourCiona {} {
set OS [NotreOS]
set OC [OCduOS $OS]
set OSOC "OS $OS.\nOC $OC"
foreach Nom [ListeDesPABs] {
set F "[RepertoireDuGenome]/protembl/$Nom"
set Texte [ContenuDuFichier $F]
regsub "CC " $Texte "$OSOC\nCC " Texte
Sauve $Texte dans $F
}
exit
}
proc CioNarcisse A {
global CioNarcisse
if {[info exists CioNarcisse($A)]} { return [set CioNarcisse($A)] }
if {[info exists CioNarcisse("EstCharge")]} { return $A }
set CioNarcisse("EstCharge") 1
foreach Ligne [LesLignesDuFichier "/genomics/Ciona/fiches/narcisse"] {
set X ""
set Y ""
scan $Ligne "%s %s" X Y
set CioNarcisse($X) $Y
set CioNarcisse($Y) $X
}
return [CioNarcisse $A]
}
proc LesOrganismesDuHTML Fichier {
set Texte [ContenuDuFichier $Fichier]
set OL [ValeurDeLaBalise "ol" Texte]
set LesOrganismes {}
while 1 {
set B [ValeurDeLaBalise "li" OL]
if {$B==""} { break }
set iPV [string last ";" $B]
set Champ [string range $B [incr iPV] end]
set iP [string last "" $Champ]
if {$iP>=0} {
set Champ [string range $Champ 0 [incr iP -1]]
}
regsub { *\(.*} $Champ "" Organisme
if {[info exists DejaVu($Organisme)]} { continue }
set DejaVu($Organisme) 1
lappend LesOrganismes $Organisme
}
return $LesOrganismes
exit
}
proc SansNarcisse {} {
foreach Nom [ListeDesPABs] {
if {[Narcisse $Nom]==""} { Espionne $Nom }
set FichierBlastP "[RepertoireDuGenome]/blastp/$Nom"
if { ! [file exists $FichierBlastP]} { Espionne "$Nom Sans Blastp" }
# AfficheFichier $FichierBlastP "AvecSegAlignement"
}
}
proc CorrelationClustersOperons {aT} {
upvar $aT T
global TableauOrf2Cluster2Operon
set LesClusters [lsort -integer [O2C2O LesClusters]]
set LesOperons [lsort -integer [O2C2O LesOperons]]
foreach Cluster [lrange $LesClusters 0 10] {
set LesOperonsDuCluster [lsort -integer [O2C2O Cluster $Cluster LesOperons]]
foreach Operon $LesOperonsDuCluster {
if {[info exists TableauOrf2Cluster2Operon(Cluster,$Cluster,Operon,$Operon,LesOrfsEnCommun)]} {
set LesOrfs [O2C2O Cluster $Cluster Operon $Operon LesOrfsEnCommun]
set nOrfs [llength $LesOrfs]
} else {
set nOrfs 0
}
set TailleOperon [O2C2O Operon $Operon TailleOperon]
if {$TailleOperon!=0} {
set P [expr ($nOrfs*100)/$TailleOperon]
} else {
set P 0
}
set T($Cluster,$Operon) [list $P $nOrfs [expr $nOrfs!=0]]
}
}
return [list $LesClusters $LesOperons]
}
proc AfficheCorrelationClustersOperons {} {
global TableauOrf2Cluster2Operon
set CO [CorrelationClustersOperons TCCO]
set LesXs [lindex $CO 0]
set LesYs [lindex $CO 1]
DessineBilanHDACroises $LesXs $LesYs TCCO "CorrelationClustersOperons"
}
proc X {} {
set R [package require xml]
return $R
}
proc AfficheToutesLesDefinitions {} {
set Sortie {}
foreach Operon [lrange [LesOperons] 0 10] {
set Premier [lindex $Operon 0]
set LesDefs [Operon $Premier "Definitions"]
lappend Sortie ""
lappend Sortie $Operon
foreach Def $LesDefs {
lappend Sortie " $Def"
}
}
return [AfficheVariable [join $Sortie "\n"] "" ""]
}
proc TL {} {
foreach Orf [lrange [ListeDesPABs] 1 10] {
foreach Orga [FamiliarOrganism LaListeMerci] {
Espionne [Glossaire $Orga Demi]
}
}
exit
}
proc VraiChemin Chemin {
set MemoWD [pwd]
if { ! [file isdirectory $Chemin]} {
set Dir [file dirname $Chemin]
set Queue [file tail $Chemin]
} else {
set Dir $Chemin
}
if {[catch { cd $Dir } ]} { return $Chemin }
set VraiChemin [pwd]
if {[info exists Queue]} { append VraiChemin "/$Queue" }
cd $MemoWD
return $VraiChemin
}
proc GCGtoTFAPourToutLeRepertoire {} {
foreach F [glob "*.nuc"] {
set Nom [file tail $F]
regsub {\.nuc} $Nom "" Nom
set TFA [SequenceFormatTFA [ContenuDuFichier $F] "$Nom Cloning vector $Nom" "gcg"]
Espionne [Sauve $TFA dans "$Nom.tfa"]
}
exit
}
proc CompareChroDebutFin {A B} {
scan $A "%s %s %d %d" NomA CA DA FA
scan $B "%s %s %d %d" NomB CB DB FB
if {[set C [string compare $CA $CB]]} { return $C }
if { $DA < $DB } { return -1 }
if { $DA > $DB } { return 1 }
if { $FA < $FB } { return -1 }
if { $FA > $BB } { return 1 }
return 0
}
proc BornesLocales {SequencePointee dG fG} {
set iL 0
set iG 0
foreach C [split $SequencePointee ""] {
incr iG
# if {[string equal $C "."]} { continue }
if {[regexp {[0-9]} $C]} { continue }
incr iL
if {$iG>$fG} { break }
if {$iG>=$dG && ! [info exists dL]} { set dL $iL }
if {[info exists dL]} { set fL $iL }
}
if {[info exists dL]} { return "$dL $fL" }
return "-1 -1"
}
proc TestDecortiqueUnRSF {} {
set n [DecortiqueUnRSF "/home/ripp/vrac/RA0037.rsf" LesName Sequences TabRSF]
foreach Name $LesName {
Espionne "name $Name [set TabRSF($Name,group)]"
set LesTypes [set TabRSF($Name,LesTypesDeFeatures)]
foreach Type $LesTypes {
Espionne "\nPour $Name : Type $Type"
EspionneL [set TabRSF($Name,Type,$Type)]
}
}
exit
}
proc CouleurSeqlab X {
global CouleurSeqlab
global CouleurSeqlabLower
if { ! [info exists CouleurSeqlab]} {
set CouleurSeqlab [list ForestGreen Orange Magenta Red \
SkyBlue LimeGreen Blue Purple Black \
Grey30 Grey50 Grey65 Grey80 Grey90 Grey95 White Pink \
orangeRed LightBlue yellow green tomato cyan brown lightGreen fireBrick darkOrange \
goldenRod seagreen coral \
violet khaki navyblue salmon sienna turquoise darkgreen maroon springgreen \
mediumblue indianred dimgray light gray gray]
foreach Couleur $CouleurSeqlab {
lappend CouleurSeqlabLower [string tolower $Couleur]
}
}
if {$X=="LaListeMerci"} { return $CouleurSeqlab }
if {[regexp -nocase {[A-Z]} $X]} {
set X [string tolower $X]
return [lsearch $CouleurSeqlabLower $X]
} else {
set Couleur [lindex $CouleurSeqlab $X]
if {$Couleur=="" } { set Couleur "Red" }
return $Couleur
}
}
proc DecortiqueUnRSF {TexteOuFichierRSF \
aLesNomsDesSequencesDansLOrdre {aSequences ""} \
{aTabRSF ""} {LesClefs ""} {AvecBornesLocales ""}} {
upvar $aLesNomsDesSequencesDansLOrdre LesNomsDesSequencesDansLOrdre
if {$aSequences!=""} { upvar $aSequences Sequences }
if {$aTabRSF!=""} { upvar $aTabRSF TabRSF }
if {$AvecBornesLocales=="" || $AvecBornesLocales==0} { set AvecBornesLocales 0 } else { set AvecBornesLocales 1 }
set LesNomsDesSequencesDansLOrdre {}
if {[regexp "\n" $TexteOuFichierRSF]} {
set LesLignes [split $TexteOuFichierRSF "\n"]
set FichierRSF "RSF"
} else {
set FichierRSF $TexteOuFichierRSF
set LesLignes [LesLignesDuFichier $FichierRSF]
}
if {[llength $LesLignes] < 2} { return 0 }
if {$LesClefs==""} { set LesClefs [list "name" "sequence" "type" "group" "feature" "descrip" "creator"] }
set ClefAvecListe(feature) 1
foreach Clef $LesClefs {
set ClefVoulue($Clef) 1
}
foreach Ligne $LesLignes {
if {[regexp {^!!RICH_SEQUENCE} $Ligne]} { continue }
if {[regexp {^(\{|\}|\.\.)} $Ligne]} { continue }
if { ! [regexp -nocase {[\.a-z0-9]} $Ligne]} { continue }
if {[regexp -nocase {^[a-z]} $Ligne]} {
scan $Ligne "%s" Clef
set Clef [string tolower $Clef]
set Valeur [StringSuivant "$Clef " dans $Ligne]
if {$Clef=="name"} {
lappend LesName $Valeur
set NameCourant $Valeur
set NumeroDeClef 0
}
if { ! [info exists ClefVoulue($Clef)]} { continue }
if { ! [info exists ClefDejaVue($NameCourant,$Clef)]} {
set TabRSF($NameCourant,ListeDes,$Clef) {}
}
if {[info exists ClefAvecListe($Clef)]} {
incr NumeroDeClef
set ClefCourante "${Clef}_$NumeroDeClef"
} else {
set ClefCourante $Clef
}
lappend TabRSF($NameCourant,ListeDes,$Clef) $ClefCourante
set ClefDejaVue($NameCourant,$Clef) 1
set TabRSF($NameCourant,$ClefCourante) {}
regsub $Clef $Ligne "" Ligne
}
if { ! [info exists ClefVoulue($Clef)]} { continue }
set Valeur [string trim $Ligne]
lappend TabRSF($NameCourant,$ClefCourante) $Valeur
continue
}
set TabRSF(LesTypesDeFeatures) {}
foreach Name $LesName {
set Sequences($Name) [join [set TabRSF($Name,sequence)] ""]
set TabRSF($Name,LesTypesDeFeatures) {}
if { ! [info exists TabRSF($Name,ListeDes,feature)]} {
set TabRSF($Name,ListeDes,feature) {}
}
foreach Feature [set TabRSF($Name,ListeDes,feature)] {
set DonneesDuFeature [lindex [set TabRSF($Name,$Feature)] 0]
scan $DonneesDuFeature "%d %d %d %s %s %s" D F C Forme EmptyFull FeatureType
set Couleur [CouleurSeqlab $C]
if { ! [info exists DejaVuCeTypeDeFeature($FeatureType)]} {
set DejaVuCeTypeDeFeature($FeatureType) 1
lappend TabRSF(LesTypesDeFeatures) $FeatureType
}
set SequencePointee [set Sequences($Name)]
if {$AvecBornesLocales} {
set BornesLocales [BornesLocales $SequencePointee $D $F]
} else {
set BornesLocales "$D $F"
}
scan $BornesLocales "%d %d" DL FL
if { ! [info exists TabRSF($Name,Type,$FeatureType)]} {
set TabRSF($Name,Type,$FeatureType) {}
lappend TabRSF($Name,LesTypesDeFeatures) $FeatureType
}
lappend TabRSF($Name,Type,$FeatureType) "$D $F $DL $FL $Couleur $Forme $EmptyFull \
[lrange [set TabRSF($Name,$Feature)] 1 end]"
}
}
set LesNomsDesSequencesDansLOrdre $LesName
return [llength $LesName]
}
proc ShowIp {} {
global Ip CafeDesSciencesDir
DecortiqueIpCafeScience "coucou" I C S
return "$CafeDesSciencesDir $I $C $S $Ip"
}
proc TestSocket {} {
# set Reponse [QuestionDeScience]
set SocketLBGS [socket lbgs.u-strasbg.fr 80]
puts $SocketLBGS "GET /people/peoplealpha.php\n"
gets $SocketLBGS Reponse
puts $Reponse
exit
while {1} {
Espionne [socket ouragan 20000]
}
exit
Espionne [socket ouragan 20000]
Espionne [catch {set Soso [socket ouragan 20001]} Message]
Espionne $Soso
Espionne $Message
Espionne [socket ouragan 25000]
Espionne [socket ouragan 25001]
exit
}
proc RemplaceSetCloClo {Fichier} {
foreach Ligne [LesLignesDuFichier $Fichier] {
if {![regexp "set CloClo" $Ligne]} {
lappend Sortie $Ligne
continue
}
if {[regexp {(^|\{)[ \t]*set CloClo} $Ligne]} {
set ClonInventorySet 1
} else {
set ClonInventorySet 0
}
regexp -nocase {set CloClo\(([\$0-9a-z_:]+[\,\)])+} $Ligne Match
regsub -all {[\,\(]} $Match " " Bon
regsub -all {\)} $Bon "" Bon
if {$ClonInventorySet} {
regsub "set CloClo" $Bon "ClonInventorySet" Bon
} else {
regsub "set CloClo" $Bon "ClonInventory" Bon
}
regexp -nocase -indices {set CloClo\(([\$0-9a-z_:]+[\,\)])+} $Ligne Indices
scan $Indices "%d %d" D F
set Nouveau [string replace $Ligne $D $F $Bon]
regsub "unClonInventory" $Nouveau "ClonInventoryUnset" Nouveau
Espionne "\n$Ligne\n$Nouveau"
lappend Sortie $Nouveau
unset Match
}
if {[OuiOuNon "Je sauve dans $Fichier.nouveau ?" ]} {
Espionne [SauveLesLignes $Sortie dans "$Fichier.nouveau"]
}
exit
}
proc RemplaceCloCloExists {Fichier} {
foreach Ligne [LesLignesDuFichier $Fichier] {
if {![regexp "info exists CloClo" $Ligne]} {
lappend Sortie $Ligne
continue
}
regexp -nocase {info exists CloClo\(([\$0-9a-z_:]+[\,\)])+} $Ligne Match
regsub -all {[\,\(]} $Match " " Bon
regsub -all {\)} $Bon "" Bon
regsub "info exists CloClo" $Bon "ClonInventoryExists" Bon
regexp -nocase -indices {info exists CloClo\(([\$0-9a-z_:]+[\,\)])+} $Ligne Indices
scan $Indices "%d %d" D F
set Nouveau [string replace $Ligne $D $F $Bon]
Espionne "\n$Ligne\n$Nouveau"
lappend Sortie $Nouveau
unset Match
}
if {[OuiOuNon "Je sauve dans $Fichier.nouveau ?" ]} {
Espionne [SauveLesLignes $Sortie dans "$Fichier.nouveau"]
}
exit
}
proc MiseAJourDesNomsDeVariables Fichier {
set Texte [ContenuDuFichier HGE1034757799155101]
set LesMots [split $Texte "&"]
foreach Mot $LesMots {
ScanLaListe [split $Mot "="] Var Val
lappend LesBonnesVars $Var
}
set Texte [ContenuDuFichier $Fichier]
set LesMots [split $Texte "&"]
foreach Mot $LesMots BonneVar $LesBonnesVars {
ScanLaListe [split $Mot "="] Var Val
lappend LesVarVal "$BonneVar=$Val"
}
Espionne [Sauve [join $LesVarVal "&"] dans $Fichier.nouveau]
exit
}
proc LisBox {Conteneur {Liste {}} {LesIllumines {}}} {
frame $Conteneur -borderwidth 10
pack $Conteneur -side left -expand yes -fill both
set LixBox "$Conteneur.list"
scrollbar $Conteneur.yscroll -command "$LixBox yview"
scrollbar $Conteneur.xscroll -command "$LixBox xview" -orient horizontal
set Largeur 30
set Hauteur 35
listbox $LixBox -width $Largeur -height $Hauteur -setgrid 1 \
-yscroll "$Conteneur.yscroll set" \
-xscroll "$Conteneur.xscroll set" \
-selectmode extended \
-background "LightGrey" \
-foreground "Black" \
-selectbackground "LightYellow" \
-selectforeground "Black" \
-font [list Courier [PolicePourListBox]]
grid $LixBox -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky nsew
grid $Conteneur.yscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky nsew
grid $Conteneur.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky nsew
grid rowconfig $Conteneur 0 -weight 1 -minsize 0
grid columnconfig $Conteneur 0 -weight 1 -minsize 0
bind $LixBox <3> "DecrisLaLigne %W %x %y"
bind $LixBox "DecrisLaLigne %W %x %y Efface"
foreach Element $Liste {
$LixBox insert end $Element
}
foreach Nom $LesIllumines {
Illumine $Nom $LixBox
}
return $LixBox
}
proc Passeur {LisBoxDep LisBoxArr} {
set LesPasses {}
foreach i [$LisBoxDep curselection] {
set Passe [$LisBoxDep get $i]
lappend LesPasses $Passe
$LisBoxArr insert end $Passe
}
return $LesPasses
}
proc Ordonateur {LisBox Action} {
if {$Action=="KillAll"} {
set LesPasses [$LisBox get 0 end]
$LisBox delete 0 end
return $LesPasses
}
set LesPasses {}
set LesI [$LisBox curselection]
if {$Action=="Up"} {
set LesI $LesI
} else {
set LesI [lsort -decreasing $LesI]
}
foreach I $LesI {
set Passe [$LisBox get $I]
lappend LesPasses $Passe
$LisBox delete $I
if {$Action=="Kill"} { continue }
if {$Action=="Up"} { set D [expr $I-1] }
if {$Action=="Down"} { set D [expr $I+1] }
$LisBox insert $D $Passe
$LisBox selection set $D
}
return $LesPasses
}
proc MorceauxChoisisAndMore {LesExistants {LesIllumines ""} {Texte ""}} {
set LesPossibles $LesExistants
set LesBons {}
while {1} {
set LesBons [MorceauxChoisis $LesPossibles $LesBons \
"$Texte\nPlease select lines in the left window and press '--->'\n\
Reorder with 'Up' and 'Down' if necessary.\n\
Press 'More' if you want to add your own file."]
if {$LesBons=={} && [OuiOuNon "Do You want an empty list ?"]} { return {} }
if {$LesBons=={} && [OuiOuNon "Do You want to select your own files ?"] \
|| [lindex $LesBons end]=="MorePlease"} {
if {[OuiOuNon "Do You want to paste a selection ?"]} {
set Sel [selection get]
set LesPersos [split $Sel "\n"]
LConcat LesPossibles $LesPersos
} else {
if {[OuiOuNon "Do we add flat files (no directories) ?"]} {
set Perso [ButineArborescence "All" "."]
if {$Perso!=""} { lappend LesPossibles $Perso }
} else {
set Perso [ChoixDuRepertoire]
if {$Perso==""} { continue }
set LesPerso [glob -nocomplain -type f "$Perso/*"]
if {$LesPerso!=""} { LConcat LesPossibles $LesPerso }
}
}
continue
} elseif {[lindex $LesBons end]=="Selection"} {
FaireLire "Enter a regular expression to select some of these files"
set ExpReg [Entre "YOURTEXT"]
set LesNouveauxPossibles {}
foreach Possi $LesPossibles {
if { ! [regexp $ExpReg $Possi]} { continue }
lappend LesNouveauxPossibles $Possi
}
set LesPossibles $LesNouveauxPossibles
continue
} else {
break
}
}
return $LesBons
}
proc MorceauxChoisis {ListeDeDepart {LesIllumines {}} {Texte ""}} {
global VariableDeRetour
set w [NomDe fenetre]
toplevel $w -width 1024
if {$Texte!=""} {
set FrameMessage "$w.texte"
frame $FrameMessage
pack $FrameMessage -side top -expand yes
set Message "$FrameMessage.message"
message $Message -text "$Texte" -width 800
pack $Message
}
set FrameLisBouLis "$w.lisboulis"
frame $FrameLisBouLis
pack $FrameLisBouLis -side top -expand yes -fill both
set LisBoxDep [LisBox "$FrameLisBouLis.fraDep" $ListeDeDepart $LesIllumines]
set FraBou "$FrameLisBouLis.panneau"
frame $FraBou
pack $FraBou -side left
set LisBoxArr [LisBox "$FrameLisBouLis.fraArr"]
set Passeur "$FraBou.passeur"
button $Passeur -text "--->" -background "green" -width 10 -height 2
bind $Passeur <1> "Passeur $LisBoxDep $LisBoxArr"
pack $Passeur
set Vide0 "$FraBou.vide0"
button $Vide0 -relief "flat" -height 1
pack $Vide0
set Aide "$FraBou.aide"
button $Aide -text "Help" -background "blue" -width 6 -height 1
bind $Aide <1> "FaireLire {Select lines in the left window,\n\
then transfer them to the right window pressing the '--->' button\n\n\
To reorder in the right window, select a line and press 'Up' or 'Down'\n\
To remove one line in the right window, select it and press 'Remove sel'\n\n\
Accept ALL LINES in the RIGHT window by pressing 'Accept'.}"
pack $Aide
set Vide1 "$FraBou.vide1"
button $Vide1 -relief "flat" -height 2
pack $Vide1
set Monteur "$FraBou.monteur"
button $Monteur -text " Up ^" -background "lightblue" -width 8
bind $Monteur <1> "Ordonateur $LisBoxArr Up"
pack $Monteur
set Tombeur "$FraBou.tombeur"
button $Tombeur -text "Down v" -background "lightblue" -width 8
bind $Tombeur <1> "Ordonateur $LisBoxArr Down"
pack $Tombeur
set Vide2 "$FraBou.vide2"
button $Vide2 -relief "flat"
pack $Vide2
set Killeur "$FraBou.killeur"
button $Killeur -text "Remove sel ->" -background "orange" -width 10
bind $Killeur <1> "Ordonateur $LisBoxArr Kill"
pack $Killeur
set KillAll "$FraBou.killAll"
button $KillAll -text "Remove all =>" -background "orange" -width 10
bind $KillAll <1> "Ordonateur $LisBoxArr KillAll"
pack $KillAll
set Vide3 "$FraBou.vide3"
button $Vide3 -relief "flat"
pack $Vide3
set Vide4 "$FraBou.vide4"
button $Vide4 -relief "flat"
pack $Vide4
set Accept "$FraBou.accept"
button $Accept -text "Accept ->" -background "green" -width 10 -height 2
bind $Accept <1> "set VariableDeRetour($w) \[$LisBoxArr get 0 end\]"
pack $Accept
if {[regexp -nocase {Press ('More'|'All')} $Texte]} {
set More "$FraBou.more"
button $More -text "<- More/Sel/All" -background "yellow" -width 10
bind $More <1> "set VariableDeRetour($w) \[concat \[$LisBoxArr get 0 end\] MorePlease\]"
bind $More <2> "set VariableDeRetour($w) \[concat \[$LisBoxArr get 0 end\] Selection\]"
bind $More <3> "Illumine \".\" $LisBoxDep"
pack $More
}
set Vide5 "$FraBou.vide5"
button $Vide5 -relief "flat"
pack $Vide5
set Cancel "$FraBou.cancel"
button $Cancel -text "Cancel" -background "red" -width 8
bind $Cancel <1> "set VariableDeRetour($w) {}"
pack $Cancel
tkwait variable VariableDeRetour($w)
set v $VariableDeRetour($w)
unset VariableDeRetour($w)
catch {destroy $w}
return $v
}
proc SubstitueHtml {FichierOuTexte} {
set Texte $FichierOuTexte
if { ! [regexp "<" $Texte] && [file exists $FichierOuTexte]} {
set Texte [ContenuDuFichier $FichierOuTexte]
}
while {[regexp {_=([^=]*)=_} $Texte Match Variable]} {
Espionne $Variable
if {[uplevel info exists $Variable]} {
set Nouveau [uplevel set $Variable]
} else {
set Nouveau ""
}
set d [string first $Match $Texte]
set f [expr $d+[string length $Match]-1]
set Texte [string replace $Texte $d $f $Nouveau]
}
return $Texte
}
proc MomentUnique {{Type ""}} {
global DataSetElemIncr
if { ! [info exists DataSetElemIncr]} { set DataSetElemIncr 100 }
set DataSetElemIncr [expr [incr DataSetElemIncr]%1000]
set NewElem "[clock clicks -milliseconds]$DataSetElemIncr"
return "$Type$NewElem"
}
proc TriHKL Fichier {
set Sortie {}
foreach Ligne [LesLignesDuFichier $Fichier] {
scan $Ligne "%5d %5d %5d %f %f %f %f %f %f %f %f" \
h k l Fp SFp Fm SFm F SF DF SDF
puts "$h $k $l"
if {$SDF<0} { continue }
if {$SFm<0} { set SFm 0 }
lappend Sortie [format "%5d%5d%5d%12.4e%12.4e%12.4e%12.4e%12.4e%12.4e%12.4e%12.4e" \
$h $k $l $Fp $SFp $Fm $SFm $F $SF $DF $SDF]
}
puts [SauveLesLignes $Sortie dans "$Fichier.nouveau"]
}
proc Random {} {
set n 30
while {[incr n -1]} {
set F [expr round(rand()*30)]
set S [expr round(rand()*50)]
if {$S<=10} { set F [expr -$F] }
puts [expr $F/10]
}
exit
}
proc TesteUnCanva {} {
set K [UnCanva 600 600 600 600 EtY]
set K2 [UnCanva 600 800 6000 8000 EtY]
$K create rectangle 200 200 300 500 -fill red
set I [image create photo ima -file /home/ripp/images/hammer.gif]
$K create image 0 0 -anchor nw -image ima
MainLeveeSurUnCanva $K
}
proc OuSontLesProcedures {{aFichierContenant ""}} {
global GscopeDir GscopeContrib
if {$aFichierContenant!=""} { upvar $aFichierContenant FichierContenant }
set LesFichiersTcl [glob $GscopeDir/gscope*.tcl $GscopeContrib/*/*.tcl /home/moumou/ordali/ordali_*.tcl]
set ToutesLesNomProc {}
foreach Fichier $LesFichiersTcl {
if {[regexp "obsolete" $Fichier]} { continue }
set LesNomProc [LesProceduresDuFichier $Fichier FichierContenant]
LConcat ToutesLesNomProc $LesNomProc
}
foreach NomProc $ToutesLesNomProc {
if {[info exists DejaVu($NomProc)]} {
# Espionne [format "%-30s %s" $NomProc [set FichierContenant($NomProc)]]
}
set DejaVu($NomProc) 1
}
return $ToutesLesNomProc
}
proc LesProceduresDuFichier {Fichier {aFichierContenant ""}} {
if {$aFichierContenant!=""} { upvar $aFichierContenant FichierContenant }
global GscopeDir
if { ! [regexp "/" $Fichier] } {
set Fichier "$GscopeDir/$Fichier"
}
if { ! [file exists $Fichier]} { return {} }
set LesNomProc {}
foreach Ligne [LesLignesDuFichier $Fichier] {
if { ! [regexp -nocase {^proc +([A-Z][a-zA-Z0-9_]+) +[\{[a-zA-Z)]} $Ligne Match NomProc]} { continue }
lappend FichierContenant($NomProc) $Fichier
lappend LesNomProc $NomProc
}
return $LesNomProc
}
proc SourceAutonome {Fichier args} {
global GscopeDir GscopeContrib
if { ! [regexp "/" $Fichier] } {
set Fichier "$GscopeDir/$Fichier"
}
foreach Supplement $args {
if { ! [regexp "/" $Supplement] } {
set Supplement "$GscopeDir/$Supplement"
}
set EstSupplement($Supplement) 1
}
OuSontLesProcedures FichierContenant
set LesNomProc [LesProceduresDuFichier $Fichier]
foreach NomProc $LesNomProc {
if {[regexp "^Teste_" $NomProc]} { continue }
foreach Appelee [QuiJAppel $NomProc "LaListeMerci"] {
if {[info exists FichierContenant($Appelee)]} {
set Contenant [set FichierContenant($Appelee)]
} else {
set Contenant "non_trouve"
}
if {$Contenant==$Fichier || [info exists EstSupplement($Contenant)]} { continue }
Espionne [format "%-30s %-30s %s" $NomProc $Appelee $Contenant]
}
}
exit
}
proc SupprimeVide Fichier {
foreach Ligne [LesLignesDuFichier $Fichier] {
if {$Ligne==""} { continue }
puts $Ligne
}
exit
}
proc FindNode {Value T} {
#returns the first node with that value
return [lindex [PathToNode $Value $T "value"] end]
}
proc PathToNode {N T {WhatToTest "link"}} {
if {$WhatToTest=="link" && $N==$T || \
$WhatToTest=="value" && $N==[ValueOfTree $T] } {
return [list $T]
}
foreach B [Branches $T] {
set Path [PathToNode $N $B $WhatToTest]
if {$Path=={}} { continue }
return [linsert $Path 0 $T]
}
return {}
}
proc SwapRoot {T N {Path ""}} {
#The node N becomes the new root"
JeMeSignale
puts "SwapRoot [ValueOfTree $T] [ValueOfTree $N] $Path"
if {$T==$N} { return $T }
if {$Path==""} { set Path [PathToNode $T $N] }
set Bonne [lindex $Path 1]
set Haut [CutBranch $T $Bonne]
DataSet linksappend $Bonne $Haut
set Swap [SwapRoot $Bonne $N [lrange $Path 1 end]]
return $Swap
}
proc Spy T {
JeMeSignale
puts [$T dump root]
}
proc CreateNode {T {Where "root"} args} {
if {$args=={}} {
set Id [$T insert $Where]
} else {
set Id [$T insert $Where $args]
}
$T tag add "IAm$Id" $Id
$T label $Id "memelabel"
return $Id
}
proc TT {} {
puts [string repeat "*" 600]
package require BLT
set T [blt::tree create]
set I1 [CreateNode $T]
Spy $T
puts "insert de $I1 dans $T en root"
$T root $I1
puts "$I1 devient root"
Spy $T
set I2 [CreateNode $T]
puts "insert de $I2 dans $T en root"
Spy $T
set I3 [CreateNode $T]
puts "insert de $I3 dans $T en root"
Spy $T
set I4 [CreateNode $T $I3]
puts "insert de $I4 dans $T en $I3"
Spy $T
set I5 [CreateNode $T $I4]
puts "insert de $I5 dans $T en $I4"
Spy $T
set TV ".tv"
blt::treeview $TV -tree $T
$TV open all
pack $TV
puts "ai trouve [$T path "IAm4"]"
set R [NewRoot $T "IAm4"]
set RV ".rv"
blt::treeview $RV -tree $R
$RV open all
pack $RV
}
proc TestDataSet {} {
global DataSet
set A [DataSet create AAA]
set B [DataSet create BBB]
set C [DataSet create CCC]
DataSet father $B $A
DataSet linksappend $A $C
DataSet spyAll $A
set Z [DataSet clone $A]
DataSet updateFather $Z
foreach X [concat [list $A $B $C $Z] [DataSet links $Z]] {
DataSet spyAll $X
}
exit
Grave DataSet
exit
}
proc DataSet {Action {Elem ""} {Val "GetStoredValue"}} {
global DataSet DataSetElemIncr
if {[string equal $Action "create"]} {
if { ! [info exists DataSetElemIncr]} { set DataSetElemIncr 100 }
set DataSetElemIncr [expr [incr DataSetElemIncr]%1000]
set NewElem "[clock clicks -milliseconds]$DataSetElemIncr"
set DataSetElem $NewElem
set DataSet($NewElem,value) $Elem
set DataSet($NewElem,father) ""
if {[string equal $Val "GetStoredValue"]} {
set DataSet($NewElem,links) {}
} else {
set DataSet($NewElem,links) $Val
}
return $NewElem
}
if {[string equal $Action "hasBranches"]} {
return [llength [DataSet links $Elem]]
}
if {[string equal $Action "isLeaf"]} {
return [expr ! [DataSet hasBranches $Elem]]
}
if {[string equal $Action "spy"]} {
set Texte "$Elem Value<[DataSet value $Elem]> Father<[DataSet father $Elem]> Links<[DataSet links $Elem]>"
if { ! [string equal $Val "Get"]} { puts $Texte }
return $Texte
}
if {[string equal $Action "spyAll"]} {
if {[string equal $Val "GetStoredValue"]} { set Val 0 }
set Indent $Val
set Indentation [string repeat " " $Indent]
puts "$Indentation[DataSet spy $Elem Get]"
incr Indent
foreach Son [DataSet links $Elem] {
DataSet spyAll $Son $Indent
}
return ""
}
if {[string equal $Action "findValue"]} {
set TheElements {}
foreach {C V} [array get DataSet] {
if { ! [regsub {,value$} $C "" E]} { continue }
if { [DataSet value $E]==$Elem } { lappend TheElements $E }
}
return $TheElements
}
if {[string equal $Action "updateFather"]} {
foreach Son [DataSet links $Elem] {
DataSet father $Son $Elem
DataSet updateFather $Son
}
return $Elem
}
if {[string equal $Action "clonedSonsOf"]} {
set TheClonedSons {}
foreach Son [DataSet links $Elem] {
lappend TheClonedSons [DataSet clone $Son]
}
return $TheClonedSons
}
if {[string equal $Action "clone"]} {
set Value [DataSet value $Elem]
set Links [DataSet links $Elem]
set Clone [DataSet create $Value]
DataSet links $Clone [DataSet clonedSonsOf $Elem]
return $Clone
}
if {[string equal $Val "GetStoredValue"]} {
return [set DataSet($Elem,$Action)]
}
if {[string equal $Action "value" ]} {
set DataSet($Elem,value) $Val
return $Val
}
if {[string equal $Action "links"]} {
set DataSet($Elem,links) $Val
return $Val
}
if {[string equal $Action "father"]} {
set DataSet($Elem,$Action) $Val
set DoIt 1
foreach Son [DataSet links $Val] {
if {$Son==$Elem} { set DoIt 0 ; break }
}
if {$DoIt} { DataSet linksappend $Val $Elem }
return $Val
}
if {[string equal $Action "linksappend"]} {
lappend DataSet($Elem,links) $Val
return [set DataSet($Elem,links)]
}
if {[string equal $Action "linkremove"]} {
set TheOthers {}
foreach Son [DataSet links $Elem] {
if {$Son == $Val} { continue }
lappend TheOthers $Son
}
set DataSet($Elem,links) $TheOthers
return $TheOthers
}
}
proc TesteGrave {} {
global NomDuFichierPierre
set NomDuFichierPierre "pierre.testegrave"
File delete -force $NomDuFichierPierre
set L {6 8 9 7 }
Grave L
set A(toto) [list 4 5 "bonjour madame" [list comment va votre mari "Jules Dupont"]]
set A(tutu) 5
set A(lili) $L
Grave A
EspionneL [array get A]
unset A
Degrave A
unset L
Degrave L
Espionne $L
EspionneL [array get A]
exit
}
proc ArbreDesClasses {} {
Degrave T
NicePrintOfTree $T
exit
if {[]} {}
}
proc TestTree {Nom {Type "Access"}} {
global RepertoireDuGenome
set A [ArbreEnListe [ContenuDuFichier "$RepertoireDuGenome/phylos/$Nom"]]
puts $A
set T [TreeFromArbre "Racine" $A $Type]
NicePrintOfTree $T
set P [PathToNode N_00006 $T "value"]
set N [lindex $P end]
puts $P
set S [SwapRoot $T $N $P]
puts " et le meme en N_00006"
NicePrintOfTree $S
exit
}
proc TreeFromArbre {Valeur Arbre {Type "Classe"}} {
global NumeroPourTreeFromArbre
if { ! [info exists NumeroPourTreeFromArbre]} {
set NumeroPourTreeFromArbre 0
}
incr NumeroPourTreeFromArbre
set Beau [format "N_%5.5d" $NumeroPourTreeFromArbre]
set Valeur $Beau
if {[EstUneFeuille $Arbre]} {
set Access [NomDeLaFeuille $Arbre]
if {$Type=="Access"} { set Info $Access }
if {$Type=="Organisme"} { set Info [OrgaDuAccess $Access] }
if {$Type=="Classe"} { set Info [OCduOS [OrgaDuAccess $Access]] }
# set L [NewLeaf [list $Valeur $Info]]
set L [NewLeaf $Info]
return $L
}
Dedouble $Arbre G x D y
# set T [NewTreeFromTrees [list $Valeur ""] [TreeFromArbre $x $G $Type] [TreeFromArbre $y $D $Type]]
set T [NewTreeFromTrees $Valeur [TreeFromArbre $x $G $Type] [TreeFromArbre $y $D $Type]]
return $T
}
proc NewTree {Value BranchList} {
return [DataSet create $Value $BranchList]
}
proc NewTreeFromTrees {Value args} {
set BranchList {}
foreach Branch $args {
lappend BranchList $Branch
}
return [NewTree $Value $BranchList]
}
proc ChangeValueTree {Tree Value} {
return [DataSet value $Tree $Value]
}
proc ValueOfTree Tree {
return [DataSet value $Tree]
}
proc Branches Tree {
return [DataSet links $Tree]
}
proc NewLeaf Value {
return [NewTree $Value {}]
}
proc IsLeaf Tree {
return [DataSet isLeaf $Tree]
}
proc HasBranches Tree {
return [DataSet hasBranches $Tree]
}
proc HeightOfTree Tree {
if {[IsLeaf $Tree]} { return 1 }
set Highest 0
foreach B [Branches $Tree] {
set H [HeightOfTree $B]
if {$H>$Highest} { set Highest $H }
}
return [incr Highest]
}
proc CutBranch {Tree {IndexOrNode end}} {
set Branches [Branches $Tree]
if {[regexp {^[0-9]+$} $IndexOrNode] && [string length $IndexOrNode]>5 } {
set Index [lsearch $Branches $IndexOrNode]
} else {
set Index $IndexOrNode
}
set NewBranches [lreplace $Branches $Index $Index]
return [NewTree [ValueOfTree $Tree] $NewBranches]
}
proc AddBranch {B Tree {Index end}} {
set NewBranches [linsert [Branches $Tree] $Index $B]
return [NewTree [ValueOfTree $Tree] $NewBranches]
}
proc AddLeaf {Value Tree {Index end}} {
return [AddBranch [NewLeaf $Value] $Tree $Index]
}
proc NicePrintOfTree {Tree {Indent 0}} {
set Indentation [string repeat " " $Indent]
puts "$Indentation [ValueOfTree $Tree]"
incr Indent
foreach B [Branches $Tree] {
NicePrintOfTree $B $Indent
}
}
proc GardePierre {} {
global CanalPierre NomDuFichierPierre
ClosPierre
if { [file exists $NomDuFichierPierre] } {
if {[Garde $NomDuFichierPierre]==""} {
FaireLire "I Couldn't make a backup of $NomDuFichierPierre"
}
File delete -force $NomDuFichierPierre
}
}
proc ClosPierre {} {
global CanalPierre NomDuFichierPierre
if { [info exists CanalPierre] } {
close $CanalPierre
unset CanalPierre
}
}
proc AppendPierre {} {
global CanalPierre NomDuFichierPierre
if { [info exists CanalPierre] } {
ClosPierre
}
if { ! [info exists NomDuFichierPierre] } {
set NomDuFichierPierre "pierre"
}
set CanalPierre [open $NomDuFichierPierre a]
return $CanalPierre
}
proc ReOuvrePierre {} {
global CanalPierre NomDuFichierPierre
if { [info exists CanalPierre] } {
ClosPierre
}
if { ! [info exists NomDuFichierPierre] } {
set NomDuFichierPierre "pierre"
}
if { ! [file exists $NomDuFichierPierre]} { return "" }
set CanalPierre [open $NomDuFichierPierre r]
return $CanalPierre
}
proc Grave VariableDeGrave {
upvar $VariableDeGrave ContenuVariableDeGrave
set Pierre [AppendPierre]
puts $Pierre ""
puts $Pierre "#Debut $VariableDeGrave"
set lElements [uplevel "array names $VariableDeGrave"]
if {[llength $lElements]==0} {
puts $Pierre "set $VariableDeGrave [list $ContenuVariableDeGrave]"
} else {
foreach e $lElements {
puts $Pierre "set $VariableDeGrave\($e\) [list $ContenuVariableDeGrave($e)]"
}
}
puts $Pierre "#Fin $VariableDeGrave"
}
proc Degrave VariableDeGrave {
upvar $VariableDeGrave $VariableDeGrave
# upvar $VariableDeGrave ContenuVariableDeGrave (pourquoi ai-je mis cette ligne ?)
set lElements [uplevel "array names $VariableDeGrave"]
if {[llength $lElements]==0} {
set Pierre [ReOuvrePierre]
if {$Pierre==""} { return "" }
set OnYest 0
while { [gets $Pierre entree]>=0 } {
if { [regexp "#Debut $VariableDeGrave" $entree] } {
set OnYest 1
gets $Pierre entree
}
if { [regexp "#Fin $VariableDeGrave" $entree] } { break }
if { $OnYest } { eval $entree }
}
} else {
}
return $VariableDeGrave
}
proc Graphiste {LesOrdresPourGIF ValWidth ValHeight X1 Y1 X2 Y2 CheminGIF {OnVeutLeTexte 1} {OnVeutLesArcs 1}} {
global CommandeCanvart
global GraphisteDir
set ValWidth [expr int($ValWidth)]
set ValHeight [expr int($ValHeight)]
set RepertoireLog ""
if {[info exists GraphisteDir]} {
set RepertoireLog "$GraphisteDir/log"
}
if {$RepertoireLog=="" || ! [file writable $RepertoireLog]} {
set RepertoireLog "[RepertoireDeTravail]/log"
}
if { ![file exists $RepertoireLog] } {
file mkdir $RepertoireLog
}
if {[regexp "/gd" $CommandeCanvart]} {
set OrdrePourGIF [string trim [join $LesOrdresPourGIF "\n"]]
set f [open "|$CommandeCanvart $ValWidth $ValHeight \
$X1 $Y1 $X2 $Y2 \
$CheminGIF $OnVeutLeTexte 2>/dev/null" "w"]
puts $f $OrdrePourGIF
flush $f
close $f
return "OK"
}
if {[regexp "^java" $CommandeCanvart]} {
if {$OnVeutLeTexte} { set TexteOuNon "yes" } else { set TexteOuNon "no" }
if {$OnVeutLesArcs} { set ArcsOuNon "yes" } else { set ArcsOuNon "no" }
set AvecLog 1
if {$AvecLog} {
set fico [open "$RepertoireLog/entreecanvart.log" "w"]
puts $fico [string trim [join $LesOrdresPourGIF "\n"]]
close $fico
}
set f [open "|$CommandeCanvart \
-width $ValWidth -height $ValHeight \
-box $X1 $Y1 $X2 $Y2 \
-output $CheminGIF -nodecompose -text $TexteOuNon -arc $ArcsOuNon \
>& $RepertoireLog/sortiecanvart.log" "w"]
puts $f [string trim [join $LesOrdresPourGIF "\n"]]
flush $f
close $f
return "OK"
}
}
proc FichierTFAsNonRedondant {FichierTFAs {NouveauFichier ""}} {
if {$NouveauFichier==""} { set NouveauFichier $FichierTFAs }
foreach Access [LaSequenceDuTFAs $FichierTFAs "LaListeDesAccess" "" "@"] {
if {[regexp "@" $Access]} { continue }
Espionne $Access
lappend LeNouveau [LaSequenceDuTFAs $FichierTFAs $Access]
}
return [SauveLesLignes $LeNouveau dans $NouveauFichier]
}