etat avant installeurs

af9dbf98 · luc.moulinier · 39458774 · 39458774 · af9dbf98 · af9dbf98
Commit af9dbf98 authored Feb 11, 2019 by luc.moulinier
8 changed files
--- a/src/#ordali_web.tcl#
+++ b/src/#ordali_web.tcl#
-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
-}
-
--- a/src/LesProcsDeGscope.tcl
+++ b/src/LesProcsDeGscope.tcl
--- a/src/ordali.tcl
+++ b/src/ordali.tcl
@@ -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 #####################

+
+
--- a/src/ordali_admin.tcl
+++ b/src/ordali_admin.tcl
@@ -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"
    

--- a/src/ordali_affiche.tcl
+++ b/src/ordali_affiche.tcl
@@ -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"
+    set fgch "$w.fmol.g"
    frame $fdrt
    frame $fgch
-    set d 1
-
+    set i 0
    foreach molc $StrucAVoir {
 	set mol [DonneIdDeAccessPDB $molc]
 	set chn [DonneChainDeAccessPDB $molc]
 	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"
 	}
 	radiobutton $fbtni \
-		-text $txt \
-		-variable chxmolref \
-		-relief flat \
-		-highlightthickness 0 \
-		-value "$molc"