Skip to content

GitLab

Commit af9dbf98 authored by luc.moulinier's avatar luc.moulinier
Browse files
Options

etat avant installeurs

parent 39458774
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 17743 additions and 557 deletions
src/#ordali_web.tcl# deleted 100755 → 0
View file @ 39458774
proc httpCallback {token} {
upvar #0 $token State
# Access State as a Tcl array
if {[info exists State(error)]} {
return [set State(error)]
} else {
return "pasmarche"
}
}
proc HttpCopy {url {aliste ""} {Query ""} {args {}}} {
#rR existe dans ordali/src/ordali_web.tcl et gscope/gscope_html.tcl
#rR si aliste est vide on return la liste sinon
#rR on return 1 et la liste dans liste
#rR moumou traite aussi les redirections (jusqu'a 5 imbriquees)
#rR Si jamais ca ne marche pas voir s'il n'y a pas un autre
#rR HttpCopy dans un gscopublic ...
#lm
#lm change tous les retours pour inclure
#lm ::http::cleanup qui libere la memoire
#lm voir wiki
if {[string range $url 0 4] eq "https"} {
package require tls
::tls::init -ssl2 false -ssl3 false -tls1 true
http::register https 443 tls::socket
}
if {$aliste eq ""} {
set NothingFound ""
} else {
set NothingFound 0
upvar $aliste liste
set liste {}
}
set timeout 30000
# query est une string retour de formatQuery
if {$Query ne ""} {
#set err [catch {set token [::http::geturl $url -timeout $timeout -query $Query]} Msg]
set err [catch {set token [::http::geturl $url -query $Query]} Msg]
} else {
#set err [catch {set token [::http::geturl $url -timeout $timeout]} Msg]
set err [catch {set token [::http::geturl $url]} Msg]
}
if {[info exists token]} {
::http::wait $token
set Dtoken $token
set ncode [::http::ncode $token]
set status [::http::status $token]
if {$status eq "timeout"} {
set err 1
}
} else {
set Dtoken "none"
set status "Not applicable"
set ncode "No token"
}
#puts "ncode $ncode"
#puts "status $status"
#puts "Dtoken $Dtoken"
if {$err || ($ncode < 200 || $ncode > 302)} {
# we should clean anyway ...
if {[info exists token]} {
::http::cleanup $token
# ncode = 400 is a 'Bad request'
if {$ncode == 400} {
unset -nocomplain ::TryErrorNTimes
return $NothingFound
}
}
incr ::TryErrorNTimes
if {$::TryErrorNTimes > 5} {
Espionne "\n----------------------------"
Espionne "Msg : $Msg"
Espionne "Url : $url"
Espionne "Query : $Query"
Espionne "Status: $status"
Espionne "Code : $ncode"
Espionne "Lev 0 : [info level 0]"
catch {Espionne "Lev-1 : [info level -1]"}
Espionne "----------------------------\n"
unset -nocomplain ::TryErrorNTimes
update
return $NothingFound
}
after 3000
update
# same player shoot again
return [HttpCopy $url $aliste $Query]
}
set WithLocation [regexp -nocase {(^| )Location ([^ ]+)( |$)} [::http::meta $token] Match a urlLocation]
if { ! $WithLocation} {
#rR Cas general
# Data de la page
set liste [split [::http::data $token] "\n"]
::http::cleanup $token
unset -nocomplain ::TryHttpCopyNTimes
update
if {$aliste ne ""} {
return 1
} else {
return [join $liste "\n"]
}
}
#rR the following is to handle URL redirects
set Location $urlLocation
#lm on va re-creer un token, clean this one
::http::cleanup $token
update
incr ::TryHttpCopyNTimes
if {$::TryHttpCopyNTimes > 5} {
unset -nocomplain ::TryHttpCopyNTimes
update
return $NothingFound
}
set RetourRecursif [HttpCopy [string trim $Location] $aliste $Query]
unset -nocomplain ::TryHttpCopyNTimes
update
return $RetourRecursif
}
proc HttpCopyVieuxDeMoumou {url {aliste ""}} {
global Ntimes
if {$aliste!=""} { upvar $aliste liste }
if {[catch {::http::geturl $url} token]} {
#puts "Error $url : bad url or no network"
return 0
}
upvar #0 $token state
unset token
set liste [split $state(body) "\n"]
foreach {name value} $state(meta) {
if {[regexp -nocase ^location$ $name]} {
if {! [info exists Ntimes]} {
set Ntimes 1
} else {
if {$Ntimes < 5} {
incr Ntimes
} else {
return 0
}
}
# Handle URL redirects
puts "Location: $value"
unset state
return [HttpCopy [string trim $value] liste]
}
}
unset state
# return 1
#rR prefererait liste au lieu de 1
return $liste
}
proc HttpProgress {args} {
puts -nonewline stderr . ; flush stderr
return
}
proc HttpGetTextFromUrl Url {
set token [::http::geturl $Url -timeout 1000000]
upvar #0 $token State
::http::cleanup $token
unset token
return $State(body)
}
proc RecupereUnFichierSurWeb {molid {url ""} {bnk ""}} {
global Defauts
if {! [info exists Defauts]} {LesDefauts}
if {$url ne ""} {
set site "UNK"
set molid ""
set bnk ""
} else {
if {[EstUnAccessPDB $molid]} {
set site "Pdb"
set bnk "pdb"
#set Motor "Hoan"
set Motor "World"
} elseif {$bnk eq ""} {
set site "SRS"
set bnk "protein"
set Motor "Hoan"
} else {
set site "SRS"
set bnk $bnk
set Motor "Hoan"
}
set url [set Defauts(Url${site}${Motor})]
}
if {[set ix [string first ":" $molid]] != -1} {
set molid [string range $molid $ix+1 end]
}
set molid [DonneIdDeAccessPDB $molid]
set Leslignes {}
regsub -all "XXXX" $url $molid url
regsub -all "YYYY" $url $bnk url
HttpCopy $url Leslignes
if {$site eq "UNK"} {return $Leslignes}
if {$site eq "SRS"} {
if {$Motor eq "World"} {
set TexteHTML [join $Leslignes "\n"]
set Texte [ValeurDeLaBalise "pre" TexteHTML]
set Leslignes [split $Texte "\n"]
}
}
set head [string range [lindex $Leslignes 0] 0 1]
set tail [string range [lindex $Leslignes end] 0 2]
if { ($site eq "SRS" && $head ne "ID") || ($site eq "Pdb" && $head ne "HE" && $tail ne "END")} {
set Leslignes {}
regsub -all "XXXX" [set Defauts(Url${site}World)] $molid url
if {$site eq "SRS"} {
::http::config -urlencoding iso8859-1
}
HttpCopy $url Leslignes
if {$site eq "SRS"} {
set TexteHTML [join $Leslignes "\n"]
set Texte [ValeurDeLaBalise "pre" TexteHTML]
set Leslignes [split $Texte "\n"]
}
set head [string range [lindex $Leslignes 0] 0 1]
if { $head ne "HE" && $head ne "ID"} {
set Leslignes "ERREUR"
if {$site eq "Pdb"} {
if {[file exists "${molid}.pdb"]} {
set Leslignes [LesLignesDuFichier "${molid}.pdb"]
set head "[string range [lindex $Leslignes 0] 0 1]"
if { $head ne "HE"} {set Leslignes "ERREUR"}
}
}
}
}
return $Leslignes
}
proc thc111 {} {
set Lid [list NM_123]
set res [eFetchREST nucleotide $Lid cds]
puts "$res"
exit
}
if {0} {
Réf 68738516
commande 468955
no client 58560505
03 67 07 70 94
}
proc thc222 {} {
set query [::http::formatQuery \
db uniprot \
id Q07930 \
style raw]
puts "[HttpCopy http://www.ebi.ac.uk/Tools/dbfetch/dbfetch? "" $query]"
exit
puts [HttpCopy "http://www.ebi.ac.uk/Tools/dbfetch/dbfetch?db\=uniprot\&id\=Q07930\&style=raw"
]
exit
}
proc tlurl {} {
set Ll [LesLignesDuFichier lurl]
foreach l $Ll {
lassign [split $l " "] tmp url tmp query
set res [HttpCopy $url "" $query]
}
exit
}
src/LesProcsDeGscope.tcl
View file @ af9dbf98
This diff is collapsed.
src/ordali.tcl
View file @ af9dbf98
......@@ -2,15 +2,14 @@
##!/home/moumou/tcl8.6.4/luinst/bin/tclsh
###!/home/moumou/tmp/tcl8.6.0/install/bin/tclsh8.6
#set ::auto_path "o:/pkgconf/"
#update
#puts [package require tls]
#set ::auto_path [list "c:/TclTk64-8.6.7/lib" "o:/ordali/Build/win32-x86_64/lib"]
# Test if we are in a starpack or not
set InStarPack [regexp {app-ordalie} [info script]]
if {! $InStarPack} {
if {$tcl_version <= 8.5} {
package require TclOO
}
if {[info exists env(ORDALIDIR)]} {
set OrdaliDir $env(ORDALIDIR)
} else {
......@@ -28,14 +27,8 @@ if {! $InStarPack} {
# in starpack
set OrdaliDir [file normalize [file join [file dirname [file normalize [info script]]] .. .. ..]]
}
package require platform
puts "\nplat : [::platform::generic]"
if {[info exists GscopeDir]} {
puts "GscopeDir $GscopeDir"
} else {
puts "Pas de GscopeDir"
}
package require platform
if {! $InStarPack} {
if {[string first "linu" [::platform::generic]] == -1} {
set OrdLibDir [file join $OrdaliDir Build [::platform::generic] lib]
......@@ -44,21 +37,14 @@ if {! $InStarPack} {
set OrdLibDir [file join $OrdaliDir lib]
}
} else {
# in startpack
set OrdLibDir [file join $OrdaliDir lib]
}
set OrdEtcDir [file join $OrdaliDir etc]
set OrdEtcDir [file join $OrdaliDir etc]
set OrdSrcDir [file join $OrdaliDir src]
puts "OrdaliDir $OrdaliDir"
puts "OrdLibDir $OrdLibDir"
flush stdout
set auto_path [linsert $auto_path 0 $OrdLibDir]
set auto_path [linsert $::auto_path 0 $OrdLibDir]
if {$tcl_version <= 8.5} {
package require TclOO
}
################
# special profiling arguments
......@@ -83,9 +69,7 @@ if {! $InStarPack} {
}
set OrdaliDejaSource 0
puts "OrdSrcDir $OrdSrcDir"
source [file join $OrdSrcDir ordali_source.tcl]
puts "*RunO* [info procs "*RunO*"]"
}
set VariablesAuDepart [info globals]
......@@ -106,3 +90,5 @@ if {$retour eq ""} {
######## Ca finit ici #####################
src/ordali_admin.tcl
View file @ af9dbf98
......@@ -31,7 +31,10 @@ proc BuildDistrib {{plat ""}} {
# 1 -- libraries --
cd lib
# copying libraries
# 1 --- lib : copying libraries
# in dir moumou/pkgconf/<platform> there are all
# binary libraries. Some are compiled, other are
# taken as is on the internet (tcl3d)
puts ""
puts "copying libraries ..."
puts "[pwd]"
......@@ -41,6 +44,7 @@ proc BuildDistrib {{plat ""}} {
}
# Now copy pure tcl libraries
file copy -force {*}[glob [file join .. .. Ressources lib *]] .
# all done
cd ..
# 2 -- etc ressouces --
......@@ -53,11 +57,18 @@ proc BuildDistrib {{plat ""}} {
file copy -force {*}[glob [file join .. .. Ressources doc *]] .
cd ..
# 4 -- executable --
CreeOrdalieTclGlobal
# 4 -- create executable --
# first harvest tcl code
CreeOrdalieTclGlobal
# create executable --
CreeOrdalieStarpack $plat
# 6 -- other needed files ---
# add license, before, after installation
# text files, and icon files
file copy -force {*}[glob [file join .. Ressources *.txt]] .
file copy -force {*}[glob [file join .. Ressources *.ico]] .
puts "\ndone !\n\n"
......
src/ordali_affiche.tcl
View file @ af9dbf98
......@@ -50,14 +50,16 @@ proc DemarrageOrdali {{w ""}} {
-variable PBV
pack $w.dmg.l $w.dmg.w $w.dmg.p -side top -fill x
wm attributes $top -topmost
wm deiconify $top
FenetreAuCentre $w.dmg
raise $top
wm attributes $top -topmost
wm deiconify $top
update idletasks
raise $top
return
}
......@@ -151,7 +153,6 @@ proc LoadingAlignement {} {
proc DecortiqueEtAfficheUnMSF {{FichierMSF ""}} {
global Defauts
global menustatus
global LeFichierMSFDeDepart
global LNOrdali
global Sequences
......@@ -3706,7 +3707,7 @@ proc FinChoixPlusieursPDB {w {quoi ""}} {
proc ChoixPlusieursPDB {} {
global oldGrab grabStatus oldFocus Defauts lesbts Retour ListePDB LNOrdali
global Defauts lesbts Retour ListePDB LNOrdali
set w .pdbras
if {[winfo exists $w]} {
......@@ -3714,12 +3715,6 @@ proc ChoixPlusieursPDB {} {
return
}
set oldFocus [focus]
set oldGrab [grab current .]
if {$oldGrab ne ""} {
set grabStatus [grab status $oldGrab]
}
set ls [llength $ListePDB]
set lep [lindex $ListePDB 0]
lassign $lep mol pdb
......@@ -3734,39 +3729,44 @@ proc ChoixPlusieursPDB {} {
wm protocol $w WM_DELETE_WINDOW KillParLaCroix
label $w.t \
-text "Choose molecules you want to display with\n 3D Viewer" -justify left -anchor nw
-text "Choose molecules you want to display with\n 3D Viewer" \
-justify left -anchor nw
set i 0
set fdrt "$w.d"
set fgch "$w.g"
set fmol "$w.fmol"
frame $fmol
set fdrt "$w.fmol.d"
set fgch "$w.fmol.g"
frame $fdrt
frame $fgch
set d 1
set i 0
foreach elt $ListePDB {
if {$elt ni $LNOrdali} {continue}
lassign $elt mol pdb
set chn [DonneChainDeAccessPDB $mol]
set mol [DonneIdDeAccessPDB $mol]
lassign $elt molname pdb
set mol [DonneIdDeAccessPDB $molname]
set chn [DonneChainDeAccessPDB $molname]
set txt "$mol, chain $chn"
if {$d == 1} {
set fbtni "${fdrt}.n$i"
set d 2
} else {
if {! ($i % 2)} {
set fbtni "${fgch}.n$i"
set d 1
} else {
set fbtni "${fdrt}.n$i"
}
checkbutton $fbtni -text $txt \
lappend lesbts $fbtni
checkbutton $fbtni \
-text $txt \
-variable molref$i \
-relief flat \
-highlightthickness 0 \
-onvalue "${mol}_${chn}" \
-offvalue ""
lappend lesbts $fbtni
pack $fbtni -side top -pady 2 -padx 2
set row [expr {($i%2?$i-1:$i)/2}]
grid $fbtni -row $row -column 0 -padx 2 -pady 2 -sticky w
incr i
}
grid $fgch -row 0 -column 0 -sticky ew
grid $fdrt -row 0 -column 1 -sticky ew
grid columnconfig $fmol all -weight 1
frame $w.sdl
radiobutton $w.sdl.net \
......@@ -3776,48 +3776,51 @@ proc ChoixPlusieursPDB {} {
-anchor w -justify left \
-relief flat
radiobutton $w.sdl.loc \
-text "Download local PDB files" \
-text "Download a local PDB files" \
-value "local" \
-variable Defauts(DownloadPDB) \
-anchor w -justify left \
-relief flat
pack $w.sdl.loc $w.sdl.net -side bottom -fill x -expand 1 -pady 5
grid $w.sdl.net -row 0 -column 0 -columnspan 1 -pady 5 -sticky w
grid $w.sdl.loc -row 1 -column 0 -columnspan 1 -pady 5 -sticky w
frame $w.btn
button $w.btn.cancel -text Cancel -background red -command [list FinChoixPlusieursPDB $w dismiss]
button $w.btn.selall -text "Select All" -background yellow -command [list SelectionneTousLesPDB]
button $w.btn.cebon -text " OK " -background green1 -command [list FinChoixPlusieursPDB $w]
pack $w.btn.cancel $w.btn.selall $w.btn.cebon -side left -padx 10 -pady 10 -fill x
button $w.btn.cancel \
-text "Cancel" \
-background red \
-command [list FinChoixPlusieursPDB $w dismiss]
button $w.btn.selall \
-text "Select All" \
-background yellow \
-command [list SelectionneTousLesPDB]
button $w.btn.cebon \
-text " OK " \
-background green1 \
-command [list FinChoixPlusieursPDB $w]
grid $w.btn.cancel -row 0 -column 0 -sticky w
grid $w.btn.selall -row 0 -column 1
grid $w.btn.cebon -row 0 -column 2 -sticky e
grid columnconfig $w.btn all -weight 1
grid rowconfig $w 0 -weight 1 -minsize 0
grid $w.t -row 0 -column 0 \
-padx 5 -pady 5 -sticky ew
grid $w.fmol -row 1 -column 0 \
-padx 5 -pady 5 -sticky ew
grid $w.sdl -row 2 -column 0 \
-padx 5 -pady 5 -sticky ew
grid $w.btn -row 3 -column 0 \
-padx 5 -pady 20 -sticky ew
grid columnconfig $w 0 -weight 1 -minsize 0
grid columnconfig $w 1 -weight 1 -minsize 0
grid $w.t -padx 5 -pady 5 \
-row 0 -column 0 -rowspan 1 -columnspan 2 -sticky news
grid $w.d -padx 5 -pady 5 \
-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
grid $w.g -padx 5 -pady 5 \
-row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
grid $w.sdl -padx 5 -pady 5 \
-row 2 -column 0 -rowspan 1 -columnspan 2 -sticky news
grid $w.btn -padx 5 -pady 10 \
-row 3 -column 0 -rowspan 1 -columnspan 2 -sticky news
$w.btn.selall configure -default active
bind $w.btn.selall <Return> {SelectionneTousLesPDB}
BoutonParDefaut $w.btn.selall
MesCouleurs $w
FenetreAuCentre $w
focus $w
grab $w
vwait Retour
if {$oldFocus ne ""} {focus $oldFocus}
if {$oldGrab ne ""} {grab $oldGrab}
destroy $w
return
......@@ -3863,65 +3866,70 @@ proc ChoixPDBReference {} {
set chxmolref ""
set w .ref
set w .pdbref
if {[winfo exists $w]} {raise $w}
toplevel $w
wm title $w "Choose Reference Structure"
wm iconname $w "PDB reference"
wm protocol $w WM_DELETE_WINDOW KillParLaCroix
frame $w.r -relief flat -borderwidth 2
pack $w.r -side top -pady 10
label $w.r.t -text "Choose the reference structure \nfor superposition (the fixed structure)" -justify left -anchor w
pack $w.r.t -pady 10 -side top
set i 0
set fdrt "$w.r.d"
set fgch "$w.r.g"
label $w.t \
-text "Choose the reference structure \nfor superposition (the fixed structure)" \
-justify left -anchor w
set fmol "$w.fmol"
frame $fmol
set fdrt "$w.fmol.d"