Commit 02e8c5b4 authored by luc.moulinier's avatar luc.moulinier

bugs ...

parent 70d5a352
......@@ -1267,18 +1267,25 @@ proc MontreInfoSeq {} {
global ListeDesAcidesAmines TDesSeqnames
foreach e $LNOrdali {
if {$e eq ""} {continue}
lappend Ln [set TDesSeqnames($e)]
set TEdit(corr,[set TDesSeqnames($e)]) $e
if {$e eq ""} {
lappend Ln [set TDesSeqnames($e)]
set TEdit(corr,[set TDesSeqnames($e)]) $e
}
}
# calcule compo pour alignement
# compute global alignment AA composition
foreach {a p} [CompositionAADuGroupe] {
set TEdit(compAll,$a) [format %5.1f $p]
}
# Fenetre
# GUI
set w ".infoseq"
if {[winfo exists $w]} {
raise $w
return
}
toplevel $w
wm title $w "Sequence Information"
wm resizable $w 0 0
......@@ -1506,18 +1513,22 @@ proc MontreInfoSeq {} {
foreach a {"AILMV" "KRH" "DEQN" "FYW" "PGST"} {
incr c
if {$c == 0} {
label $wcmp.ls$r -text "Seq" \
-anchor center -justify right
label $wcmp.lg$r -text "Grp" \
label $wcmp.ls$r \
-text "Seq" \
-anchor center -justify right
label $wcmp.lg$r \
-text "Grp" \
-anchor center -justify right
label $wcmp.la$r -text "All" \
label $wcmp.la$r \
-text "All" \
-anchor center -justify right
grid $wcmp.ls$r -row [expr {$r+1}] -column $c -sticky ew
grid $wcmp.lg$r -row [expr {$r+2}] -column $c -sticky ew
grid $wcmp.la$r -row [expr {$r+3}] -column $c -sticky ew
incr c
}
label $wcmp.l$a -text "$a" -font EdtItem \
label $wcmp.l$a \
-text "$a" -font EdtItem \
-anchor w -justify center
label $wcmp.es$a \
-anchor w -justify left \
......@@ -1540,9 +1551,9 @@ proc MontreInfoSeq {} {
# Frame Boutons
frame $wf.btn
button $wf.btn.ok \
-bg green1 \
-text " Close " \
-command "DismissInfoSeq $w"
-text " Close " \
-bg green1 \
-command "DismissInfoSeq $w"
grid $wf.btn.ok -row 0 -column 0
grid $wf.btn -row 2 -column 0 -columnspan 2 -sticky ew -pady 15
grid columnconfig $wf.btn 0 -weight 1
......@@ -1572,11 +1583,13 @@ proc DismissInfoSeq {w} {
proc AcceptInfoSeq {w} {
global Defauts TEdit {*}[info globals "TD*"]
InfosDeLaSeq toto ""
#InfosDeLaSeq toto ""
set nseqIn $TEdit(nseqCombo)
set nseq [set TEdit(corr,$nseqIn)]
if {$nseq in $LNOrdali} {
FaireLire "Warning !\nSequence Name already exists ! Sequence Name should be unique !"
FaireLire "Warning !\nSequence Name already exists ! Sequence Name should be unique !\nPlease choose an other Sequence Name for this sequence."
return
}
......@@ -1586,7 +1599,13 @@ proc AcceptInfoSeq {w} {
set r [set TEdit($e)]
switch $k {
"seqname" {set TDesSeqnames($nseq) $r}
"seqname" {
set LT [array get TDesSeqnames]
set Lr [lmap {a b} $LT {set $b}]
if {[llength [lsearch -all $Lr $r]] == 1} {
set TDesSeqnames($nseq) $r
}
}
"access" {set TDesAccess($nseq) $r}
"bid" {set TDesBId($nseq) $r}
"desc" {set TDesDescriptifs($nseq) $r}
......@@ -1629,7 +1648,7 @@ proc InfosDeLaSeq {w nseqCombo {quoi "edit"}} {
grid forget ${ww}.wrn
destroy ${ww}.wrn
}
set nseq [set TEdit(corr,$nseqCombo)]
if {[ExisteAABizarres $nseq]} {
label ${ww}.wrn \
......@@ -1650,9 +1669,11 @@ proc InfosDeLaSeq {w nseqCombo {quoi "edit"}} {
set TEdit(taxid,$nold) [set TEdit(taxid)]
set TEdit(orga,$nold) [set TEdit(orga)]
set TEdit(lifed,$nold) [set TEdit(lifed)]
if {$nseqCombo eq ""} {return}
if {$nseqCombo eq ""} {
return
}
}
# nseq corrspond alors a l'access
set nseq [set TEdit(corr,$nseqCombo)]
......@@ -1733,7 +1754,7 @@ proc EditInfoSeq {} {
FaireLire "Not available in Editor mode !"
return
}
# already open ..
set w ".editinfoseq"
if {[winfo exists $w]} {
......@@ -1742,11 +1763,6 @@ proc EditInfoSeq {} {
return
}
if {[winfo exists $w]} {
raise $w
return
}
if {[VueEditee]} {
EnregistreLeMac
VueEditee 0
......@@ -1754,9 +1770,10 @@ proc EditInfoSeq {} {
set Ln [list]
foreach n $LNOrdali {
if {[string trim $n] eq ""} {continue}
lappend Ln $n
set TEdit(corr,$n) $n
if {[string trim $n] ne ""} {
lappend Ln $n
set TEdit(corr,$n) $n
}
}
set nseqCombo [lindex $Ln 0]
set nold $nseqCombo
......@@ -1764,7 +1781,7 @@ proc EditInfoSeq {} {
set LMx [PlusLongEltDe $Ln]
set LMx [expr {$LMx>20?$LMx:20}]
set TEdit(mode) "edit"
toplevel $w
wm title $w "Edit Sequences Information"
wm protocol $w WM_DELETE_WINDOW KillParLaCroix
......@@ -2244,9 +2261,9 @@ proc BindingsOrdali {} {
# selection Zone sur alignment
bind BTSel <1> {StockPosition %W @%x,%y}
bind BTSel <Control-3> {DeselectLesColonnes %W @%x,%y}
bind BTSel <3> {SelectLesColonnes @%x,%y}
bind BTSel <Control-3> {DeselectLesColonnes %W @%x,%y}
OrdaliDefaultTags
# Status pos seq - gen
......@@ -2536,10 +2553,10 @@ proc SauveLeLog {{fichier ""}} {
proc TotalWSize {win} {
set top [winfo toplevel $win]
wm geometry $top +10+10
wm geometry $top +2+2
update idletasks
# Recuperation geometrie (avec decoration)
# Scan de la geometrie pour extraire les champs
set g [wm geometry $top]
......@@ -5066,7 +5083,7 @@ proc RepeintSeqs {} {
}
}
"cluster" {
# ChangeFeaturePourCluster
# ChangeFeaturePourCluster
AfficheZonesSelectionnees $::ZoneSelect
}
"superpose" {
......@@ -6724,7 +6741,7 @@ proc ChangeFeature {{w ""}} {
AppliqueFeature $feat
set Ltags [$NomTextSeq tag names]
regsub -all " " $feat "_" fnsp
set fnsp [string map {" " _} $feat]
foreach t $Ltags {
if {[regexp "FX_$fnsp" $t]} {
$NomTextSeq tag bind $t <Control-1> {SelectLaFeature @%x,%y ; break}
......@@ -7470,7 +7487,6 @@ proc AfficheBarreMenus {} {
set mse $mb.sequence
set mal $mb.alignement
set mst $mb.structure
set mto $mb.tools
set min $mb.info
set mhe $mb.help
......@@ -7489,7 +7505,6 @@ proc AfficheBarreMenus {} {
menu $mse -activebackground "#0083ffff0000" -foreground black
menu $mal -activebackground "#0083ffff0000" -foreground black
menu $mst -activebackground "#0083ffff0000" -foreground black
menu $mto -activebackground "#0083ffff0000" -foreground black
menu $min -activebackground "#0083ffff0000" -foreground black
menu $mhe -activebackground "#0083ffff0000" -foreground black
......@@ -7500,7 +7515,6 @@ proc AfficheBarreMenus {} {
$mb add cascade -label Sequences -menu $mse -underline 0
$mb add cascade -label Alignment -menu $mal -underline 0
$mb add cascade -label Structures -menu $mst -underline 0
$mb add cascade -label Tools -menu $mto -underline 0
$mb add cascade -label " ? " -menu $min -underline 1
$mb add cascade -label Help -menu $mhe -underline 0
......@@ -7632,7 +7646,6 @@ proc AfficheBarreMenus {} {
$mst add command -label "Save PDB" -command "SauveLesPDB"
# menu tools
$mto add command -label "Profile identity" -command IdentityProfileGUI
# Menu info
$min add command -label "About Ordali" -command "InfosSurOrdali"
......@@ -9401,17 +9414,18 @@ proc CheckInfosSeqs {{Liste ""}} {
if {$Liste eq ""} {
set Lids [list] ; set Lacc [list]
foreach n $LNOrdali {
if {$n ne ""} {
if {$n ne "" && $n ni $ListePDB} {
lappend Lids $n
lappend Lacc $TDesAccess($n)
}
}
} else {
# Liste not empty, so its acc
set Lacc $Liste
set Lids $Liste
set Lacc $Liste
}
puts "Lacc $Lacc"
set out [FetchInfosSeqs $Lacc]
if {$out == 0} {
# no information fetched !
......@@ -9420,6 +9434,12 @@ proc CheckInfosSeqs {{Liste ""}} {
return
}
array set Res $out
puts "\nOUTPUT:\n"
foreach k [array names Res "*,currAC"] {
puts "$k $Res($k)"
}
exit
set LaccNew [list]
foreach k [array names Res "*,currAC"] {
lassign [split $k ,] ac tmp
......@@ -9670,11 +9690,4 @@ proc posemsg {x y what} {
}
#
# ordali_cluster.tcl
#
proc DefinitionGroupes {Type {NbGr -1}} {
global Defauts Sequences LNOrdali LNDG SDG
global TabRSF TabSF yaord LesPoidsDesSequences OrdrePrecedent
......@@ -1142,6 +1148,119 @@ proc InitPremierGroupe {} {
}
proc ReadCluspackOutputFile {file aLgrp aTgrp} {
upvar $aLgrp Lgrp $aTgrp Tgrp
set Lf [LesLignesDuFichier $file]
lappend Lf ""
set i 0
foreach l [lrange $Lf 2 end] {
regsub -all { +} [string trim $l] " " l
if {[regexp -nocase {^Cluster|^Unclustered} $l]} {
incr i
set startGrp 1
lassign [split $l] tmp num tmp tmp tmp size
if {[string is integer -strict $num]} {
set ngr "gr$num"
} else {
set ngr "gr$i"
}
} elseif {$l ne ""} {
set listev [split $l "\t"]
set v [lindex $listev 0]
lappend Lv $v
} else {
if {$startGrp} {
set startGrp 0
set Tgrp($ngr) $Lv
lappend Lgrp $ngr
}
}
}
return
}
proc kir {{method ""}} {
global Cons ScoreMeth LNDG SDG Defauts
ReadCluspackOutputFile kir.clu LNDG SDG
puts "LNDG $LNDG"
set i -1
foreach g $LNDG {
incr i
if {[string first "Gr" $g] > -1} {
continue
}
set Lg [split $g ""]
set i 0
set c [lindex $Lg $i]
while {! [string is integer -strict $c]} {
incr i
set c [lindex $Lg $i]
}
set no [string range $g $i end]
set newG "Group$no"
set i [lsearch -exact $LNDG $g]
lset LNDG $i $newG
set SDG($newG) $SDG($g)
unset SDG($g)
}
puts "LNDG $LNDG"
MetAJourNomsEtSeqs
set Cons(OnlyGlobal) 0
set Cons(PDB) 0
set Cons(Title) ""
if {$method eq ""} {
set method BILD
}
set Cons(Method) $method
set Cons(Entry) ""
set Cons(ComboSel) ""
set ft [LanceCalculConservation]
set Cons(ConsCou) $ft
SauveConservation
set file "[file rootname [set Defauts(Fichier[TypeAli])]].scores"
set o [open $file w]
foreach g $LNDG {
set Lv [array names ScoreMeth "Cons-BILD,$g,*"]
puts "\ng= $g [llength $Lv]"
set Lv [lsort -dictionary $Lv]
set Lout {}
foreach k $Lv {
lassign [split $k ,] tmp tmp i
if {[string is integer -strict $i]} {
lappend Lout $i $ScoreMeth($k)
}
}
puts "Lout [llength $Lout]"
set Lres {}
set k 0
foreach {i v} $Lout {
#puts "$k $i"
while {$i > $k} {
lappend Lres -999.
incr k
}
lappend Lres $v
incr k
}
puts $o "$g;[join $Lres "\;"]"
}
close $o
exit
}
......
......@@ -1047,7 +1047,7 @@ proc EnregistreLeMac {{titre ""} {desc ""}} {
proc EnregistreInfosSeqs {} {
global db LNOrdali TDesSeqnames TDesAccess TDesBId TDesDescriptifs TDesOrganismes TDesTaxId TDesFragment TDuGroupeDesSeqs TDesEC TDesComplex TDesPhylum TDesGO TDuLineage TDesHydro TDespI
global db LNOrdali {*}[info globals "TD*"]
$db eval {begin transaction}
set pkm [MacCourant]
......@@ -1063,7 +1063,7 @@ proc EnregistreInfosSeqs {} {
if {$v eq ""} {
$db eval "update seqinfo set $c=NULL where pk_seqinfo = $pksi"
} else {
set v [string map [list "'" "''"] $v]
set v [string map {"'" "''"} $v]
$db eval "update seqinfo set ${c} = '${v}' where pk_seqinfo = $pksi "
}
} else {
......@@ -1071,7 +1071,6 @@ proc EnregistreInfosSeqs {} {
}
}
}
$db eval {commit}
return
......
......@@ -169,7 +169,9 @@ proc SelectSeqRegion {pos what {what2 ""}} {
proc ChangeFeatureForEditing {{w ""}} {
global NomTextSeq EFeat NomNomSeq
if {$w eq ""} {set w $EFeat(FeatCombo)}
if {$w eq ""} {
set w $EFeat(FeatCombo)
}
set feat [$w get]
# keep selection
......
#
# ordali_misc.tcl
#
......@@ -10477,8 +10478,7 @@ proc tms {} {
proc frat {} {
global TabSF Sequences Cons
set Cons(PDB) 1
set Cons(Method) Threshold
set Cons(Title) ""
......@@ -12306,3 +12306,28 @@ proc clau {} {
}
proc kirsley {} {
global TabSF Sequences Cons
set Cons(PDB) 0
set Cons(Method) BILD
set Cons(Title) ""
set Cons(OnlyGlobal) 0
e set Cons(Entry) ""
set Cons(ComboSel) ""
LanceCalculConservation
SauveConservation
foreach k [array names TabSF "*,Cons*"] {
#puts "$k"
set n [lindex [split $k ,] 0]
foreach f $TabSF($k) {
DecortiqueUneFeature $f d f col sc nt
if {$nt eq "IdenGlob"} {
puts "[string index $Sequences($n) $d] $d $f $col $nt"
}
}
}
exit
}
#
# ordali_misynpat.tcl
#
#lm 2015/03/18
# This script is part of the MiSynPat project.
# It checks if new aaRS PDB structures were releaseed.
......
......@@ -8,7 +8,10 @@ proc ChangeMode {{mode ""}} {
if {! [ModeI]} {return}
if {[TypeAli] eq "pasdali"} {return}
if {$mode eq "superposition" && $::ListePDB == {}} {
return
}
set modcou [QuelMode]
if {$modcou eq $mode} {return}
......@@ -801,28 +804,28 @@ proc AfficheBoutonsSuperposition {} {
set wdt [PlusLongEltDe $ListeTypesDeFeatures]
set LesTypes [linsert $ListeTypesDeFeatures 0 "None"]
ttk::combobox $ws.falcl.cft \
-state readonly \
-width $wdt \
-background white \
-values $LesTypes \
-textvariable SupFeat
-state readonly \
-width $wdt \
-background white \
-values $LesTypes \
-textvariable SupFeat
$ws.falcl.cft current 0
bind $ws.falcl.cft <<ComboboxSelected>> [list ChangeFeature %W]
button $ws.falcl.cle \
-text "Clear" \
-background white \
-command "DeselectToutesLesColonnes "
-text "Clear" \
-background white \
-command "DeselectToutesLesColonnes "
button $ws.falcl.sal \
-text "Select All" \
-background cyan \
-command "SelectionneToutesColonnes"
-text "Select All" \
-background cyan \
-command "SelectionneToutesColonnes"
grid $ws.falcl.lbf -row 0 -column 0 -sticky ew
grid $ws.falcl.cft -row 0 -column 1 -sticky ew
grid $ws.falcl.cle -row 1 -column 0 -sticky ew
grid $ws.falcl.sal -row 1 -column 1 -sticky ew
grid columnconfig $ws.falcl 1 -weight 1
frame $ws.frmsst
grid $ws.frmsst -row 0 -column 1 -sticky nw -padx 2 -pady 2
# buttons for helix and sheet
......
#
# ordali_ordali.tcl
#
proc lesso {} {
......@@ -819,7 +821,7 @@ proc PrepareRunOrdali {} {
ColorieSelonFeature "Clear"
}
MetAJourGroupes
#MetAJourGroupes
InitCouleursGroupes
InitPoints
......
#
# ordali_outils.tcl
#
proc RepresentantDeTaxId {t} {
......@@ -3165,14 +3167,14 @@ proc EstUnBonPattern {motif} {
# on cree le motif pour regexp
set motif [string map [list "<" "^" ">" "$" "X" "."] $motif]
puts "motif out : $motif"
#puts "motif out : $motif"
return $motif
}
proc CompositionAADuGroupe {{grp ""}} {
global LNDG SDG Sequences ListeDesAcidesAmines
set res [list]
foreach a $ListeDesAcidesAmines {
set n$a 0
......@@ -3182,12 +3184,12 @@ proc CompositionAADuGroupe {{grp ""}} {
set grp [lindex $LNDG 0]
}
set Ln [set SDG($grp)]
set sall ""
foreach s $Ln {
append sall [set Sequences($s)]
}
set nTot 0
foreach a $ListeDesAcidesAmines {
set stmp [string map [list $a ""] $sall]
......@@ -3195,6 +3197,7 @@ proc CompositionAADuGroupe {{grp ""}} {
set sall $stmp
incr nTot [set n$a]
}
foreach a $ListeDesAcidesAmines {
lappend res $a [expr {100.0*[set n$a]/$nTot}]
}
......@@ -3206,7 +3209,7 @@ proc CompositionAADuGroupe {{grp ""}} {
}
lappend res $m [expr {100.0*$np/$nTot}]
}
return $res
}
......@@ -3307,6 +3310,11 @@ proc IdentityProfileGUI {} {
set ret 0
set w .prmip
if {[winfo exists $w]} {
raise $w
return
}
toplevel $w
wm title $w "Identity Profile"
wm iconname $w "Profile"
......@@ -3321,7 +3329,7 @@ proc IdentityProfileGUI {} {
label $wf.lb \
-text "Identity Profile :" \
-font "Helvetica 14 bold"
set ws $wf.fs
frame $ws
label $ws.lbw \
......@@ -3450,7 +3458,7 @@ proc LanceIdentityProfile {} {
set if [expr {$wlg-1}]
set Nsq 0
foreach p [lrange $LPil $id $if] {
set p [string map [list "." ""] $p]
set p [string map {"." ""} $p]
if {[string length $p] >= 2} {
incr Nsq
}
......
......@@ -410,10 +410,6 @@ proc EnvoiePrfDatabases {} {
entry $pdbs.epd1 -bg white -textvariable TmpDef(UrlPdbWorld)
entry $pdbs.epd2 -bg white -textvariable TmpDef(UrlPdbHome)
label $pdbs.lsrs -text "Sequence Retrieval System (SRS) location :" -justify left -anchor w
entry $pdbs.esr1 -bg white -textvariable TmpDef(UrlSRSWorld)
entry $pdbs.esr2 -bg white -textvariable TmpDef(UrlSRSHome)
label $pdbs.lbrd -text "Biological Information Retrieval Database (BIRD) location :" -justify left -anchor w
entry $pdbs.ebr1 -bg white -textvariable TmpDef(UrlPdbHoan)
......@@ -421,9 +417,6 @@ proc EnvoiePrfDatabases {} {
grid $pdbs.lpdb -row 1 -column 0 -sticky news -pady {20 1}
grid $pdbs.epd1 -row 2 -column 0 -sticky news
grid $pdbs.epd2 -row 3 -column 0 -sticky news
grid $pdbs.lsrs -row 4 -column 0 -sticky news -pady {20 1}
grid $pdbs.esr1 -row 5 -column 0 -sticky news
grid $pdbs.esr2 -row 6 -column 0 -sticky news
grid $pdbs.lbrd -row 7 -column 0 -sticky news -pady {20 1}
grid $pdbs.ebr1 -row 8 -column 0 -sticky news -pady {0 10}
......
#
# ordali_residu.tcl
#
proc MontreCacheScores {pos} {
global NomTextSeq NomFenetreOrdali CestLeScore ListeScore
......@@ -630,7 +635,9 @@ proc TraiteResultatClustering {fres ident {nomgrp ""} {method "dpc"}} {
set mv 0.
set nval 0
} elseif {$l ne ""} {
if {! [info exists ngr]} {puts "[join $Lf \n]"}
if {! [info exists ngr]} {
puts "[join $Lf \n]"
}
set listev [split $l "\t"]
set v [lindex $listev 0]
lappend Lv $v
......@@ -3925,7 +3932,7 @@ proc StockScores {f g {DoNorm 1}} {
proc RunMethode {method {Grp ""}} {
global ConsMeth ScoreMeth LNDG SDG LNOrdali TableScore OrdTmpDir ListeTypesDeFeatures ListeDesPiliersDuGroupe TbScores
set NSqs [llength $LNOrdali]
set NSqs [llength $SDG(GroupeToutLeMonde)]
if {$NSqs <= 3} {
FaireLire "Too few sequences ! !"
return
......@@ -4007,7 +4014,7 @@ proc RunMethode {method {Grp ""}} {
} else {
set LGrp $Grp
}
puts "grp >$Grp< LGrp $LGrp"
if {! [info exists ListeDesPiliersDuGroupe]} {
CreeLesPiliers
}
......@@ -4221,7 +4228,8 @@ proc tpros {} {
proc Pattern2Regexp {pat} {
if {[string index $pat 0] eq "{" && [string index $pat end] eq "}"} {
if {[s
tring index $pat 0] eq "{" && [string index $pat end] eq "}"} {
set pat [string range $pat 1 end-1]
}
......
#
# ordali_selection.tcl
#
proc CutLesNoms {} {
......
......@@ -1096,11 +1096,12 @@ proc BonneSequencePourAlignement {s {outtype ""}} {
return $s
}
proc BonAccess {s} {
proc BonAccess {s {AsIs ""}} {
set s [string trim $s]
set s [lindex [split $s " "] 0]
if {[string equal -nocase $AsIs "AsIs"]} { return $s }
if {! [info exists ::Defauts] || ! [set ::Defauts(RemoveBankPrefix)]} {
return [string trim $s]
return $s
}
set a [EnlevePrefixeBank $s]
......
#
# ordali_service.tcl
#
proc InitWebServices {} {
package require WS::Client
......@@ -935,7 +941,7 @@ proc IDMapping_web {from to LId {orga ""}} {
#
# For the list of abbreviations of available
# databases, see
# http://www.uniprot.org/help/programmatic_access#id_mapping_examples
# https://www.uniprot.org/help/programmatic_access#id_mapping_examples
# for updated available databases
# Also reported below
#lm 08/04/2016
......@@ -951,7 +957,7 @@ proc IDMapping_web {from to LId {orga ""}} {
# refseq protein = P_REFSEQ_AC